Google
 

Trailing-Edge - PDP-10 Archives - BB-H311D-RM - monitor-sources/sched.mac
There are 52 other files named sched.mac in the archive. Click here to see a list.
; UPD ID= 5072, SNARK:<6.MONITOR>SCHED.MAC.153,   7-Nov-84 18:44:38 by MOSER
;MORE 6.2245 - REARRANGE SKDSHK TABLE - SPEED UP APSKED
; UPD ID= 5016, SNARK:<6.MONITOR>SCHED.MAC.152,  26-Oct-84 10:58:51 by LEACHE
;Add code (under EHLJSB conditional) for extended JSB
; UPD ID= 5005, SNARK:<6.MONITOR>SCHED.MAC.151,  25-Oct-84 07:25:31 by GRANT
;In SWHLT, stop the KLIPA
; UPD ID= 4978, SNARK:<6.MONITOR>SCHED.MAC.150,  22-Oct-84 16:32:32 by GRANT
;Remove references to FTCI
; UPD ID= 4952, SNARK:<6.MONITOR>SCHED.MAC.149,  18-Oct-84 14:35:40 by MOSER
;TCO 6.2245 - MAKE SCHEDULER WASTE LESS TIME IN SKDJOB
;CORRECT ACCOUNTING OF LAST THROES AT HLTFK2
;REWRITE NEWST FOR BETTER RESPONSE 
; UPD ID= 4910, SNARK:<6.MONITOR>SCHED.MAC.148,  10-Oct-84 15:50:18 by GLINDELL
;TCO 6.2241 - Call SETPSK before deleting user UPT in HLTFK2
; UPD ID= 4833, SNARK:<6.MONITOR>SCHED.MAC.147,  17-Sep-84 11:22:07 by PURRETTA
;Update copyright notice
; UPD ID= 4772, SNARK:<6.MONITOR>SCHED.MAC.146,  29-Aug-84 13:57:53 by TGRADY
;TCO 6.2202 (QAR 706091) Fix DEBRK code to ERJMP after UMOVE to prevent
; ILMNRF's from extended section user programs.
; UPD ID= 4619, SNARK:<6.MONITOR>SCHED.MAC.145,  28-Jul-84 15:54:17 by MOSER
;TCO 6.2083 - ENHANCE MONBK FACILITY
; UPD ID= 4508, SNARK:<6.MONITOR>SCHED.MAC.144,  12-Jul-84 21:56:44 by TGRADY
;TCO 6.2126 Use Global job number in GETOK% .GOCLS function
; UPD ID= 4336, SNARK:<6.MONITOR>SCHED.MAC.143,  13-Jun-84 21:42:16 by MOSER
;TCO 6.2037 - ADD BLOCKE - GO ECSKED AND BLOCK NOT IBS
; UPD ID= 4324, SNARK:<6.MONITOR>SCHED.MAC.142,  12-Jun-84 13:27:31 by MOSER
;TCO 6.2086 - FIX SHROFN UNMAP INDEX FILE
; UPD ID= 4147, SNARK:<6.MONITOR>SCHED.MAC.141,  26-Apr-84 14:00:47 by MCINTEE
;Change a CAMN to a CAME in SKDRTJ.
; UPD ID= 4091, SNARK:<6.MONITOR>SCHED.MAC.140,  17-Apr-84 16:07:14 by PAETZOLD
;More TCO 6.2032 - Change a TXZE to a TXNE in PIRQ to avoid reseting FKSTA2
; UPD ID= 4083, SNARK:<6.MONITOR>SCHED.MAC.139,  12-Apr-84 15:53:25 by TGRADY
;TCO 6.2032 - Set batch jobs in the dregs using global job number, not local.
; UPD ID= 4064, SNARK:<6.MONITOR>SCHED.MAC.138,  11-Apr-84 15:55:38 by PAETZOLD
;TCO 6.2020 - Save FKSTA2 in PIRQ and restore it in PIRQR.
; UPD ID= 3804, SNARK:<6.MONITOR>SCHED.MAC.137,  29-Feb-84 01:44:52 by TGRADY
;IMPLEMENT GLOBAL JOB NUMBERS
; -IN .TWAKE, CONVERT USER-SUPPLIED JOB NUMBER FROM GLOBAL TO LOCAL.
; -IN SKDRTJ (.SKED), CONVERT USER-SUPPLIED JOB NUMBER FROM GLOBAL TO LOCAL
; -SAME THING FOR SKDSJC...
; UPD ID= 3731, SNARK:<6.MONITOR>SCHED.MAC.136,  22-Feb-84 14:00:35 by MOSER
;TCO 6.1562 CALL SERVER IF REQUESTED IN SHORT CYCLE. REMEMBER IF WE ARE IN
; NULL JOB.
; UPD ID= 3731, SNARK:<6.MONITOR>SCHED.MAC.136,  22-Feb-84 14:00:35 by MOSER
;TCO 6.1562 CALL SERVER IF REQUESTED IN SHORT CYCLE. REMEMBER IF WE ARE IN
; NULL JOB.
; UPD ID= 3637, SNARK:<6.MONITOR>SCHED.MAC.135,   1-Feb-84 22:10:26 by MURPHY
;More 6.1525 - Make JSYSes from monitor sections .G. 1 work.
; UPD ID= 3587, SNARK:<6.MONITOR>SCHED.MAC.134,  29-Jan-84 12:11:16 by PAETZOLD
;More TCO 6.1954 - Fix day one J0NRUN and NODDMP bug.
; UPD ID= 3559, SNARK:<6.MONITOR>SCHED.MAC.133,  26-Jan-84 13:58:04 by PAETZOLD
;More TCO 6.1954 - Determine new CHKTIM and DDPTIM in NOCHKR and NODDMP code.
; UPD ID= 3540, SNARK:<6.MONITOR>SCHED.MAC.132,  25-Jan-84 15:15:28 by PAETZOLD
;TCO 6.1954 - Rework NODDMP and NOCHKR code.  Add DDMPNR and CHKRNR BUGHLTs.
; UPD ID= 3514, SNARK:<6.MONITOR>SCHED.MAC.131,  23-Jan-84 15:16:22 by MOSER
;TCO 6.1910 - ALLOW -1 IN PATADR
; UPD ID= 3450, SNARK:<6.MONITOR>SCHED.MAC.130,  12-Jan-84 15:07:45 by PAETZOLD
;TCO 6.1927 - Zero out FKPGS in HLTFK1
; UPD ID= 3446, SNARK:<6.MONITOR>SCHED.MAC.129,  12-Jan-84 14:20:26 by PAETZOLD
;TCO 6.1929 - Change FKJOBN to FKJBN
; UPD ID= 3308, SNARK:<6.MONITOR>SCHED.MAC.128,  13-Dec-83 18:15:00 by PAETZOLD
;TCO 6.1906 - Change J0NRUN to NOCHKR and add NODDMP BUGHLT.
; UPD ID= 3297, SNARK:<6.MONITOR>SCHED.MAC.127,  12-Dec-83 15:58:13 by LOMARTIRE
;TCO 6.1860 - Clear all non-zero sections during logout to prevent hanging
; UPD ID= 3268, SNARK:<6.MONITOR>SCHED.MAC.126,   6-Dec-83 17:33:04 by MOSER
;TCO 6.1827 - PREVENT ILMNRF DURING FORK CREATION
; UPD ID= 3257, SNARK:<6.MONITOR>SCHED.MAC.125,   6-Dec-83 09:22:56 by MOSER
;TCO 6.1825 - MAKE JP%SYS FORKS IMUNE FROM WINDFALL WITHHELD
; UPD ID= 3056, SNARK:<6.MONITOR>SCHED.MAC.124,  21-Oct-83 19:30:51 by MURPHY
;Get JOBNO initialized in FKSET so UCLOCK not confused.
; UPD ID= 2987, SNARK:<6.MONITOR>SCHED.MAC.123,   5-Oct-83 14:08:04 by MURPHY
;TCO 6.1815 - Fix old bugs in .DISMS and SCHEDJ.
; UPD ID= 2864, SNARK:<6.MONITOR>SCHED.MAC.122,  23-Aug-83 15:42:50 by LOMARTIRE
;TCO 6.1767 - Fix .SKBCS function of SKED to loop through all batch jobs
; UPD ID= 2832, SNARK:<6.MONITOR>SCHED.MAC.121,  16-Aug-83 12:03:57 by TGRADY
;TCO 6.1689 - Put JTDEQ back the way it was until the fork tables are completed
; UPD ID= 2800, SNARK:<6.MONITOR>SCHED.MAC.120,   4-Aug-83 00:33:09 by LEACHE
;TCO 6.1737  Add crash-on-fork facility
; UPD ID= 2771, SNARK:<6.MONITOR>SCHED.MAC.119,  27-Jul-83 11:45:24 by MURPHY
;Ditto
; UPD ID= 2766, SNARK:<6.MONITOR>SCHED.MAC.118,  25-Jul-83 17:12:34 by MURPHY
;TCO 6.1751 - SKDJFC - Don't use FX as aobjn pointer.
; UPD ID= 2705, SNARK:<6.MONITOR>SCHED.MAC.117,  19-Jul-83 08:39:26 by MILLER
;TCO 6.1689. Fix JTDEQ not to cause ILMNRF
; UPD ID= 2685, SNARK:<6.MONITOR>SCHED.MAC.116,   7-Jul-83 06:38:03 by HALL
;TCO 6.1689 - Move fork tables to extended section
;	Use DEFSTRs for fork tables
; UPD ID= 2650, SNARK:<6.MONITOR>SCHED.MAC.115,   1-Jul-83 15:22:16 by TAMBURRI
;TCO 6.1712 Remember and use the section number of the current PA1050
; UPD ID= 2638, SNARK:<6.MONITOR>SCHED.MAC.114,  27-Jun-83 16:17:30 by CHALL
;TCO 6.1673 Make FKTMI global
; UPD ID= 2623, SNARK:<6.MONITOR>SCHED.MAC.113,  21-Jun-83 19:38:06 by PAETZOLD
;TCO 6.1669 - Get rid of HPSCHKs for now.
; UPD ID= 2552, SNARK:<6.MONITOR>SCHED.MAC.112,   2-Jun-83 22:26:54 by MURPHY
;More - must have EA.ENTs in routines called from outside.
; UPD ID= 2547, SNARK:<6.MONITOR>SCHED.MAC.111,  31-May-83 16:46:14 by MURPHY
;More 6.1525 - Move class sched data to extended section.
; UPD ID= 2486, SNARK:<6.MONITOR>SCHED.MAC.110,  18-May-83 11:51:49 by MURPHY
;TCO 6.1660 - Remove RTMIN, RTMAX stuff in AJBALS.
; UPD ID= 2423, SNARK:<6.MONITOR>SCHED.MAC.108,   5-May-83 13:56:54 by RIZZOLO
; Change .DEBRK:+5/SETPCS [MSEC1,,0] to be an AC.
; UPD ID= 2422, SNARK:<6.MONITOR>SCHED.MAC.107,   5-May-83 11:16:04 by MURPHY
;More 6.1635 - Make sure environment right at PSII.
; UPD ID= 2410, SNARK:<6.MONITOR>SCHED.MAC.106,   3-May-83 16:11:51 by COBB
;TCO 6.1639 - ?s in PRINTX messages...
; UPD ID= 2386, SNARK:<6.MONITOR>SCHED.MAC.105,  29-Apr-83 15:18:13 by MCINTEE
;TCO 6.1630 - Change MONBK/PSIMB
; UPD ID= 2372, SNARK:<6.MONITOR>SCHED.MAC.104,  29-Apr-83 14:22:46 by MURPHY
;TCO 6.1635 -Use MONENV instead of MONFLG to include PCU and PCS values.
; UPD ID= 2370, SNARK:<6.MONITOR>SCHED.MAC.102,  28-Apr-83 17:12:34 by MURPHY
;Fix bug in UPD ID 1791 - PCS must be exactly 1 in DEBRK so BLT works.
; UPD ID= 2341, SNARK:<6.MONITOR>SCHED.MAC.101,  25-Apr-83 20:12:14 by MCLEAN
;TCO 6.1624. UU1050 HAS PCU IN  PC WORD
; UPD ID= 2269, SNARK:<6.MONITOR>SCHED.MAC.100,  13-Apr-83 13:02:18 by MILLER
;Conce more on the previous edit
; UPD ID= 2268, SNARK:<6.MONITOR>SCHED.MAC.99,  13-Apr-83 12:49:06 by MILLER
;TCO 6.1610. Call CFONLT when requested
; UPD ID= 2259, SNARK:<6.MONITOR>SCHED.MAC.98,  13-Apr-83 08:43:50 by MCINTEE
;stray character
; UPD ID= 2257, SNARK:<6.MONITOR>SCHED.MAC.97,  13-Apr-83 08:31:13 by MCINTEE
;Remove the last occurrence of FTNSPSRV
; UPD ID= 2244, SNARK:<6.MONITOR>SCHED.MAC.96,  12-Apr-83 13:14:48 by MCINTEE
;Remove IFNDEF FTNSPSRV
; UPD ID= 2123, SNARK:<6.MONITOR>SCHED.MAC.95,  31-Mar-83 15:52:21 by HALL
;TCO 6.1502 - Allow free space in extended sections
;	Added an EA.ENT to SAVRT to cover its call to UCLOCK
; UPD ID= 2105, SNARK:<6.MONITOR>SCHED.MAC.94,  28-Mar-83 17:46:51 by MURPHY
;Remove MONPC and MONFL no longer used.
; UPD ID= 2011, SNARK:<6.MONITOR>SCHED.MAC.93,  16-Mar-83 14:14:22 by MOSER
;TCO 6.1375 - PREVENT JOBS STUCK ON DREGS QUEUE AFTER REMOVAL
; UPD ID= 1962, SNARK:<6.MONITOR>SCHED.MAC.91,  10-Mar-83 15:07:10 by MURPHY
;Handle second PSB page consistently with first.  Change name to FKPS2.
; UPD ID= 1936, SNARK:<6.MONITOR>SCHED.MAC.90,   7-Mar-83 23:19:49 by CDUNN
;MORE TCO 6.1127 - Make SCS% JSYS locs in PSB external (for now) to clean up
;compile and syms end up in GLOBS.
; UPD ID= 1933, SNARK:<6.MONITOR>SCHED.MAC.89,   7-Mar-83 22:40:50 by CDUNN
;More TCO 6.1127 - Make PSITR1 global such that SCSPSI: (in SCSJSY)
;can return there.
; UPD ID= 1925, SNARK:<6.MONITOR>SCHED.MAC.88,   7-Mar-83 20:44:07 by CDUNN
;Make default monitor load KLIPA code
; UPD ID= 1915, SNARK:<6.MONITOR>SCHED.MAC.87,   3-Mar-83 14:24:30 by CDUNN
;More TCO 6.1127 - Add code to PIRQ to take entries off SCS% work Q and place
;on fork and CB queues for user mode SYSAP.
; UPD ID= 1881, SNARK:<6.MONITOR>SCHED.MAC.86,  27-Feb-83 22:07:09 by MURPHY
;Revise 6.1514 - Add ERJMPS and ERCALS handling. ERJMPR and ERCALR too.
; UPD ID= 1851, SNARK:<6.MONITOR>SCHED.MAC.85,  22-Feb-83 08:47:17 by LEAPLINE
;Remove conditional for KLNI. Call has been added to LV8CHK.
; UPD ID= 1849, SNARK:<6.MONITOR>SCHED.MAC.84,  21-Feb-83 17:22:19 by MURPHY
;Refine previous edit a bit.
; UPD ID= 1846, SNARK:<6.MONITOR>SCHED.MAC.83,  21-Feb-83 00:45:14 by MURPHY
;TCO 6.1517 - ITRSIM handle interal call.
; UPD ID= 1837, SNARK:<6.MONITOR>SCHED.MAC.82,  20-Feb-83 20:25:08 by MURPHY
;TCO 6.1514 - Don't clobber user AC1 if taking ERJMP/ERCAL.
;More 6.1472 - Adjust mousetraps in MENTR, etc.
; UPD ID= 1791, SNARK:<6.MONITOR>SCHED.MAC.81,  11-Feb-83 16:45:52 by MURPHY
;TCO 6.1472 - Don't clear CRSKED in ITRAP.
; Revise BUGHLTs and BUGCHKs in ITRAP; require ERJMP after nested JSYS calls.
; UPD ID= 1639, SNARK:<6.MONITOR>SCHED.MAC.80,  11-Jan-83 15:19:27 by MCINTEE
;Remove edits 1609,1616,1620 - do it in SCJSYS
; UPD ID= 1631, SNARK:<6.MONITOR>SCHED.MAC.79,   7-Jan-83 15:53:25 by MURPHY
;TCO 6.1447 - More settable scheduler parameters
; UPD ID= 1620, SNARK:<6.MONITOR>SCHED.MAC.78,   5-Jan-83 20:20:31 by NICHOLS
;Typo in previous edit, again
; UPD ID= 1616, SNARK:<6.MONITOR>SCHED.MAC.77,   4-Jan-83 13:46:11 by MCINTEE
;Typo in previous edit.
; UPD ID= 1609, SNARK:<6.MONITOR>SCHED.MAC.76,   3-Jan-83 09:01:53 by MCINTEE
;Add code to PDBK1 to avoid losing SCJSYS wakeups. (under IFE FTNSPSRV)
; UPD ID= 1583, SNARK:<6.MONITOR>SCHED.MAC.75,  27-Dec-82 17:49:11 by LEAPLINE
;Add KLNI scheduler test.
; UPD ID= 1564, SNARK:<6.MONITOR>SCHED.MAC.74,  22-Dec-82 12:58:38 by MCINTEE
;Change PSIRQ's NOSKED to check for PI in progress.
; UPD ID= 1563, SNARK:<6.MONITOR>SCHED.MAC.73,  22-Dec-82 07:36:44 by MCINTEE
;MORE TCO 6.1391 - MAKE ILUUO1 A GLOBAL !! SINCE IT IS IN GLOBS
; UPD ID= 1560, SNARK:<6.MONITOR>SCHED.MAC.72,  21-Dec-82 15:39:22 by MOSER
;TCO 6.1391 - NEW ENTRY FOR ILUUO IF ALREADY IN JSYS CONTEXT
; UPD ID= 1542, SNARK:<6.MONITOR>SCHED.MAC.70,  20-Dec-82 19:26:03 by NICHOLS
;Move DECnet-36 scheduler calls from SCHED to STG
;Feature test some more NSPSRV code
; UPD ID= 1540, SNARK:<6.MONITOR>SCHED.MAC.69,  20-Dec-82 17:45:24 by NICHOLS
;Add FTNSPSRV to distinguish between release 6.0 and 6.1
;Change BITWAI to use FORKX instead of requiring caller to pass fork number
; UPD ID= 1532, SNARK:<6.MONITOR>SCHED.MAC.68,  11-Dec-82 17:15:15 by PAETZOLD
;Delete pre release 5 edit history.  Update copyright.
; UPD ID= 1531, SNARK:<6.MONITOR>SCHED.MAC.67,  11-Dec-82 17:08:40 by PAETZOLD
;TCO 6.1413 - Add CSKBUG BUGHLT to detect excessive ECSKEDs
; UPD ID= 1346, SNARK:<6.MONITOR>SCHED.MAC.66,  18-Oct-82 12:38:54 by MOSER
;TCO 6.1310 - LOOK AT NBPROC INSTEAD OF NGOJOB WHEN DETERMINING IDLE
; UPD ID= 1337, SNARK:<6.MONITOR>SCHED.MAC.65,  13-Oct-82 18:10:52 by MILLER
;tco 6.1000. PSI code has new conventions for saving and changing PC variables
; UPD ID= 1302, SNARK:<6.MONITOR>SCHED.MAC.64,   8-Oct-82 15:13:19 by MURPHY
;MORE 5.1.1075 - Make bias 11 same as release 4.
; UPD ID= 1223, SNARK:<6.MONITOR>SCHED.MAC.63,  23-Sep-82 18:06:34 by MURPHY
;TCO 6.1280 - Revisions to NEWST.
; UPD ID= 1168, SNARK:<6.MONITOR>SCHED.MAC.62,  13-Sep-82 12:53:11 by MOSER
;TCO 6.1246 - PREVENT ILMNRF WHEN JSYS TRAPPING
; UPD ID= 1163, SNARK:<6.MONITOR>SCHED.MAC.61,  10-Sep-82 14:56:54 by MILLER
;One more time
; UPD ID= 1160, SNARK:<6.MONITOR>SCHED.MAC.60,  10-Sep-82 13:51:29 by MILLER
;TCO 6.1259. Make PIRLGO force reinit fo stack at FLOGO
; UPD ID= 1109, SNARK:<6.MONITOR>SCHED.MAC.59,  25-Aug-82 08:12:04 by MCINTEE
;TCO 6.1030 - Make BITCLR & BITSET global
; UPD ID= 1102, SNARK:<6.MONITOR>SCHED.MAC.58,  20-Aug-82 13:19:51 by MCINTEE
;TCO 6.1030 - Make SKDLCY & SKDSCY global
; UPD ID= 1099, SNARK:<6.MONITOR>SCHED.MAC.57,  19-Aug-82 14:34:46 by MCINTEE
;TCO 6.1030 - DAP% JSYS - Fix up FKDAP, and calls to it.
;  dismiss routine (BITWAI) and scheduler test routines (BITCLR, BITSET)
; UPD ID= 1005, SNARK:<6.MONITOR>SCHED.MAC.56,  27-Jul-82 15:07:38 by COBB
;TCO 6.1193 - Put Call to NBNSB under SKEDSW conditional, make NSBTAB
;bigger (100 decimal words from 20)
; UPD ID= 996, SNARK:<6.MONITOR>SCHED.MAC.55,  19-Jul-82 13:26:33 by MCINTEE
;Typo in previous edit...
; UPD ID= 975, SNARK:<6.MONITOR>SCHED.MAC.54,   6-Jul-82 12:57:24 by MCINTEE
;More TCO 6.1030 - DAP% JSYS - Add routine for DAP action interrupt (FKDAP),
;  dismiss routine (BITWAI) and scheduler test routines (BITCLR, BITSET)
; UPD ID= 960, SNARK:<6.MONITOR>SCHED.MAC.53,  24-Jun-82 13:40:24 by HALL
;TCO 6.1000 - Support the 2080
;	Use new kind of LDPAC and STPAC in JSYS entry and exit for KC
; UPD ID= 955, SNARK:<6.MONITOR>SCHED.MAC.52,  22-Jun-82 15:55:18 by MURPHY
;More 6.1160 - Replace WATCH tag lost in previous edit.
; UPD ID= 938, SNARK:<6.MONITOR>SCHED.MAC.51,  16-Jun-82 14:14:32 by MURPHY
;More 6.1160 - Discount load average by holding forks.
; UPD ID= 889, SNARK:<6.MONITOR>SCHED.MAC.50,   9-Jun-82 18:27:04 by MURPHY
;More 6.1160
; UPD ID= 887, SNARK:<6.MONITOR>SCHED.MAC.49,   9-Jun-82 16:51:39 by MURPHY
;TCO 6.1147 - Move bugdefs from BUGS.MAC to here and put them in-line.
; UPD ID= 885, SNARK:<6.MONITOR>SCHED.MAC.48,   9-Jun-82 16:29:49 by MURPHY
;TCO 6.1160 - Account IDLE time correctly.
; UPD ID= 881, SNARK:<6.MONITOR>SCHED.MAC.47,   9-Jun-82 15:09:15 by MURPHY
;Fix bug introduced in 6.1125 - NBWT going negative.
; UPD ID= 822, SNARK:<6.MONITOR>SCHED.MAC.46,   3-Jun-82 13:24:05 by HALL
;A few comments in the software interrupt code
; UPD ID= 798, SNARK:<6.MONITOR>SCHED.MAC.45,  29-May-82 16:04:16 by HALL
;TCO 6.1000 - Support the 2080
;	Use LDPAC. and STPAC. to save and restore user AC's
;	At MENT1, get section number using defstr rather than half-word instruction
;	Fix previous edit to ITRAP to diddle P correctly
; UPD ID= 761, SNARK:<6.MONITOR>SCHED.MAC.44,  18-May-82 14:59:45 by HALL
;TCO 6.1000 - Support the 2080
;	In PSI code, clean up setting of user context in flags word
; UPD ID= 756, SNARK:<6.MONITOR>SCHED.MAC.43,  15-May-82 13:44:31 by HALL
;TCO 6.1000 - Support the 2080
;	MENTU - Make TRAPSI run in section 1
;	MENT1 - Set PCS in new flags word
;	ITRAP - Save fixed-up stack pointer in MPP for MRETN
;	PSIS5 - When returning flag word in LEVTAB, return only the flag bits
;	SCDIN - Provide reasonable initial value for INSKED
;	DEBRK JSYS - Preserve only flags when comparing new and old flags words,
;		set previous context correctly on entry
;	JTENQ - Save flags from ENSKR instead of left half of CX
;	MRETN - Remove clearing of QUOTAB (appears never to be set)
; UPD ID= 744, SNARK:<6.MONITOR>SCHED.MAC.42,  13-May-82 13:52:03 by HALL
;TCO 6.1000 - Support the 2080
;	Move IMCFLG to PROLOG with other bits
; UPD ID= 712, SNARK:<6.MONITOR>SCHED.MAC.41,   9-May-82 14:35:55 by HALL
;TCO 6.1000 - Support the 2080
;	Make UUO and RMS entry get op code and AC from the right place
; UPD ID= 705, SNARK:<6.MONITOR>SCHED.MAC.40,   9-May-82 12:59:06 by HALL
;TCO 6.1000 - Support the 2080
;	SCDIN - Initialize new flags word in RSKCHK block; Make RSCCHK point
;		to section 1
;	PISC7 - Set AC blocks only on KL. Check for GOUSR only on KL. Fix new
;		flags word for XJEN
;	SCHED0 - Change inline XJRSTF to use XJRST; add AC blocks to new
;		flags word for starting at PIRQ
;	FKSET - Initialize PIPC block new flags word to set AC blocks, do same
;		for PIFL, make new flags word include user AC block
;	PIRQR - Initialize PFL correctly if going to WFORKA
;	PIRSFK - Set AC blocks in PIFL when fork is in JSYS trap queue wait
;	PIRLGO - Set AC blocks in PIFL when sending fork to FLOGO
;	PSII - At PSIS9, don't clear right half of flags for the KC; at PSIMB,
;		set AC blocks in PIFL; at PSISM, set AC blocks in PIFL when
;		forcing user mode; at PSIS4 preserve rest of flags word when
;		setting PCU and PCS.
;	PSISV1 AND PSISV0 - Put DATAO PAG under KL conditional
;	DEBRK - Preserve right half of flags word from JSYS entry when returning
;		control to the user. Clear right half of flags word when
;		comparing with LEVTAB; preserve rest of flags word when setting
;		PCU and PCS.
;	Add KIMOAC to SAVCT table for the KC
;	GOUSR - Put DATAO under KL conditional
; UPD ID= 691, SNARK:<6.MONITOR>SCHED.MAC.39,   5-May-82 00:09:54 by CDUNN
;TCO 6.1127 - Add CISRV asyncronous event simulation code to SKDLV8
; UPD ID= 688, SNARK:<6.MONITOR>SCHED.MAC.38,   4-May-82 18:01:52 by MURPHY
;TCO 6.1125 - Scheduler tests called with CALL instead of JSP.
; UPD ID= 671, SNARK:<6.MONITOR>SCHED.MAC.37,  29-Apr-82 12:31:15 by MURPHY
;Put HPSCHK back in.
; UPD ID= 511, SNARK:<6.MONITOR>SCHED.MAC.36,  16-Mar-82 20:06:34 by PAETZOLD
;TCO 6.1070 - Remove SCTLW definition
; UPD ID= 502, SNARK:<6.MONITOR>SCHED.MAC.35,  15-Mar-82 17:50:08 by COBB
;TCO 5.1754 - CHECK ARGS WHEN SETTING NEW CLASS FOR SKED JSYS
; UPD ID= 405, SNARK:<6.MONITOR>SCHED.MAC.34,  15-Feb-82 16:46:45 by MURPHY
;TCO 5.1730 - Restore lost flags, fix APSKED.
; UPD ID= 371, SNARK:<6.MONITOR>SCHED.MAC.33,   1-Feb-82 19:05:18 by MILLER
;TCO 6.1059. Treat BSCRSK and PIBMP the same as JP%SYS
; UPD ID= 370, SNARK:<6.MONITOR>SCHED.MAC.32,   1-Feb-82 16:02:33 by MILLER
; UPD ID= 368, SNARK:<6.MONITOR>SCHED.MAC.31,   1-Feb-82 13:42:25 by MILLER
;Fix missing ENDIF. in previous edit
; UPD ID= 366, SNARK:<6.MONITOR>SCHED.MAC.30,   1-Feb-82 12:56:38 by MILLER
;TCO 6.1059 AGAIN. Give JP%SYS forks a little less of a boost
; UPD ID= 364, SNARK:<6.MONITOR>SCHED.MAC.29,  30-Jan-82 16:09:41 by HALL
;More on TCO 6.1000 - removing PCU from JSTAB broke JSYS trapping
; UPD ID= 349, SNARK:<6.MONITOR>SCHED.MAC.28,  25-Jan-82 14:02:03 by MILLER
;TCO 6.1059 once more.
; UPD ID= 348, SNARK:<6.MONITOR>SCHED.MAC.27,  25-Jan-82 13:17:09 by MILLER
;TCO 6.1059. CORFCT fixes
; UPD ID= 346, SNARK:<6.MONITOR>SCHED.MAC.26,  24-Jan-82 23:49:52 by MURPHY
;TCO 5.1697 - XSSEV%, etc.  Handle extended entry vectors in UU1050, DMSENT.
; UPD ID= 335, SNARK:<6.MONITOR>SCHED.MAC.25,  21-Jan-82 11:57:49 by LEACHE
;For now, turn off HPSCHK - It's polluting CTY and ERROR.SYS
; UPD ID= 326, SNARK:<6.MONITOR>SCHED.MAC.23,  19-Jan-82 15:14:43 by MILLER
;TCO 5.1689. Fix run time guarantee
; UPD ID= 306, SNARK:<6.MONITOR>SCHED.MAC.22,  16-Jan-82 13:52:13 by PAETZOLD
;TCO 5.1680 - fix TCO 5.1658
; UPD ID= 287, SNARK:<6.MONITOR>SCHED.MAC.21,   8-Jan-82 16:40:51 by MURPHY
;TCO 5.1660 - Tags in MENTR, MRETN for JSLOOK program.
; UPD ID= 281, SNARK:<6.MONITOR>SCHED.MAC.20,   7-Jan-82 21:46:22 by PAETZOLD
;TCO 5.1658 - preserve PIFL in carrier off interrupt requests in PIRCOF and PIRLG1
; UPD ID= 213, SNARK:<6.MONITOR>SCHED.MAC.19,  18-Nov-81 17:43:55 by MURPHY
;TCO 5.1615 - MAKE SETPCV INTERNAL
; UPD ID= 208, SNARK:<6.MONITOR>SCHED.MAC.18,  13-Nov-81 13:10:31 by HALL
;TCO 6.1000 - Load full word from JSTAB in IMCLL0 code.
;	Clean up some comments
; UPD ID= 187, SNARK:<6.MONITOR>SCHED.MAC.17,   5-Nov-81 17:34:59 by HALL
;TCO 6.1000 - Clean up JSYS entry, necessary for 2080
;	Assume JSTAB doesn't contain flags. Microcode sets PCU
;	Save some code at MENTM
; UPD ID= 179, SNARK:<6.MONITOR>SCHED.MAC.16,  31-Oct-81 14:43:29 by PAETZOLD
;More TCO 6.1010 - Change CST3 references
; UPD ID= 175, SNARK:<6.MONITOR>SCHED.MAC.15,  30-Oct-81 14:59:36 by MURPHY
;Make HPSCHK less sensitive.
; UPD ID= 158, SNARK:<6.MONITOR>SCHED.MAC.14,  22-Oct-81 16:22:17 by MURPHY
;Ditto
; UPD ID= 157, SNARK:<6.MONITOR>SCHED.MAC.13,  22-Oct-81 11:37:49 by MURPHY
;Fix bug in 5.1428
; UPD ID= 108, SNARK:<6.MONITOR>SCHED.MAC.12,  15-Oct-81 13:29:37 by SCHMITT
;Reinsert TCO 5.1419 but check JOBRT instead of JOBDIR
; UPD ID= 103, SNARK:<6.MONITOR>SCHED.MAC.11,  13-Oct-81 16:19:41 by MURPHY
;Remove TCO 5.1419, ID 51 - it prevented class from being set during LOGIN
; UPD ID= 102, SNARK:<6.MONITOR>SCHED.MAC.10,  13-Oct-81 10:57:44 by MURPHY
;TCO 5.1570 - Fix bug in computation of utilization.
; UPD ID= 96, SNARK:<6.MONITOR>SCHED.MAC.9,   7-Oct-81 14:53:08 by PAETZOLD
;Remove TCO 5.1559 as it caused problems
; UPD ID= 86, SNARK:<6.MONITOR>SCHED.MAC.8,   4-Oct-81 20:23:56 by PAETZOLD
;TCO 5.1559 - Treat NVT's as real TTY's and not as PTY's in NEWST
; UPD ID= 82, SNARK:<6.MONITOR>SCHED.MAC.7,  23-Sep-81 16:25:01 by MURPHY
;TCO 5.1530 - reset local flags in AJBALS
; UPD ID= 72, SNARK:<6.MONITOR>SCHED.MAC.6,  15-Sep-81 16:02:59 by PAETZOLD
;TCO 6.1010 - Move CSTs to CSTSEC - Change CST1 non-mask references
; UPD ID= 63, SNARK:<6.MONITOR>SCHED.MAC.5,   9-Sep-81 17:27:12 by MURPHY
;Get rid of XCT of BUGHLT - make it CALL instead. (REEBUG)
;Revise previous - preserve T3 and T4 in CORFCT
; UPD ID= 55, SNARK:<6.MONITOR>SCHED.MAC.4,  25-Aug-81 09:29:51 by GRANT
;Preserve T3 and T4 over CALL CORFCT in ONGOL
; UPD ID= 50, SNARK:<6.MONITOR>SCHED.MAC.3,  11-Aug-81 14:49:11 by HALL
;Rearrange, comment
; UPD ID= 48, SNARK:<6.MONITOR>SCHED.MAC.2,  10-Aug-81 16:17:52 by HALL
;A little more cleanup
; UPD ID= 45, SNARK:<6.MONITOR>SCHED.MAC.1,   8-Aug-81 13:25:59 by HALL
;TCO 6.1000 - Remove XWD from PISC7
; 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
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED
;OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT  (C)  DIGITAL  EQUIPMENT  CORPORATION  1976, 1984.
;ALL RIGHTS RESERVED.


	SEARCH PROLOG
	TTITLE SCHED

; SCHEDULER - D. MURPHY

	IFNDEF FTKLIPA,<FTKLIPA==-1> ;Default is include KLIPA code

;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>		;GO TO ENSKED

;LOCAL ITEMS IN STG.MAC

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

;SCSJSY externals
EXTERN SCSTEQ,SCSBEQ,SCSTCQ,SCSBCQ,SCSTMQ,SCSBMQ,SCSTDQ,SCSBDQ,SCSTXQ,SCSBXQ
EXTERN SCSPSI,SCSPS0,SCSPS1

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

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


SHLTW==:30			;SCHEDULER HALT REQUEST WORD

				;MISC PARAMETERS
MINNR==:4			;MIN SIZE OF RPLQ FOR LOADING FORK
TRMINT==^D19			;FORK TERMINATION CHANNEL
DDPMAX==:^D15			;DDMP OVERDUE MAXIMUM COUNT
CHKMAX==:^D15			;CHKR OVERDUE MAXIMUM COUNT

;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

;Random constant that MACRO can't seem to get in a literal in certain places.

MSEC1A:	MSEC1,,0
;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
SK%HT2==:1B21			;NO HOLD TIME AFTER SKIPPED FORK
SK%HQR==:1B22			;HIGH QUEUE FORK HAVE PRIORITY UNDER LOAD
SK%CL1==:1B23			;CLASS SKED, USE NORMAL QUEUE PRIORITIES IF 1
;SK%BQE==:1B24			;BALSET QUEUE ON ENTRY
SK%RSQ==:1B25			;QUICK RESCHEDULE ON WAKEUPS
SK%RQ1==:1B26			;REQUEUE TO QUEUE 1
SK%TTP==:1B27			;TTY PREFERENCE
SK%WCF==:1B28			;WAIT CREDIT PROPORTIONAL TO LOAD AV
SK%TOP==:1B29			;TTY OUTPUT PREFERENCE
   >

;			C I H H H C B R R T W T
;			Y O T T Q L Q S Q T C O
;			T C 1 2 R 1 E Q 1 P F P
SKFLGV::BYTE (18) 0 (1) 1,0,1,1,1,1,1,1,1,1,1,1
	BYTE (18) 0 (1) 1,0,1,1,1,1,1,1,1,1,1,1
	BYTE (18) 0 (1) 1,0,1,1,1,1,1,0,1,1,1,1
	BYTE (18) 0 (1) 1,0,1,1,1,1,1,0,1,1,1,1
	BYTE (18) 0 (1) 1,0,1,0,1,1,1,0,1,1,1,1
	BYTE (18) 0 (1) 1,0,1,0,1,1,1,0,1,1,1,1
	BYTE (18) 0 (1) 1,0,1,0,0,1,1,0,1,1,1,1
	BYTE (18) 0 (1) 1,0,1,0,0,1,1,0,1,1,1,1
	BYTE (18) 0 (1) 1,0,1,0,0,1,1,0,1,1,0,1
	BYTE (18) 0 (1) 1,0,1,0,0,1,1,0,1,1,0,1
SKFLDF:	BYTE (18) 0 (1) 1,0,1,0,0,1,1,0,1,1,0,1 ;NORMAL DEFAULT
	BYTE (18) 0 (1) 1,0,1,0,0,0,1,0,0,1,0,1
	BYTE (18) 0 (1) 1,0,0,0,0,0,1,0,0,1,0,0
	BYTE (18) 0 (1) 1,0,0,0,0,0,1,0,0,1,0,0
	BYTE (18) 0 (1) 1,0,0,0,0,0,1,0,0,1,0,0
	BYTE (18) 0 (1) 1,0,0,0,0,0,1,0,0,1,0,0
	BYTE (18) 0 (1) 1,0,0,0,0,0,1,0,0,0,0,0
	BYTE (18) 0 (1) 1,0,0,0,0,0,1,0,0,0,0,0
	BYTE (18) 0 (1) 0,0,0,0,0,0,1,0,0,0,0,0
	BYTE (18) 0 (1) 0,0,0,0,0,0,1,0,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
;Code for crash-on-fork facility

;Crash-on-fork code for SCHED4:

DEFINE $CRSF1<
   IFN DEBUG,<
	SKIPN CRSFRF		;;Are we trying to crash on a fork?
	IFSKP.			;;Yes
	  EXCH T1,CRSFRN	;;Get fork number to crash on
	  CAME T1,FORKX		;;Is it the current fork?
	  IFSKP.		;;Yes
	    MOVE 0,[PAC+1,,1]	;;Restore AC's
	    BLT 0,17		;;...
	    MOVE 0,PAC		;;...
	    BUG.(HLT,KRSFRK,SCHED,HARD,<Crash-on-fork invoked>,<<FORKX,CRFORK>,<CRSJBN,REQJOB>>,<

Cause:  The crash-on-fork facility was invoked, scheduling the specfied
	fork and then crashing the system.  Console output includes the
	crashed fork number and the job number that requested the crash.

>)
	  ENDIF.
	  EXCH T1,CRSFRN		;;No, restore T1
	ENDIF.
  >
>

;Crash-on-fork code for SKDLV8:
;States for CRSFRF:
; .EQL. ZERO		No request made
; .EQL. -1		Request made, no PSI yet
; .GTR. ZERO		Request made, PSI given

DEFINE $CRSF2 <
   IFN DEBUG,<
	SKIPL CRSFRF		;;PSI needed for crash-on-fork?
	IFSKP.			;;Yes
	  PUSH P,T1		;;Save AC's
	  PUSH P,T2		;;...	
	  SETZB T1,CRSFRF	;;Get a zero flag-word for PSI
				;; and zero crash-on-fork flag
	  AOS CRSFRF		;;Keep crash-on-fork flag nonzero + positive
	  HRRZ T2,CRSFRN	;;Get number of fork to be crashed
	  CALL PSIGR		;;Give him a PSI
	  POP P,T2		;;Restore Ac's
	  POP P,T1		;;...
	ENDIF.
  >
>

;The routine for invoking crash-on-fork
;Args: T1/  fork to crash on

   IFN DEBUG,<
	EXTERN CRSFRN,CRSJBN,CRSFRF

CRSFRK:	HRRZM T1,CRSFRN		;Save fork # to crash on
	MOVE T1,FORKX		;Get our fork number
	HLRZ T1,FKJOB(T1)	;Get our job number
	HRRZM T1,CRSJBN		;Save it for attribution
	SETOM CRSFRF		;Turn on the crash flag
	RET			;Return and wait for the excitement
   >
;SCHEDULER INITIALIZATION

SCDIN::	SETZM SYSIFG
	SETZM PWRDWN
	SETZM FACTSW		;INITIALIZE SYSTEM FLAGS WORD
	MOVE F,SKFLDF		;SET DEFAULT CONTROL FLAGS
	MOVEM F,SCHFLG
	MOVE T1,[BUG.(HLT,SCDUUO,SCHED,HARD,<UUO IN SCHEDULER>,,<

Cause:	An illegal instruction has been executed while in
	the scheduler's context. Since the scheduler's PSB
	is only a prototype PSB and UPT, allowing this MUUO
	to behave like others results in bizarre errors
	that mask the original problem. This BUGHLT should
	be analyzed like an ILLUUO.

Action:	Most likley a software bug. Analyze this like any other
	ILLUUO.

>)]
	MOVEM T1,MJRSTF		;INIT SCHEULER'S UUO DISPTACH TO BUGHLT
	MOVEI T1,SKFLDF-SKFLGV+1 ;GET KNOB VALUE
	STOR T1,CLSKV		;SAVE IT
	MOVEI T1,0
     DO.
	SETOM @[EP. CLSSWA(T1)]	;INIT WINDFALL ALLOCATION
	CAIGE T1,MAXCLS-1
	AOJA T1,TOP.
     ENDDO.
	MOVEI T1,UTLTMI*UTLINI	;DEFAULT INTERVAL FOR UTIL
	MOVEM T1,UTLINT		;SET UP INTERVAL
	SETZM UTLTIM		;WHEN TO COMPUTE UTILIZATION
	MOVX T1,MONENV		;INITIALIZE NEW FLAGS WORD FOR MONITOR MODE
	MOVEM T1,RSKCHK+2	; FOR XCT RSKED
	MOVE T1,[MSEC1,,RSKCH1]	;INITIALIZE NEW PC
	MOVEM T1,RSKCHK+3	; FOR XCT RSKED
	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
	MOVEI T1,1		;ANY POSITIVE VALUE WILL DO
	MOVEM 1,INSKED		;INDICATE IN THE SCHEDULER
	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
	MOVX T1,<1B1>		;GET A LARGE TIME VALUE
	MOVEM 1,CHKTIM		;PREVENT CHKR ALARM UNTIL INITIALIZED
	MOVEM 1,DDPTIM		;PREVENT DDMP 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::	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 SRVSKD		;MSCP SERVER REQUEST OR
	SKIPE CFSSKC		;Check on CFS interconnect?
	AOS SKEDF3		;Yes. Make the scheduler run
	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. On the KC, new flags word for interrupt
;set the AC blocks to make monitor be current and user be previous. On the
;KL, we have to set them here.

PISC7A:
   IFN KLFLG,<
	DATAO PAG,SETMON	;SET MON CONTEXT
   >				;END OF IFN KLFLG
	MOVEM 17,PAC+17		;SAVE PROCESS AC'S
	MOVEI 17,PAC
	BLT 17,PAC+16
	DMOVE T1,PISC7R		;GET FLAGS AND PC

;On the KL, the process could be at GOUSR, in which case it would have set
;the current AC block to be user, in preparation for returning to the user.
;If so, back up the PC so that the DATAO can be executed again when the
;process is resumed. This isn't necessary on the KC since XJRSTF sets the
;block

   IFN KLFLG,<
	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.
   >				;END OF IFN KLFLG
	DMOVEM T1,PFL
	MOVE 1,RSKEDN		;RESET NOSKED TRAP
	MOVEM 1,RSKED
	AOS INSKED
	JSP FX,KISSAV		;SAVE APR-DEPENDENT STUFF
	XJEN [MONENV
	     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

;Prepare to tell the hardware what AC blocks to use, based on the user
;mode flag in the new flags word. On the KC, the setting of the AC blocks
;will be done by the XJEN below. On the KL, we do it with a DATAO.

   IFN KLFLG,<
	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
   >				;END OF IFN KLFLG
	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
   IFN KLFLG,<
	DATAO PAG,SETPAG	;SET AC BLOCKS
   >				;END OF IFN KLFLG

;See whether process was NOSKED or running in critical code. If so, set
;up RSKED so that the scheduler will be run as soon as possible.
;In either case, dismiss the interrupt and run the process.

	SKIPN NSKED		;RESUMING NOSKED PROCESS?
	SKIPE CRSKED		;OR CSKED PROCESS?
	SKIPA
	XJEN PFL		;RUN PROCESS
	AOS SKEDF3		;YES, REMEMBER SCHEDULING NEEDED
	MOVEM 1,RSKED		;SAVE THE AC
	MOVE 1,RSKEDT		;GET THE XPCW TO FORCE SCHEDULER TO RUN
	EXCH 1,RSKED		; WHEN THE PROCESS ALLOWS IT
	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.(HLT,OKSKBG,SCHED,SOFT,<OKSKD0 - OKSKED WHEN NOT NOSKED>,<<CX,ADR>>,<

Cause:	An OKSKED or OKSKD1 was done when the code was not NOSKED.
	This is bad as sensitive code may be getting messed up due to
	races etc...  A NSKDIS would probably have resulted when a
	DISMS was done later on.

>)
	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
	JE FKPS0,(FX),R		;RETURN IF NO INTERRUPT IS PENDING
	AOS SKEDF3		;REQUEST RESKED
	ISB SCDCHN		;INTERRUPT ON SCHEDULER CHANNEL
	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)
	SKIPG CRSKED		;REALLY CSKED?
	 BUG.(HLT,CSKBUG,SCHED,SOFT,<ECSKED WHEN NOT CSKED>,,<

Cause:	An ECSKED was done when the code was not really CSKED. This is
        bad  as  sensitive code may be getting messed up due to races
        etc...

>)
	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.(HLT,NSKDIS,SCHED,HARD,<DISMISS WHILE NOSKED OR WITH NON-RES TEST ADDRESS>,,<

Cause:	A process has declared its intention to cease running (dismiss) until
	a particular event occurs. The scheduler will test for the occurrence
	of the event by calling a routine that the process has provided.  The
	BUGHLT occurs if one of the following happens:
		1. The process has already declared itself to be
		NOSKED, thereby preventing the running of other processes;
		2. The test routine is in  part of the monitor's swappable code
		and could therefore cause an illegal page fault in the
		scheduler.

>)
	STOR T1,FKSTX,(FX)	;PUT IN TEST WORD
	; ..
	; ..
FRIBP2::!			;(WATCH BPT TAG)
	CALL SAVRT		;
	LOAD 1,FKSTR,(FX)	;GET SCHEDULER TEST
	CAIE 1,HALTT		;FORK TERMINATING?
	CAIN 1,FORCTM
	CALL SUPUNB		;YES, UNBLOCK SUPERIOR IF NECESSARY
	MOVE T3,JOBNO		;GET JOB NUMBER
	MOVE T3,@[EP. 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
	IFE. T2			;IF 0 HOLD TIME,
	  CALL REMBSJ		;IF 0 HOLD TIME, REMOVE IMMEDIATELY
	  CALL GLREM		;REMOVE FROM GOLST
	  CALL WTCONC
	  SETOB FX,FORKX
	  JRST SCHED0
	ENDIF.
	MOVE 1,TODCLK		;HOLD IN BALSET
	ANDI 1,377777
	ADDI 1,0(2)		;CONSTRUCT SPECIAL TEST FOR HOLD TIME
	STOR T1,FKPTD,(FX)	;SAVE TEST DATA
	MOVEI 1,DISMT
	STOR 1,FKPTR,(FX)	;SAVE TEST ROUTINE
	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
	STOR 1,FKPTX,(FX)	;SAVE SCHEDULER TEST WORD
	DMOVE 1,SKDFL		;GET FLAGS AND PC
	DMOVEM 1,PFL		;SAVE THEM IN PSB

IFN SKEDSW,<

	HRRZ T1,PPC		;Keep a record of PC's that call this routine
	SKIPE NSKED		;BLOCK WHILE NOSKED?
	CALL NBNSB		;YES, SAVE PC

	>			;END IFN SKEDSW

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

SCHP3:	MOVE 1,TODCLK		;REMEMBER TIME WAIT STARTED
	STOR 1,FKNB%,(FX)
	AOS NBWT		;COUNT WAITING BALSET PROCESS
	LOAD T1,FKPTR,(FX)	;GET SCHEDULER TEST ROUTINE
	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:	OPSTRM <IORM T1,>,FKSWX,(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.(HLT,ILOKSK,SCHED,,<OKSKED EXECUTED WHEN NOT NOSKED>,,<

Cause:	A process has declared itself to be OKSKED and ready to cease running
	(dismiss) until some event occurs.  This BUGHLT occurs because the
	process is OKSKED, indicating a mismatch of NOSKED and OKSKED states.

>)
	SOS INTDF		;FIX UP NOINT AS WELL
	JRST SCHP1
;COMMON SCHEDULER ENTER ROUTINE, SAVE AC'S
; ** INSKED MUST BE NON-0 BEFORE THIS CALL **

;Here via ENTSKD macro, which executes XPCW ENSKR

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
	MOVSI T1,MSEC1
	HLLM T1,ENSKR+1		;FORCE RETURN TO SECION 1
	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.(HLT,SKDCL1,SCHED,HARD,<CALL TO SCHEDULER WHEN ALREADY IN SCHEDULER>,,<

Cause:	Code running in scheduler context has attempted to dismiss, block
	or page fault thereby trying to enter scheduler context again.
	This might result from an unexpected page fault or faulty logic,
	i.e. the code doing the dismiss was not expected to be run
	in scheduler context.

>)		;SOME SORT OF DISMISS IN SCHED

IFN SKEDSW,<
;ROUTINE TO SAVE PC'S WHICH CAUSE NOSKED BLOCKS
;CALLED FROM PGRTRP ALSO.  ALL CALLS CURRENTLY UNDER SKEDSW CONDITIONAL
; 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==^D100			;SIZE OF PC TABLE
RS NSBTAB,NNSBT			; PC,,COUNT
RS NNSBE,1			;NUMBER OF ENTRIES IN USE
	>			;END IFN SKEDSW
	SUBTTL Instruction trapping (ITRAP)

;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
ITRAP::	MOVEM T2,LSTIPC		;SAVE LAST ITRAP PC

;Check for illegal conditions

	SKIPE INSKED
	BUG.(HLT,SKDTRP,SCHED,HARD,<INSTRUCTION TRAP WHILE IN SCHEDULER>,<<KIMUPC,PC>,<LSTERR,LSTERR>,<LSTIPC,ERRPC>>,<

Cause:	An error occurred, resulting in an illegal instruction
	trap. If a JSYS is being executed by the monitor, the
	process normally receives an error return when this happens.
	However, in this case the error occurred in the scheduler,
	and there is no recovery.

Data:	1. PC of last MUUO.  This may or may not be relevant.
	2. Last error code.  This may indicate where error was generated.
	3. PC where ITRAP was called.

>)
	SKIPL FORKX		;NO FORK RUNNING, OR
	CONSZ PI,177B27		;PI IN PROGRESS?
	BUG.(HLT,PIITRP,SCHED,HARD,<INSTRUCTION TRAP WHILE PI IN PROGRESS OR IN SCHEDULER>,<<LSTERR,LSTERR>,<LSTIPC,ERRPC>>,<

Cause:	An error occurred, resulting in an illegal instruction trap. If a JSYS
	were being executed by the monitor, the process would receive an
	error return.  However, in this case the error occurred  while a
	hardware interrupt (PI) was being processed, or while the monitor was
	executing code that starts the scheduler cycle.

Data:	1. Last error code.  This may indicate where error was generated.
	2. PC at which error was generated.
>)
	SKIPL SLOWF		;NOW IN SLOW CODE?
	IFSKP.
	  BUG.(HLT,ITNOJC,SCHED,HARD,<INSTRUCTION TRAP NOT IN JSYS CONTEXT>,<<LSTERR,LSTERR>,<LSTIPC,ERRPC>,<KIMUPC,MUUOPC>>,<

Cause:	The illegal instruction trap handler has been entered, but the
	process is not in JSYS context.

Data:	1. Last error code.
	2. PC at which error was generated.
	3. Last MUUO PC.
>)
	ENDIF.
	DMOVE 1,KIMUU1		;GET LAST USER MUUO
	DMOVEM 1,UMUUOW		;SAVE AS TRAPPED INSTRUCTION
	MOVE P,MPP		;GET LAST STACK FRAME
	SETZM INTDF		;NORMALIZE AND PREVENT INTERRUPTS

;See if previous context is monitor and ERJMP present.

	DMOVE T1,-1(P)		;GET RETURN PC AND FLAGS
	EXCH T1,T2		;IN PROPER ORDER...
	TXNE T1,UMODF		;FROM MONITOR?
	IFSKP.
	  CALL ITRSIM
	ANSKP.
	  MOVEM T3,-1(P)	;ERJMP BACK TO MONITOR, OK.
	  JRST MRETN		;DO IT
	ENDIF.

;Here if the previous level was user or monitor without ERJMP.

;We should not be NOSKED or CSKED.  I.e., the
;JSYS code at this level should have cleaned up before
;going to ITRAP.  If it didn't, the trap is probably unexpected.

	SKIPN CRSKED
	SKIPE NSKED		;CHECK FOR PROPER STATE
	  BUG.(HLT,NOSKTR,SCHED,SOFT,<ITRAP FROM NOSKED OR CSKED CONTEXT>,<<KIMUPC,MUUOPC>,<LSTERR,LSTERR>,<LSTIPC,LSTIPC>>,<

Cause:	An illegal instruction trap has occurred while the process
	was NOSKED or CSKED.  This suggests that important
	resources may be left locked.

Action:	See if this is reproducible, and if so, report the
	sequence to Software Engineering.

Data:	1. PC of last MUUO.
	2. Last error code.
	3. PC from which ITRAP was called.
>)

;See if previous context was user

	TXNN T1,UMODF
	IFSKP.
	  CALL ITRSIM		;YES, CHECK FOR ERJMP
	   JRST ITR2		;NONE, GO DO INTERRUPT
	  MOVEM T3,-1(P)	;YES, DO IT
	  JRST MRETN
	ENDIF.

;Here only if previous context is monitor without ERJMP.

	BUG.(CHK,MONNEJ,SCHED,SOFT,<NESTED JSYS WITHOUT ERJMP>,<<T1,FLAGS>,<T2,PC>>,<

Cause:	An illegal instruction trap has occured and the previous context
	is the monitor, but no ERJMP is present following the nested
	JSYS call.  This violates required coding practice because
	the previous context may have locks that need to be released.

Action:	If this is reproducible, report the circumstances to
	Software Engineering.

Data:	1. Flags;
	2. PC at which faulty nested JSYS was done.
>)

	JRST MRETN		;RETURN +1 ANYHOW


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

ITR2:	MOVE 1,CHNSON
	ANDCAM 1,PSIBW		;FLUSH PREVIOUS PANIC BREAKS
	MOVEI 1,.ICILI		;INITIATE CHANNEL 15 INTERRUPT
	CALL PSIRQ0
	CHKINT			;GET THE INTERRUPT "SEEN"
	OKINT			;INTERRUPT SHOULD TAKE HERE
	JRST MRETN
;BLOCK UNTIL CONDITION SATISFIED
;BLOCK0 - STAYS IN BALSET,  BLOCK1 - LEAVES BALSET
;BLOCKE - LIKE BLOCK1 BUT GO ECSKED FIRST

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

BLOCKE::PUSH P,CX		;SAVE CX
	ECSKED			;NOT CRITICAL NOW
	POP P,CX		;RESTORE CX
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
	SKIPA 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,FKJBN		;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 T1,0(T1)
	CALL GL2LCL		;CONVERT GLOBAL JOB NUMBER TO LOCAL INDEX
	 RETERR()		;ILLEGAL JOB NUMBER
	SKIPGE JOBRT(T1)		;AND JOB EXISTS?
TWAKER:	RETERR ATACX1		;NO
	HRRZ T2,JOBDIR(T1)	;GET LOGIN DIRECTORY
	JUMPE T2,TWAKER		;ERROR IF JOB NOT LOGGED IN
	MOVSI T2,(JWAKEF)
	IORM T2,JOBNAM(T1)	;SEND SIGNAL
	SMRETN
	SUBTTL Null Job

;SCHEDULER

;'NULL' JOB - WAITS WHEN NO FORKS RUNNABLE

SCDNUL:	SETOM NULJBF		;TELL THE WORLD WE ARE IN THE NULL JOB
SCDNL2:	SKIPE PSKD1		;ANY BS (POSSIBLE) WAKEUPS
	JRST SCDNL1		;YES, CHECK BS
	SKIPN PSKED		;OR DEFINITE CHANGES OF STATE?
	SKIPE SKEDF3		;SCHEDULING REQUESTS?
	JRST SCDNL1		;YES
	JRST SCDNL2		;NO

SCDNL1:	SETZM NULJBF		;NO LONGER IN THE NULL JOB
	CALL RDSIVL		;GET LAST INSKED INTERVAL
	SKIPN NBSWP		;FORKS WAITING FOR SWAPPING?
	IFSKP.
	  ADDM T1,SKDSWP	;YES, CHARGE SWAP-WAIT TIME
	ELSE.
	  SKIPN T2,NBPROC	;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.(HLT,PISKED,SCHED,HARD,<ENTERED SCHEDULER WITH PI IN PROGRESS>,,<

Cause:	The monitor started to execute the main scheduler routine.  The
	hardware indicates that a hardware interrupt is being held. Since
	hardware interrupts operate at a higher priority than the scheduler,
	this should not happen.
>)

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

	XJRSTF [MONENV
		MSEC1,,.+1]	;SECTION 1 DAMMIT
	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
	SKIPN CFSSKC		;Need to check on CFS?
	IFSKP.			;If so
	 SETZM CFSSKC		;Clear this
	 CALL CFONLT		;And do the checking
	ENDIF.
	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
	JN FKPS0,(FX),SCHED5	;IF PSI REQUEST PENDING, GO CHECK IT

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

SCHED4:	$CRSF1			;Generate code for crash-on-fork facility
	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:	TMNN FKPS1,(FX)		;PSI NOW BEING DEFERRED?
	SKIPE NSKED		;NO. NOSKED FORK?
	JRST SCHED4		;YES, CONTINUE CURRENT SEQUENCE
	MOVX T1,FKPSI1		;CLEAR WORD EXCEPT FOR PI IN PROG
	OPSTRM <EXCH 1,>,FKINX,(FX)
	MOVEM 1,PIMSK		;PASS REQUEST WORD TO SERVICE ROUTINE
	DMOVE T1,PFL		;SAVE PROCESS PC FOR PSI HANDLER
	DMOVEM T1,PIFL
	DMOVE T1,[MONENV	;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:	$CRSF2			;Generate code for crash-on-fork facility
	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
	SKIPE SRVSKD		;NEED TO CHECK SERVER
	CALL MSSCHK		;YES, DO IT.
	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
	SKIPGE FX,FORKX
	IFSKP.
	  CAME FX,LSTPFK	;SEE IF CONTEXT STILL SETUP
	  CALL SETPPG
	  MOVEM FX,LSTPFK
	ENDIF.

;Set up to get next timer interrupt. Timer interrupts every millisecond.
;When SCKATM goes to  zero, APRSRV generates a channel 7 interrupt. New
;value depends on setting of bias knob.

	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
	SKIPGE SCDRN1		;RUNNING SPECIFIC JOB?
	IFSKP.
	   MOVX T1,<1B1>       	;GET MASK FOR A LONG TIME FROM NOW
	   MOVEM T1,CHKTIM	;YES, DISABLE CHKR CHECK
	   MOVEM T1,DDPTIM	;AND DISABLE DDMP CHECK
	ENDIF.
	MOVE T1,TODCLK		;GET THE CURRENT TIME
	CAMGE T1,CHKTIM		;CHKR OVERDUE?
	 JRST CLK3		;NOT OVERDUE
	AOS T1,CHKDUE		;BUMP THE COUNT OF OVERDUES
	CAIL T1,CHKMAX		;HAS IT BEEN OVERDUE TOO LONG?
	BUG.(HLT,CHKRNR,SCHED,SOFT,<CHKR FORK NOT RUN FOR TOO LONG>,,<

Cause:	The  monitor  creates  a fork in job zero that exists for the life of
	the  system.  This  fork  runs  periodically  to  perform   essential
	functions.  The  BUGHLT  occurs  when the scheduler detects that the
	CHKR fork has not run in too long a time.

	Possible causes for CHKR not running include the following:
		1. A disk failure that prevents fork 0 from updating the disk
		2. Removal of a  mounted structure
		3. Logic errors in the monitor.
		4. An HSC or MSCP server disk is hung.

>)
	CAIE T1,1		;IS THIS THE FIRST TIME?
	BUG.(CHK,NOCHKR,SCHED,SOFT,<CHKR FORK BLOCKED>,<<T1,D>>,<

Cause:	The CHKR fork has not run in a while.  The monitor is getting
	nervous.  If the CHKR fork continues to not run for a long time
	the a CHKRNR BUGHLT will result.
>)
	AOS JB0FLG		;MAKE SURE CHKR WILL RUN
	MOVE T1,TODCLK		;GET THE CURRENT TIME
	ADD T1,CHKPER		;GET THE ALARM TIME
	MOVEM T1,CHKTIM		;SET THE ALARM TIME
CLK3:				;HERE AFTER CHECKING UP ON CHKR
	CAMGE T1,DDPTIM		;DDMP OVERDUE?
	 JRST CLK4		;NOT OVERDUE
        AOS T1,DDPDUE		;BUMP THE OVERDUE COUNT
	CAIL T1,DDPMAX		;OVERDUE TOO LONG?
	BUG.(HLT,DDMPNR,SCHED,SOFT,<DDMP FORK NOT RUN FOR TOO LONG>,,<

Cause:	The  monitor  creates  a fork in job zero that exists for the life of
	the  system.  This  fork  runs  periodically  to  perform   essential
	functions.  The  BUGHLT  occurs  when the scheduler detects that the
	DDMP fork has not run in too long a time.

	Possible causes for DDMP not running include the following:
		1. A disk failure that prevents fork 0 from updating the disk
		2. Removal of a  mounted structure
		3. Logic errors in the monitor.

>)
	CAIE T1,1		;IS THIS THE FIRST TIME?
	BUG.(CHK,NODDMP,SCHED,SOFT,<DDMP FORK BLOCKED>,<<T1,D>>,<

Cause:	The DDMP fork has not run in a while.  The monitor is getting
	nervous.  If the DDMP fork continues to not run for a long time
	the a DDMPNR BUGHLT will result.
>)
	MOVE T1,TODCLK		;GET THE CURRENT TIME
	ADD T1,DDPPER		;GET THE NEXT ALARM TIME
	MOVEM T1,DDPTIM		;SETTHE NEXT ALARM
CLK4:				;HERE AFTER CHECKING UP ON DDMP
	CALL BSBCK
	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,NBWT		;DISCOUNT BY FORKS IN BS WAIT 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
	IDIVI T1,NTMS
	MOVEM T1,SKDTM0
	MOVE T1,SKDSWP
	IDIVI T1,NTMS
	MOVEM T1,SKDTM1
	MOVE T1,SKDOVH
	IDIVI T1,NTMS
	MOVEM T1,SKDTM2
	RET
;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,@[EP. 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,@[EP. CLSSUM(Q1)]	;GET INTEGRAL
	MOVE T2,@[EP. CLSSHR(Q1)]	;GET SHARE
	CAMGE T2,@[EP. CLSUTL(Q1)]	;GOT ANY WINDFALL?
	MOVE T2,@[EP. CLSUTL(Q1)]	;YES. USE UTIL THEN
	FDVR T1,T2		;SCALE
	JFOV [	FLTR T1,@[EP. CLSSUM(Q1)] ;IF OVERFLOW, USE SUM AS INTEGRAL
		JRST .+1]	;AND PROCEED
	SETZM @[EP. CLSSUM(Q1)]	;NO SUM NOW
	MOVEI T2,0(Q1)		;GET CLASS
	IMULI T2,NRJAVS		;FIND N-WORD CHUNK FOR THIS CLASS
	ADD 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 - 30-BIT ADDRESS

DORJ1:	FLTR T1,T1		;FLOAT INTEGRAL
DORJ2:	FDVRI T1,(1000.0)	;DIVIDE BY 1 SECOND
	JFOV .+1		;CLEAR OV FLAG
	MOVEI T3,0
	TDO T2,[EP. 0(T3)]	;MAKE EFIW INDEXED BY T3
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
	CAIGE T3,NRJAVS-1
	AOJA T3,SCHC1
	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 and shutdown system
;	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.
;This will lead to shutdown of system, or breakpoint if set, at SCWAIT.

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
   IFN FTKLIPA,<XCT XCKLP>	;STOP THE KLIPA
	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.(CHK,SRQBAD,SCHED,HARD,<SCDRQ-BAD CALL TO SCDRQ7>,,<

Cause:	SCDRQ7 has been called with a function it does not know about.

Action:	Fix the call or fix SCDRQ7 to know about this function.

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

;Job creation effectively starts here. If called by TTYSRV, a terminal
;has been assigned (because CTRL/C was received on it). This routine picks
;a job number, allocates job storage, and creates the top fork. It then
;sets NEWJB% and NEWFK% in the top fork's FKINT word. Ultimately the fork
;gets to PIRQ with NEWFK% and NEWJB% set.

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 @[EP. 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,@[EP. JOBCLS(T2)]	;INIT TO DEFAULT CLASS
	AOS @[EP. 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,FKJBN		;LEAVE JOB NUMBER IN FORK
	CALL ASFSB		;ASSIGN JSB
	STOR 1,FKJSB
   IFDEF EHLJSB,<
	CALL ASSPT		;Assign SPT slot for extended JSB
	STOR T1,FKJPT		;Save it
   >
	MOVE T1,Q1		;TTY NUMBER
	TXO T1,NEWJB%
	OPSTRM <IORM 1,>,FKINX,(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
	SETZRO FKQ2X,(FX)	;INIT FLAGS AND Q VALUES
	MOVEI 1,JSKP
	STOR 1,FKSTR,(FX)	;INIT STATUS
	SETZRO FKSTD,(FX)	;CLEAR DATA FOR SCHEDULER TEST
	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
	STOR 1,FKTIM,(FX)
	MOVX 1,FKPSI0+NEWFK%
	STOR 1,FKINX,(FX)	;LEAVE INTERRUPT REQUEST
	SETONE PIBMP		;BE SURE IT RUNS ASAP
	SETZRO FKSWX,(FX)
	SETZM FKPT(FX)
	SETZRO FKIBX,(FX)
	SETZRO FKPSB		;CLEAR SPT SLOT FOR PSB
	SETZRO FKUPT		;CLEAR SPT SLOT FOR SECTION 0 MAP
	SETZRO FKPS2		;CLEAR SPT SLOT FOR SECOND PSB PAGE
	SETZRO FKJSB		;CLEAR SPT SLOT FOR JSB
	SETZRO FKJBN		;CLEAR JOB NUMBER
	SETZRO FKNWCE		;CLEAR NUMBER ENTRIES IN WORKING SET CACHE
	SETZRO FKCSIZ		;CLEAR CURRENT SIZE
	MOVEI T1,100100		;INIT CURRENT AGE TO 100
	STOR T1,FKAGE
	MOVEI T1,3		;INIT WORKING SET TO 3
	STOR T1,FKWSS
	CALL ASFSB		;ASSIGN PSB
	STOR 1,FKPSB
	CALL ASFSB		;ASSIGN UPT
	STOR 1,FKUPT
	CALL ASFSB		;GET ONE FOR THE STACK PAGE
	STOR T1,FKPS2		;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

;RETURNS +1: ALWAYS,
;	FX/ FORK HANDLE OF FORK TO RUN
;		OR
;	FX/ -1 IF NO FORK RUNNABLE

SKDJOB:	SETZM PSKED		;CLEAR WAKEUP FLAG
	SETZM PSKD1		;AND POSSIBLE BS WAKEUP FLAG
	SETZM SKDFST		;RUNNING FAST
	SKIPGE FX,SSKED		;CURRENTLY A NOSKED FORK?
	IFSKP.
	  LOAD T1,FKSWX,(FX)	;GET SWAP FLAGS
	  JXE T1,FKGL%,BKGND1
	  JXE T1,FKWSL,BKGND1
	  TXNN T1,BSWTB		;IN BS WAIT?
	  JRST SKDJ2		;NO RUN IT
	  CALL SKDJ3		;YES. STILL?
	   JRST BKGND1
	  JRST SKDJ2		;NOW RUNNABLE
	ENDIF.

	HRRZ FX,GOLST		;SCAN GOLST FOR FORK TO RUN
SKCB5:	JUMPE FX,BKGND1		;NO RUNNABLE FORK
	SUBI FX,FKPT		;GET FORK INDEX
	HRRZ Q1,FKPT(FX)	;Q1 IS NEXT FORK TO SCAN
	LOAD T1,FKSWX,(FX)	;GET SWAP FLAGS
	JXE T1,FKWSL,SKCB2	;IF NOT LOADED, SKIP IT
	JXE T1,BSWTB,SKDJ2	;JUMP IF RUNNABLE
	CALL SKDJ3		;NO, TEST IT
	 SKIPA
	JRST SKDJ2		;RUN IT
SKCB2:	MOVE FX,Q1		;GET NEXT FORK
	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 WAITING BALANCE SET FORKS

BSBCK:	SKIPL FORKX		;FORK CONTEXT SETUP
	BUG.(HLT,SKDFKS,SCHED,HARD,<ILLEGAL SCHEDULER ACTION WHILE FORK CONTEXT SETUP>,,<

Cause:  The scheduler was about to perform an action that requires that no fork
	context is setup. The monitor found that FORKX was non-negative which
	indicates that fork context was setup.

Cure:	Change the monitor to call DISMSJ before callint the offending
	routine or move the call to a more appropriate place. CLK2 always
	forces DISMSJ and is usually a good place for periodic actions.
>)
	SETOM SKDFST		;NOT RUNNING FAST
	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
	HRRZ FX,GOLST
BSBCK1:	JUMPE FX,R		;DONE
	SUBI FX,FKPT
	HRRZ Q1,FKPT(FX)	;Q1 IS NEXT FORK TO SCAN
	LOAD T1,FKSWX,(FX)
	JXE T1,BSWTB,BSBCK2	;JUMP IF NOT BLOCKED
	CALL SKDJ3		;TEST IT - REMOVE FROM BS WAIT IF DONE
	 JFCL
BSBCK2:	MOVE FX,Q1		;STEP LIST
	JRST BSBCK1
;FOUND NO FORK TO RUN

BKGND1:	CALL UPDTCK		;UPDATE TODCLK
	MOVSI P1,-NSHAKL	;TRY TO SHAKE LOOSE A JOB
	MOVE P2,NGOJOB		;GET NUMBER OF JOBS ON GOLST
BKGND3:	SKIPN PSKD1		;ANY EVENTS?
	SKIPE PSKED
	JRST BKGND2		;YES!
	PUSH P,P2		;*** P2 TRASHED BY SOME SCHED ROUTINES
	XCT SKDSHK(P1)		;TRY THIS
	POP P,P2		;*** RESTORE P2
	CAMN P2,NGOJOB
	IFSKP.
	   AOS PSKD1		;REQUEST SCHEDULER
	   JRST BKGNDT		;*****
	ENDIF.
	AOBJN P1,BKGND3		;NO
	JRST BKGND2

BKGNDT:				;***
	CAML P2,NGOJOB		;***CHANGE FOR THE BETTER?
	AOS SKDSHQ		;***QUESTION THIS
	AOS SKDSHN(P1)		;***YES NOTE HOW WE GOT IT
BKGND2:	AOS SKDSHS		;***COUNT TIMES THROUGH SHORT
	SETO FX,		;NOTE NO FORK TO RUN
	RET

; ROUTINES TO CALL TO TRY TO "SHAKE LOOSE" A RUNNABLE FORK
; ORDER MAY MAKE A DIFFERENCE

SKDSHK:	CALL WTCHK		;CHECK WAITING FORKS
	CALL SKDLV8		;DO ALL BACKGROUND STUFF
	CALL CLK2
	CALL AJBALS		;CHECK BALSET
	CALL WSMCHK		;CHECK WS
NSHAKL==.-SKDSHK		;NUMBER OF SHAKE LOOSE ROUTINES

RS PSKD1,1			;BS EVENT FLAG BUT NO OVERIDE
RS SKDFST,1			;FAST BS CHECK FLAG

;*** THE FOLLOWING LOCATIONS ARE TEMPORARY PERFORMANCE COUNTERS

RS GOLPWC,1			;***number of pwc boosts given after bswt
RS SKDSHS,1			;***          short background
RS SKDSHQ,1			;***number of "bad" bkgnd decisions
RS SKDBRM,1			;***number of bswt hold time exp removals
RS SKDBSK,1			;***number of dismt successes
RS MXQNBO,1			;***forks on MAXQ that got PWC but still MAXQ
RS MXQGBO,1			;***SUBSET of above that got boost to MAXQ-1
RS SKDSHN,NSHAKL		;***count of times this routine changes NGOJOB

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

SKDJFC:	MOVSI P1,-NFKS
SKJFC1:	HRRZ FX,P1		;PLAIN FORK INDEX FOR CALLS
	TMNE FKIBS		;IS THIS FORK IN THE BALANCE SET?
	CALL CLRIBS		;YES. REMOVE IT
	IFQN. FKWSL
	  CALL REMWS		;IF WS LOADED, REMOVE IT
	ENDIF.
	AOBJN P1,SKJFC1

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

	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
; FX/ FORK
;	CALL SKDJ3
; RETURN +1: STILL WAITING
;	 +2: NO LONGER WAITING

SKDJ3:	LOAD T2,FKPTR,(FX)	;GET TEST ROUTINE
	LOAD T1,FKPTD,(FX)	;SETUP TEST DATA
	XMOVEI T4,JSPRET	;DUMMY FOR OLD JSP TESTS
	CALL 0(T2)		;(T1,FX) DO TEST
	 RET			;STILL WAITING ** NOTE: DISMT BYPASSES THIS
				; AND RETS DIRECTLY
FRIBP3::CALL DISACC		;ACCOUNT FOR WAIT (WATCH tag)
	MOVE 1,TODCLK		;COMPUTE LENGTH OF TIME WAITED
	OPSTR <SUB 1,>,FKNB%,(FX)
	LSH T1,-1		;PENALIZE FOR GOLST WAIT BY FACTOR OF 2
	CAIGE T1,^D100		;ABOVE MINIMUM TIME?
TAMWTC:	IFSKP.
	  AOS GOLPWC		;***
	  PUSH P,T1		;***
	  CALL GLREM		;YES, REMOVE FROM GOLST AND
	  POP P,T1		;***
	  IMULI T1,NTMS		;CONVERT TO HIGH PRECISION UNITS
	  CALL NEWST2		;GIVE WAIT CREDIT
	  CALL GOCONC		;AND REPLACE ON GOLST
	ENDIF.
	LOAD T1,FKPTR,(FX)	;GET TEST ROUTINE
	CAIN T1,PRELWT		;PRELOAD WAIT?
	IFSKP.
	  CAIE 1,SWPINT		;NO, WAS BEING LOADED?
	  RETSKP		;NO, RETURN RUNNABLE
	  TMNN PIBMP		;RETURNING TO NORMAL PROCESSING?
	  SKIPN PRELDF		;PRELOADING DESIRED?
	  JRST SKDJ3X		;NO
	ENDIF.
;Preload wait or being loaded and preloading desired.
	MOVE T1,NRPLQ		;SAVE NUMBER PAGES NOW AVAIL
	ADD T1,IOIP
	PUSH P,T1
	CALL PRELD		;TRY TO PRELOAD
	IFNSK.
	  SETONE BSWTB		;NOT COMPLETE, PUT FORK BACK INTO WAIT
	  STOR T1,FKPTX,(FX) 	;WAIT TEST RETURNED BY PRELD
	  AOS NBWT		;COUNT IT
	  AOS NBSWP		; AS SWAP WAIT
	  MOVE 1,TODCLK		;RESET TIME OF START OF WAIT
	  STOR 1,FKNB%,(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
	  RET			;RETURN NOT RUNNABLE
	ENDIF.
	POP P,T1		;FLUSH TEMP
SKDJ3X:	CALL SOSNEB		;PROCESS FINISHED ENTERING BALSET
	RETSKP			;RETURN RUNNABLE
;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
	OPSTR <SUB 1,>,FKNB%,(FX)
	CAIGE T1,^D100		;ABOVE MINIMUM TIME?
	IFSKP.
	  SETZRO <BSNST,BSOVRD>	;YES, NOTE
	ENDIF.
	LOAD 2,FKPTR,(FX)	;WAIT TEST ADR
	ADDM 1,BSWT		;ACCUMULATE TOTAL WAIT
	CAIN T2,PRELWT		;PRELOAD WAIT?
	IFSKP.
	  CAIE 2,SWPINT		;OR SWAPIN?
	  CAIN 2,SWPRT		;OR SWAP?
	ANSKP.
	ELSE.
	  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
	  RET
	ENDIF.
	CAIE T2,DWRTST		;WRITE WAIT?
	IFSKP.
	  ADDM T1,DWRWT		;YES, CHARGE IT
	  CALLRET DISMT5	;DO IO CHARGE AND RETURN
	ENDIF.
	CAIE 2,UDWDON		;UTILITY DSK? OR
	CAIN 2,DSKRT		;DSK?
	IFNSK.
	  ADDM T1,DSKWT		;YES, CHARGE TO DSK
	  CALLRET DISMT5	;DO IO CHARGE IF NECESSARY
	ENDIF.
	RET

;DO IO CHARGE IF NECESSARY

DISMT5:	TXNE F,SK%IOC		;QUANTUM CHARGE FOR IO?
	RET			;NO
	MOVEI T1,^D10*NTMS	;YES, 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
	CALLRET CHGHLF		;CHARGE FOR FILE READ

;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

;WAIT TEST FOR FORK HAVING DONE EDISMS, BEING HELD IN BALSET
; FX/ FORK
;	CALL DISMT		;FROM SKDJ3 ONLY
; RETURN +1: CONTINUE SCAN, NO CHANGE TO FORK (OR CHANGED HEREIN)
;	+2: UNBLOCK THE FORK

DISMT:	LOAD T2,FKSTR,(FX)	;SEE IF EDISMS WAIT FINISHED
	LOAD T1,FKSTD,(FX)
	XMOVEI T4,JSPRET	;DUMMY FOR OLD JSP TESTS
	CALL 0(T2)		;(T1,FX) WAIT COMPLETED?
	 IFSKP. <JRST FRIBP1>	;YES, LET FORK RUN
	SKIPN SKDFST		;RUNNING FAST
	RET			;YES, DON'T DO THIS ** RETURN TO SKDJ3 CALLER
	LOAD T1,FKPTD,(FX)	;GET TIME PARAMETER FOR BLOCKW
	CALL BLOCKW		;(T1,FX) HOLD TIME EXPIRED?
	IFSKP.
	  AOS SKDBRM		;**** COUNT REMOVALS
	  SOS NHOLDF		;ONE LESS HOLDING FORK
	  CALL DISACC		;YES, ACCOUNT FOR WAIT
	  CALL DISMT2		;PUT FORK INTO NORMAL BLOCK STATE
	  RET			;CONTINUE SCAN ** RETURN TO SKDJ3 CALLER
	ENDIF.
	JE FKPS0,(FX),R		;RETURN IF NO INTERRUPT PENDING **
	JN FKPS1,(FX),R		;INTERRUPT PENDING. RETURN IF DEFERRED **
	SETONE FKIWT,(FX)	;NOT DEFERRED. REMEMBER FORK WAS WAITING.
FRIBP1::SOS NHOLDF		;ONE LESS HOLDING FORK
	AOS SKDBSK		;***
	RETSKP

;MOVE FORK FROM HOLD WAIT TO REGULAR NON-BALSET WAIT
; FX/ FORK

DISMT2:	ACVAR <W1>
	LOAD W1,FKNB%,(FX)	;SAVE TIME THAT WAIT STARTED
	CALL REMBSJ		;REMOVE JOB FROM BAL SET
	CALL GLREM		;REMOVE FORK FROM GOLST
	STOR W1,FKPTX,(FX)	;SAVE TOD OF DISMISS FOR NEWST
	CALL WTCON2		;PUT ON WAIT LIST
	RET
	ENDAV.
;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
	IFQN. <FKIBH,FKIBS>	;WAS IN BALSET **ASSUMES FKIBH FULL DEFSTR**
	  SETZRO FKIBH
	  ADD T3,[FHUNIT]
	ENDIF.
	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:	LOAD T4,FKSWX,(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:	LOAD T1,FKSWX,(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.(CHK,SUMNR2,SCHED,HARD,<WSMGR-SUMNR INCORRECT>,<<T3,D>,<T4,D>>,<

Cause:	This BUG is not documented yet.

Action:

>)
	  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
	TMNN FKBLK		;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

   REPEAT 0,<
RTUNIT==^D10000			;RT UNIT FOR FORCED REMOVAL
RTMIN==^D30000			;MINIMUM TIME-OUT
RTMAX==^D120000			;MAX TIME-OUT
   >
AJBYPF==1B0			;LOCAL FLAG - PASSED A NON-BALSET FK
AJNNLF==1B1			;NO NEW LQ FORKS
AJHQOF==1B2			;HQ FORKS ONLY
;AJRTRM==1B4			;RT REMOVAL FLAG

;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
   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
   >				;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,FKJBN
	SUB T1,JOBRT(T2)	;COMPUTE TIME REMAINING
   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:   >			;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:	JN FKBSHF,,AJBAL1	;IF HELD, ALREADY ACCOUNTED
	JN <BSNSK,BSCRSK>,,AJBL77 ;IF NOSKED OR CRSKED, TRY TO KEEP IT
	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.(CHK,SUMNR1,SCHED,HARD,<AJBALX-SUMBNR INCORRECT>,<<T3,D>,<T4,D>>,<

Cause:	This BUG is not documented yet.

Action:

>)
	  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
	TMNN 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]
	LOAD 2,FKJBN		;MAINTAIN SUBSYSTEM INFO...
	HRRZ 2,JOBNAM(2)
	LOAD 1,FKWSS
	ADDM 1,@[EP. SSIZE(2)]	;INTEGRATE WS SIZE
	AOS @[EP. 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,FKJBN
	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:	IFQN. BSWTB		;IF FORK IN BALSET WAIT,
	  CALL DISACC		;TERMINATE WAIT
	  LOAD T1,FKPTR,(FX)
	  CAIE T1,DISMT		;HDISMS?
	  IFSKP.
	    CALL DISMT2		;YES, CLEAN UP
	    SOS NHOLDF		;ONE LESS HOLDING FORK
	  ELSE.
	    CAIE T1,PRELWT	;ENTERING?
	    CAIN T1,SWPINT
	    CALL SOSNEB		;YES, CLEAN UP
	  ENDIF.
	ENDIF.
	SKIPN POSPGF		;POSTPURGING?
	IFSKP.
	  XMOVEI T4,JSPRET	;DUMMY FOR OLD JSP TESTS
	  CALL SWPINT		;(T1,FX) 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,@CST1X+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::LOAD T1,FKPSB		;PSB
	LOAD T1,FKUPT		;UPT
	LOAD T1,FKJSB		;JSB
	LOAD T1,FKPS2		;SECOND PSB

   IFDEF EHLJSB,<
	LOAD T1,FKJPT		;PT of extended JSB
   >

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
	SETZRO FKPTD,(FX)	;CLEAR TEST DATA
	MOVEI 1,SWPINT
	STOR 1,FKPTR,(FX)	;SET TEST TO WAIT FOR PSB AND PT
	LOAD 1,FKWSS		;GET WORKING SET SIZE
	LOAD 2,FKCSIZ		;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
	STOR T1,FKNB%,(FX)
	SKIPN INSKED		;CHECK COMPLETION UNLESS NOT INSKED
	SKIPN PRELDF		; AND PRELOADING
	SKIPL FORKX		;CAN'T DO IT IF FORK CONTEXT SETUP
	RETSKP
	CALL SKDJ3
	 JFCL
	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.(CHK,FKWSP1,SCHED,HARD,<LOADBS-UNREASONABLE FKWSP>,<<T1,D>,<T2,D>,<T3,D>>,<

Cause:	This BUG is not documented yet.

Action:

>)
	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:	EA.ENT			;RUN IN SECTION 1 BECAUSE OF TIMERS
	CALL UCLOCK		;UPDATE CLOCKS
	SETZ T1,
	SKIPN T2,JOBBIT		;GET FORK PRIO IF ANY
	MOVE T2,JOBSKD		;NONE GET JOB PRIO
	TXNE T2,JP%SYS		;SYSTEM FORK?
	TXO T1,BSSPQ		;YES
	SKIPE NSKED		;NOSKED?
	TXO T1,BSNSK		;YES
	SKIPE CRSKED		;CSKED?
	TXO T1,BSCRSK		;YES
	OPSTR <XOR T1,>,FKSWX,(FX) ;COMPARE WITH LAST SETTING
	TXNN T1,BSNSK!BSCRSK!BSSPQ ;CHANGED?
	IFSKP.
	  ANDX T1,BSNSK!BSCRSK!BSSPQ
	  OPSTRM <XORM T1,>,FKSWX,(FX) ;YES, UPDATE VALUES
	  CALL GLREM		;CHANGE FORK POSITION ON GOLST
	  CALL GOCONC
	ENDIF.
	LOAD T1,FKSWX,(FX)
	TMNN PIBMP		;ANY HIGH PRIORITY SCHED FLAGS?
	TXNE T1,BSCRSK!BSSPQ
	IFSKP.
	  TXZE T1,BSNST!BSOVRD	;NO, CLEAN UP IF NECESSARY
	  STOR T1,FKSWX,(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.
	    STOR T1,FKSWX,(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

;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.  The bugchk reports
;the job and fork number of the offending fork.   DLM  10/28/81

	    SKIPA
	    BUG.(CHK,HPSCHK,SCHED,SOFT,<SCHEDULER - EXCESSIVE TIME IN HIGH PRIORITY>,<<T2,JOBNO>,<FX,FRKNO>>,<

Cause:	A fork has entered a high priority scheduling condition, i.e.
PIBMP, CSKED, or JP%SYS, and has remained compute-bound for more than
5 seconds.  The fork has probably malfunctioned in some way, and
the high scheduling priority is affecting overall system response.

Action:	The high priority status is disabled until the fork itself
clears the condition.
>)
	    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
	JUMPG T1,[CAIG T2,MAXQ	;ON DREGS QUEUE
		  RET		;NO AND NOT EXHAUSTED, DONE
		  LOAD T3,FKMNQ	;DREGS, GET MIN QUEUE
		  CAMG T2,T3	;SHOULD STILL BE DREGS?
		  RET		;YES AND NOT EXHAUSTED
		  JRST .+1]	;NO LONGER DREGS RECALC
	AOS BSKED		;EXHAUSTED, REQUEST ADJUST OF BALSET
	CALL GLREM		;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
	STOR 3,FKTIM,(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
	JN <BSNSK,BSCRSK,BSSPQ>,,R ;IF CRITICAL OR SPECIAL PRIORITY DO IT
	CAIG T1,INTQ1		;NO, BUT 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.(CHK,NEGJRT,SCHED,SOFT,<UCLOCK: NEGATIVE JOBRT DETECTED>,<<T2,JOBNO>>,<

Cause:	The job runtime (JOBRT) is negative for an existing job.  This
	would cause the job to appear non-existant to most JSYSes.

Action:	Use a reasonable value for JOBRT (0) and logout the job.

Data:	T2/ Job number

>)
		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,@[EP. JOBIRT(T2)]	;ACCUMULATE JOB RUN-TIME AS WELL
	HRRZ T3,@[EP. JOBCLS(T2)]	;GET CLASS OF THIS FORK
	ADDM T1,@[EP. 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,@[EP. 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
	LOAD T2,FKJO%,(T2)	; 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
	STOR 1,FKPTX,(FX)
WTCON2:	LOAD 1,FKSTR,(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
	LOAD T2,FKSTR,(FX)	;NOW TRY TEST ONCE
	LOAD T1,FKSTD,(FX)
	XMOVEI T4,JSPRET	;DUMMY FOR OLD JSP TESTS
	CALL 0(T2)		;(T1,FX)
	IFSKP.
	  CALL UNBLK1		;CONDITION ALREADY SATISFIED
	ELSE.
	  TMNN FKPS0,(FX)	;TEST FAILED. IS INTERRUPT REQUESTED?
	  IFSKP.
	    TMNE FKPS1,(FX)	;YES. ARE INTERRUPTS DEFFERED?
	  ANSKP.
	    SETONE FKIWT,(FX)	;NO. FLAG INTERRUPT FROM WAIT STATE
	    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
	AOS PSKD1		;WAKEUP FAST IF NULL JOB
	RET
;UNBLOCK SPECIFIC FORK - MAY BE CALLED FROM OUTSIDE SCHEDULER
; 1/ FORK INDEX
;	CALL UNBLKF
; RETURN +1 ALWAYS

UNBLKF::SAVEAC <FX>
	EA.ENT
 	MOVEM 1,FX		;SETUP ARG
	NOSKD1			;NOSKED WHILE DIDDLING LISTS
	JE FKBLK,,UNBF1		;JUMP IF NOT BLOCKED
UNBF2:	LOAD T2,FKSTR,(FX)	;GET TEST ROUTINE
	LOAD T1,FKSTD,(FX)	;GET DATA FOR TEST ROUTINE
	XMOVEI T4,JSPRET	;DUMMY FOR OLD JSP TESTS
	CALL 0(T2)		;(T1,FX)
	 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.(CHK,UNBFNF,SCHED,HARD,<UNBLK1 - FORK NOT FOUND>,,<

Cause:	This BUG is not documented yet.

Action:

>)
	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
	OPSTR <CAME T2,>,FKSTR,(FX) ;IS SCHEDULER TEST THE ONE WE WANT?
	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
	LOAD T1,FKSTR,(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
	LOAD T2,FKSTR,(FX)	;GET SCHEDULER TEST ROUTINE
	LOAD T1,FKSTD,(FX)	;GET TEST ROUTINE DATA
	XMOVEI T4,JSPRET	;DUMMY FOR OLD JSP TESTS
	CALL 0(T2)		;(T1,FX)
	 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
	LOAD FX,FKSTD,(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
	LOAD T2,FKSTR,(FX)	;YES. GET SCHEDULER TEST
	CAIN 2,TRMTS1		;WAITING FOR ANY FORK?
	JRST SUPU1		;YES, WAKE IT
	LOAD T2,FKSTD,(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
	LOAD T2,FKSTR,(FX)	;GET TEST ROUTINE
	LOAD T1,FKSTD,(FX)	;GET DATA FOR TEST ROUTINE
	XMOVEI T4,JSPRET	;DUMMY FOR OLD JSP TESTS
	CALL 0(T2)		;(T1,FX)
	 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 NEWST		;ESTABLISH NEW QUEUE STATUS
	CALL GOCONC		;PUT ON READY LIST
	CALL APSKED		;SEE IF RESCHEDULE NEEDED
	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::JE SK%RSQ,SCHFLG,APSK1	;SYSTEM MGR WANTS THIS?
	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>	;SAVE SOME ACS

;*** THIS CHECK IS SLIGHTLY BOGUS SINCE QUEUE NUMBER DOES NOT ALWAYS
;*** INDICATE CORRECT PRIORITY!

	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?
	JRST APSK1		;NO, DO NOTHING
	AOS SKEDF3		;YES, REQUEST RESCHED
	AOS PSKED
	ISB SCDCHN		;RIGHT NOW
	RET

APSK1:	AOS PSKD1		;FLAG POSSIBLE SCHEDULING EVENT
	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,FKJBN		;GET JOB #
	MOVSI CX,1		;GET AN INCREMENTOR
	ADDB CX,@[EP. JOBCLS(T3)]	;ONE MORE ON GOLST
	TLNE CX,777776		;FIRST ONE ON?
	JRST GOCNC0		;NO.
	HRRZ T3,@[EP. 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
	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)
	SETONE FKOGL		;MARK ON GOLST
	RET			;DONE
;REMOVE SELECTED FORK FROM GOLST
;	FX/ fork index

GLREM:	SAVEQ
	JE FKOGL,,GLREM2	;IF NOT MARKED ON GOLST DIE
	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,FKJBN		;GET JOB NUMBER
	MOVSI CX,-1		;GET A DECREMNTOR
	ADDB CX,@[EP. JOBCLS(Q1)]	;DO IT
	TLNE CX,-1		;LAST ONE OFF?
	JRST GLREM0		;NO
	HRRZ Q1,@[EP. 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
	SETZRO FKOGL		;NO LONGER ON GOLST
	RET

GLREM2:	BUG.(HLT,GLFNF,SCHED,HARD,< GLREM - FORK NOT FOUND>,,<

Cause:	The scheduler is trying to remove a process from its linked list of
	runnable processes (the GOLIST).  The BUGHLT occurs because the
	scheduler does not find the process in the GOLIST.  This indicates an
	inconsistency in the scheduler's data base.

>)

;DUMMY RETURNS FOR ROUTINES CALLED WITH 'CALL' BUT ACT AS IF THEY
;WERE CALLED WITH JSP T4,.  T4 IS SETUP TO CONTAIN JSPRET.
JRET::
JSPRET::RET			;THROUGH HERE ON JRST 0(T4)
JSKP::	AOS 0(P)		;THROUGH HERE ON JRST 1(T4)
	RET
;wait bit routine - dismiss until bit becomes 0 or 1
;CALL BITWAI
;T1/ test bit set
;T2/ address of test word
;T3/ test value
;  0 means dismiss until bit becomes 0
;  nonzero means dismiss until bit becomes 1
;returns +1 eventually, uses T1-T3, preserves all others
;returns +1 immediately if T1=0
BITWAI::SAVEAC <T4>
	MOVE T4,FORKX		;get fork index
	STOR T2,FKST2,(T4)	;additional datum - address of word to test
	JFFO T1,BITWA1		;get bit number
	RET			;no bit to test, return
BITWA1:	HRL T1,T2    		;bit number in LH (data)
	SKIPN T3		;waiting for bit to be set ?
	IFSKP.
	  HRRI T1,BITSET	;yes. address of test routine
	ELSE.
	  HRRI T1,BITCLR	;no. address of test routine
	ENDIF.
	MDISMS
	RET

;Test routine -  waiting for a bit to be cleared
;FX/ fork index
;preserves all ACs
BITCLR::SAVEAC <T1,T2>
	LOAD T1,FKSTD,(FX)	;get bit number
	LOAD T2,FK2DT		;get test word
	TDNN T2,BITS(T1)	;is that bit of that word set ?
	RETSKP    		;no. wait no more.
	RET     		;yes. wait some more

;Test routine -  waiting for a bit to be set
;FX/ fork index
;preserves all ACs
BITSET::SAVEAC <T1,T2>
	LOAD T1,FKSTD,(FX)	;get bit number
	LOAD T2,FK2DT		;get test word
	TDNN T2,BITS(T1)	;is that bit of that word set ?
	RET       		;no. wait some more.
	RETSKP 			;yes. wait no more.
;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
	OPSTR <SUB T1,>,FKTIM,(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:	LOAD T2,FKSWX,(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>
	JN BSNSK,,CORFC4	;NOSKED?
	JUMPE T2,[MOVX T1,<4.0>	;NO. 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
	 CAIG CX,INTQ1		;INTERACTIVE QUEUES?
	 FADRI T1,(EXP 0.5)	;YES. ATTENUATE CLASS DISTANCE SUCH
				; THAT A WELL-BEHAVED CLASS WILL
				; ACHIEVE PRIORITY ON THIS QUEUE
	ENDIF.
	LOAD T3,FKSWX,(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
	OPSTR <SUB T2,>,FKTIM,(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
	RET			; AND USE PRESENT VALUES
;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,@[EP. CLSIRT(W1)];ANY TIME IN THIS INTERVAL?
	JRST NEWUT1		;NO. PROCEED
	SETZM @[EP. CLSIRT(W1)]	;CLEAR COUNTER
	FLTR T3,T3		;FLOAT THE VALUE
	FDVR T3,W2		;COMPUTE FRACTIONAL USE
NEWUT1:	MOVE T1,@[EP. 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,@[EP. CLSUTL(W1)]
	FSBR T1,@[EP. CLSSHR(W1)]	;COMPUTE LINEAR DISTANCE
	SKIPL T1		;WINDFALL?
	SKIPGE T3,@[EP. CLSSWA(W1)]	;YES. ANY WINDFALL ALLOCATION?
	MOVE T3,@[EP. 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,@[EP. 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,@[EP. JOBIRT(W1)]	;THIS JOB HAVE SOME RUN-TIME?
	JRST NEWU01		;NO
	SETZM @[EP. JOBIRT(W1)]	;YES. CLEAR COUNTER
	FLTR T3,T3		;GET FLOAT OF TIME
	FDVR T3,W2		;GET FRACTION
NEWU01:	MOVE T1,@[EP. 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,@[EP. JOBUTL(W1)]	;SAVE IT
	HRRZ T2,@[EP. JOBCLS(W1)]	;GET CLASS
	MOVE T3,@[EP. CLSSHI(T2)]	;GET JOB'S SHARE
	FSBR T3,T1		;COMPUTE LINEAR DIFFERENCE
	FDVR T3,@[EP. CLSSHI(T2)]	;COMPUTE "EXPONENTIAL DIFFERENCE
	JFOV [	SKIPE @[EP. CLSSHI(T2)] ;ANY SHARE?
		SETZM T3	;NO. ASSUME ON TARGET THEN
		JRST .+1]
	MOVEM T3,@[EP. 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,FKJBN		;GET JOB NUMBER
	HRRZ T1,@[EP. JOBCLS(T2)]	;GET JOB CLASS
	MOVE T1,@[EP. CLSDST(T1)]	;GET CLASS DISTANCE
	MOVE T2,@[EP. 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 @[EP. CLSCNT(T1)]	;ONE LESS ITEM
INCSHR:	AOS @[EP. 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 @[EP. JOBIRT(W1)]	;NO INCREMENTAL RUN-TIME YET
	SETZM @[EP. JOBUTL(W1)]	;NO UTIL
	SOJGE W1,STRCL0		;DO ALL JOBS
	MOVE T1,USRTIM		;GET CURRENT "SOLD" TIME
	MOVEM T1,OLDSLD		;INIT INTERVAL
   >
	MOVEI T1,0
      DO.
	SETZM @[EP. CLSIRT(T1)]
	SETZM @[EP. CLSSUM(T1)]
	SETZM @[EP. CLSCNT(T1)]	;CLEAR COUNTS AS WELL
	CAIGE T1,MAXCLS-1
	AOJA T1,TOP.
      ENDDO.
	MOVEI T1,0
      DO.
	SETZM @[EP. CLSRJA(T1)]
	CAIGE T1,MAXCLS*NRJAVS-1
	AOJA T1,TOP.
      ENDDO.
	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,@[EP. JOBCLS(T4)]	;YES. GET CLASS
	AOS @[EP. CLSCNT(T2)]	;INCREMENT COUNT
COUNT4:	SOJGE T4,COUNT0		;DO ALL JOBS
COUNT1:	MOVEI T1,MAXCLS-1
COUNT2:	SKIPE @[EP. 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,FKJBN		;GET JOB NUMBER
	MOVSI CX,1		;AN INCREMENTOR
	ADDB CX,@[EP. JOBCLS(T2)]	;ONE MORE ON GOLST
	TLNE CX,777776		;FIRST ONE?
	JRST COUNT6		;NO
	HRRZ T2,@[EP. 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,@[EP. JOBCLS(T2)]	;GET NEW CLASS
	SKIPN FX,GOLST		;ANYTHING ON GOLST?
	RET			;NO
CHGCN0:	SUBI FX,FKPT		;GET FORK #
	LOAD T3,FKJBN		;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

CHGCLS:	SASUBR <NCLASS,JOBNOM>
	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,@[EP. JOBCLS(T2)]	;GET CURRENT CLASS VALUE
	SOS @[EP. CLSCNT(T3)]	;ONE LESS IN THIS CLASS
	AOS @[EP. CLSCNT(T1)]	;ONE MORE IN THIS CLASS
	HRRM T1,@[EP. 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,@[EP. CLSSHR(T2)]	;SET CLASSES SHARE
	MOVE T1,T2		;GET CLASS I.D.
	CALLRET ADJCLS		;GO ADJUST CLASS PARAMETERS

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

ADJCLS:	SKIPN T2,@[EP. 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,@[EP. CLSSHR(T1)]	;GET CLASS'S SHARE
	FDVR T3,T2		;GET EACH MEMBER'S FAIR SHARE
	MOVEM T3,@[EP. 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,GBLJNO	;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,@[EP. 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		;0 - SPECIAL HIGH PRIO QUEUE *
	200*NTMS		;1 - QUICK INTERACTIVE QUEUE
	400*NTMS		;2 - REGULAR INTERACTIVE
	1500*NTMS		;3 - LOW PRIO INTERACTIVE OR HIGH PRIO COMPUTE
				;    TRANSITIONAL QUEUE
	3000*NTMS		;4 - MIDDLE QUEUE (HIGH PRIO COMPUTE QUEUE)
	5000*NTMS		;5 - COMPUTE QUEUE
	10000*NTMS		;6 - "DREGS" QUEUE *

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

;DEFINE PROTO TABLE FOR CLASS SCHEDULER

QUANTC:	300*NTMS
  INTQ0==.-QUANTC		;HIGHEST INTERACTIVE QUEUE
	100*NTMS
	400*NTMS
  INTQ1==.-QUANTC		;LOWEST INTERACTIVE QUEUE
	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+2			;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			;BASE FOR CRSKED FORK

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
	OPSTR <SUB T1,>,FKPTX,(FX)
	OPSTRM <ADDM T1,>,FKTIM,(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
	LOAD 2,FKSTR,(FX)	;GET SCHEDULER TEST
	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 [	LOAD T2,FKSTD,(FX) ;YES. GET LINE NUMBER
		CALL CKPHYT	;IS IT A PSEUDO TTY?
		 JRST NEWST2	;FOR PTY, FOLLOW NORMAL ALGORITHM
		JRST NEWST1]	;NO, BE MORE GENEROUS
NEWST2:	TXNE F,SK%WCF		;CONSIDER LOAD AVG?
	JRST NEWST5		;NO
	MOVE 2,IRJAV		;AV NUMBER RUNNABLE FORKS
	CAILE T2,^D10		;BUT LIMIT IT TO 10 MAX
	MOVEI T2,^D10
	SUBI T2,2		;IGNORE LOAD AVERAGE IF .LT. IGNORED VALUE
	SKIPLE T2
	IDIV T1,T2		;WAIT CREDIT INV PROP'L TO LOAD AV - IGNORED
NEWST5:	MOVE T2,T1
	LOAD T1,FKQN		;CURRENT QUEUE
	CAIN T1,LOWQ		;DREGS QUEUE?
	JRST NEWSTX		;YES, NO CHANGE
	CAIL T1,INTQ1		;ELIGIBLE FOR BIG BONUS IF LOW INT OR WORSE
	CAMGE T2,QUANTT+1(T1)	;WAITED LONGER THAN Q+1 QUANTUM?
	SKIPA			;NOT ELIGIBLE OR NOT LONG ENOUGH
	JRST NEWST1		;YES. MAJOR BONUS
	LOAD T3,FKQTM		;CREDIT REMAINING QUANTUM
	ADD T3,T2
	CAMG T3,QUANTT(T1)	;GREATER THAN INITIAL QUANTUM?
	JRST NEWST7		;NO, JUST UPDATE
	CAIG T1,INTQ1		;ONE OF THE HIGHEST?
	JRST NEWST3		;YES, DON'T MOVE UP BUT GIVE FULL QUANT AGAIN
NEWST6:	SUB T3,QUANTT(T1)	;SUBTRACT QUANT FOR THIS QUEUE
	SOJG T1,[CAMLE T3,QUANTT(T1) ;BUMP UP ONE QUEUE, FULL QUANT HERE?
TAMQB2:		JRST NEWST6	;YES, KEEP GOING HIGHER
		JRST .+1]	;EXIT QUEUE NUMBER IN T1
	CAIGE T1,INTQ1		;BUT LIMIT TO LOW INT Q
	MOVEI T1,INTQ1
	JRST NEWST3		;SET NEW QUEUE
;ESTABLISH VALUES FOR NEW QUEUE

NEWST7:	CAIE T1,MAXQ		;STILL ON MAXQ?
	JRST NEWST8		;NO, STORE NEW QUANT = (OLD QUANT + PWC)
	AOS MXQNBO		;***COUNT THIS TEMP
	MOVEI T3,1		;USE 1 UNLESS
	TXNN F,SK%WCF		;PROPORTIONAL TO LDAV?
	MOVE T3,IRJAV		;YES, GET LDAV
	CAILE T3,^D10		;OR 10 MAX (NOTE: 10*500 = MAXQ QUANTUM)
	MOVEI T3,^D10
	IMULI T3,NTMS*^D500	;GET LDAV * 500 MS IN HP UNITS
	
	CAML T2,T3		;WAITED THAT LONG?
	IFNSK.
	  AOS MXQGBO		;***
	  SUBI T1,1		;BUMP ONE QUEUE
	  JRST NEWST3		;AND GIVE FULL QUANTUM 
	ENDIF.
	JRST NEWSTX		;NOT ABOVE THRESHOLD FORGET IT

NEWST1:	CALL NEWWSS		;SET NEW WS SIZE
	CALL INIQ		;GET INITIAL INT QUEUE
NEWST3:	SKIPA T2,QUANTT(1)
NEWST8:	MOVE T2,T3
	STOR T2,FKQTM		;SET NEW QUEUE VALUE
	STOR T1,FKQN		;SET NEW QUEUE NUMBER
	MOVE T2,TODCLK
	STOR T2,FKTIM,(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>
	LOAD T1,FKCSIZ		;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,INTQ0+1
	TXNN F,SK%RQ1
	SKIPE CLASSF		;ALWAYS USE FIRST INTQ IF CLASS SCHED
	MOVEI T1,INTQ0		;USE HIGHEST 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)
	CALL UNMIDX		;UNMAP THE DIRECTORY AND INDEX FILE
	CALL CLNZSC		;CLEAR ALL NON-ZERO SECTIONS
	 JFCL			;UNABLE TO CLEAR ALL - CONTINUE ANYWAY
	SETZM JOBM0+JSBPG	;CLEAR FAKE JSB MAPPING
	MOVE FX,FORKX		;THIS FORK.
	LOAD 1,FKJSB		;GET JSB
	CALL WTSPT		;WAIT FOR IT TO BE UNSHARED
	SETZ 1,
	LOAD T2,FKJSB		;GET SPT INDEX OF JSB
	HRLS T2			; INTO LEFT HALF
	HRRI 2,JOBMAP-JSBPGA	;(SPT INDEX FOR JSB,,OFFSET FOR JOB MAP)
	MOVEI 4,JSLST-JSBPG
	CALL MSETP1		;CLEAR JOB MAP
	LOAD 2,FKPSB		;GET SPT INDEX OF PSB
	HRLS T2			; INTO LEFT HALF
	HRRI 2,PPLOW		;(SPT INDEX FOR PSB,,OFFSET FOR PROCESS MAP)
	SETZ 1,
	MOVEI 4,PPHI+1-PPLOW
	CALL MSETP1		;CLEAR ALL PAGES OF PROCESS MAP
   IFDEF EHLJSB,<
	;Clear page-table for extended JSB
	LOAD T1,FKJPT		;Get SPT index
	CALL WTSPT		;Wait for it to be unshared
	SETZ 1,			;Indicate we want the map cleared
	LOAD T2,FKJPT		;Get SPT index
	HRLZS T2		;Move to left half for PTN.PN
	MOVEI 4,PGSIZ		;Do the whole map
	CALL MSETP1		;Clear it
   >
	LOAD 1,FKJSB		;SPT INDEX OF 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,@[EP. JOBCLS(T2)]	;SAVE CLASS OF JOB
	ADDI T2,JOBPT
	EXCH T2,FREJOB		;PUT SLOT ON FREE LIST
	MOVEM T2,@FREJOB
	SOS @[EP. 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.(CHK,MAPCLF,SCHED,SOFT,<FAILED TO CLEAR MAPS WHEN KILLING JOB>,,<

Cause:	A call to MSETPT to clear the job map or process map for
	the top fork of a job being killed has failed.

Action:	Continue.
>)
	RET
;HLTJB CONTINUED..
;DEASSIGN OF JOB CONTROLLING FAILED

HLTJB3:	TXZN T1,1B0		;FAILED. NEED TO WAIT?
	BUG.(HLT,TTDAS1,SCHED,HARD,<HLTJB: UNABLE TO DEASSIGN CONTROLLING TERMINAL>,,<

Cause:	The monitor is killing the last (top) fork in a job and is trying to
	deassign the job's controlling terminal.  The attempt has failed for an
	unexpected reason (one that will not be corrected if the fork waits a
	while).  This indicates inconsistency in the monitor's data base.

>)
	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
	CALL SETPSK		;Set to scheduler context
	LOAD 1,FKJSB		;JSB
	CALL GETSHR		;GET SHARE COUNT
	MOVE 2,1		;SAVE IT
	LOAD 1,FKJSB		;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.
   IFDEF EHLJSB,<
	;Decrement share count/delete page table for extended JSB
	LOAD T1,FKJPT		;Get SPTX for extended JSB PT
	CALL GETSHR		;Get share count
	MOVE T2,T1		;Save it
	LOAD T1,FKJPT		;Get JSB PT SPTX again
	CAIN T2,T1		;Last use of page table?
	IFSKP.
	  CALL DWNSHR		;No, merely reduce share count
	ELSE.
	  CALL DESPT		;Yes, delete page table
	ENDIF.
   >
	LOAD 1,FKUPT		;UPT
	CALL DESPT		;DELETE IT
	LOAD T1,FKPS2		;GET STACK I.D.
	CALL DESPT		;RELEASE IT AS WELL
	LOAD 1,FKPSB
	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
	SETZM FKPGS(FX)		;ZERO FKPGS AS A FLAG OF NON ASSIGNED FORK
	LOAD 1,FKCSIZ		;MAKE SURE FORK CLEANED UP
	CAIE 1,0
	BUG.(CHK,FRKNDL,SCHED,HARD,<FORK NOT PROPERLY DELETED>,,<

Cause:	This BUG is not documented yet.

Action:

>)
	CALL RDSIVL		;GET TIME SINCE ENTSKD
	IDIVI T1,NTMS		;CONVERT TO MS
	ADDM T1,USRTIM		;ACCUMULATE TOTAL USER TIME
	JRST SCHED0		;NOW THERE IS NOTHING LEFT OF JOB...
;WAIT FOR PSB AND UPT TO HAVE SHARE COUNT OF 1

WTFPGS::LOAD 1,FKPSB		;PSB
	CALL WTSPT
	LOAD T1,FKPS2		;GET STACK PAGE
	CALL WTSPT		;WAIT FOR THIS AS WELL
	LOAD 1,FKUPT		;UPT
	;CALLRET WTSPT

;WAIT FOR SPECIFIED SPT TO HAVE SHARE COUNT OF 1
; T1/ SPT INDEX
;	CALL WTSPT
;RETURN +1: ALWAYS, COUNT NOW 1

WTSPT::	SAVEAC <T4>
WTSPT2:	MOVE 2,1		;SAVE 1 SINCE WTSPTT CLOBBERS IT
	CALL WTSPTT		;(T1,FX)
	IFNSK.
	  MOVSI 1,0(2)
	  HRRI 1,WTSPTT
	  MDISMS
	  HLRZ 1,1
	  JRST WTSPT2
	ENDIF.
	RET

WTSPTT::CALL GETSHR		;GET SHARE COUNT
	CAIE 1,1
	RET
	RETSKP
	SUBTTL Fork initialization

;Here when NEWFK% was set in FKINT. Initialize the fork. If this is the top
;fork in a newly-created job, NEWJB% is set, too.

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
	MOVX T1,MONENV		;INITIALIZE XPCW BLOCK USED BY PSI SERVICE
	MOVEM T1,PIPC+1		;NEW FLAGS WORD
	XMOVEI 1,PSISV1
	MOVEM 1,PIPC+2		;NEW PC WORD
	SETZM NSKED
	SETZM CRSKED
	SETZM SNPPGS		;INITIALIZE SNOOP BREAK POINTS
	SETZM SNPLST		;  NONE TO START WITH
	SETOM PSISYS		;INIT PI SYSTEM OFF

IFN <FTKLIPA>,<
	SETOM SCSPS0		;Init SCS% PSI channels as off
	SETOM SCSPS1		;.	.	.

	SETZM SCSTMQ		;Zero top of message queue
	XMOVEI T1,SCSTMQ	;Get a pointer to the top of the queue
	MOVEM T1,SCSBMQ		;Init tail as pointer to head

	SETZM SCSTDQ		;Zero top of datagram queue
	XMOVEI T1,SCSTDQ	;Get a pointer to the top of the queue
	MOVEM T1,SCSBDQ		;Init tail as pointer to head

	SETZM SCSTEQ		;Zero top of event queue
	XMOVEI T1,SCSTEQ	;Get a pointer to the top of the queue
	MOVEM T1,SCSBEQ		;Init tail as pointer to head

	SETZM SCSTXQ		;Zero top of DMA queue
	XMOVEI T1,SCSTXQ	;Get a pointer to the top of the queue
	MOVEM T1,SCSBXQ		;Init tail as pointer to head

	SETZM SCSTCQ		;Zero top of CB queue
	XMOVEI T1,SCSTCQ	;Get a pointer to the top of the queue
	MOVEM T1,SCSBCQ		;Init tail as pointer to head
>;End IFN <FTKLIPA>

	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
	NOINT			;FORK MUST BE NOINT DURING PAGE CREATION
	CALL FKSETP		;SETUP PSB AND UPT POINTERS
	MOVEI T1,NPSIPG		;MUST CREATE ALL PI PAGES
	MOVEI T2,PSIPGA		;THE FIRST ONE
      DO.
	SETZM 0(T2)		;CREATE THIS ONE
	ADDI T2,PGSIZ		;NEXT PAGE
	SOJG T1,TOP.		;DO ALL OF THEM
      ENDDO.
	OKINT			;MAKE INTDF LOOK NORMAL AGAIN
	LOAD 1,FKJBN		;GET JOB NUMBER
	MOVEM 1,JOBNO
	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
	LOAD 1,FKJSB		;GET JSB
	CALL UPSHR		;BUMP SHARE COUNT
   IFDEF EHLJSB,<
	LOAD T1,FKJPT		;Get SPT slot for PT of extended JSB
	CALL UPSHR		;Bump share count on page table
   >
	XMOVEI 1,FKSET2
FKSET3:	MOVEM 1,PIPC
	MOVX T1,MONENV		;GET AC BLOCK DEFINITION FOR MONITOR MODE
	MOVEM T1,PIFL		;MAKE THIS BE THE OLD FLAGS WORD FOR INTERRUPT
	SETZM PIOLDS
	JRST PIRQR		;DEBREAK - RUN IN NORMAL MODE
;INIT NEW JOB

;Here when NEWJB% was set in PIMSK during fork initialization.
;FKSET was called because NEWFK% was set, too.

FKSET1:	HRREI T2,0(6)		;GET NUMBER OF CONTROLLING TTY, IF ANY
	MOVE T1,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,@[EP. 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
	MOVX 1,USRCTX		;SET USER MODE CONTEXT
	MOVEM 1,PFL
	MOVEI 1,HALTT
	JRST DISMSE
	SUBTTL Software Interrupt Service

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

;Save wait state at time of interrupt

	SETZ T2,
	TXNE FX,PSIWT%		;WAS FORK IN WAIT STATUS?
	LOAD T2,FKSTX,(Q2)	;YES, GET OLD STATUS
	MOVEM T2,PIOLDS		;SAVE OLD STATUS, OR 0 IF WAS RUNNING
	SETZ T2,
	TXZE FX,PSIWT%		;WAS FORK IN WAIT STATUS
	LOAD T2,FKST2,(Q2)	;YES GET OLD STATUS
	MOVEM T2,PIOLD2		;SAVE OLD STATUS

;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
IFN <FTKLIPA>,<
	TXZE FX,PSISC%		;Does SCS% need attention???
	 CALL SCSPSI		;Yes,take entries off work Q,put on fork+CB Q's
>;End IFN <FTKLIPA>
PSITR1::TXNE FX,PSIIF%+SUSFK%+PSILO%+PSICO%+PSIJT%+ADRBK%+PSIDP%
	JRST PSII		;CHANNEL INTERRUPT SPEC. BY FKINTB -
				; PSIIF%, PSIJT%.
				;Interrupt superior - ADRBK%.
				;Special request - SUSFK%.
				;Dispatch to action procedure -
				; PSILO%, PSICO%, PSIDP%
	;..
;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 PSIDF2		;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
	MOVX T1,MONENV		;SET UP AC BLOCKS FOR MONITOR MODE
	MOVEM T1,PFL		; AND MAKE THIS THE NEW FLAGS
	JRST SCHED0		;GO RESCHEDULE THIS PROCESS

PSIDF2:	MOVE T2,PIOLD2		;GET THE OLD FKSTA2 WORD
	STOR T2,FKST2,(FX)	;AND RESTORE IT
	JRST DISMSE		;AND GO DISMISS
;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
	MOVE FX,FORKX
	TMNN FKPS1,(FX)		;INTERRUPT IN PROGRESS?
	BUG.(CHK,UNPIRX,SCHED,HARD,<UNPIR-NO PSI IN PROGRESS>,,<

Cause:	This BUG is not documented yet.

Action:

>)
	SETZRO FKPS1,(FX)	;YES. CLEAR IT
	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
	EA.ENT
	OPSTRM <IORM 1,>,FKIBX,(2);SET BIT IN INTERRUPT WAITING BUFFER
PSITQ:	MOVX T1,PSIIF%		;REGULAR INTERRUPT FLAGS
PSIGR::	TXO T1,FKPSI0
	OPSTRM <IORM 1,>,FKINX,(2)
	CAMN 2,FORKX		;FOR THIS FORK?
	RET			;YES
PSIR4::	CONSO PI,177B27		;AT PI LEVEL ?
	NOSKD1			;NO. KEEP SCHEDULER OUT.
	PUSH P,FX
	MOVEI FX,0(2)
	JN FKPS1,(FX),PSIR61	;IF NOT INTERRUPT, DON'T DO THIS
	IFQN. FKBLK,
	  SETONE FKIWT,(FX)	;SET WAKE FLAG
	  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
	CONSO PI,177B27		;AT PI LEVEL ?
	OKSKD1			;NO. ALLOW SCHEDULER TO RUN
	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 T3,TRMCD,(T2)	;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,TRMCD,(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?
	CAIGE T4,0
	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
	LOAD T3,FKSTR,(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:	JE FKFRJ,(T2),PSIT1C	;ORDINARY FREEZE IF NOT FROZEN BY JSYS TRAP
	JN FKEFR,(T2),PSIT1C	;IF OTHER TRAPS, TOO, DON'T CONSIDER THIS FORK
	JRST PSIT1D		;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
	OPSTRM <IORM 1,>,FKINX,(FX) ;KEEP OTHER REQUESTS
	DMOVE 1,PIFL
	CALL PITEST		;NOW INTERRUPTABLE?
	 JRST PIRSF1		;NO
	MOVEI 3,SUSWT		;SUSPENDED FORK TEST
PIRSK1:	MOVE 2,FORKX
	SETZRO FKSUS,(T2)
	CALL UNPIRN		;LEAVE INTERRUPT STATE
	SETONE FKPS1,(FX)	;SET 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			;
	LOAD T1,FKSTR,(FX)	;
	CAIN T1,JTQWT		; IN JSYS TRAP QUEUE WAIT?
	JRST PIRSF2		; YES, ALLOW SUSPENSION
	OKSKED			;
	SETONE FKSUS,(FX)	;TURN REQUEST BIT BACK ON
	JRST PSIDFR		;AND SET DEFERRED INTERRUPTS

PIRSF2:	MOVEI T1,FKJTQ(FX)	; FORK IN JSYS TRAP QUEUE WAIT
	CALL JTDEQ		; REMOVE IT FROM QUEUE
	MOVX T1,MONENV		;SET AC BLOCKS
	MOVEM T1,PIFL		;SAVE AS FLAGS WORD
	XMOVEI T1,JTRLCK	; SET RESUME ADDR. TO LOCK ROUTINE
	SETZM PIOLDS		;
	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
		SETONE FKICO,(FX) ;KEEP REQUEST IN FKINT
		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
	MOVE FX,FORKX		;GET THIS FORK'S ID
	SETZRO FKICO,(FX)	;CLEAR THIS CONDITION (NECESSARY
				; IF THIS WAS DEFERRED).
	XMOVEI T1,JOBCOF	;SET TO DEBREAK TO ACTION PROCEDURE

PIRLG1:	SETZM PIOLDS		;MAKE FORK RUNNABLE
	EXCH T1,PIPC
	MOVX T2,MONENV		;SET AC BLOCKS FOR NEW FLAGS WORD
	EXCH T2,PIFL		;GET FLAGS, SET NEW ONES FOR DEBREAK
	TXNN T2,UMODF
	IFSKP.
	  MOVEM T1,P5		;IN USER MODE, SIMULATE JSYS
	  MOVEM T2,P3		;Store new flags as well
	  JRST PIRQR
	ENDIF.
	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

;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
		SETONE FKILO,(FX)
		JRST PSIDFR]
	XMOVEI T1,FLOGO
	SETZM PIOLDS		;MAKE FORK RUNNABLE
	MOVEM T1,PIPC
	MOVX T2,MONENV		;SET AC BLOCKS FOR NEW FLAGS WORD
	MOVEM T2,PIFL		;Set new ones for DEBREAK
	MOVX P3,USRCTX		;Force reinit of stack at FLOGO
	SETZM P5		;Unique address for new PC
	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
;DAP attention interrupt
;Here when PSIDP% is set in FKINT
FKDAP: 	DMOVE T1,PIFL
	CALL PITEST		;interrupt OK now?
	IFNSK.
	  MOVE FX,FORKX		;no, setup defer
	  SETONE FKIDP,(FX)	;keep request
	  JRST PSIDFR 		;go set defer
	ENDIF.
	MOVX T1,PSIWT%		;see if process was waiting
	TDNE T1,PIMSK		;was it?
	SOS PIPC		;yes. make it go back into wait when finished
	MOVE FX,FORKX		;get this fork's id
	SETZRO FKIDP,(FX)	;clear interrupt condition bits
	XMOVEI T1,DAPHND	;get addr of action procedure
	JRST PIRLG1		;set to debreak to action procedure
; JSYS TRAP REQUEST

;Here when PSIJT% is set in FKINT
;A process executed a JSYS that this process was monitoring. This process
;will receive an interrupt on the channel that it specified.

PIRJTP:	DMOVE T1,PIFL		; Pick up flags
	CALL PITEST		; FORK INTERRUPTABLE?
	 JRST PIRJT1		; NO, DEFER IT
	MOVE FX,FORKX		; IN CASE THIS PSI WAS DEFERRED
	SETZRO FKIJT,(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
	SETONE FKIJT,(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
	OPSTRM <IORM T1,>,FKINX,(FX) ;SAVE OTHERS
	DMOVE T1,PIFL		;GET INTERRUPTED PC DOUBLEWORD
	CALL PITEST		;INTERRUPTABLE?
	 JRST PIRBK1		;NO
	SETONE <FKFR1,FKFRA>,(FX) ;YES. INDICATE FREEZE DUE TO ADDRESS BREAK
	SETZRO FKABK,(FX)	;CLEAR ORIGINAL REQUEST BIT
	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:	SETONE FKABK,(FX)	;RE-LIGHT REQUEST BIT
	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
	XSFM T1			;SEE IF CONTEXT BEING SETUP RIGHT
	TXNE T1,PCU
	TXNN T1,EXPCS
	IFNSK.
   IFN SKEDSW,<
	  BUG.(CHK,PSIIBE,SCHED,SOFT,<PSII - Flags not set properly>,<<T1,FLAGS>>,<
Cause:	At PSII, the PC flags were found not set properly.  All paths
	to PSII should ensure that PCU is 1 and PCS is non-0.  This
	is under a debug conditional and so should not be seen in the
	field.

Data:	T1 - Flags from XSFM.
>)
   >				;END DEBUG CONDITIONAL
	  MOVX T1,MONENV
	  JSP T2,[XJRSTF T1]	;MAKE THEM RIGHT
	ENDIF.

;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
	TXNE FX,PSIDP%		;DAP attention ?
	JRST FKDAP		;yes. handle it

;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
	OPSTRM <EXCH 1,>,FKIBX,(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
	AND 1,PSIBW		;FLUSH DISABLED CHANS
	TDNN 1,MONCHN		;MONITOR CHANNEL?
	SKIPN 3,PIOLDS		;NO. 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.
	MOVEM 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)

	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
;Set up PIPC to go to the interrupt routine provided in user's CHNTAB

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

;This removes op code and AC, which may have been in the flags word if it
;came from FFL. This may not be necessary on the KL. On the KC, it is wrong

   IFN KLFLG,<
	HLLZM T1,PIFL		;PRESERVE USERS FLAGS
   >				;END OF IFN KLFLG
	;..
;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,,[
		ANDX T1,EXFLBT	;DON'T RETURN BITS THE USER SHOULDN'T SEE
		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
;MONBK/ 30 bit address of interrupt routine (include section number !!)
;Copy new PC to PIPC, and new flags to PIFL
;Store old flags in ITFFL, and old PC in ITFPC

PSIMB:	MOVX T1,MONENV		;COOK UP NEW FLAGS
	EXCH T1,PIFL		;GET OLD FLAGS & SET UP NEW FLAGS
	MOVE T2,MONBK		;GET ROUTINE ADDRESS (30 BIT ADDRESS)
	EXCH T2,PIPC		;GET OLD PC - SET NEW PC
	DMOVEM T1,ITFFL		;SAVE OLD FLAGS & OLD PC
	SETZM PIOLDS		;WE WERE RUNNING BEFORE PSI.
	JRST PIRQR		;GO TO IT.
;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 CURRENT STACK 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 (IN PIAC)

	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

;Copy previous context AC's onto the PI stack.

	ADD FX,[20,,20]		;POINT TO END OF BLT
	JUMPGE FX,PIOVFW	;IF POSITIVE NO ROOM
	STPAC. T2,-17(FX)	;COPY PREVIOUS AC'S TO THE STACK

;Load previous context AC's saved during JSYS entry

	LDPAC. T2,UACB		;LOAD PREVIOUS CONTEXT AC'S

;Copy all AC blocks (saved in UACB during nested JSYS entry) onto the PI stack

	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)

;Set up to return to user mode

PSISM1:	PUSH FX,1		;SAVE COUNT FOR DEBRK
	PUSH FX,ACBAS		;AND CURRENT ACBAS
	MOVE 1,UPP		;RESET MON STACK
	MOVEM 1,PIAC+P
	MOVE 1,UPDL+1		;USER FLAGS AT MONITOR CALL
	ANDX T1,EXFLBT		;GET ONLY FLAGS BITS
	TXO T1,USRCTX		;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
	TXZ T1,USRCTX		;SO HE CAN TELL IT WAS MON INTERRUPT
	SETOM SLOWF
	JRST PSIS5		;FINISH INTERRUPT START

;At this point,
;	PIFL/ flags from top of UPDL with user context forced on
;	PIPC/ New PC as provided by user's channel table
;	T1/ flags from top of UPDL with user context forced off
;	T4/ PC from the top of UPDL

;T1 and T4 will be stored into the user's LEVTAB

PIOVFW:	BUG.(HLT,PSISTK,SCHED,HARD,<PSI STORAGE STACK OVERFLOW>,,<

Cause:	A software interrupt occurred while a process was running
	in the monitor. The monitor is saving information regarding
	the state of the process so that in can restore that state
	when the process dismisses the interrupt. The BUGHLT indicates
	that the storage area has overflowed.

>)
;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
	SKIPE MONCHN		;MONITOR CHANNELS ACTIVATED
	JRST [	MOVEI T1,^D35	;YES GIVE CH 35 INTERRUPT TO THIS FORK
		MOVE T2,FORKX
		CALLRET PSIRQ]
	SKIPN 1			;OR
	SKIPA 1,[^D35]		;TERMINATING TOP FORK, GIVE CH 35
	MOVEI 1,TRMINT		;19 IS FORK TERMINATED
	CALL PSIT		;TRANSMIT IT
	RET

;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


;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
	SETONE FKPS1,(FX)	; BUT LEAVE PENDING BIT
	CALL CHKBMP		;SEE IF NEED PI BUMPING AGAIN
	 NOP
	JRST PSIDF1		;RESUME

;These are two possible contents of MJRSTF. JSYS return executes this
;location. MJRST0 causes a return to the previous context. If a process
;is NOINT when an interrupt occurs, PSIDFR stores MJRST1 in MJRSTF (see
;above). WHen the process executes MJRSTF, the code at PSISV0 is executed.

MJRST0:	XJRSTF FFL		;NORMAL CONTENTS OF MJRSTF
MJRST1:	JRST PSISV0		;TRY FOR INTERRUPT NOW

;These are two possible contents of INDTFF. The OKINT macro executes this
;location. INTDF0 decrements the noint count. If a process is NOINT when an
;interrupt occurs, PSIDFR stores INTDF1 in INTDFF (see above). When the
;process executes an OKINT, the code at PSISV1 is executed, and the flags
;and PC are stored in PIFL/PIPC.

INTDF0:	SOS INTDF		;NORMAL CONTENTS OF INTDFF
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:
   IFN KLFLG,<
	DATAO PAG,SETMON	;SET MON AC BLOCK CURRENT
   >				;END OF IFN KLFLG
	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:
   IFN KLFLG,<
	DATAO PAG,SETMON	;SET MON AC BLOCK CURRENT
   >				;END OF IFN KLFLG
	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		;COPY FFL TO PIFL, RESTORE AC
	EXCH 2,PIPC		;COPY FPC TO PIPC, RESTORE AC
	;..
;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
	LOAD FX,FKINX,(2)
	XJRSTF [MONENV		;ESTABLISH PROPER CONTEXT
		MSEC1,,PSII]	;AND 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.(CHK,PSINSK,SCHED,HARD,<PSI FROM NOSKED OR CRSKED CONTEXT>,,<

Cause:	This process is NOSKED or CSKED, but is not NOINT.

>)
	JRST RSKP		;IMMEDIATE

;TEST FOR PI BUMPING NEEDED
;	FX/ FORK INDEX

CHKBMP:	LOAD CX,FKINX,(FX)
	TXNE CX,SUSFK%!PSILO%!PSIT1%!PSIT2%!PSIDP%!PSIPRI ;ANY INTERRUPT BITS ON?
	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
	SETPCS MSEC1A		;SET PCS TO 1 SO PXCT [BLT] WORKS
	MOVE 2,FORKX
	SETONE FKPS1,(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]
		 ERJMP [MOVE T2,FORKX   ; get fork # back
			MOVX T1,FKPSI1  ; no longer uninterruptable
			ANDCAM T1,FKINT(T2) ; so prevent us from hanging
			MOVE T1,LSTERR  ; get the last error
			ITERR ()] 	; and generate an interrupt 
		ANDX Q1,EXFLBT		;GET ONLY THE FLAG BITS
		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
	ANDX Q1,EXFLBT		;GET ONLY THE FLAG BITS
	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:	MOVE 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+37777777B35 ;SAVE RIGHT HALF FLAGS, TOO
	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
	ANDX T2,EXFLBT		;GET ONLY THE FLAG BITS
	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	;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

;Restore AC blocks that had been saved at JSYS entry

	MOVEI Q1,UACB
	HRLI Q1,1(FX)
	ADDI 4,0(Q1)
	HRRZS T4
	BLT Q1,-1(4)		;RESTORE AC BLOCKS

;Copy previous context AC's to UACB block

	STPAC. Q1,UACB		;SAVE PREVIOUS CONTEXT AC'S

;Load previous context AC block from PI stack

	SUB FX,[20,,20]		;COMPUTE START OF WHERE AC'S ARE
	LDPAC. T2,1(FX)		;LOAD PREVIOUS CONTEXT AC'S FROM STACK


;Restore current context AC's from PIAC

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
	PIOLDS
	P2			;TRAPFL
	P3			;KIMUFL
	P4			;TRAPPC
	P5			;KIMUPC
	P6			;KIMUEF
   IFN KCFLG,<
	KIMOAC
   >
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
TRPSI4:	LOAD T2,JTMCN,(P6)
	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.(CHK,TRPSIE,SCHED,HARD,<NO MONITOR FOR TRAPPED FORK>,,<

Cause:	This BUG is not documented yet.

Action:

>)
	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
;Note: It may be necessary to work on this for the KC. It's not clear
;whether FFL has the right context always or not. But JSTAB no longer contains
;PCU, and FFL got PCU at MENTU, so this HLLZM no longer seems necessary. It
;also has the side-effect of clearing PCS.
;	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

;INVOKED VIA JSP CX,FRZPSI (MAKES USE OF CX)

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		;CLEAR FLAGS IN CASE SECTION 0 CALLED
	MOVEM CX,PPC		; Save return for DISMSE
	MOVE CX,ENSKR		;GET THE RIGHT FLAGS (ENTSKD STORED THEM)
	MOVEM 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
	SETONE <FKPS1,FKFRJ>,(FX) ;DO "JSYS TRAP" FREEZE OF SELF
				;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:	RETSKP


;Here when lock was already locked. Go add this process to the queue

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

;JTENQ - ROUTINE TO PLACE FORK ON QUEUE

;INVOKED VIA JSP CX,JTENQ (MAKES USE OF CX)

;This routine dismisses, with the process pointing to the instruction
;following the JSP that invoked it.

JTENQ:	HRL T1,SYSFK(P4)	;1=FORK WAITING ON
	ENTSKD			;ENTER SCHEDULER
	TXZ CX,EXFLBT		;CLEAR FLAGS IN CASE SECTION 0 CALLED
	MOVEM CX,PPC		; Save return for DISMSE
	MOVE CX,ENSKR		;GET THE RIGHT FLAGS (ENTSKD STORED THEM)
	MOVEM CX,PFL		;FOR RESUME AFTER DISMSE
	SOSE NSKED		;MATCHED NOSKED IN JTLOCK
	BUG.(HLT,JTENQE,SCHED,SOFT,<JTENQ WITH BAD NSKED>,,<

Cause:	A process has attempted to lock the JSYS trap lock and found
	it already locked. The process will enter a queue and dismiss until
	the lock becomes available. The BUGHLT occurs because when the process
	decrements its NOSKED counter, the value does not go to 0. This
	means that the process is still NOSKED or it was OKSKED when it
	should have been NOSKED.
>)
	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:	JE FKSUS,(FX),0(T4)	;DON'T WAKE IF NOT SUSPENDED BEFORE BLOCKING
	SETONE <FKPS0,FKIWT>,(FX) ;WAS SUSPENDED. REINITIATE SUSPEND
	SETZRO FKPS1,(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
	LOAD T3,FKSTD,(T4)
	CAMN T3,T2		;THIS FORK WAITING ON EX FORK?
	JRST JTULC2		;YES, REMOVE IT FROM QUEUE
	LOAD T1,FKJTN,(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 1,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		;MAKE HEADER POINT TO "PREVIOUS"
	OKSKED
	RET
	SUBTTL Context switching for MUUO's


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

ILUUO::	MCENTR
ILUUO1::MOVEI T1,ILINS1
	ITERR			;ILLEGAL UUO

;ALL UNDEFINED JSYS'S

UJSYS0::MCENT
UJSYS::	MOVEI T1,ILINS2
	ITERR			;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,[MSEC1B+TRAPSI] ; We are, go JSYS trap route
		JRST MENTU1]	; Join JSYS code
U10501::SKIPL T1,PATADR		;Get the possible address of PAT
	TRNN T1,777777		;Do we have one now? (If yes, RH non-zero)
	 JRST GETPAT		;NO PAT CURRENTLY TRY TO GET ONE
	SETPCS T1		;SET PCS TO SECTION OF ENTRY VECTOR
	TXNN T1,XS%EEV		;EXTENDED FORMAT VECTOR?
	IFSKP.
	  MOVE T1,PATUPC	;YES, GET ITS ADDRESS
   IFN KLFLG,<
	  MOVE T2,KIMUFL	;GET FLAGS WITH OP CODE, AC, AND PCS
   >				;END OF IFN KLFLG
   IFN KCFLG,<
	  MOVE T2,KIMUFL	;GET FLAGS WITH PAB, CAB, AND PCS
	  HRR T2,KIMOAC		;CREATE FLAGS WITH OP CODE AND AC AS ON KL
   >				;END OF IFN KCFLG
	  MOVE T3,FPC		;GET PC WORD
	  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
   IFN KLFLG,<
	  HRL T2,KIMUFL		;GET OP CODE AND AC
   >				;END OF IFN KLFLG
   IFN KCFLG,<
	  HRL T2,KIMOAC		;GET OP CODE AND AC
   >				;END OF IFN KCFLG
	  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
	SETPCS T1		;SET PCS TO SECTION OF ENTRY VECTOR
	TXNN T1,XS%EEV		;EXTENDED FORMAT VECTOR?
	IFSKP.
	  MOVE T1,DMSUPC	;PTR TO PC
   IFN KLFLG,<
	  MOVE T2,KIMUFL	;GET FLAGS WITH OP CODE, AC, AND PCS
   >				;END OF IFN KLFLG
   IFN KCFLG,<
	  MOVE T2,KIMUFL	;GET FLAGS WITH PAB, CAB, AND PCS
	  HRR T2,KIMOAC		;CREATE FLAGS WITH OP CODE AND AC AS ON KL
   >				;END OF IFN KCFLG
	  MOVE T3,FPC		;GET PC WORD
	  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
   IFN KLFLG,<
	  HRL T2,FFL		;GET OP CODE AND AC
   >				;END OF IFN KLFLG
   IFN KCFLG,<
	  HRL T2,KIMOAC		;GET OP CODE AND AC
   >				;END OF IFN KCFLG
	  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

;At this point,
;FFL, FPC  - return flags and PC stored on MUUO.

MENTM::	LOAD CX,EXPCBT,JSTAB(CX) ;GET ROUTINE ADDRESS WITHOUT FLAGS
	SETOM SLOWF
	PUSH P,INTDF		;SAVE CONTEXT VARIABLES
	PUSH P,MPP
	PUSH P,FPC		;SAVE RETURN PC, FLAGS
	PUSH P,FFL
	MOVEM P,MPP		;SET NEW FRAME POINTER
	XSFM FFL
	MOVEM CX,FPC		;SETUP START PC FOR NEW JSYS
   IFN SKEDSW,<
	MOVE CX,-1(P)		;GET OLD PC
	TXNN CX,EXSCBT		;CALLED FROM NON-0 SECTION?
	BUG.(CHK,JSSEC0,SCHED,SOFT,<NESTED JSYS CALL FROM SECTION 0>,<<CX,PC>>,<

Cause:	At entry to a JSYS called within the monitor, the return PC is
	in section 0.  This is a coding error which should be corrected.
	This is under a debug conditional, so should never occur in
	the field.

Data:	1. PC of offending JSYS.
>)
	AOSGE INTDF		;CHECK STATE OF INTDF
	BUG.(CHK,IDFOD1,SCHED,SOFT,<AT MENTR - INTDF OVERLY DECREMENTED>,<<CX,PC>>,<

Cause:	At the time of a nested JSYS call, INTDF was less than -1.  Some
	code in the calling context must have fouled it up.  This is
	under a debug conditional and so should not appear in the field.

Data:	1. PC at which last JSYS was executed.

>)
	SOS INTDF
   >				;END OF IFN SKEDSW

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

	AOS P,ACBAS		;SETUP NEXT AC STACK BLOCK
	CAIL P,<EUACB>B39	;USED ALL BLOCKS?
	BUG.(HLT,NOACB,SCHED,SOFT,<MENTR - NO MORE AC BLOCKS>,<<CX,PC>>,<

Cause:	When a JSYS is executed from within the monitor, the
	AC's of the current process are stored in a special area in the
	monitor.  This area consists of several 20-word blocks that are used
	successively as one JSYS invokes another.  The BUGHLT indicates that a
	JSYS has been called but that no 20-word block is left in which to
	store the contents of the AC's.  This usually means that the counter
	that the monitor uses to keep track of these blocks has been
	clobbered.

Data:	1. PC at which last JSYS was executed.
>)
	LSH P,4			;MAKE INTO ADDRESS

;Copy the former "current" AC's (block 0) to the new "previous" AC's (block 1)

   IFN KLFLG,<
	SETPCS MSEC1A		;SET PCS SO PXCT [BLT] WORKS
	MOVEI CX,0(P)
	XCT 1,[BLT CX,17(P)]	;SAVE PREVIOUS CONTEXT AC'S
	SETZ CX,
	XCT 4,[BLT CX,CX-1]	;LOAD PREVIOUS CONTEXT AC'S 0-15 FROM CURRENT
   >				;END OF IFN KLFLG
   IFN KCFLG,<
	STPAC. CX,(P)		;SAVE PREVIOUS CONTEXT AC'S
	LDPAC <CX-1>,0		;LOAD PREVIOUS CONTEXT AC'S 0-15 FROM CURRENT
   >				;END OF IFN KCFLG
	MOVE P,MPP		;RESTORE P
	SETZM SLOWF
	XCT MJRSTF		;RESUME MONITOR ROUTINE (NORMALLY XJRSTF FFL)
;Entry for MCENTR (JSP CX,MENT0).  FFL and FPC have been setup by
;the caller, and may only be a user PC.

MENT0::	SETOM SLOWF
	MOVE T1,FFL
	TXNE T1,UMODF		;SIMULATING CALL FROM USER MODE?
	IFSKP.
   IFN SKEDSW,<
	  BUG.(HLT,MNTRNU,SCHED,SOFT,<MCENTR WITHOUT SETUP OF USER OLD PC>,<<CX,PC>>,<

Cause:	MCENTR has been used without FFL having been setup to be a
	user PC.  This is a coding error.

Data:	1. PC at which MCENTR was executed.
>) >
	  MOVX T1,UMODF		;DUMMY UP ONE
	  MOVEM T1,FFL
	ENDIF.
	MOVE P,UPP		;YES
	PUSH P,FPC
	PUSH P,FFL
	PUSH P,FPC
	PUSH P,FFL
	XSFM T1			;COOK UP PROPER FLAGS
	TXO T1,PCU		;PCU MUST BE ON
	LOAD T2,VSECNO,FPC	;SECTION NUMBER OF RETURN PC
	STOR T2,EXPCS,T1	;PUT IT WHERE HARDWARE SEES IT
	MOVEM T1,FFL		;USE THAT AS NEW FLAGS
	JRST MENT2		;JOIN NORMAL USER CASE, PC IN CX
;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
		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?
		MOVE CX,[MSEC1,,TRAPSI] ;YES. HANDLE THIS SPECIALLY
		JRST MENTU1]
	MOVE CX,JSTAB(CX)	;GET ROUTINE ADDRESS

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

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

MENT2:	MOVEM CX,FPC		;SAVE NEW PC
	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
   IFN SKEDSW,<
	SKIPN NSKED		;IS THIS PROCESS NOSKED?
	SKIPE CRSKED		;OR CSKED?
	IFNSK.
	  SKIPN PNSKDC		;YES, SHOULD IT BE?
	  BUG.(HLT,MCLNSK,SCHED,SOFT,<PROCESS IS NOSKED OR CSKED AT JSYS ENTRY>,,<

Cause:	At entry to a monitor call from user mode, process was found to
	be NOSKED or CSKED.  This should not be unless flag PNSKDC is set
	indicating that a DIAG% has been done.
>)
	ENDIF.
 >			;END SKEDSW
	SKIPN PNSKDC		;DIAG% NOSKED MEANS DON'T RESET INTDF
	SETOM INTDF		;INIT INTDF
	SETZM SLOWF		;INIT SLOWF
	XCT MJRSTF		;RESUME MONITOR ROUTINE (NORMALLY XJRSTF FFL)

;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 in LSTERR and
;	into user's AC 1 if no ERJMPS/ERCALS present
;EMRET0 - invoked via EMRETN. Stores error code into LSTERR
;EMRET1 - invoked via JRST. Assumes LSTERR already stored.

MRETNE::CALL TSTERJ		;ERCALS/ERJMPS PRESENT?
	 UMOVEM T1,1		;NO, RETURN ERR CODE IN AC1
EMRET0::MOVEM T1,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.(CHK,IDFOD2,SCHED,SOFT,<AT MRETN - INTDF OVERLY DECREMENTED>,,<

Cause:	At MRETN, INTDF was found to be less than -1.  This indicates
	that this JSYS code did an unmatched OKINT and may have
	allowed interrupts when it didn't intend to.  This is
	a coding error.

>) >
	MOVE P,MPP		;GO BACK TO LAST STACK FENCE
	POP P,CX		;RETURN FLAGS
	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
JSLKB2::			;TAG FOR JSLOOK (SNOOP PGM)
	POP P,FPC		;RESTORE PC

   IFN SKEDSW,<
	SKIPN CRSKED
	SKIPE NSKED		;FAILED TO MATCH NOSKED, CSKED?
	IFNSK.
	  SKIPN PNSKDC		;DIAG% NOSKED?
	  BUG.(HLT,RTNNSK,SCHED,SOFT,<PROCESS IS NOSKED OR CSKED AT MRETN>,,<

Cause:	Process is NOSKED or CSKED at return from monitor call.  Probably
	this JSYS went NOSKED or CSKED and forget to do the matching
	OKSKED or ECSKED.  This is a coding error.
>)
	ENDIF.
	SKIPGE FKLOCK		;FORK LOCK FREE?
	IFSKP.
	  HRRZ CX,FORKN		;GET US
	  CAME CX,FLKOWN	;ARE WE THE OWNER?
	ANSKP.
	  BUG.(CHK,INCFLK,SCHED,SOFT,<Fork lock set at return to user>,,<

Cause:	Coding error has neglected to unlock the fork lock.

Action:	The monitor unlocks the fork lock before returning
	to the user. However,  this BUGCHK may be indicative
	of other failures to properly release resources

>)		;YES. COMPLAIN THEN
	  SETOM FKLOCK		;FREE IT
	  SETZM FLKCNT		;AND FREE THIS TOO
	ENDIF.
    >			;END IFN SKEDSW

;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::
   IFN KLFLG,<
	DATAO PAG,SETUSR	;SETUP USER AC BLOCK AS CURRENT
   >			;END OF IFN KLFLG
	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".

   IFN KLFLG,<
	SETPCS MSEC1A		;FUDGE PCS SO PXCT [BLT] WORKS
	SETZ CX,		;MOVE PREV AC TO CURRENT
	XCT 1,[BLT CX,CX-1]	;RESTORE CURRENT AC'S 0-15 FROM PREVIOUS
   >				;END OF IFN KLFLG

   IFN KCFLG,<
	STPAC <CX-1>,0		;RESTORE CURRENT AC'S 0-15 FROM PREVIOUS
   >				;END OF IFN KCFLG

;Restore previous AC's from ACBAS block, stored at JSYS entry.

	HRRZ CX,ACBAS		;POINT TO CURRENT LOCATION ON STACK
	LSH CX,4
	LDPAC. CX,0(CX)		;LOAD PREVIOUS CONTEXT AC'S FROM STACK
	SOS CX,ACBAS		;DECREMENT ACBAS PTR
	CAIGE CX,<UACB>B39-1
	BUG.(HLT,OPOPAC,SCHED,HARD,<MRETN - TRIED TO OVER-POP AC STACK>,,<

Cause:	When a JSYS is executed from within the monitor, the
	AC's of the current process are stored in a special area in the
	monitor.  This area consists of several 20-word blocks that are used
	successively as one JSYS calls another.

	As each nested JSYS returns, the monitor's pointer to this area of
	memory is decremented.  The BUGHLT indicates that the pointer has
	been decremented too far.  This indicates either a clobbered pointer,
	or an attempt to return from a JSYS without having entered one.

>)

;Restore variables stored on UPDL stack at JSYS entry.

	POP P,MPP		;RESTORE VARIABLES
	POP P,INTDF
	SETZM SLOWF
	XCT MJRSTF		;RETURN TO CALLER (NORMALLY XJRSTF FFL)
;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		;INHIBIT PSI
	XSFM FFL		;SAVE FLAGS
	TXZ CX,EXFLBT		;MASK OFF FLAGS FROM JSP (IF CALLED FROM SEC 0)
	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,INTDF		;ESTABLISH USUAL STACK CONTEXT
	PUSH P,MPP
	AOS FPC			;BUMP RETURN PAST CALL ADDRESS WORD
	PUSH P,FPC		;SAVE RETURN PC
	MOVE CX,FFL		;PICK UP FLAGS
	TXO CX,IMCFLG		;FLAG INTERNAL CALL
	PUSH P,CX		;SAVE RETURN FLAGS
	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
	  MOVE CX,JSTAB(CX)	;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 FLAGS WORD

IMCLL1:	POP P,MPP		;RESTORE CONTEXT VARIABLES
	POP P,INTDF
	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
	CAIE T4,<ERJMPS>B58
	CAIN T4,<ERJMP>B58	;AN ERJMP?
	JRST ITRSX		;YES
	CAIE T4,<ERJMPR>B58	;AN ERJMPR?
	IFSKP.
	  MOVE T4,LSTERR	;YES, MAKE SURE ERRCOD RETURNED IN AC1
	  UMOVEM T4,1
	  JRST ITRSX
	ENDIF.
	CAIE T4,<ERCAL>B58	;AN ERCAL?
	CAIN T4,<ERCALS>B58
	IFSKP.
	  CAIE T4,<ERCALR>B58	;NO, AN ERCALR?
	  RET			;NOTA, RETURN
	  MOVE T4,LSTERR	;RETURN ERRCOD IN AC1 ALWAYS
	  UMOVEM T4,1
	ENDIF.

;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
	TXNN T1,IMCFLG		;MONITOR AND INTERNAL CALL?
	IFSKP.
	  TXNN T3,<Z 0(17)>	;INDEXING?
	  IFSKP.
	    XCT T3		;YES, DO THE XMOVEI
	  ELSE.
	    TXNN T3,<Z @0>	;INDIRECTION?
	    IFSKP.
	      HLL T3,T2		;YES, SIMULATE ONE LEVEL...
	      MOVE T3,0(T3)	;PICK UP INDIRECT WORD FROM LOCAL SECTION
	    ELSE.
	      HLL T3,T2		;NO, PLUG IN SECTION FROM RETURN PC
	    ENDIF.
	  ENDIF.
	  RETSKP		;DONE
	ENDIF.
	XCTUU T3		;GET PREV CONTEXT ADDRESS
	 ERJMP R		;GIVE UP IF E CALC FAILS
	RETSKP			;GIVE GOOD RETURN
;TSTERJ - Test for putting error code into specific AC.
;	CALL TSTERJ
; RETURN +1: Error code should be stored.
;	+2: ERJMPR/ERCALR/ERJMPS/ERCALS present, don't store.
;	ALL ACS PRESERVED

TSTERJ::SAVET
	MOVE T4,MPP		;GET LAST STACK FENCE
	DMOVE T1,-1(T4)		;GET PC DOUBLEWORD
	EXCH T1,T2		;IN PROPER ORDER
	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,<ERJMPR>B58
	CAIN T1,<ERCALR>B58	;THE R FLAVOR?
	RETSKP			;YES, CODE STORED BY ITRSIM ONLY.
	CAIE T1,<ERJMPS>B58	;IS IT AN ERJMPS?
	CAIN T1,<ERCALS>B58	; OR AN ERCALS?
	RETSKP			;YES, NO CODE IN AC
	RET			;NO

;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
;Finds S flavor too.

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,<ERJMPR>B58	;R FLAVOR?
	CAIN T1,<ERCALR>B58
	RETSKP			;YES
	CAIE T1,<ERJMPS>B58	;S FLAVOR?
	CAIN T1,<ERCALS>B58
	RETSKP			;YES
	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



;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
	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,@[EP. CLSSHR(P1)]	;GET CLASS' SHARE
	UMOVEM T4,0(T3)		;RETURN TO CALLER
	AOBJP T3,SKDONE		;WANT MORE?
	MOVE T4,@[EP. 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,@[EP. CLSRJA(P1)] ;GET FIRST AVERAGE
	UMOVEM T4,0(T3)		;STORE IT
	AOBJP T3,SKDONE		;WANT MORE?
	MOVE T4,@[EP. CLSRJA+1(P1)] ;GET SECOND AVERAGE
	UMOVEM T4,0(T3)		;STORE IT
	AOBJP T3,SKDONE		;LAST ONE TOO?
	MOVE T4,@[EP. 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
	CAME T1,[-1]		;THIS JOB?
	IFSKP.			;IF SKIP, T1 IS -1, SO GET OUR OWN JOB INDEX
	 MOVE T1,JOBNO		;FROM THE LOCAL JOB NUMBER
	ELSE.			;IF NO SKIP, T1 IS A GLOBAL JOB NUMBER, SO
	 CALL GL2LCL		;ASK CFS TO CONVERT IT TO A LOCAL
	  ITERR(ARGX08)		;AND COMPLAIN IF THE JOB NUMBER WAS ILLEGAL
	ENDIF.			;NOW CONTINUE WITH THE LOCAL JOB INDEX IN T1
	SKIPGE JOBRT(T1)	;LOGGED IN?
	ITERR (ARGX15)		;NO
	HRRZ P1,@[EP. JOBCLS(T1)]	;GET CLASS OF JOB
	UMOVEM P1,0(T3)		;RETURN CLASS NUMBER
	AOBJP T3,SKDONE		;WANT MORE?
	MOVE T4,@[EP. CLSSHI(P1)]	;YES. GET JOB'S SHARE
	UMOVEM T4,0(T3)		;AND RETURN TO USER
	AOBJP T3,SKDONE		;WANT MORE?
	MOVE T4,@[EP. JOBUTL(T1)]	;YES. GET UTILIZATION
	UMOVEM T4,0(T3)		;AND RETURN IT TO THE USER
	AOBJP T3,SKDONE		;WANT MORE?
	MOVE T4,@[EP. CLSSHR(P1)]	;YES. GET CLASS SHARE
	UMOVEM T4,0(T3)		;AND RETURN TO USER
	AOBJP T3,SKDONE		;WANT MORE?
	MOVE T4,@[EP. 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 CLSSWA 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,@[EP. CLSSHR(T1)]	;SAVE OLD CLASS VALUE
	MOVEM T2,@[EP. CLSSHR(T1)]	;SET NEW CLASS
	SETZM P1		;GET ACCUMULATOR
	MOVEI T3,MAXCLS-1
SKDSC1:	FAD P1,@[EP. CLSSHR(T3)]	;GET TOTAL SHARES ALLOCATED
	SOJGE T3,SKDSC1
	POP P,@[EP. 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,@[EP. CLSSWA(T1)]		;SET CLSSWA 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?
	IFSKP.			;SKIP MEANS OUR OWN JOB
	 MOVE T4,GBLJNO		;Save Global job number for GETOK%
	 MOVE T1,JOBNO		;GET OUR LOCAL JOB INDEX
	ELSE.			;NO SKIP, MEANS A GLOBAL JOB NUMBER IS THERE
	 MOVE T4,T1		;Save global job number for GETOK%
	 CALL GL2LCL		;SO CONVERT IT TO A LOCAL INDEX
	  ITERR(ARGX08)		;AND COMPLAIN IF THAT GLOBAL WAS NO GOOD.
	ENDIF.			;
	CAMN T2,JOBNO		;DID WE END UP WITH OURSELF?
	IFSKP.			;SKIP MEANS IT'S SOMEONE ELSE'S JOB NUMBER
	 MOVX T3,SC%WHL!SC%OPR	;SO CHECK FOR THESE PRIV'S
	 TDNN T3,CAPENB		;FOR WHEEL/OPR
	  ITERR(CAPX1)		;NOT GOOD ENOUGH
	ENDIF.			;JUST FINE.
	SKIPGE JOBRT(T1)	;LOGGED IN?
	 ITERR (ARGX15)		;NO
	SKIPL T2		;TRYING TO SET A VALID CLASS?
	CAIL T2,MAXCLS		;HMMMMM?
	 ITERR (ARGX25)		;ITRAP TO USER, THE LOSER
;	MOVX T3,SC%WHL		;SEE IF THIS JOB IS WHEELED
;	TDNE T3,CAPENB		;IS IT?
;	JRST SKDSJ1		;YES. SKIP GETOK THEN
	GTOKM (.GOCLS,<T4,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:	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
	MRETNG			;AND DONE

;RUN ALL BATCH JOBS ON DREGS QUEUE

SKDRDQ:	STKVAR <OPRIOR,NPRIOR,JOBN,TTYN>
	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 PTYTTY		;CONVERT TO TERMINAL NUMBER
	MOVEM T2,TTYN		;SAVE TERMINAL NUMBER
	MOVE T1,TTYN		;GET TTY NUMBER IN AC1
	CALL CHKBCH		;IS THIS JOB A BATCH JOB?
	 JRST SKDDQ2		;NO, IGNORE IT
	MOVE T2,TTYN		;GET BACK TERMINAL NUMBER
	CALL GTCJOB		;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
	CALL LCL2GL		;Convert local job index to global job number
	 JRST SKDDQ2		; No such job, this shouldn't happen.
	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

;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