Google
 

Trailing-Edge - PDP-10 Archives - BB-M080V-SM_1990 - monitor-sources/fork.mac
There are 53 other files named fork.mac in the archive. Click here to see a list.
; Edit= 9119 to FORK.MAC on 24-Aug-89 by GSCOTT
;Implement new GETOK functions .GODSK, .GOSJP, and .GOSPR. 
; Edit= 9041 to FORK.MAC on 13-Dec-88 by RASPUZZI
;Finish off some of the security features that were started at one time (like
;password expiration). Also, add new features to help a system manager secure
;the system.
; Edit= 9017 to FORK.MAC on 8-Nov-88 by LOMARTIRE
;Merge Production changes to BUG text
; Edit= 8937 to FORK.MAC on 23-Aug-88 by LOMARTIRE
;Spell MONITR correctly in ACTION field of BUGs!
; Edit= 8910 to FORK.MAC on 17-Aug-88 by LOMARTIRE
;Improve BUG. documentation
; UPD ID= 8519, RIP:<7.MONITOR>FORK.MAC.5,   9-Feb-88 15:36:11 by GSCOTT
;TCO 7.1218 - Update copyright date.
; UPD ID= 291, RIP:<7.MONITOR>FORK.MAC.4,  12-Nov-87 15:20:13 by WADDINGTON
;More of TCO 7.1120 - Move call to LATRST to after the CLZFF
; UPD ID= 275, RIP:<7.MONITOR>FORK.MAC.3,   6-Nov-87 23:16:09 by WADDINGTON
;TCO 7.1120 Call LATRST to clean up reverse-lat connections in KSELF:
; *** Edit 7456 to FORK.MAC by GSCOTT on 23-Apr-87, for SPR #19597
; Write session records properly when a job is attached, detached, or its
; session remark is changed. Also make sure session start time is correct. 
; *** Edit 7433 to FORK.MAC by MCCOLLUM on 2-Apr-87, for SPR #21502
; In SETJSB, map FPG2 to the second page of the other job's JSB. 
; *** Edit 7421 to FORK.MAC by PUCHRIK on 9-Mar-87, for SPR #21262
; Remove routines DGET and FFUSEC.  Cleanup GETPA1, GETDMS, and GETSEG.
; Fix situation where DSK: defined to be a program and that program gets
; loaded instead of XRMS.EXE.
; *** Edit 7254 to FORK.MAC by MRASPUZZI on 9-Mar-86, for SPR #20965
; Prevent GLFNF bughlts by reinstalling edit 1868 
; Edit 7173 to FORK.MAC by PALMIERI on 23-Oct-85 (TCO 6.1.1542)
; Move modules NIUSR and LLMOP to an extended section. This required the
; changing of some global routine names in LLMOP; Therefor the changes to
; MEXEC, JSYSA, and FORK. 
; Edit 7146 to FORK.MAC by TBOYLE on 10-Sep-85, for SPR #19847 (TCO 6-1-1537)
; Fix 30-bit argument address problems. 
; Edit 7109 to FORK.MAC by WAGNER on 26-Jul-85, for SPR #17842 (TCO 6-1-1498)
; Fix GFRKH% to not TAKE .FHSUP IN AC2, but will take in AC 1 
;TCO 6.1.1498 Change GFRKH% to not take .FHSUP in AC2, but will in AC1
; UPD ID= 2299, SNARK:<6.1.MONITOR>FORK.MAC.151,  17-Jul-85 11:17:19 by LEACHE
;TCO 6.1.1478 Reinitialize datablock size in argblock of recursive PDVOP
; UPD ID= 2076, SNARK:<6.1.MONITOR>FORK.MAC.150,   3-Jun-85 14:36:21 by MCCOLLUM
;TCO 6.1.1406  - Update copyright notice.
; UPD ID= 2036, SNARK:<6.1.MONITOR>FORK.MAC.149,  31-May-85 10:06:30 by MOSER
;TCO 6.1.1411 - FIX UP FLKTIM FOREVER
; UPD ID= 1986, SNARK:<6.1.MONITOR>FORK.MAC.148,  17-May-85 15:13:08 by MCCOLLUM
;TCO 6.1.1397 - Kill newly created fork after MSETPT error in CFK4
; UPD ID= 1878, SNARK:<6.1.MONITOR>FORK.MAC.147,   4-May-85 12:29:06 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1751, SNARK:<6.1.MONITOR>FORK.MAC.146,  12-Apr-85 15:45:37 by TBOYLE
;TCO 6.1.1318 - fix handling of handle counts by SPLFK% with suicide option.
; UPD ID= 1729, SNARK:<6.1.MONITOR>FORK.MAC.145,   8-Apr-85 14:35:26 by MCCOLLUM
;TCO 6.1.1238 - Fix BUG. documentation
; UPD ID= 1687, SNARK:<6.1.MONITOR>FORK.MAC.144,  26-Mar-85 15:28:58 by LOMARTIRE
;TCO 6.1.1288 - Make the RT%DIM bit work as documented
; UPD ID= 1684, SNARK:<6.1.MONITOR>FORK.MAC.143,  25-Mar-85 15:08:28 by MCCOLLUM
;TCO 6.1.1287 - Change an ITERR to a RETERR in .CFORK.
; UPD ID= 1587, SNARK:<6.1.MONITOR>FORK.MAC.142,   5-Mar-85 10:53:24 by WAGNER
;TCO 6.1.1229 - *PERFORMANCE* Modify SETJSB to check if ourselves
; UPD ID= 1481, SNARK:<6.1.MONITOR>FORK.MAC.141,   5-Feb-85 17:18:33 by GLINDELL
;  TCO 6.1.1174 - EPCAP% jsys and ACJ
; UPD ID= 1426, SNARK:<6.1.MONITOR>FORK.MAC.140,  29-Jan-85 15:40:23 by MCCOLLUM
;TCO 6.1.1163 - Do not clear SYSFK entry until after CLNZSC succeeds in KSELF
; UPD ID= 1182, SNARK:<6.1.MONITOR>FORK.MAC.139,  11-Dec-84 14:12:08 by LEACHE
;Change EHLJSB conditional to EXTJSB
; UPD ID= 1051, SNARK:<6.1.MONITOR>FORK.MAC.138,  13-Nov-84 01:04:08 by GROSSMAN
;TCO 6.1.1045 - Add NI% JSYS reset code to KSELF.
; UPD ID= 5020, SNARK:<6.MONITOR>FORK.MAC.137,  26-Oct-84 13:58:23 by LEACHE
;Add code (under EHLJSB conditional) for extended JSB
; UPD ID= 4807, SNARK:<6.MONITOR>FORK.MAC.136,  17-Sep-84 10:00:42 by PURRETTA
;Update copyright notice
; UPD ID= 4741, SNARK:<6.MONITOR>FORK.MAC.135,  24-Aug-84 09:43:02 by PAETZOLD
;TCO 6.2193 - Prevent IDFOD2 BUGCHKs from long form RFSTS% at RFSLN2.
; UPD ID= 4639, SNARK:<6.MONITOR>FORK.MAC.134,  31-Jul-84 14:34:34 by GLINDELL
;More TCO 6.2153 - fix MOVEI/MOVX
; UPD ID= 4636, SNARK:<6.MONITOR>FORK.MAC.133,  31-Jul-84 12:28:36 by TBOYLE
;COMMENTS FOR WFORK% AND USE OF FKSPL.
; UPD ID= 4631, SNARK:<6.MONITOR>FORK.MAC.132,  30-Jul-84 13:55:31 by GLINDELL
;Tco 6.2153 - fix section 0/section local confusion in PDVOP% jsys
; UPD ID= 4554, SNARK:<6.MONITOR>FORK.MAC.131,  18-Jul-84 10:52:30 by MOSER
;TCO 6.2125 -  SYNCRONOUS KFORK
; UPD ID= 4453, SNARK:<6.MONITOR>FORK.MAC.130,  12-Jul-84 10:35:49 by CDUNN
;More TCO 6.1127 Make KFORK% call SCSKIL in SCSJSY to delete any connects
;the fork may have had.
; UPD ID= 4440, SNARK:<6.MONITOR>FORK.MAC.129,   5-Jul-84 16:51:56 by GROSSMAN
;TCO 6.2118 - Fix UTFRK% function UT%TRP so that forks don't get started at
; PC of ITRAP in user mode if their PC was changed via SFORK%.
; UPD ID= 4389, SNARK:<6.MONITOR>FORK.MAC.128,  26-Jun-84 19:03:26 by PAETZOLD
;TCO 6.2110 - Use correct index register when testing FKEFR in TFRKSR.
; UPD ID= 4348, SNARK:<6.MONITOR>FORK.MAC.127,  15-Jun-84 16:03:18 by TBOYLE
;TCO 6.2090 - Replace TCO 6.2075 - Do not allow indirection or indexing
; UPD ID= 4325, SNARK:<6.MONITOR>FORK.MAC.126,  12-Jun-84 13:28:35 by MOSER
;TCO 6.2086 - FIX SHROFN UNMAP INDEX FILE
; UPD ID= 4301, SNARK:<6.MONITOR>FORK.MAC.125,   4-Jun-84 23:01:56 by MOSER
;REFERENCE SC%CTC SYMBOLICLY
; UPD ID= 4273, SNARK:<6.MONITOR>FORK.MAC.124,  30-May-84 21:21:58 by MOSER
;TCO 6.2059 ADD SETVGN TO RESTORE FORK VIRGINITY
; UPD ID= 4263, SNARK:<6.MONITOR>FORK.MAC.123,  30-May-84 17:59:40 by TBOYLE
;TCO 6.2075 - Make pointers to .POADR in PDVs work the way they should.
; UPD ID= 4225, SNARK:<6.MONITOR>FORK.MAC.122,  16-May-84 15:42:11 by TBOYLE
;More TCO 6.2056 - unblk1 code nosked, be sure fork was blocked, see
; if on TRMLST rather than checking if TRMTST, remove KSELFJ, keep
; whole code to the killing with fork lock locked.
; UPD ID= 4223, SNARK:<6.MONITOR>FORK.MAC.121,  15-May-84 16:26:38 by MOSER
;TCO 6.2061 - PREVENT NOSKED PAGE FAULT IN SFORK
; UPD ID= 4203, SNARK:<6.MONITOR>FORK.MAC.120,   9-May-84 17:02:32 by TBOYLE
;More TCO 6.2056 - Change the value of FLKOWN during the NOSKED splice.
; UPD ID= 4186, SNARK:<6.MONITOR>FORK.MAC.119,   8-May-84 15:40:15 by TBOYLE
;More TCO 6.2056 - Make KSELFJ also call DASFKH to free fork handles.
; UPD ID= 4150, SNARK:<6.MONITOR>FORK.MAC.118,  30-Apr-84 12:26:01 by TBOYLE
;TCO 6.2056 Use FKSPL bit in TRMTST in case of race condition.
; UPD ID= 4133, SNARK:<6.MONITOR>FORK.MAC.117,  25-Apr-84 11:12:15 by LOMARTIRE
;TCO 6.2046 - Add GSWFRK to return system wide fork number given handle
; UPD ID= 4046, SNARK:<6.MONITOR>FORK.MAC.116,   4-Apr-84 16:27:12 by TBOYLE
;More TCO 6.2017 For non WHL: don't use SETJFK on .FHSUP, code explicitly.
; UPD ID= 4015, SNARK:<6.MONITOR>FORK.MAC.115,  31-Mar-84 16:14:24 by PAETZOLD
;TCO 6.2019 - Use ADJSPs
; UPD ID= 3997, SNARK:<6.MONITOR>FORK.MAC.114,  28-Mar-84 15:19:03 by TBOYLE
;More TCO 6.2017 Add comments to SPLFK code in .WFORK, KSELF, .SPLFK
; UPD ID= 3971, SNARK:<6.MONITOR>FORK.MAC.112,  24-Mar-84 23:11:07 by TBOYLE
;More TCO 6.2017 Fix a bug in .wfork on restart, and fix unblk1 at splfk4
; UPD ID= 3965, SNARK:<6.MONITOR>FORK.MAC.111,  23-Mar-84 18:56:54 by TBOYLE
;More TCO 6.2017 Change KFORK to use subroutine to remove fork. New KSELFJ
; routine will perform suicidal death. End of new SPLFK will disable
; interrupts and enter KSELFJ.
; UPD ID= 3920, SNARK:<6.MONITOR>FORK.MAC.110,  13-Mar-84 17:48:23 by TBOYLE
;More TCO 6.2017 Fix error return, to goto EFRKR.
; UPD ID= 3918, SNARK:<6.MONITOR>FORK.MAC.109,  13-Mar-84 17:15:34 by TBOYLE
;More TCO 6.2017 Fix the calls to SFRKV, XSFRK%, and some bugs.
; UPD ID= 3862, SNARK:<6.MONITOR>FORK.MAC.108,   6-Mar-84 17:32:45 by TBOYLE
;More TCO 6.2017 Fix the code, and do the error recovery.
; UPD ID= 3859, SNARK:<6.MONITOR>FORK.MAC.107,   5-Mar-84 18:44:12 by TBOYLE
;More TCO 6.2017 Fix the code.
; UPD ID= 3858, SNARK:<6.MONITOR>FORK.MAC.106,   5-Mar-84 17:52:33 by TBOYLE
;More TCO 6.2017 Fix the new code.
; UPD ID= 3855, SNARK:<6.MONITOR>FORK.MAC.105,   5-Mar-84 16:51:50 by TBOYLE
;More SPLFK, TCO 6.2017, Fix the old code, subroutinize.
; UPD ID= 3854, SNARK:<6.MONITOR>FORK.MAC.104,   5-Mar-84 15:53:09 by TBOYLE
;New SPLFK% Replace self with inferior fork, start, destroy old self.
; UPD ID= 3797, SNARK:<6.MONITOR>FORK.MAC.103,  29-Feb-84 01:42:04 by TGRADY
;IMPLEMENT GLOBAL JOB NUMBERS
; IN .SJPRI, DON' COMPARE JOB NUMBER TO NJOBS...USE GL2LCL TO CONVERT IT
; UPD ID= 3631, SNARK:<6.MONITOR>FORK.MAC.102,   1-Feb-84 22:08:05 by MURPHY
;Flush refs to SYMPAG
; UPD ID= 3626, SNARK:<6.MONITOR>FORK.MAC.101,   1-Feb-84 18:56:49 by MOSER
;MORE 6.1748 - COMPARE TO LOWQ NOT MAXQ
; UPD ID= 3445, SNARK:<6.MONITOR>FORK.MAC.99,  12-Jan-84 14:19:52 by PAETZOLD
;TCO 6.1929 - Change FKJOBN to FKJBN
; UPD ID= 3341, SNARK:<6.MONITOR>FORK.MAC.98,  19-Dec-83 09:56:04 by TSANG
;TCO 6.1913 - Make .POADE ending address available
; UPD ID= 3296, SNARK:<6.MONITOR>FORK.MAC.97,  12-Dec-83 15:57:31 by LOMARTIRE
;TCO 6.1860 - Make routine CLNZSC global
; UPD ID= 3267, SNARK:<6.MONITOR>FORK.MAC.96,   6-Dec-83 17:25:20 by MOSER
;TCO 6.1828 - PREVENT HUNG JOBS - UNLOCK DEVLKK
; UPD ID= 3266, SNARK:<6.MONITOR>FORK.MAC.95,   6-Dec-83 17:06:38 by MOSER
;TCO 6.1748 - CHECK ARGS FOR SJPRI AND SPRIW
; UPD ID= 3259, SNARK:<6.MONITOR>FORK.MAC.94,   6-Dec-83 10:05:40 by MOSER
;TCO 6.1887 - PREVENT FLKINT DOING TFORK .TFRES
; UPD ID= 3115, SNARK:<6.MONITOR>FORK.MAC.93,   8-Nov-83 09:01:45 by MCINTEE
;~6.0 - Remove NSP% jsys
; UPD ID= 3054, SNARK:<6.MONITOR>FORK.MAC.92,  21-Oct-83 19:30:09 by MURPHY
;Remove init of JOBNO from .CFORK - it is done in FKSET now.
;Suppress BP$xxx breakpoint symbols.
; UPD ID= 3010, SNARK:<6.MONITOR>FORK.MAC.91,   7-Oct-83 23:25:33 by TGRADY
;TCO 6.1821 - don't use XRMS, since it breaks lots of old applications
; UPD ID= 3005, SNARK:<6.MONITOR>FORK.MAC.90,   7-Oct-83 17:56:00 by GUNN
;~6.0 Add call to LLMRSF from KSEF0 to clean up LLMOP resources on KFORK%.
; UPD ID= 2883, SNARK:<6.MONITOR>FORK.MAC.89,   9-Sep-83 10:59:38 by TBOYLE
;More TCO 6.1788 - fix GFRKS correctly.
; UPD ID= 2878, SNARK:<6.MONITOR>FORK.MAC.88,   7-Sep-83 10:48:59 by TBOYLE
;TCO 6.1788 - Correct off by one bug in GFRKS%.
; UPD ID= 2728, SNARK:<6.MONITOR>FORK.MAC.87,  22-Jul-83 14:58:34 by PAETZOLD
;TCO 6.1733 - Remove NETKFK call as NCP has gone away.
; UPD ID= 2698, SNARK:<6.MONITOR>FORK.MAC.86,  15-Jul-83 17:57:59 by TAMBURRI
;Two instruction edit to 2652 to pass correct args to GETSEG.
; UPD ID= 2661, SNARK:<6.MONITOR>FORK.MAC.85,   4-Jul-83 14:54:20 by HALL
;TCO 6.1689 - Move fork tables.
;	Remove one more direct reference
; UPD ID= 2652, SNARK:<6.MONITOR>FORK.MAC.84,   1-Jul-83 15:23:28 by TAMBURRI
;TCO 6.1712 Remember and use the section number of the current PA1050
; UPD ID= 2648, SNARK:<6.MONITOR>FORK.MAC.83,  29-Jun-83 21:23:04 by MCLEAN
;REMOVE RFSTS: IN PREVIOUS EDIT IT CAUSES A MUUO SINCE RFSTS JSYS IS USED HERE
; UPD ID= 2640, SNARK:<6.MONITOR>FORK.MAC.82,  27-Jun-83 16:19:52 by CHALL
;TCO 6.1673 MRFSTS- Add special check for signal JFN
; UPD ID= 2625, SNARK:<6.MONITOR>FORK.MAC.81,  22-Jun-83 14:04:14 by HALL
;TCO 6.1689 - Move fork tables to extended section
;	Reference fork tables via DEFSTRs
; UPD ID= 2455, SNARK:<6.MONITOR>FORK.MAC.80,  11-May-83 08:42:58 by MCINTEE
;Move calls to release DECnet resources (6.1) in KSELF to after the CLZFF
; UPD ID= 2375, SNARK:<6.MONITOR>FORK.MAC.79,  29-Apr-83 14:24:00 by MURPHY
;TCO 6.1635 - Use MONENV instead of MONFLG to init flag word.
; UPD ID= 2280, SNARK:<6.MONITOR>FORK.MAC.78,  16-Apr-83 19:12:41 by PAETZOLD
;TCO 6.1557 - TCP Merge - Delete old edit history - Update copyright.
; UPD ID= 2247, SNARK:<6.MONITOR>FORK.MAC.77,  12-Apr-83 13:16:55 by MCINTEE
;Remove IFNDEF FTNSPSRV
; UPD ID= 2220, SNARK:<6.MONITOR>FORK.MAC.76,   8-Apr-83 13:55:02 by TSANG
;TCO 6.1580 - Use JRST MRETN instead of JSP T2,ITRAP1
; UPD ID= 2097, SNARK:<6.MONITOR>FORK.MAC.75,  28-Mar-83 17:37:36 by MURPHY
;Minor cleanup.
; UPD ID= 2052, SNARK:<6.MONITOR>FORK.MAC.74,  21-Mar-83 18:03:26 by MURPHY
;GET RID OF OBSOLETE SEARCH PROKL
; UPD ID= 1874, SNARK:<6.MONITOR>FORK.MAC.73,  23-Feb-83 21:45:30 by MURPHY
;TCO 6.1514 - Use ITERX instead of JSP T2,ITRAP.
; UPD ID= 1869, SNARK:<6.MONITOR>FORK.MAC.72,  23-Feb-83 14:25:36 by HALL
;TCO 6.1511 - Make RESET JSYS undo SWTRP (Add CLRTRP)
; UPD ID= 1797, SNARK:<6.MONITOR>FORK.MAC.71,  14-Feb-83 14:35:03 by MCINTEE
;Still more TCO 6.1484 - remove conditional from CALL EVRKIL
; UPD ID= 1753, SNARK:<6.MONITOR>FORK.MAC.70,   3-Feb-83 13:15:03 by MCINTEE
;More TCO 6.1484 - Put CALL EVRKIL under IFN FTNSPSRV
; UPD ID= 1750, SNARK:<6.MONITOR>FORK.MAC.69,   3-Feb-83 10:32:49 by GRANT
; Previous edit should say KSELF, not .RESET
; UPD ID= 1748, SNARK:<6.MONITOR>FORK.MAC.68,   3-Feb-83 10:22:05 by GRANT
;TCO 6.1484 - In .RESET, check for DECnet event reader fork
; UPD ID= 1722, SNARK:<6.MONITOR>FORK.MAC.67,  28-Jan-83 16:01:57 by MURPHY
;More 6.1475 - Use macro for setting PCS so all CPU types work.
; UPD ID= 1696, SNARK:<6.MONITOR>FORK.MAC.66,  26-Jan-83 07:34:12 by MCINTEE
;Remove conditional from CALL NTCOFF (6.1 now has net top change int)
; UPD ID= 1689, SNARK:<6.MONITOR>FORK.MAC.65,  20-Jan-83 18:32:42 by MURPHY
;TCO 6.1475 - Fix starting PA1050 in non-0 section.
; UPD ID= 1624, SNARK:<6.MONITOR>FORK.MAC.64,   6-Jan-83 16:16:30 by CHALL
;Move call to .NSPRS to KSELF from .RESET
; UPD ID= 1568, SNARK:<6.MONITOR>FORK.MAC.63,  22-Dec-82 19:12:09 by NICHOLS
;Add DECnet-36 code under IFE FTNSPSRV
; UPD ID= 1548, SNARK:<6.MONITOR>FORK.MAC.62,  21-Dec-82 08:08:16 by MOSER
;TCO 6.1409 -  REINSTALL FLKINT DON'T DISMS WHEN UNLOCKING FORK LOCK
; UPD ID= 1501, SNARK:<6.MONITOR>FORK.MAC.61,   1-Dec-82 12:15:50 by MOSER
;TCO 6.1208 - CHECK MINOR STATE IN TRMTST
; UPD ID= 1493, SNARK:<6.MONITOR>FORK.MAC.60,  30-Nov-82 15:57:41 by MOSER
;TCO 6.1133 - PREVENT HUNG JOBS WHEN JSYS TRAPPING
; UPD ID= 1468, SNARK:<6.MONITOR>FORK.MAC.59,  19-Nov-82 14:24:48 by MOSER
;MORE TCO 6.1376
; UPD ID= 1464, SNARK:<6.MONITOR>FORK.MAC.58,  18-Nov-82 13:52:17 by MOSER
;TCO 6.1376 - PREVENT FLKTIM-FLKNS
; UPD ID= 1036, SNARK:<6.MONITOR>FORK.MAC.57,   4-Aug-82 14:04:05 by WALLACE
;TCO 6.1104 - Place initialization of CTSSBK and call to CLRCTS
;  under FTDYN instead of FTCTS since Known Library List is in CTS
;  State Block
; UPD ID= 954, SNARK:<6.MONITOR>FORK.MAC.55,  22-Jun-82 15:34:18 by MURPHY
;TCO 5.1.1036 - Prevent confusion in GCVEC% when getting -1 PATADR.
; UPD ID= 929, SNARK:<6.MONITOR>FORK.MAC.54,  14-Jun-82 09:58:48 by HALL
;TCO 6.1156 - Don't clear ADRBRK when killing fork
; UPD ID= 891, SNARK:<6.MONITOR>FORK.MAC.53,   9-Jun-82 22:55:51 by MURPHY
;TCO 6.1147 - Move bugdefs from BUGS.MAC to here and put them in-line.
; UPD ID= 873, SNARK:<6.MONITOR>FORK.MAC.52,   8-Jun-82 09:44:14 by MILLER
;TCO 6.1157. Fix GJCAPS to inhibit "temporary capabilities".
; UPD ID= 872, SNARK:<6.MONITOR>FORK.MAC.51,   8-Jun-82 09:00:19 by MCINTEE
;Typo in previous edit
; UPD ID= 865, SNARK:<6.MONITOR>FORK.MAC.50,   7-Jun-82 10:52:25 by HALL
;TCO 6.1156 - Allow exec mode address break
;	Decrement user mode break count at KSELF
; UPD ID= 789, SNARK:<6.MONITOR>FORK.MAC.49,  26-May-82 19:11:23 by WALLACE
;TCO 6.1105 - Add Canonical Terminal Support
;  Call to CLRCTS (Clear CTS State Information) when fork is killed
;  Initialize the CTS State Block (CTSSBK) to zero at fork creation
; UPD ID= 729, SNARK:<6.MONITOR>FORK.MAC.48,  11-May-82 10:47:51 by HALL
;TCO 6.1000 - Support the 2080
;	SFRKV - Set monitor's AC blocks when starting fork at SFRKV1
;	Set user AC blocks when forcing user mode flags (SFRKV,SFORK0)
; UPD ID= 711, SNARK:<6.MONITOR>FORK.MAC.47,   9-May-82 14:17:35 by HALL
;TCO 6.1000 - Support the 2080
;	Make GETDAT and GETDMS set up data correctly for the KC
; UPD ID= 706, SNARK:<6.MONITOR>FORK.MAC.46,   9-May-82 13:01:09 by HALL
;TCO 6.1000 - Support the 2080
;	Change contents of new flags word for user mode to include CAB
;		(CFORK, KSELF)
;	Change contents of new flags word for monitor mode to include CAB
;		and PAB (KFORK, MSFRK)
;	Make extended RFSTS return only the flags bits that users should see
;	Make SFORK1 store full word of flags
; UPD ID= 636, SNARK:<6.MONITOR>FORK.MAC.45,  13-Apr-82 15:24:42 by MURPHY
;TCO 6.1091 - Fix SCVEC% -1.
; UPD ID= 525, SNARK:<6.MONITOR>FORK.MAC.44,  18-Mar-82 03:21:24 by PAETZOLD
;TCO 5.1761 - Fix LOKK macro in SCTSET
; UPD ID= 498, SNARK:<6.MONITOR>FORK.MAC.43,  15-Mar-82 14:41:31 by MILLER
;TCO 6.1066. ADD CALL TO INTCLR
; UPD ID= 468, SNARK:<6.MONITOR>FORK.MAC.42,  11-Mar-82 21:46:50 by PAETZOLD
;TCO 5.1751 - Zero PATLEV when zeroing PATADR in SEVC
; UPD ID= 452, SNARK:<6.MONITOR>FORK.MAC.41,  11-Mar-82 07:02:28 by HALL
;TCO 6.1000 - Support the 2080
;	Add search of PROKL temporarily.. XGTPW JSYS expects to know bits
;	in the page fail word.
; UPD ID= 429, SNARK:<6.MONITOR>FORK.MAC.40,   1-Mar-82 09:45:29 by MURPHY
;More 5.1697 - try for XRMS.EXE and XPAT.EXE
; UPD ID= 359, SNARK:<6.MONITOR>FORK.MAC.39,  29-Jan-82 11:39:29 by WALLACE
;TCO 5.1706 - Fix three problems with XGTPW%: 1) Properly return
;  page trap address from page fail word.  2) Get OpCode from right
;  half of MUUO OpCode word.  3) Fix counter so the number of words
;  requested by user will be returned.  Count was off by one.
;TCO 5.1703 - Initialize Previous Context Section (PCS) to section
;  number of entry vector in the SFRKV% routine, SFRKV5
;TCO 5.1702 - Make .POLOC function of PDVOP% return the number of
;  available PDVA's in the left half of argument block word .POCT2
;  as well as the actual number of PDVA's returned in the right half
; UPD ID= 352, SNARK:<6.MONITOR>FORK.MAC.38,  26-Jan-82 18:42:29 by MURPHY
;DITTO
; UPD ID= 345, SNARK:<6.MONITOR>FORK.MAC.37,  24-Jan-82 23:49:24 by MURPHY
;TCO 5.1697 - XSSEV%, etc.  Move GETPAT and GETDMS from MEXEC.MAC to here.
; UPD ID= 321, SNARK:<6.MONITOR>FORK.MAC.36,  19-Jan-82 08:05:37 by MILLER
;MORE OF THE SAME
; UPD ID= 319, SNARK:<6.MONITOR>FORK.MAC.34,  18-Jan-82 19:00:20 by MILLER
;TCO 5.1678 again. Release TTY if top fork and FRKTTY is set
; UPD ID= 318, SNARK:<6.MONITOR>FORK.MAC.33,  18-Jan-82 17:49:02 by MILLER
; UPD ID= 315, SNARK:<6.MONITOR>FORK.MAC.32,  18-Jan-82 14:49:22 by MILLER
;TCO 5.1678. Don't call TTYDAS for FRKTTY TTY when fork goes away
; Make sure TTY in SCTTY is assigned to this job
; UPD ID= 288, SNARK:<6.MONITOR>FORK.MAC.31,   9-Jan-82 19:39:07 by PAETZOLD
;TCO 5.1662 - Unlock FKLOCK during error processing for MSETPT in CFK4
; UPD ID= 205, SNARK:<6.MONITOR>FORK.MAC.30,  11-Nov-81 18:06:46 by HALL
;Fix typo in previous edit
; UPD ID= 203, SNARK:<6.MONITOR>FORK.MAC.29,  11-Nov-81 16:37:11 by HALL
;TCO 6.1037 - ADD PDL OVERFLOW TO SWTRP JSYS
;TCO 6.1000 - ADD SW%NMI TO SWTRP JSYS (NEEDED FOR 2080)
; UPD ID= 189, SNARK:<6.MONITOR>FORK.MAC.28,   6-Nov-81 12:32:11 by MURPHY
;TCO 5.1608 - extended address for MSFRK.
; UPD ID= 138, SNARK:<6.MONITOR>FORK.MAC.27,  19-Oct-81 15:54:40 by COBB
;TCO 6.1029 - CHANGE SE1CAL TO EA.ENT
; UPD ID= 113, SNARK:<6.MONITOR>FORK.MAC.26,  16-Oct-81 17:13:29 by WALLACE
;TCO 5.1558 - Make .PONAM function of PDVOP% include section number of
;  the PDVA in the addresses of a name string if no section number is
;  specified in the PDV.
; UPD ID= 112, SNARK:<6.MONITOR>FORK.MAC.25,  16-Oct-81 12:23:57 by MURPHY
;Ignore FH%EPN bit in fork handles.
; UPD ID= 237, SNARK:<5.MONITOR>FORK.MAC.24,   2-Oct-81 13:14:47 by SCHMITT
;TCO 5.1548 - OKINT Jsys trapped process if not resumed in UTFRK JSYS
; UPD ID= 84, SNARK:<5.MONITOR>FORK.MAC.23,  30-Jul-81 07:10:33 by FLEMMING
;add code for XGTPW
; UPD ID= 50, SNARK:<5.MONITOR>FORK.MAC.22,  19-Jul-81 06:38:39 by FLEMMING
;TCO 5.1422 - turn on PM%EPN when PMAPping away section 0
; UPD ID= 45, SNARK:<5.MONITOR>FORK.MAC.21,  17-Jul-81 16:18:16 by MURPHY
;TCO 5.1398 - SKIP RETURN FROM MSETPT
; UPD ID= 1993, SNARK:<5.MONITOR>FORK.MAC.20,  14-May-81 13:22:18 by HALL
;Temporary addition to previous edit -- wait a while after FLKTIM BUGCHK
; UPD ID= 1928, SNARK:<5.MONITOR>FORK.MAC.19,   4-May-81 09:47:40 by GRANT
;Add FORKN optional data to FLKNS;  don't commandeer the lock after a FLKTIM
; UPD ID= 1875, SNARK:<5.MONITOR>FORK.MAC.18,  23-Apr-81 16:11:33 by SCHMITT
;More TCO 5.1296 - Change around previous edit
; UPD ID= 1869, SNARK:<5.MONITOR>FORK.MAC.17,  22-Apr-81 11:05:59 by SCHMITT
;TCO 5.1296 - Call CLRVGN before loading ACS in CFK1
; UPD ID= 1658, SNARK:<5.MONITOR>FORK.MAC.16,  10-Mar-81 09:06:42 by FLEMMING
; UPD ID= 1602, SNARK:<5.MONITOR>FORK.MAC.15,  27-Feb-81 09:52:42 by FLEMMING
;tco 5.1265 - fix RMAP returning wrong access information
; UPD ID= 1441, SNARK:<5.MONITOR>FORK.MAC.14,  15-Jan-81 15:52:20 by FLEMMING
;add code for SMAP/RSMAP
; UPD ID= 1328, SNARK:<5.MONITOR>FORK.MAC.13,   1-Dec-80 16:11:13 by OSMAN
;tco 5.1205 - Add XGVEC and XSVEC jsyses
;tco 5.1204 - Add XSFRK jsys
; UPD ID= 1284, SNARK:<5.MONITOR>FORK.MAC.12,  18-Nov-80 14:39:44 by OSMAN
;Fixups for runing programs in other sections
;Use only right half of .JBSA and .JBREN
; UPD ID= 1196, SNARK:<5.MONITOR>FORK.MAC.11,  25-Oct-80 12:14:59 by HALL
;TCO 5.1180 - MOVE THE DST TO NON-ZERO SECTION
;	KFORK -- MAKE KILLED FORK START IN SECTION 1 AT KSELF
; UPD ID= 1084, SNARK:<5.MONITOR>FORK.MAC.10,   1-Oct-80 11:59:27 by MURPHY
;FIX ACVAR
; UPD ID= 1012, SNARK:<5.MONITOR>FORK.MAC.9,  12-Sep-80 14:21:45 by OSMAN
;tco 5.1145 - Fix SCTTY to not thaw frozen forks.
; UPD ID= 962, SNARK:<5.MONITOR>FORK.MAC.8,  25-Aug-80 16:26:39 by ENGEL
;TCO 5.1136 - ADD DEVLKK
; UPD ID= 840, SNARK:<5.MONITOR>FORK.MAC.7,   5-Aug-80 16:19:37 by OSMAN
;tco 5.1109 - Add PDVOP%
; UPD ID= 795, SNARK:<5.MONITOR>FORK.MAC.6,  24-Jul-80 09:21:26 by OSMAN
;Add temporary .PDVOP for until real one is in
; UPD ID= 709, SNARK:<5.MONITOR>FORK.MAC.5,  26-Jun-80 17:01:06 by SANICHARA
;TCO 5.1085 - ALLOW CH 23 TO USER ASSIGNABLE
; UPD ID= 670, SNARK:<5.MONITOR>FORK.MAC.4,  17-Jun-80 16:36:34 by KONEN
;TCO 5.1068 - DO DESTRUCTIVE PMAP IN KSELF IF OF%DUD IS ON
; UPD ID= 564, SNARK:<5.MONITOR>FORK.MAC.3,  28-May-80 15:18:52 by ZIMA
;TCO 5.1049 - FIX SECURITY CHECK IN MSFRK
; UPD ID= 435, SNARK:<5.MONITOR>FORK.MAC.2,  13-Apr-80 15:13:22 by OSMAN
; UPD ID= 427, SNARK:<4.1.MONITOR>FORK.MAC.250,  13-Apr-80 14:34:51 by OSMAN
;<OSMAN.MON>FORK.MAC.2, 10-Apr-80 17:51:10, EDIT BY OSMAN
;Shorten source by using FRKTTY instead of FKCTYP
; UPD ID= 392, SNARK:<4.1.MONITOR>FORK.MAC.249,  31-Mar-80 13:59:57 by OSMAN
;tco 4.1.1132 - Fix EPCAP to always trim AC3 according to what fork's allowed
;capabilities are, regardless of wheel.
; UPD ID= 283, SNARK:<4.1.MONITOR>FORK.MAC.248,  20-Feb-80 17:55:31 by MURPHY
;MAKE FKINT BITS FULL-WORD DEF
; UPD ID= 225, SNARK:<4.1.MONITOR>FORK.MAC.247,  25-Jan-80 11:28:38 by GRANT
;TCO 4.2598 - ADD CHECK FOR PRARG JSB FREE SPACE TO KSELF
; UPD ID= 62, SNARK:<4.1.MONITOR>FORK.MAC.246,  29-Nov-79 16:34:15 by MILLER
;ONE MORE TIME. FIX UP FKLOCK WHEN NEXTING
; UPD ID= 58, SNARK:<4.1.MONITOR>FORK.MAC.245,  29-Nov-79 13:39:57 by MILLER
;TCO 4.1.1036. FKLOCK ALWAYS NESTS WITHIN A PROCESS
; UPD ID= 56, SNARK:<4.1.MONITOR>FORK.MAC.244,  29-Nov-79 12:26:58 by MILLER
;MORE.... FIX FLOCK, FLOCKN AND FUNLKI
; UPD ID= 52, SNARK:<4.1.MONITOR>FORK.MAC.243,  29-Nov-79 10:28:37 by MILLER
;TCO 4.1.1026. ADD FUNLKI ENTRY
; UPD ID= 38, SNARK:<4.1.MONITOR>FORK.MAC.242,  28-Nov-79 11:06:55 by MILLER
;TCO 4.2582 AGAIN. SET FKTIMW LARGE WHEN UNLOCKED
; UPD ID= 35, SNARK:<4.1.MONITOR>FORK.MAC.241,  28-Nov-79 10:58:26 by MILLER
; UPD ID= 32, SNARK:<4.MONITOR>FORK.MAC.239,  28-Nov-79 10:50:56 by MILLER
;TCO 4.2582. ADD CHECK AND SET FOR FKTIMW
; UPD ID= 16, SNARK:<4.1.MONITOR>FORK.MAC.240,  27-Nov-79 10:29:05 by OSMAN
;Document FLKTIM
; UPD ID= 8, SNARK:<4.1.MONITOR>FORK.MAC.239,  21-Nov-79 14:52:34 by OSMAN
;<4.1.MONITOR>FORK.MAC.238, 16-Nov-79 14:50:41, EDIT BY ENGEL
;PUT INTERNAL LINE NUMBER INTO T2 AT CALL TO STTOPF IN SCTT3

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A  LICENSE AND MAY BE USED AND  COPIED
;	ONLY IN  ACCORDANCE  WITH  THE  TERMS OF  SUCH  LICENSE  AND  WITH  THE
;	INCLUSION OF THE ABOVE  COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY  OTHER
;	COPIES THEREOF MAY NOT BE PROVIDED  OR OTHERWISE MADE AVAILABLE TO  ANY
;	OTHER PERSON.  NO  TITLE TO  AND OWNERSHIP  OF THE  SOFTWARE IS  HEREBY
;	TRANSFERRED.
;
;	THE INFORMATION IN THIS  SOFTWARE IS SUBJECT  TO CHANGE WITHOUT  NOTICE
;	AND SHOULD  NOT  BE CONSTRUED  AS  A COMMITMENT  BY  DIGITAL  EQUIPMENT
;	CORPORATION.
;
;	DIGITAL ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY OF  ITS
;	SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
	SEARCH PROLOG
	TTITLE FORK


;FORK CONTROLLING JSYSES AND FUNCTIONS - D. MURPHY

;LOCAL ITEMS DECLARED IN STG.MAC

EXTN <DEVKFK>

;ITEMS DEFINED IN APRSRV FOR SWTRP

EXTN <SETART,SETLUU,GTLUUB>

;AC DEFINITIONS USED HEREIN

DEFAC (FX,Q3)			;FORK INDEX

;DATA STRUCTURES REFERENCED ONLY IN SWPMON

;Definitions for SYSFK in JSB (index by JRFN)

;Bit 0 set indicates JRFN not in use
DEFSTR(SFEXO,SYSFK,1,1)		;Fork is Execute-Only if set
DEFSTR(SFNVG,SYSFK,2,1)		;Fork is not "virgin" if set
DEFSTR(SFGXO,SYSFK,3,1)		;Fork can PMAP into execute-only forks
				; because it is doing an execute-only GET
DEFSTR(SFSRT,SYSFK,4,1)		;FORK HAS BEEN STARTED

;Bits 5 to 8 are unused
DEFSTR(FKHCNT,SYSFK,17,9)	;COUNT OF HANDLES ON A GIVEN FORK
;Bits 18 to 35 is the system fork number

	SWAPCD
;XSVEC% allows a global PC to be specified for the entry vector address

.XSVEC::MCENT
	CALLRET SEVEC0		;USE COMMON CODE

;GET/SET ENTRY VECTOR

.SEVEC::MCENT
	HRRZ C,B		;GET ADDRESS PART OF ENTRY VECTOR
	HLRZ B,B		;GET LENGTH
	CALLRET SEVEC0		;USE COMMON CODE

;SEVEC0 is common routine for setting entry vectors
;
;Accepts:	A/	fork handle
;		B/	length
;		C/	address

SEVEC0:	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFX		;Map PSB and check for execute-only
	CAIN B,0
	CAIE C,0
	CAIA
	JRST SEV1		;ALL-0 IS LEGAL
	CAIN B,<JRST>B53	;10/50 STYLE?
	JRST SEV1		;YES
	CAIL B,1000
ESVX1:	ERRJMP(SEVEX1,ITFRKR)	;NOT LEGAL
SEV1:	MOVEM B,EVLNTH(A)	;SAVE LENGTH
	MOVEM C,EVADDR(A)	;SAVE ADDRESS
	JRST CLFRET

.XGVEC::MCENT
	CALL FLOCK
	CALL SETLFK
	DMOVE B,EVLNTH(A)	;GET VECTOR
	XCTU [DMOVEM B,B]	;TELL USER
	CALLRET CLFRET

.GEVEC::MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFK
	HRL B,EVLNTH(A)		;GET LENGTH
	HRR B,EVADDR(A)		;GET ADDRESS PART (WITHOUT SECTION FOR NOW)
GCV1:	UMOVEM 2,2
	JRST CLFRET
;GET/SET COMPATIBILITY ENTRY VECTOR AND PARAMETERS

.GCVEC::MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFK
	MOVE T2,PATADR(1)
	JUMPL T2,GCV1		;NEGATIVE - JUST RETURN IT
	TLNE T2,-1		;EXTENDED FIELDS?
	ITERR XSEVX3,<CALL FKLERR> ;YES, CAN'T READ WITH THIS JSYS
	HRL T2,PATLEV(T1)	;LENGTH
	MOVE 3,PATUPC(1)
	HRL 3,PATU40(1)
	UMOVEM 3,3
	JRST GCV1

.SCVEC::MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFX		;Map PSB and check for execute-only
	IFL. T2			;NEG ARG?
	  SETOM PATADR(T1)	;YES, MEANS PREVENT LOADING OF PA1050
	  SETZM PATLEV(T1)
	  JRST CLFRET
	ENDIF.
	HLRZM T2,PATLEV(T1)	;SAVE LENGTH
	XCTU [XHLLI T2,.]	;DEFAULT SECTION
	MOVEM 2,PATADR(1)
	HRRM 3,PATUPC(1)
	HLRM 3,PATU40(1)
	JRST CLFRET

;GET/SET RMS (FORMERLY DMS) ENTRY VECTOR

;GET DMS ENTRY VECTOR
;ACCEPTS IN 1/	FORK HANDLE
;	GDVEC
;RETURNS +1:	ALWAYS
;	2/	LENGTH ,, ENTRY VECTOR ADDRESS

.GDVEC::MCENT
	CALL FLOCK		;LOCK FORK STRUCTURE
	CALL SETLFK		;MAP IN PSB OF FORK
	MOVE 2,DMSADR(1)	;GET ENTRY VECTOR
	TLNE T2,-1		;ENTENDED ADDRESS?
	ITERR XSEVX3,<CALL FKLERR> ;YES, CAN'T READ WITH THIS JSYS
	HRL T2,DMSLEV(T1)	;LENGTH
	JRST GCV1		;GIVE THESE TO USER

;SET DMS ENTRY VECTOR
;ACCEPTS IN 1/	FORK HANDLE
;	    2/	LENGTH ,, ENTRY VECTOR ADDRESS

.SDVEC::MCENT
	CALL FLOCK		;LOCK FORK STRUCTURE
	CALL SETLFX		;Map PSB and check for execute-only
	HLRZM T2,DMSLEV(T1)	;SAVE LENGTH
	XCTU [XHLLI T2,.]	;DEFAULT SECTION
	MOVEM T2,DMSADR(T1)	;SAVE DMS ENTRY VECTOR
	UMOVE 3,4(2)		;GET POINTER TO PC WORD
	HRRM 3,DMSUPC(1)	;SAVE ADR OF WHERE TO PUT PC
	UMOVE 3,3(2)		;GET POINTER TO JSYS LOCATION
	HRRM 3,DMSU40(1)	;SAVE ADR OF WHERE TO PUT JSYS
	JRST CLFRET		;EXIT UNLOCKING PSB
;Extended SET/GET special entry vector - i.e. RMS or PA1050
; T1/	vector type code ,, fork handle
; T2/	length
; T3/	30-bit address. bit 0 = 1 for extended vector format, = 0
;		for non-extended format

.XSSEV::MCENT
	CALL FLOCK
	CALL SETLFX		;MAP PSB, ETC.
	XCTU [HLRZ T2,T1]	;GET VECTOR TYPE
	CAIL T2,SEVTL
	ITERR XSEVX1,<CALL FKLERR> ;ILLEGAL VECTOR TYPE
	HRRZ T2,SEVTB(T2)	;DISPATCH TO APPROPRIATE CODE
	JRST 0(T2)

.XGSEV::MCENT
	CALL FLOCK
	CALL SETLFK		;MAP PSB
	XCTU [HLRZ T2,T1]	;GET VECTOR TYPE
	CAIL T2,SEVTL
	ITERR XSEVX1,<CALL FKLERR> ;ILLEGAL VECTOR TYPE
	HLRZ T2,SEVTB(T2)	;DISPATCH TO APPROPRIATE CODE
	JRST 0(T2)

;DISPATCH FOR SPECIAL VECTOR TYPES
;  GET ROUTINE ,, SET ROUTINE

SEVTB:	PHASE 0
.XSEVC::! GEVC,,SEVC		;TOPS10 COMPATIBILITY PKG.
.XSEVD::! GEVD,,SEVD		;RMS
	DEPHASE
SEVTL==.-SEVTB
;GET/SET PA1050 ENTRY VECTOR

GEVC:	MOVE T2,PATLEV(T1)	;LENGTH
	UMOVEM T2,T2
	MOVE T3,PATADR(T1)	;ADDRESS
	UMOVEM T3,T3
	JRST CLFRET

SEVC:	UMOVE T2,T2		;GET LENGTH
	IFLE. T2
	  MOVEM T2,PATADR(T1)	;CLEAR
	  SETZM PATLEV(T1)
	  JRST CLFRET		;DONE
	ENDIF.
	CAIGE T2,.SVRPC		;LONG ENOUGH FOR REQUIRED WORDS?
	ITERR XSEVX2,<CALL FKLERR> ;NO, INVALID LENGTH
	MOVEM T2,PATLEV(T1)	;SAVE LENGTH
	UMOVE T2,T3		;GET ADDRESS
	MOVEM T2,PATADR(T1)	;SAVE IT
	CALL SETPVV		;SET PC AND UUO WORDS
	JRST CLFRET		;RELEASE LOCKS AND RETURN

;GET PA1050 PC AND UUO WORDS
; T1/ FORK PSB OFFSET
; T2/ ENTRY VECTOR ADDRESS

SETPVV:	SETPCS T2		;SET PCS TO SECTION OF ENTRY VECTOR
	UMOVE T3,.SVRPC(T2)	;GET POINTERS FROM VECTOR
	TXNN T3,VSECNO		;SECTION NUMBER SUPPLIED?
	HLL T3,T2		;NO, DEFAULT TO SAME AS ENTRY VECTOR
	MOVEM T3,PATUPC(T1)
	UMOVE T3,.SV40(T2)
	TXNN T3,VSECNO		;SECTION?
	HLL T3,T2		;NO, DEFAULT IT
	MOVEM T3,PATU40(T1)
	RET

;GET/SET RMS VECTOR

GEVD:	MOVE T2,DMSLEV(T1)	;LENGTH
	UMOVEM T2,T2
	MOVE T3,DMSADR(T1)	;ADDRESS
	UMOVEM T3,T3
	JRST CLFRET		;DONE

SEVD:	UMOVE T2,T2		;GET LENGTH OF VECTOR
	IFE. T2
	  SETZM DMSADR(T1)	;CLEAR
	  JRST CLFRET		;DONE
	ENDIF.
	CAIGE T2,.SVRPC		;LONG ENOUGH FOR REQUIRED WORDS?
	ITERR XSEVX2,<CALL FKLERR> ;NO
	MOVEM T2,DMSLEV(T1)	;SAVE LENGTH
	UMOVE T2,T3		;GET ADDRESS
	MOVEM T2,DMSADR(T1)
	CALL SETDVV		;SET PC AND UUO POINTERS
	JRST CLFRET		;UNLOCK AND RETURN

;SET PC AND UUO WORD POINTERS
; T1/ FORK PSB OFFSET
; T2/ ENTRY VECTOR ADDRESS

SETDVV:	SETPCS T2		;SET PCS TO SECTION OF ENTRY VECTOR
	UMOVE T3,.SVRPC(T2)	;GET POINTERS FROM VECTOR
	TXNN T3,VSECNO		;SECTION?
	HLL T3,T2		;NO, DEFAULT IT
	MOVEM T3,DMSUPC(T1)
	UMOVE T3,.SV40(T2)
	TXNN T3,VSECNO		;SECTION?
	HLL T3,T2		;NO, DEFAULT IT
	MOVEM T3,DMSU40(T1)
	RET
;HERE ON FIRST OCCURRANCE OF MUUO IN FORK.  MAP TOPS10 COMPATIBILITY
;MODULE INTO USER ADDRESS SPACE.
;THIS CODE ALSO IMPLEMENTS THE VIROS/TOPS10 TEST UUO.  IF
;THE USER DOES A GETTAB (CALLI 41) WITH ARGUMENT 112,,11 (TABLE
;11, WORD 112) THEN BITS 18-23 TELL WHAT KIND OF MONITOR IT IS.
;IN PARTICULAR, 4 MEANS VIROS.
;THIS CODE CHECKS FOR THIS SPECIFIC CALLI AND ARGUMENT SO THAT
;THE USER PROGRAM CAN EXECUTE IT WITHOUT ACTUALLY INVOKING THE
;COMPATIBILITY MODULE.

GETPAT::
   IFN KLFLG,<
	MOVE P1,FFL		;GET FLAGS WORD WITH OP CODE AND AC AND PCS
   >
   IFN KCFLG,<
	MOVE P1,FFL		;GET FLAGS WORD WITH CAB AND PAB AND PCS
	HRR P1,KIMOAC		;GET OP CODE AND AC TO LOOK LIKE KL
   >				;END OF IFN KCFLG
	MOVE P2,FPC		;GET PC WORD
	MOVE P3,KIMUEF		;GET EFFECTIVE ADDRESS WORD
	MCENTR			;GETS HERE FROM UUO HANDLER
	HRLZ T1,P1		;LOOK AT UUO
	HRR T1,P3
	TLZ 1,(777B17)		;DON'T LOOK AT AC, I, X
	CAME 1,[047000,,41]	;WAS IT A CALLI 41 ?
	JRST GETPA1		;NO, CONTINUE
	LDB 2,[POINT 4,P1,30]	;YES, CHECK ARGUMENT
	UMOVE 1,0(2)		;GET CONTENTS OF DESIGNATED AC
	CAME 1,[112,,11]	;IS IT MAGIC NUMBER?
	JRST GETPA1		;NO, CONTINUE
	MOVEI 1,4B23		;YES, RETURN ANOTHER MAGIC NUMBER
	UMOVEM 1,0(2)		;RETURN IT IN DESIGNATED AC
	SMRETN

GETPA1:	SKIPGE T1,PATADR	;FORCED INCOMPATABLILITY?
	ITERR(ILINS4)		;YES - GIVE ERROR.
	MOVE T1,PATADR		;Get the possible entry vector
	HRROI T2,[ASCIZ /SYS:PA1050.EXE/]
;	HRROI T3,[ASCIZ /SYS:EPAT.EXE/] ;[7421] EXTENDED VERSION
	CALL GETSEG		;Get PA1050
	 ITERR(ILINS3)		;NO FILE
	MOVEM T1,PATLEV		;SAVE LENGTH
	MOVEM T2,PATADR		;ADDRESS
	SETZ T1,		;NO PSB OFFSET
	CALL SETPVV		;SET PC AND UUO POINTERS
	SKIPG T1,PATADR		;SHOULD HAVE IT NOW
	ITERR ILINS3		;BAD FILE
REPEAT 0, <			;[7421]
	TXNN T1,XS%EEV		;EXTENDED FORMAT VECTOR?
	IFSKP.
	  MOVE T1,PATUPC	;YES, GET ITS ADDRESS
	  DMOVE T2,P1		;GET FLAGS, PC
	  XCTU [DMOVEM T2,0(T1)] ;PASS THEM TO PA1050
	  MOVE T1,PATU40	;PTR TO UUO WORD
	  MOVE T2,P3		;MOVE UUO WORD TO PA1050
	  UMOVEM T2,0(T1)
	ELSE.
> ;[7421] Repeat 0
	  MOVE T1,PATUPC	;NON-EXTENDED FORMAT, GET PTR TO PC
	  MOVE T2,P2		;CONSTRUCT OLD STYLE FLAGS,,PC
	  HLL T2,P1
	  UMOVEM T2,0(T1)	;PASS IT TO PA1050
	  MOVE T1,PATU40	;PTR TO UUO WORD
	  MOVE T2,P3		;CONSTRUCT OLD STYLE UUO WORD
	  HRL T2,P1
	  UMOVEM T2,0(T1)
;	ENDIF.			;[7421]
	MOVE T1,PATADR
	ADDI T1,.SVINE		;INITIAL ENTRY IS OFFSET
	MOVEM T1,-1(P)		;CHANGE RETURN PC TO ENTER PA1050
	JRST MRETN		;GO TO COMPATIBILITY
;HERE ON FIRST RAF JSYS TO LOAD RMS.EXE INTO FORK ADDRESS SPACE

GETDMS::
   IFN KLFLG,<
	MOVE P1,FFL		;GET FLAGS WORD WITH OP CODE AND AC AND PCS
   >
   IFN KCFLG,<
	MOVE P1,FFL		;GET FLAGS WORD WITH CAB AND PAB AND PCS
	HRR P1,KIMOAC		;GET OP CODE AND AC TO LOOK LIKE KL
   >				;END OF IFN KCFLG
	MOVE P2,FPC		;GET PC WORD
	MOVE P3,KIMUEF		;GET EFFECTIVE ADDRESSS WORD
	MCENTR			;ENTER MONITOR CONTEXT
	MOVE T1,DMSADR		;Get address of entry vector
	HRROI T2,[ASCIZ/SYS:RMS.EXE/]
	SETZM T3		;[7421] MAKE SURE WE DON'T TRY AN EXTENDED FLAVOR
;	HRROI T3,[ASCIZ /SYS:XRMS.EXE/] ;[7421] EXTENDED ADR VERSION
	CALL GETSEG		;Get RMS into this process
	 ITERR(ILINS5)		;NO FILE
	MOVEM T1,DMSLEV		;SAVE LENGTH
	MOVEM T2,DMSADR		;ADDRESS
	SETZ T1,		;NO PSB OFFSET
	CALL SETDVV		;SET PC AND UUO POINTERS
	MOVE T1,DMSADR		;NOW SETUP PC AND UUO WORD
REPEAT 0, <			;[7421]
	TXNN T1,XS%EEV		;EXTENDED FORMAT VECTOR?
	IFSKP.
	  MOVE T1,DMSUPC	;PTR TO PC
	  XCTU [DMOVEM P1,0(T1)] ;PASS IT TO RMS
	  MOVE T1,DMSU40	;PTR TO UUO WORD
	  UMOVEM P3,0(T1)	;PASS UUO WORD TO RMS
	ELSE.
> ;[7421] Repeat 0
	  MOVE T1,DMSUPC	;OLD FORMAT VECTOR, GET PTR TO PC
	  MOVE T2,P2		;CONSTRUCT OLD STYLE FLAGS, PC
	  HLL T2,P1
	  UMOVEM T2,0(T1)	;PASS IT TO RMS
	  MOVE T1,DMSU40	;PTR TO UUO WORD
	  MOVE T2,P3		;CONSTRUCT OLD STYLE UUO WORD
	  HRL T2,P1
	  UMOVEM T2,0(T1)
;	ENDIF.			;[7421]
	MOVE T1,DMSADR
	ADDI T1,.SVINE
	MOVEM T1,-1(P)		;CHANGE PC TO ENTER RMS
	JRST MRETN
; GETSEG - Get a segment into this process
;
; Call:
;	T2/	String pointer to file name of segment
;Note - as of edit 7421, GETSEG no longer uses T3
;	T3/	String pointer to file name of possible extended version	
;	CALL GETSEG
;
; Returns:
;	+1:	No such file (GTJFN failed)
;	+2:	Success, entry vector from file in T1
;
; Clobbers T1, T2
;

GETSEG:	ASUBR <GETSG1,GETSG2>	;[7421]
	SAVEAC <Q1,Q2>
	MOVE Q1,EVLNTH		;Save old entry vector
	MOVE Q2,EVADDR
	MOVE T1,FORKN		;Get current JRFN
	CALL CKNXOR		;Skip if not execute-only
	 SKIPA T1,[EXP GJ%PHY!GJ%SHT!GJ%OLD] ;Execute-only-- make sure physical  SYS:
	MOVX T1,GJ%SHT!GJ%OLD	;Not execute-only, just get file
;	MOVEM T1,GETSG4		;[7421] SAVE FLAGS FOR RETRY
	MOVE T2,GETSG2		;[7421] TRY NON-EXTENDED VERSION
	GTJFN
REPEAT 0, <			;[7421]
	IFSKP.
	  MOVEM T1,GETSG4	;HAVE EXTENDED VERSION, SAVE JFN
	  SKIPG T2,GETSG1	;Get the address of the entry vector
	  IFSKP.
	    HLRZ T1,(T2)	;Get the section number from previous vector
	    TRZ T1,770000	; ...so we reuse section,,Zap extraneous flags
	  ELSE.
	    MOVEI T1,.FHSLF	;This fork
	    CALL FFUSEC		;FIND FREE USER SECTION
	     RET		;ALL FULL
	  ENDIF.
	  BLCAL. DGET,<GETSG4,[GT%BAS],0,0,T1> ;GET INTO SPECIFIED SECTION
	   RET
	ELSE.
	  MOVE T1,GETSG4	;RECOVER FLAGS
	  MOVE T2,GETSG2	;NON-EXT FILE NAME
	  GTJFN			;Get a JFN on file
> ;[7421] Repeat 0
	   ERJMP R		;[7421] Error-- return +1 from GETSEG
	  HRLI T1,.FHSLF		;Get into this process
	  GET			;Get it
	   ERJMP R		;FAIL
;	ENDIF.			;[7421]
	DMOVE T1,Q1		;GET OLD ENTRY VECTOR
	EXCH T1,EVLNTH		;Put old entry vector back, get one from file in T1
	EXCH T2,EVADDR
	RETSKP			;Return +2 from GETSEG

	ENDAS.

;DO EXTENDED GET - CALLED FROM ABOVE AS CONVENIENT WAY TO BUILD
;ARG BLOCK FOR GET

REPEAT 0,< ;[7421]
DGET:	BLSUB. <DGJFN,DGFLG,DGAB1,DGAB2,DGAB3>
	MOVE T1,DGJFN
	HRLI T1,.FHSLF
	TXO T1,GT%ARG		;SAY ARG BLOCK PTR IN T2
	XMOVEI T2,DGFLG		;AND PUT IT THERE
	GET			;GET INTO SECTION SPECIFIED BY DGAB3
	 ERJMP R
	RETSKP

	ENDBS.
> ;[7421] Repeat 0

;FIND FREE USER SECTION
; T1/ FORK HANDLE
;	CALL FFUSEC
; RETURN +1: FAILED, no free sections or unexpected failures of RSMAP%, SMAP%
;	+2: SUCCESS, T1/ section number

REPEAT 0,<
FFUSEC:	ASUBR <FFUA1,FFUA2>
	MOVEI T1,2		;START WITH SECTION 2
	MOVEM T1,FFUA2
      DO.
	HRL T1,FFUA1		;SPECIFIED FORK
	RSMAP%			;FIND OUT ABOUT SECTION
	CAME T1,[-1]		;EMPTY?
	IFSKP.
	  SETZ T1,		;YES, CREATE PRIVATE SECTION
	  MOVE T2,FFUA2
	  HRL T2,FFUA1
	  MOVX T3,SM%RD!SM%WR!SM%EX+1
	  SMAP%
	   ERJMP R
	  MOVE T1,FFUA2		;RETURN SECTION CREATED
	  RETSKP
	ENDIF.
	AOS T1,FFUA2		;SECTION NOT FREE, STEP TO NEXT
	CAIG T1,(VSECNO)	;BEYOND END?
	LOOP.			;NO, CHECK THIS ONE
	RET			;YES, RETURN FAILURE
      ENDDO.

	ENDAS.
> ;[7421] Repeat 0
;SET SCHEDULER PRIORITY WORD
; 1/ FORK HANDLE
; 2/ PRIORITY WORD
;	SPRIW

.SPRIW::MCENT
	MOVE 2,CAPENB
	TRNN 2,SC%WHL+SC%OPR
	ITERR(WHELX1)		;MUST BE PRIVILEGED
	GTOKM(.GOSPR,<T1,T2>)	;[9119] Get permission from ACJ

	CALL CKPRWV		;CHECK WORD FOR LEGALITY
	 ITERR (ARGX22)		;INVALID BITS
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFK
SPRI1:	UMOVE 2,2
	MOVEM 2,JOBBIT(1)
	MOVE T2,FORKN(T1)	;GET JOB-WIDE INDEX
	HRRZ T2,SYSFK(T2)	;GET SYSTEM INDEX
	CALL SETPRF		;INTERRUPT PROCESS
	JRST CLFRET
;SET PRIORITY WORD FOR ANOTHER JOB
; 1/ JOB NUMBER
; 2/ PRIORITY WORD
;	SJPRI

.SJPRI::MCENT
	CALL CKMMOD		;SEE IF MONITOR OR USER
	IFNSK.			;[9119] SJPRI was done from user mode today
	  MOVE T3,CAPENB	;[9119] Load current capabilities
	  TXNN T3,SC%WHL!SC%OPR	;[9119] Enough capabilites?
	  ITERR(WHELX1)		;[9119] Wheel or operator required
	  GTOKM(.GOSJP,<T1,T2>)	;[9119] Get permission from ACJ
	ENDIF.			;[9119] End of user mode checks

	CALL CKPRWV		;CHECK WORD FOR LEGALITY
	 ITERR (ARGX22)		;INVALID BITS
	CALL FLOCK		;GET FORK LOCK IN CASE THIS JOB
	CALL GL2LCL		;CONVERT GLOBAL JOB NUMBER TO LOCAL
	 JRST SJPRI1		;ILLEGAL JOB NUMBER
	CALL MAPJSB		;GET THE JSB MAPPED
	 JRST SJPRI1		;NON-EX JOB
	UMOVE T2,2		;GET PRIORITY WORD
	MOVEM T2,JOBSKD(T1)	;STORE IT
	MOVE P1,T1		;GET JSB OFFSET
	HRLI P1,-NUFKS		;FORM AOBJN POINTER
SJPRI2:	SKIPGE T2,SYSFK(P1)	;THIS FORK ACTIVE?
	JRST SJPRI3		;NO. GO ON
	HRRZS T2		;YES. GET FORK HANDLE
	CALL SETPRF		;UPDATE ITS PRIORITY
SJPRI3:	AOBJN P1,SJPRI2		;DO ALL PROCESSES
	JRST CLFRET		;AND DONE

SJPRI1:	CALL FUNLK
	ITERR (SJPRX1)		;NON-EXISTANT JOB

;CKPRWV - CHECK PRIORITY WORD IN USERS AC2 FOR .SJPRI AND .SPRIW JSYSES
;
;RETURN +1: ILLEGAL VALUES
;	+2: VALUES ARE LEGAL

CKPRWV:	SAVEAC <T1>		;PRESERVE T1 FOR CALLERS
	UMOVE T2,2		;GET PRIORITY WORD
	LOAD T1,JP%MXQ,T2	;GET MIN Q
	LOAD T2,JP%MNQ,T2	;AND MAX Q
	CAIG T2,LOWQ		;MIN > MAX?
	CAILE T1,LOWQ+1		;MAX > MAX+1?
	RET			;ERROR
	RETSKP			;ALL IS OK
;GET AND SET PRIMARY IO JFN'S

.GPJFN::MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFK
	MOVE 2,PRIMRY(1)
	UMOVEM 2,2
	JRST CLFRET

.SPJFN::MCENT
	XCTU [SKIPN 2]		;PROVIDING A VALID VALUE?
	ITERR (DESX3)		;NO. DISALLOW IT THEN
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	MOVX T2,<CALL SPJFN1>	;ROUTINE TO EXECUTE
	CALL MAPFKH
	 NOP			;WON'T BLOCK
	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	JRST MRETN

SPJFN1:	CALL SKIIF
	JRST FRKE2
	CALL SETLF1
	UMOVE 2,2
	MOVEM 2,PRIMRY(1)
	JRST CLRLFK

;GET TRAP WORDS FROM FORK

.GTRPW::MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFK		;MAP PSB
	MOVE 2,UTRSW(1)		;TRAP STATUS WORD
	TXNN T2,TWUSR		;SETUP BITS IN OLD FORMAT
	TXO T2,TSW%MN		;MONITOR MODE REFERENCE
	TXNE T2,TWWRT
	TXO T2,TSW%WT		;WRITE REF
	TXO T2,TSW%RD		;READ ALWAYS
	UMOVEM 2,1		;RETURNED IN 1
	HRL 2,UMUUOW(1)		;MUUO WORD
	HRR 2,UMUUOW+1(1)
	UMOVEM 2,2		;RETURNED IN 2
	JRST CLFRET

;XGTPW
;	1/fork handle,,0
;	2/address of data block
;	XGTPW%
;where data block is
;	number of words in data block (including this one)
;return .+1 always, data block filled in with last page fail word and MUUO

.XGTPW::MCENT
	UMOVE P1,(T2)		;NUMBER OF WORDS TO RETURN
	SUBI P1,1		;ACCOUNT FOR THE COUNT WORD
	JUMPL P1,[ITERR (ARGX17)]
	AOS P2,T2		;WHERE TO STORE THE ANSWERS
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFK		;MAP THE PSB
	MOVE T3,UTRSW(T1)	;GET LAST PAGE FAIL WORD
	MOVEI T2,0		;ASSUME LAST PAGE FAIL WAS A READ IN EXEC MODE
	TXNE T3,TWUSR		;USER OR MONITOR?
	TXO T2,PF%USR		;USER
	TXNE T3,TWWRT		;READ OR WRITE REFERENCE?
	TXO T2,PF%WTF		;WRITE
	CALL PUTWRU		;STORE THE ANSWER IF THE USER PROVIDED ROOM
	LOAD T2,TWVADR,UTRSW(T1);Get the virtual address
	CALL PUTWRU		;STORE THAT
	HRLZ T2,UMUUOW(T1)	;Get MUUO OpCode AC,
	CALL PUTWRU		;STORE THAT
	MOVE T2,UMUUOW+1(T1)	;MUUO E FIELD
	CALL PUTWRU		;STORE THAT
	JRST CLFRET		;UNMAP THE PSB AND RETURN

PUTWRU:	SOSL P1			;DECREMENT COUNT, DON'T STORE IF EXHAUSTED
	UMOVEM T2,(P2)		;STORE ANSWER
	AOJA P2,R		;INCREMENT TO NEXT PLACE TO STORE AND RETURN
;FORK CREATION AND CONTROL JSYS'S

.CFORK::MCENT
	MOVE T1,FKCNT		;COUNT OF FORKS
	ADDI T1,2		;CORRECT COUNT FOR THIS CREATION AND INITIAL JOB'S FORK
	HRRZ T2,GTOKPR+.GOCFK	;GET COUNT OF FORKS
	CAMG T1,T2		;AND DO GETOK IF REQUIRED
	JRST CFGOK		;NO PROCEED WITHOUT GETOK
	SOS T1			;MAKE CURRENT NUMBER
	GTOKM (.GOCFK,<T1>,[RETERR ()])
CFGOK:	CALL FLOCK		;LOCK THE FORK STRUCTURE
	MOVEI T1,-1
	CALL GFKH		;GET LOCAL HANDLE
	ERRJMP(FRKHX6,EFRKR)	;NONE
	PUSH P,T1		;SAVE IT
	NOSKED
	MOVE T2,DRMFRE		;GET FREE SWAPPING SPACE
	CAMG T2,DRMLV0		;SPACE LEFT?
	JRST CFBAD		;NO. DON'T CREATE THE FORK
	MOVE T2,SPTC		;CURRENT SPT COUNT
	CAML T2,SPC2		;ROOM LEFT?
	JRST CFBAD		;NO
	SKIPE FREFK		;ROOM IN SYSTEM?
	SKIPN FREJFK		;ROOM IN JOB?
	JRST CFBAD		;NO
	CALL ASSFK		;YES, ASSIGN FORK IN SYSTEM
	CALL ASSJFK		;AND ASSIGN FORK IN JOB
	PUSH P,T1		;SAVE JOB FORK HANDLE
	AOS FKCNT		;UPDATE THIS JOBS FORK COUNT
	MOVE T1,FORKX
	LOAD T2,FKJO%,(T1)	;GET JOB NUMBER
	STOR T2,FKJBN		; AND SET IT FOR NEW FORK
	LOAD T2,FKJS%,(T1)	;GET SPT INDEX FOR JSB
	STOR T2,FKJSB		; AND SET IT FOR NEW FORK
   IFN EXTJSB,<
	LOAD T2,FKJP%,(T1)	;Get SPT index for extended JSB
	STOR T2,FKJPT		; And set it for new fork
   >
	CALL WTCONC		;PUT FORK ON WAIT LIST
	OKSKED

	; ..
;CFORK ...

BP$019:!			;BREAKPOINT FOR CREATE SUBFORK
	HRLZ T1,FX
	CALL WAITFK		;WAIT FOR IT TO INITIALIZE
	POP P,T1		;RESTORE JOB FORK HANDLE
	HRRZM FX,SYSFK(T1)
				;Note that this clears all the
				; flag bits in LH of SYSFK
	MOVEI T2,1		;INDICATE 1 HANDLE ON THIS FORK
	STOR T2,FKHCNT,(T1)	; ...
	SETZM FKPTRS(T1)
	SETZM FKPSIE(T1)
	SETZM FKDPSI(T1)
	HRRZ T2,FORKN		;PUT NEW FORK INTO STRUCTURE LISTS
	MOVEI Q2,FKPTRS(T2)
	HLL Q2,INFERP
	LDB T3,Q2		;GET INFERIORS OF THIS FORK
	DPB T1,Q2		;PUT NEW FORK AT HEAD OF IT
	MOVEI Q2,FKPTRS(T1)
	HLL Q2,SUPERP
	DPB T2,Q2		;THIS FORK IS SUPERIOR OF NEW FORK
	HLL Q2,PARALP
	DPB T3,Q2		;OTHER INFERIORS ARE PARALLEL TO NEW FORK
	LOAD T4,FRKTTY,(T2)	;GET CTTY
	STOR T4,FRKTTY,(T1)	;PUT SUPERIOR'S CTTY IN INFERIOR
	PUSH P,T1
	CALL SETLF1		;MAP PSB OF NEW FORK
	; ..
;CFORK ...
	MOVE 2,0(P)		;NEW FORK'S JOB HANDLE
	MOVEM 2,FORKN(1)
	ADDM T2,JTBLK(T1)	;MAKE INFERIOR POINT TO CORRECT FKJTB
	MOVE T3,@JTBLK		;GET EXECUTING FORK'S MONITOR, IF ANY
	MOVEM T3,FKJTB(T2)	;SAME ENVIRONMENT TO INFERIOR
	MOVE 2,PRIMRY
	MOVEM 2,PRIMRY(1)
	MOVE 2,JOBBIT
	MOVEM 2,JOBBIT(1)	;PASS PRIORITY
	SETZM CAPMSK(1)
	SETZM CAPENB(1)
FTDYN <	SETZM CTSSBK(T1)	;Initially No CTS State Block
>				;End of Conditional Assembly
	SETZM PDVS(1)		;SAY NO PDVS YET
	MOVEI 2,LSTRX1		;INITIALIZE LAST ERROR CODE TO NONE
	MOVEM 2,LSTERR(1)
	POP P,4			;GET JOB WIDE INDEX
	MOVE 2,0(P)		;LOCAL HANDLE
	ANDI 2,377777		;MASK OFF FORK BIT
	IDIVI 2,2		;GET FKTAB INDEX
	ADD 2,FKPTAB(3)		;GET PROPER BYTE POINTER
	DPB 4,2			;STORE LOCAL POINTER
	JE FKIIF,(FX),CFK5	;IF NO INTERRUPT PENDING, ASSUME INIT SUCCEEDED
	MOVE 2,BITS+.ICMSE	;GOT INT. SEE IF FATAL
	OPSTR <TDNN T2,>,FKIBX,(FX) ;WAS IT?
	JRST CFK5		;NO. LET IT GO ON

;Here on fatal error

CFFAT:	CALL CLRLFK		;YES. CLEAR MAPPING
	POP P,1			;GET LOCAL INDEX
	CALL SETJFK		;GET JOB-WIDE FORK HANDLE
	CALL KFORK1		;ZAP THE FORK
	CALL FUNLK		;RELEASE FORK LOCK
	RETERR (CFRKX3)		;GIVE NO RESOURCES ERROR

	; ..
;CFORK...

CFK5:	UMOVE T2,1		;GET ARG
	TXNE T2,CR%MAP		;Same map?
	CALL CFK4		;YES
	TXNE T2,CR%CAP		;Give special capabilities?
	CALL CFK3
	TXNE T2,CR%ACS		;Load ACs?
	CALL CFK1		;YES
	TXNE T2,CR%ST		;Start process?
	CALL CFK2
	CALL CLRLFK		;UNMAP PSB
	POP P,1			;RETURN LOCAL HANDLE
	UMOVEM 1,1
	MOVEI T2,0(7)		;GET SYSTEM FORK INDEX
	MOVE 7,FORKX		;GET INDEX OF THIS FORK
	LOAD T1,FKMNQ		;GET LOCAL MAX Q
	MOVE 7,T2		;RESTORE INDEX OF CREATED FORK
	STOR T1,FKMNQ		;SET UP ITS MAX Q
	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	SMRETN

CFBAD:	OKSKED
	ERRJMP(CFRKX3,EFRKR)	;NO ROOM

;FORK CONTROL SUBRS

;Load ACs

CFK1:	SAVET
	XCTU [MOVE T2,2]	;GET LOC OF INITIAL AC'S
	XMOVEI T3,UAC(T1)	;FIND ADDRESS OF SAVE AREA
	MOVEI T1,20		;ALL ACS
	CALL BLTUM1		;TRANSFER AC'S TO MONITOR AND RETURN
	MOVE T1,T4		;GET JRFN
	CALLRET CLRVGN		;SET NON-VIRGIN FOR PROCESS

;Start process

CFK2:	MOVEI T3,0(T2)		;START ADDRESS
	MOVEM T3,PPC(T1)
	MOVX T3,USRCTX		;FLAGS WORD FOR USER MODE
	MOVEM T3,PFL(T1)
	PUSH P,T1
	NOSKED
	CALL UNBLK1		;UNBLOCK IT
	OKSKED
	MOVE T1,0(P)		;Get PSB address
	MOVE T1,FORKN(T1)	;Get JRFN for process
	SETONE SFSRT,(T1)	;FLAG THAT FORK HAS BEEN STARTED
	CALL CLRVGN		;No longer a Virgin Process
	POP P,T1
	RET

;Give special capabilities

CFK3:	MOVE T3,CAPMSK		;GIVE NEW FORK SAME SPEC CAP
	MOVEM T3,CAPMSK(T1)
	MOVE T3,CAPENB
	MOVEM T3,CAPENB(T1)
	RET
;'SAME MAP' BIT - CAUSES MAP OF INFERIOR TO BE FILLED WITH
;IND PTRS TO SUPERIOR

CFK4:	PUSH P,1
	PUSH P,2
	MOVE 1,FORKX
	LOAD T3,FKUP%,(T1)
	HRLZ T1,T3		;SOURCE IS THIS FORK
	LOAD T3,FKUPT
	HRLZ T2,T3		;DESTINATION IS NEW FORK
	MOVSI 3,(PTRW)
	MOVEI 4,PGSIZ
	CALL MSETPT		;DO FOR ALL PAGES
	 JRST [ ADJSP P,-3	;FIX UP STACK POINTER
		JRST CFFAT]	;HANDLE FATAL ERROR
	CALL CKXADR		;EXTENDED ADDRESSING SUPPORTED?
	 JRST CFK41		;NO
;SECTION 0 COULD BE HANDLED WITH AN INDIRECT SECTION POINTER AS WELL
; MAYBE FUTURE ...
	MOVE 1,FORKX
	LOAD T1,FKPS%,(T1)	;GET SPT INDEX FOR PSB OF THIS FORK
	HRLS T1			; INTO LEFT HALF
	HRRI 1,1		;THIS FORK, SOURCE SECTION 1
	LOAD T2,FKPSB		;GET SPT INDEX FOR PSB OF NEW FORK
	HRLS T2			; INTO LEFT HALF
	HRRI 2,1		;NEW FORK, DESTINATION SECTION 1
	TXO 3,SM%IND		;MAP VIA INDIRECT POINTERS
	MOVEI 4,MXSECN-1	;ALL SECTIONS
	CALL MSETST		;MAP SECTIONS 1 THRU MXSECN
	 JFCL			;CAN'T HAPPEN
CFK41:	MOVE T1,FORKN		;Get current JRFN
	CALL CKNXOR		;Is current process Execute-only?
	 JRST [	MOVE T1,-1(P)		;Yes-- get PSB of new process
		MOVE T1,FORKN(T1)	;Get JRFN of new process
		CALL SETEXO		;Make new process execute-only also
		 JFCL			;Can't (should never happen)
		JRST .+1]
	POP P,2
	POP P,1
	RET

;Wait for fork to become blocked.

;Accepts:
;	T1/ fork handle for fork we're waiting for

;	CALL WAITFK

;Returns +1: always, after waiting for the event

WAITFK:	HRRI 1,WTFKT
	MDISMS
	RET

;Scheduler test. Called with fork handle in T1. Returns 1(T4) if fork
;is blocked.

	RESCD			;SCHEDULER TEST, MUST BE RESIDENT
WTFKT:	JE FKBL%,(T1),0(T4)	;IF NOT BLOCKED, DON'T WAKE UP CALLER
	JRST 1(4)		;FORK IS BLOCKED. WAKE UP CALLER

ASSJFK:	MOVE 1,@FREJFK
	EXCH 1,FREJFK
	SUBI 1,FKPTRS
	RET

	SWAPCD
;SPLICE FORK STRUCTURE
; 1/ FORK HANDLE OF NEW SUPERIOR
; 2/ FORK HANDLE OF FORK TO BECOME INFERIOR
; RETURNS +2: SUCCESS, WITH 1/ FORK HANDLE OF 2 RELATIVE TO 1

DEFINE SPLERR (ERN,JMP)<
	JRST [CALL RALLI	;RESUME ALL INFERIORS
	       ERRJMP (ERN,JMP)]>

.SPLFK:: MCENT
	TRVAR <F1,F2,F3>
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL FALLI		;FREEZE ALL OF CALLER'S INFERIORS
	UMOVE Q1,T1
	TXNE Q1,SF%EXT		;IS THIS AN EXTENDED CALL?
	 JRST SPLFK4		;YES, DO SPECIALLY..
	XCTU [HRRZ T1,T1]	;GET RFH OF NEW SUPERIOR
	CALL SETJFK		;GET JOB FORK HANDLE OF 1
	MOVEM T1,F1
	CALL SKIIF		;IS 1 INFERIOR OR EQ TO SELF?
	 SPLERR(SPLFX1,EFRKR)	;NO
	XCTU [HRRZ T1,T2]	;GET 2
	CALL SETJFK		;GET JOB HANDLE OF 2
	MOVEM T1,F2
	CAME T1,FORKN		;IS 2 STRICTLY INFERIOR TO SELF?
	CALL SKIIF
	 SPLERR(SPLFX2,EFRKR)	;NO
	MOVE T1,F1		;GET 1
	MOVE T2,F2		;GET 2
	CALL SKIIFA		;IS 1 ALREADY EQ OR INFERIOR TO 2?
	 JRST .+2		;NO, OK
	SPLERR(SPLFX3,EFRKR)	;YES, ERROR
	MOVE T1,F1		;GET F1
	SKIPN T1,FKJTB(T1)	;DOES F1 HAVE A JTB?
	TROA T1,7777		;NO, THERE IS NO MONITOR
	LOAD T1,JTIMP,(T1)	;YES, GET F1'S MONITOR
	MOVE T2,F2		;GET F2
	SKIPN T2,FKJTB(T2)	;DOES F2 HAVE A JTB?
	TROA T2,7777		;NO, THERE IS NO MONITOR
	LOAD T2,JTIMP,(T2)	;YES, GET F2'S MONITOR
	CAIE T1,(T2)		;F1 AND F2 HAVE THE SAME MONITOR?
	CAMN T2,F1		;OR IS F1 THE IMMEDIATE MONITOR OF F2?
	CAIA			;YES, OK.
	 CALL SPLFK3		;NO. UPDATE TRAP ENVIRONMENTS
	CALL SPLFK9		;DO THE SPLICE
	MOVE T1,F1		;GET 1
	CALL SETLF1		;MAP PSB OF 1
	MOVSI T1,0(T1)		;SETUP ARG FOR GRFKH
	HRR T1,F2		;PSB OFFSET ,, JOB HANDLE
	CALL GRFKH		;GET RELATIVE HANDLE FOR 2 RELATIVE TO 1
	 SETZ T1,
	UMOVEM T1,T1
	CALL CLRLFK
	HRRZ T1,F2		;NEW INFERIOR
	HRRZ FX,SYSFK(T1)
	SETONE FKFR1,(FX)	;NEW INFERIORS ALWAYS BECOME FROZEN
	CALL RALLI		;RESUME ALL INFERIORS
	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	SMRETN
; UPDATE JSYS TRAP ENVIRONMENTS DUE TO SPLICING
; F2 HAS ITS OLD JSYS TRAP ENVIRONMENT REMOVED AND A NEW ONE ADDED.
; THE NEW ENVIRONMENT IS EITHER THE SAME AS F1'S OR IS THE ENVIRONMENT
; F1 INDIRECTLY SET FOR F2 (BY MONITORING ONE OF F2'S SUPERIORS)

SPLFK3:	MOVE P1,F2		;F2
	MOVE P2,F1		;F1
	PUSH P,FKJTB(P2)	;SAVE F1'S JTB, IF ANY.
	MOVE P4,T2		;SAVE F2'S MONITOR
	SKIPA P3,P1		;START WITH IMD. MON. OF F2 AND
SPFK3A:	MOVE P3,T1		;FIND OUT IF F1 IS A MON. OF F2
	SKIPN T1,FKJTB(P3)	;GET THE NEXT MONITOR UP THE CHAIN
	JRST SPFK3B		;NO MORE IN CHAIN
	LOAD T1,JTIMP,(T1)	;WHO IS THE MONITOR?
	CAIE T1,(P2)		;IS IT F1?
	JRST SPFK3A		;NO, KEEP LOOKING.
	PUSH P,FKJTB(P1)	;SAVE F2'S CURRENT JTB
	CALL NEWJTB		;GET A NEW BLOCK
	POP P,FKJTB(P1)		;RESTORE OLD BLOCK, ADDR OF NEW IN T2
	MOVEM T2,0(P)		;USE IT AS NEW ENVIRONMENT FOR F2
	HRL T1,FKJTB(P3)	;COPY F1'S INFERIOR'S BLOCK
	HRR T1,T2		;TO NEW BLOCK FOR F2
	BLT T1,JTBSIZ(T2)	;RETAINING ENV OF F2 SET BY F1
SPFK3B:	HRRZ T1,P1		;FIND SUPERIOR OF F2
	ADD T1,SUPERP		;BUILD NEEDED POINTER
	LDB T1,T1		;GET FORK
	CAIN P4,(T1)		;IS F2'S MONITOR SAME AS F2'S SUPERIOR?
	 CALL RELJTB		;YES. RELEASE JTB POINTER TO BY FK IN P1
	POP P,FKJTB(P1)		;F2'S NEW JSYS TRAP ENVIRONMENT
	CALLRET TFINF		;UPDATE F2'S INFERIORS (FORK IN P1)
				;CONTINUE WITH SPLICE NOW THAT THE
				;JSYS TRAP ENVIRONMENTS ARE THE SAME
; DO THE SPLICE.
; F1 IS THE NEW SUPERIOR AND F2 IS THE NEW INFERIOR

SPLFK9:
	NOSKED			;NOSKED WHILE CHANGING POINTERS
	MOVE T1,F2
	ADD T1,SUPERP		;MAKE PTR TO SUPERIOR OF 2
	LDB T1,T1		;GET IT
	ADD T1,INFERP		;MAKE PTR TO FIRST INFERIOR
SPLFK1:	LDB T2,T1		;SEARCH FOR 2
	CAMN T2,F2
	JRST SPLFK2		;FOUND IT
	MOVE T1,T2
	ADD T1,PARALP
	JRST SPLFK1		;CONTINUE SEARCH

;REMOVE 2 FROM THE INFERIOR LIST OF ITS SUPERIOR

SPLFK2:	ADD T2,PARALP
	LDB T3,T2		;GET SUCCESSOR
	DPB T3,T1		;PATCH AROUND 2

;NOW MAKE 2 BE THE FIRST INFERIOR OF 1

	MOVE T1,F2
	MOVE T2,F1
	ADD T2,INFERP		;MAKE PTR TO INFERIOR LIST OF 1
	LDB T3,T2		;GET CURRENT FIRST INFERIOR OF 1
	DPB T1,T2		;MAKE 2 NEW FIRST INFERIOR OF 1
	ADD T1,PARALP
	DPB T3,T1		;CONC REST OF INFERIOR LIST TO 2

;NOW UPDATE TO SHOW 1 IS SUPERIOR OF 2

	MOVE T1,F2
	ADD T1,SUPERP		;MAKE PTR TO SUPERIOR OF 2
	MOVE T2,F1
	DPB T2,T1			;PUT 1 AS SUPERIOR OF 2
	OKSKED
	RET
SPLFK4:	TXZ Q1,SF%EXT		;REMOVE FLAG FROM ARG BLOCK ADDRESS
	XCTU [HRRZ P1,.SFLEN(Q1)] ;GET WORD COUNT FROM USER
	CAIGE P1,2		;LONG ENOUGH FOR FUNCTION CODE?
	 SPLERR(SPLBTS,EFRKR)	;NO, ERROR, BLOCK TOO SHORT
	UMOVE T1,.SFCOD(Q1)	;GET FUNCTION CODE
	CAIE T1,.SFUNS		;IS IT .SFUNS (ONLY ONE SO FAR)
	 SPLERR(SPLBFC,EFRKR)	;NO, ERROR, BAD FUNCTION CODE.
	CAIGE P1,4		;DOES WORD COUNT INCLUDE FLAGS?
	 SPLERR(SPLBTS,EFRKR)	;NO, ERROR, BLOCK TOO SHORT
	UMOVE T1,.SFUFL(Q1)	;GET FLAGS
	TXNN T1,SF%GO
	IFSKP.			;IF SF%GO..
	 CAIGE P1,5		;IS THERE ROOM FOR ENTRY VECTOR.
	  SPLERR(SPLBTS,EFRKR)	;NO, ERROR
	ENDIF.
	TXNN T1,SF%ADR		;IF SF%ADR
	IFSKP.			;IS THERE ROOM FOR PC FLAGS AND ADDRESS
	 CAIGE P1,6		;NO, ERROR
	  SPLERR(SPLBTS,EFRKR)
	ENDIF.

; SET UP F1, F2, F3 AND CHECK FOR ERRORS

	MOVE T1,FORKN
	ADD T1,SUPERP
	LDB T1,T1
	MOVEM T1,F1		;F1 IS OUR SUPERIOR
	XCTU [HRRZ T1,.SFUIN(Q1)]
	CALL SETJFK
	MOVEM T1,F2		;F2 IS THE NEW INFERIOR
	CAME T1,FORKN
	CALL SKIIF		;BE SURE F2 IS STRICTLY INFERIOR TO SELF
	 SPLERR(SPLFX2,EFRKR)
	MOVEI T1,.FHSLF
	CALL SETJFK
	MOVEM T1,F3		;F3 IS US

; DO THE XSFRK% OR SFRKV NOW WHILE WE HAVE A VALID HANDLE. NOTHING
; WILL HAPPEN YET ANYWAY BECAUSE F2 IS FROZEN. WE ALSO CATCH ANY
; ERRORS HERE.

	CALL SPLFK5		;SETUP AND CALL APPROPRIATE JSYS.
	 JRST	[CALL RALLI	;RESUME INFERIORS
		MOVE T1,LSTERR
		JRST EFRKR]	;ERROR RETURN

	MOVE T1,F1		;KILL ANY JSYS TRAPS TO F1
	MOVEI Q1,.TFRAL
	CALL TFSR

	NOSKED			;EXCHANGE FORKN NUMBERS BETWEEN F3 AND F2
	MOVE T2,FORKN		;GET OUR FORKN NUMBER
	MOVE T1,F2
	CALL SETLF1		;MAP NEW INFERIOR 
	EXCH T2,FORKN(T1)	;SWAP FORK NUMBERS
	PUSH P,T2		;DON'T LOSE T2
	CALL CLRLFK		;UNMAP NEW INFERIOR
	POP P,T2
	MOVEM T2,FORKN		;COMPLETE SWAP OF FORKN NUMBERS

	CALL SPSWAP		;SWAP INFO BETWEEN F3 AND F2
	CALL SPLFK9		;CHANGE FORK STRUCTURE BASED ON F1,F2

	HRRZ T1,FORKN		;VIA OUR FORKN
	ADD T1,SUPERP		;GET SUPERIOR FORKN
	LDB T1,T1
	HRRZ FX,SYSFK(T1)	;GET SYSTEM ID OF SUPERIOR.
	SETONE FKSPL,(FX)	;SET INFERIOR HAS SPLICED EVENT.
	MOVE T1,FORKN		;GET NEW VALUE OF FORKN FOR US.
	MOVEM T1,FLKOWN		;FIX THE OWNER OF FLOCK WHILE WE STILL HAVE IT

	DO.			;WAKE SUPERIOR IF IT IS IN TRMTST FOR US.
	 JE FKBL%,(FX),ENDLP.	;IF NOT BLOCKED, THERE IS NO SCHEDULER TEST
	 LOAD T1,FKWTL		;BLOCKED, SEE WHERE IT IS?
	 CAIE T1,TRMLST		;WAITING FOR TERMINATION?
	 IFSKP.
	  LOAD T1,FKSTD,(FX)	;YES, FOR WHICH FORK?
	  CAMN T1,FORKX		;WAITING FOR US?
	  CALL UNBLK1		;YES, THEN UNBLOCK.
	  ENDIF.
	 ENDDO.

	OKSKED

	CALL RALLI		;RESUME INFERIORS
	MOVE T1,F3		;THIS IS OUR BROTHER WHO WAS INFERIOR
	CALL RFORK3		;ALSO RESUME OUR BROTHER WHO WAS INFERIOR
	CALL RFORK1		;THIS NEEDS TO BE DONE ALSO, FOR SOME REASON.

	MOVE T1,FORKN		;GET JOB FORK NUMBER
	CALL DASFKH		;DEASSIGN FORK HANDLES
	CALL KFORK3		;REMOVE FROM FORK STRUCTURE
	CALL FUNLK		;UNLOCK, WE ARE NOW OUT OF FORK STRUCTURE.

; THE FOLLOWING IS WHAT IS NECESSARY TO DO THE EQUIVALENT OF KSELF FOR ONES
; OWN JOB. THE CODE JUST ABOVE DOES WHAT .KFORK WHAT HAVE DONE.

	MOVE 7,FORKX		
	MOVX T1,FKPSI1		;DEFERRED INTERRUPT STATE
	STOR T1,FKINX,(FX)	;THIS MAKES US NON-INTERRUPTIBLE
	JRST KSELF1		;ENTER KSELF CODE IN THE RIGHT PLACE.

	SMRETN

; setup and call appropriate JSYS based on flags.

SPLFK5:	UMOVE T1,.SFUFL(Q1)
	TXNN T1,SF%CON		;continue fork specified?
	IFSKP.			;yes, do it.
	 MOVX T1,SF%CON		;LH T1/ continue flag for XSFRK%
	 XCTU [HRR T1,.SFUIN(Q1)] ;RH T1/ obtain inferior to continue
	 XSFRK%
	  ERJMP [RET]		;error return
	 RETSKP			;good return
	ENDIF.
	TXNN T1,SF%ADR		;start fork at address?
	IFSKP.			;yes, do it.
	 UMOVE T1,.SFUIN(Q1)	;T1/ inferior handle
	 UMOVE T2,.SFUA1(Q1)	;T2/ PC flags,,0
	 UMOVE T3,.SFUA2(Q1)	;T3/ PC address
	 XSFRK%
	  ERJMP [RET]		;error return
	 RETSKP			;good return
	ENDIF.
	TXNN T1,SF%GO		;start fork at entry vector?
	IFSKP.			;yes, do it.
	 UMOVE T1,.SFUIN(Q1)	;T1/ inferior handle
	 UMOVE T2,.SFUA1(Q1)	;T2/ entry vector address
	 SFRKV
	  ERJMP [RET]		;error return
	 RETSKP			;good return
	ENDIF.
	RETSKP			;if no flags, then leave as is, good return.

; swap information between forks.

SPSWAP:
	MOVEI T4,SYSFK		;MAKE F3 BECOME F2 AND VICE VERSA
	CALL SPEXCH
	CALL FHEXCH		;swap back the fork handle counts.
	MOVEI T4,CTTAB		;controlling terminal
	CALL SPEXCH
	MOVEI T4,FKJTB		;JSYS traps
	CALL SPEXCH
	MOVEI T4,FKPSIE		;PSI related
	CALL SPEXCH
	MOVEI T4,FKDPSI		;PSI related
	CALL SPEXCH
	RET
;
; EXCHANGES INFORMATION IN JOB TABLES.
; T4/ JOB TABLE NAME
; F3 AND F2 INDICATE TGHE ONES TO EXCHANGE
;
SPEXCH:
	MOVE T1,T4
	ADD T1,F3	;PTR TO TABLE(F3)
	MOVE T3,0(T1)
	MOVE T2,T4
	ADD T2,F2	;PTR TO TABLE(F2)
	EXCH T3,0(T2)
	MOVEM T3,0(T1)
	RET
;
; EXCHANGE FORK HANDLE COUNTS BETWEEN FORK F3 AND F2.
;
FHEXCH:	MOVE T1,F2	;JFH OF FORK F2
	MOVE T2,F3	;JFH OF FORK F3
	LOAD T3,FKHCNT,(T1)
	LOAD T4,FKHCNT,(T2)
	STOR T3,FKHCNT,(T2)
	STOR T4,FKHCNT,(T1) ;SWAP COMPLETE
	RET
	ENDTV.
;.KFORK - KILL FORKS
;
; DESTROYS Q2,FX,P1,P2
;
; REGISTER USAGE - P1 IS COUNT OF FORKS KILLED
;		   P2 IS POINTER TO LIST OF KILLED FORKS

.KFORK::MCENT
	MOVEI T1,0(T1)
	CAIN T1,-4		;ALL INFERIORS?
	JRST KFORK2		;YES
	CALL FLOCK		;1 FORK, LOCK THE FORK STRUCTURE
	CALL SETJFK		;GET SYSTEM FORK INDEX
	CAMN 1,FORKN		;SELF?
	ERRJMP(KFRKX2,ITFRKR)	;YES, NOT PERMITTED
	CALL SKIIF		;INFERIOR?
	JRST FRKE2		;NO, NOT PERMITTED
	SETZ P1,		;ZERO COUNT OF FORKS KILLED
	MOVE P2,P		;GET STORAGE POINTER
	ADJSP P,1		;STORAGE FOR 1 FORK
	CALL KFORK1		;KILL IT
	CALL FUNLK		;UNLOCK FORK STRUCTURE
	CALL KFKWAT		;WAIT FOR COMPLETION
	ADJSP P,-1		;REMOVE STORAGE
	JRST MRETN		;AND DONE

KFORK2:	CALL FLOCK		;LOCK FORK STRUCTURE
	HRRZ T1,FORKN
	CALL MAPINF		;FREEZE ALL TO INSURE INTERRUPTIBILITY
	 CALL FFORK1
	CALL KALLI		;KILL ALL INFERIORS (RETURNS FLOCK UNLOCK)
	JRST MRETN		;AND DONE

KFORK1:	HRLM T1,0(P)
	CALL FFORK1		;FREEZE ALL TO INSURE INTERRUPTIBILITY
	HLRZ T1,0(P)
	XHLLI Q2,20		;GET CURRENT SECTION
	HLLM Q2,0(P)
KFORK0:	CALL DASFKH		;DEASSIGN LOCAL FORK HANDLE
	MOVE Q2,T1
	HRRZ FX,SYSFK(Q2)
	CAMN FX,FORKX		;THIS FORK?
	ERRJMP(KFRKX2,ITFRKR)	;CAN'T KILL SELF
	CALL KFORK3		;remove fork from structure
	CALL SETLF1		;MAP PSB
	CALL SUSFK		;SUSPEND FORK
	MOVE T2,FORKX		;GET SYSTEM FORK INDEX FOR SELF
	MOVEM T2,PAC+4(T1)	;LEAVE IT IN AC4 OF VICTIM
	SETZM INTDF(T1)		;MAKE VICTIM NON-INTERRUPTABLE
	MOVX T2,MONENV		;MONITOR CONTEXT FLAGS WORD
	MOVEM T2,PFL(T1)	;SET IT FOR DESTINATION PROCESS
	MOVE T2,[MSEC1,,KSELF]
	MOVEM T2,PPC(T1)	;START IT SO AS TO KILL ITSELF
	AOS P1			;COUNT FORKS KILLED
	AOS P2			;ADVANCE STORAGE POINTER
	MOVEM FX,(P2)		;SAVE FORK INDEX
	SETONE FKKIL		;SAY FORK IS WAITING TO DIE
	CALL UNBLK1		;NOW ALLOW FORK TO RUN
	OKSKED			;MATCH NOSKED IN SUSFK
	CALL CLRLFK
	SETZ T1,
	MOVEI T2,FPG0A
	MOVEI T3,FPG3+1-FPG0	;CLEAR FORK TEMP PAGES
	CALL MSETMP
	RET
;KILL ALL INFERIORS OF THIS FORK - MUST BE CALLED FLOCK LOCKED
; UNLOCKS IT FOR RETURN

KALLI:	SETZ P1,		;INIT COUNT OF FORKS KILLED
	MOVE P2,P		;GET POINTER TO STORAGE
	ADJSP P,NUFKS		;GET SOME ROOM
	DO.
	   HRRZ T1,FORKN
	   ADD T1,INFERP
	   LDB T1,T1		;GET NEXT INFERIOR
	   JUMPE T1,[CALL FUNLK	;NO MORE UNLOCK FORK STR
		     CALL KFKWAT ;AND WAIT
		     ADJSP P,-NUFKS ;CLEAR SPACE
		     RET]	;AND DONE
	   CALL KFORK0		;KILL ALL INFERIORS TOO
	   JRST TOP.
	ENDDO.

; remove fork from structure, called by KSELF and KSELFJ.
; T1/ job fork number, destroys T3,T4

KFORK3:	MOVE T3,T1
	ADD T3,SUPERP
	LDB T3,T3		;GET SUPERIOR
	ADD T3,INFERP
KFK01:	LDB T4,T3		;GET NEXT PARALLEL
	CAIN T4,0(T1)		;DESIRED FORK?
	JRST KFK02		;YES
	MOVE T3,T4
	ADD T3,PARALP
	JRST KFK01
KFK02:	ADD T4,PARALP		;FOUND FORK TO BE KILLED IN LIST
	LDB T4,T4
	DPB T4,T3		;PUT NEXT IN LAST, REMOVING FORK FROM LIST
	RET

;WAIT FOR FORKS TO DIE - CALLING FORK MUST NOT HAVE FLOCK

KFKWAT:	SOJL P1,R		;ALL DONE RETURN
	HRL T1,(P2)		;GET FORK INDEX
	HRRI T1,KFKTST		;AND ROUTINE
	MDISMS			;WAIT FOR FORK TO DIE
	SOJA P2,KFKWAT		;DECREMENT STORAGE POINTER AND LOOP

	RESCD

;SCHEDULER TEST FOR ABOVE

KFKTST:	JE FKKL%,(T1),RSKP	;IF FLAG IS CLEAR DONE WAITING
	RET			;KEEP WAITING

	SWAPCD
;FORK KILL SELF
; 4/ FORK WHICH INITIATED KSELF

BP$021:!			;(KSELF): BREAKPOINT FOR KFORK
				;ASSUMES FORKX HAS SUICIDAL FORK INDEX
KSELF::
	MOVE FX,FORKX
	MOVX T1,FKPSI1
	STOR T1,FKINX,(FX)	;DISABLE ANY FURTHER INTERRUPTS
	MOVX T1,USRCTX		;SET UMODF AND CAB FOR USER MODE
	MOVEM T1,FFL
	SETZM FPC
	MCENTR			;GET INTO REASONABLE MONITOR STATE
KSELF1:	CALL ABTBUF		;FLUSH TCP BUFFERS FOR THIS FORK
	MOVEI T1,0(FX)		;GET FORK HANDLE
	CALL SCSKIL		;DEALLOCATE ANY SCS% RESOURCES
	PUSH P,T2		;SAVE
	SETZ T2,		;CLEAR ALL FORK'S ENTRIES ON STACK
	CALL JSBSTF		;GO PROCESS DEALLOCATION LIST
	NOINT			;NOINT IN CASE THERE'S FREE SPACE TO REMOVE
	SKIPE T2,PRARGP		;ANY JSB SPACE USED BY PRARG?
	JRST [SETZM PRARGP	;ZERO OLD POINTER
	      CALL PRARGF	;RELEASE THE SPACE
	      JRST .+1]
	SKIPE T2,PDVS		;ANY PDVAS STORED?
	CALL RELJFR		;YES, RELEASE THEM
	SETZM PDVS		;SAY NO PDVAS STORED ANYMORE
	OKINT			;DONE WITH FREE SPACE STUFF, SO ALLOW INTERRUPTS AGAIN
FTDYN <	CALL CLRCTS		;Clear all CTS State Information
>				;End of Conditional Assembly
	CALL INTCLR		;CLEAR PROCESSOR DEPENDENT STUFF
	CALL EVRKIL		;CHECK FOR DECNET EVENT READER
        CALL NTCOFF        	;CLEAR THE NETWORK CHANGE INTERRUPT TABLE
	JFCL			;IGNORE
	CALL NIJKFK##		;Reset NI% JSYS stuff
	MOVEI T1,0(FX)		;GET FORK HANDLE
	SETZ T2,0		;CLEAR ALL FORK'S ENTRIE
	CALL GOKFRE
	POP P,T2		;RESTORE T2
	CAMN FX,ACJFN		;CHECK FOR ACJ FORK
	CALL ACJKIL		;KILL ACJ NOW
	SETOM INTDF
	MOVEM T4,P1		;SAVE FORKX OF SUPERIOR
	SETZM PSIBW
	CALL DTIALL		;DEASSIGN TERM INTERRUPTS
	OPSTR <SKIPE >,PSUTPS	;DID THIS FORK USE .MOTPS MTOPR FUNCTION?
	CALL TTDTPS		;YES, SCAN TTYS FOR THIS FORK
	MOVE 1,JOBNO		;GET JOB NUMBER OF THIS PROCESS
	OPSTR <SKIPE >,DIAFL,(T1) ;DOES THIS JOB HAVE DIAG RESOURCES?
	CALL DGFKIL		;YES. GO RELEASE THIS PROCESSES SET
	CALL MTAKFK		;KILL MTA ONLINE/OFFLINE PSI INTERRUPTS
	HLRZ T1,DSPSFK		;GET DSK PSI FORK
	CAIN FX,0(T1)		;SAME AS THIS ONE?
	SETZM DSPSFK		;YES CANCEL IT
	;..
	;..
KSEFW:	HRRZ T1,FORKN		;GET SELF
	LOAD T2,FRKTTY,(T1)	;GET MY CTTY
	CAIN T2,-1		;JUST THE JOB'S CTTY?
	JRST KSEF0		;YES, NOTHING TO DO.
	TRZN T2,1B18		;CONVERT FROM DESIGNATOR TO LINE NUMBER
	JRST KSEF0		;WASN'T A DESIGNATOR?
	CAIGE T2,NLINES		;RANGE CHECK
	CAIGE T2,0
	JRST KSEF0		;NOT A VALID LINE
	CALL GTTOPF		;GET THE TOP FORK OF CTTY GRP FOR THIS TTY
	 JRST KSEF0		;NOT AN ACTIVE LINE
	CAME T3,FORKX		;IS IT ME?
	JRST KSEF0		;NO. NOTHING TO DO.
	SKIPN FORKN		;IS THIS THE TOP FORK?
	IFNSK.			;IF SO
	 LOKK DEVLKK
	 CALL TTYDAS		;RELEASE TTY NOW
	 IFNSK.			;IFF ERROR RETURN
	 IFL. T1
		HRL T1,T2
		UNLOKK DEVLKK
		MDISMS		;WAIT HERE FOR CONDITION TO IMPROVE
		JRST KSEFW	;AND TRY IT AGAIN
	 ENDIF.
	 UNLOKK DEVLKK		;RELEASE DEVICE LOCK
	 ENDIF.
	ELSE.
	 MOVEI T1,-1		;CLEAR IT
	 CALL STTOPF		;SET TO NOT IN USE
	ENDIF.
	;..
	;..
KSEF0:	SETO T1,
	RFRKH			;GO RELEASE ALL RELEASABLE HANDLES
	 JFCL
	MOVSI T2,.FHSLF
	MOVE T3,[PM%CNT+PM%ABT+PM%EPN+1000] ;REQUEST PMAP OF 1000 PAGES
	PMAP			;CLEAR ALL PAGES FROM SECTION-ZERO MAP
	CALL CLNZSC		;UNMAP PAGES FROM NON-ZERO SECTIONS
	 JFCL			;DON'T CARE IF SECTIONS STILL EXIST
	MOVE T1,FORKX		;GET FORK NUMBER
	CALL PIDKFK		;KILL ALL PIDS BELONGING TO THIS FORK
	MOVE T1,FORKX
	CALL ENQFKR		;DEQ ALL REQUESTS FOR THIS FORK
	MOVE T1,FORKX		;CHECK IF THIS FORK OWNS THE UTEST LOCK
	CAMN T1,UTLOCK		;...
	CALL UTREL		;YES, RELEASE IT

;Clean up the effect of setting address break. Decrement the count of users
;who have address break set. We cannot zero ADRBRK here, because address break
;is still turned on in the hardware. When the process goes to HLTFK1, it will
;go through KISSAV, which will turn off address break in the hardware. Note
;that this code must not be executed twice for this fork, because that would
;cause a second SOS of USERBK.

	SKIPE ADRBRK		;HAVE ADDRESS BREAK SET NOW?
	SOS USERBK		;YES. DECREMENT NUMBER OF USERS BREAKING
	SETOM PRIMRY		;SET PRIMARY I/O TO CONTROLLING TERMINAL
	MOVE T1,[CZ%UNR+CZ%ABT+400000] ;REASSIGN STILL-MAPPED+FLUSH NONX FILES
	CLZFF			;CLOSE FILES HERE AND BELOW
IFE FTNSPSRV,<
	CALL RELSAB		;FREE DECNET SABs (Session Control Arg Blk)
	CALL LLMRFK##		;[7173] Release any LLMOP resources
>
IFN LAHFLG,<
	MOVE T1,FX		;[7.1120]Fork number to T1
	CALL LATRST		;[7.1120](T1)Release any reverse LAT TTY's
>				;[7.1120]End of IFN LAHFLG
	SOS FKCNT		;COUNT OF FORKS
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL KALLI		;KILL ALL FORKS AND UNLOCK FLOCK
	CALL UNMIDX		;UNMAP THE DIRECTORY AND INDEX FILE
	CALL CLKREL		; Release any clocks for this fork
	MOVE T1,JOBNO		;GET JOB NUMBER OF THIS FORK
	SKIPE SNPPGS		;THIS FORK SNOOPING?
	CALL SNPREL		;YES, GO REMOVE ITS BREAK POINTS
	MOVE FX,FORKX
	LOAD T1,FKUPT		;GET SPT INDEX FOR UPT
	LOAD T2,SPTSHC,(T1)	;GET SHARE COUNT OF UPT
	PUSH P,T2		;SAVE IT FOR LATER CHECK
	CALL FLOCK
	SKIPN T2,@JTBLK		;DO WE HAVE A JSYS TRAB BLOCK?
	JRST KSEF1		;NO
	HRRZ T3,FORKN		;YES, SEE WHETHER IT SHOULD BE RELEASED
	ADD T3,SUPERP		;IDENTIFY MY SUPERIOR
	LDB T3,T3		; ..
	HRRZ P1,FORKN		;NEED MY FORK NUMBER FOR RELJTB
	LOAD T2,JTIMP,(T2)	;MY MONITOR
	CAIN T3,(T2)		;IS MY SUPERIOR MY MONITOR?
	CALL RELJTB		;YES. RELEASE THE JTB
KSEF1:	CALL FUNLK
	LOAD T1,NOSTR
	SKIPE T1		;IF NO STRUCTURES MOUNTED, SKIP STR CODE
	CALL RELSTR		;RELEASE ALL STRUCTURE MOUNTS FOR FORK
	SETZRO FKKIL		;FORK IS NOW EFECTIVLY DEAD - TURN OFF FLAG
	;..
;FINAL RUNDOWN - HAVE TO WAIT FOR THE SHARE COUNTS ON ALL SECTION MAPS
;TO GO TO ZERO.  NON-ZERO SECTIONS ARE CHECKED WITH THE CLNZSC ROUTINE.
;SECTION ZERO IS CHECKED WITH BY EXPLICITLY TESTING ITS SHARE COUNT.
;IF ANY SECTIONS ARE STILL SHARED, DISMISS AND TRY AGAIN LATER.

	;..
KSEF2:	CALL CLNZSC		;DELETE USER'S NON-ZERO SECTIONS
	 JRST [	POP P,T2	;STILL SOME LEFT, FIX STACK
		JRST KSEF3]	;GO WAIT FOR A WHILE
	POP P,T2		;SHARE COUNT OF UPT
	CAIE T2,1		;UNSHARED?
	JRST KSEF3
	CALL FLOCK
	HRRZ T4,FORKN		;GET JOB FORK HANDLE FOR SELF
	LOAD T1,FKHCNT,(T4)	;GET NUMBER HANDLES OF THIS FORK
	JUMPN 1,[MOVSI T1,(1B0)	;NO. MARK IT DELETED THEN
		IORM T1,SYSFK(4)	;""
		JRST KSEF5]	;AND GO FINISH UP
	MOVEI T1,FKPTRS(4)	;NO OTHERS, PUT JOB SLOT BACK ON FREE LIST
	EXCH T1,FREJFK
	MOVEM T1,@FREJFK
	SETOM SYSFK(T4)		;NOTE SLOT AVAILABLE
KSEF5:	CALL FUNLK
	MOVE FX,FORKX
	LOAD T2,FKPSB		;GET SPT INDEX FOR PSB
	HRLS T2			; INTO LEFT HALF
	SETZ T1,
	HRRI T2,PPLOW		;CLEAR PROCESS MAP FROM PPLOW
	MOVEI T4,PPHI-PPLOW+1	; TO PPHI
	CALL MSETPT		;CLEAR PROCESS MAP
	 NOP			;IGNORE FAILURES
	CALL WTFPGS		;WAIT FOR UPT AND PSB TO BE UNMAPPED
	JRST HLTFK1		;GO DELETE UPT AND PSB

;Here when share count of section 0 map (UPT) is non-zero. Clear map
;again.

KSEF3:	MOVEI T1,^D5000
	DISMS			;WAIT FOR 5 SECS
	LOAD T1,FKUPT		;GET SPT INDEX FOR UPT
	LOAD T2,SPTSHC,(T1)	;SHARE COUNT OF UPT
	PUSH P,T2
	SETZ T1,		;INDICATE CLEARING
	LOAD T2,FKUPT		;GET SPT INDEX OF UPT
	HRLZS T2		;UPT,,PAGE 0
KSEF4:	HRRZ T3,T2		;MAKE A GOOD ADDRESS.
	SKIPE UPTPGA(T3)	;QUICK CHECK FOR ALREADY EMPTY
	CALL SETPT		;BUT NOT USING PMAP
	MOVEI Q2,0(T3)
	CAIGE Q2,777
	AOJA T2,KSEF4
	JRST KSEF2
;CLNZSC - DELETE NON-ZERO SECTIONS OF USER'S ADDRESS SPACE
;RETURNS +1: ONE OR MORE SECTIONS CAN'T BE DELETED BECAUSE
;	     THEY ARE STILL SHARED
;	 +2: ALL NON-ZERO SECTIONS CLEARED

CLNZSC::CALL CKXADR		;EXTENDED-ADDRESSING MACHINE?
	 RETSKP			;NO, CAN'T HAVE NON-ZERO SECTIONS, DONE
	SAVEAC <Q1,Q2>		;GET WORK AC'S
	MOVEI Q1,(VSECNO)	;GET HIGHEST SECTION #
	SETZ Q2,		;CLEAR COUNT OF SECTIONS I COULDN'T KILL

;LOOP TO SCAN ALL SECTIONS, ATTEMPTING TO DELETE ANY THAT EXIST

CLNZS1:	MOVE T1,Q1		;GET SECTION #
	CALL CHKMPS		;DOES THIS SECTION EXIST?
	 JUMPE T1,CLNZS2	;NO, SKIP IT
	SETO T1,		;YES, GET -1 TO SPECIFY DELETION
	MOVSI T2,.FHSLF
	HRR T2,Q1		;GET FORK HANDLE,,SECTION#
	MOVE T3,[PM%ABT+1]	;COUNT (DESTRUCTIVE PMAP IF OF%DUD ON)
	SMAP%			;TRY TO DELETE THE SECTION
	 ERJMP [HRRZ T1,LSTERR	;FAILED, GET ERROR CODE
		CAIN T1,SMAPX1	;FAILED BECAUSE STILL SHARED?
		AOS Q2		;YES, COUNT IT
		JRST .+1]
CLNZS2:	SOJG Q1,CLNZS1		;LOOP THRU ALL SECTIONS
	JUMPE Q2,RSKP		;SKIP RETURN IF ALL DELETED
	RET			;SOME SECTION(S) STILL SHARED
;FREEZE FORK

;ACCEPTS:
;	T1/ RELATIVE FORK HANDLE

;RETURNS +1: ALWAYS
;	ILLEGAL INSTRUCTION TRAP ON ERROR

.FFORK::MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	MOVEI 1,0(1)
	CAIN 1,-4		;ALL INFERIORS?
	JRST FFORK5		;YES

;USER WANTS TO FREEZE JUST ONE FORK. GET THE JOB-WIDE FORK HANDLE
;RETURN ERROR IF REQUEST IS FOR SELF, SUPERIOR, OR PARALLEL

	CALL SETJFK		;OTHERWISE, ANY SINGLE INFERIOR
	CAME 1,FORKN		;REQUESTING FREEZE OF SELF?
	CALL SKIIF		;REQUESTING SELF OR INFERIOR?
	 JRST FRKE1		;NOT INFERIOR. RETURN ERROR

;DO THE FREEZE. UPDATE TTY PSI INFORMATION IF REQUESTED FORK AND
;REQUESTING FORK HAVE THE SAME CONTROLLING TERMINAL

	PUSH P,T1		;SAVE THE REQUESTED JOB-WIDE INDEX
	CALL FFORK1		;DO THE WORK
	POP P,T1		;RESTORE REQUESTED INDEX
	LOAD T1,FRKTTY,(T1)	;HERE'S ONE FORK'S CTTY
	HRRZ T2,FORKN		;NOW DO SAME FOR SELF
	LOAD T2,FRKTTY,(T2)	;HERE'S MY CTTY
	CAIN T1,0(T2)		;ARE THEY THE SAME SOURCE?
	CALLRET UPDTIR		;YES. SO GO UPDATE TTY PSI INFO
	CALL FUNLK		;NO. SO JUST RELEASE FORK STRUCTURE
	MRETNG			;AND RETURN

;HERE WHEN REQUESTED ALL INFERIORS OF THE CALLER. STEP THROUGH
;ALL IMMEDIATE INFERIORS AND, FOR EACH ONE, CALL FFORK1 TO
;FREEZE IT.

FFORK5:	HRRZ 1,FORKN		;SELF
	CALL MAPINF		;MAP ALL IMMED INFERIORS
	 CALL FFORK1		;THROUGH FFORK1
	HRRZ T1,FORKN		;GET MY SOURCE OF TERMINAL PSI'S
	LOAD T1,FRKTTY,(T1)
	CALLRET UPDTIR
;FFORK1 AND FFORK3 - FREEZE A FORK AND ALL OF ITS INFERIORS

;ACCEPTS:
;	T1/ JOB-WIDE FORK HANDLE

;	CALL FFORK1 - DIRECT FREEZE
;	CALL FFORK3 - INDIRECT FREEZE

;RETURNS +1: ALWAYS

FFORK3:	SKIPA 2,[FRZB2%]	;INDIRECT FREEZE BIT
FFORK1:	MOVX 2,FRZB1%		;DIRECT FREEZE BIT
	HRRZ FX,SYSFK(1)	;GET SYSTEM WIDE FORK INDEX
	CAIE FX,-1		;[7254] Fork exist?
	OPSTR <TDNE 2,>,FKINX,(FX) ;ALREADY DONE?
	RET			;YES
	TXNE 2,FRZB1%		;REMEMBER WHICH BIT - B1?
	TRO 1,1B18		;YES
	HRLM 1,0(P)		;SAVE CURRENT FORK
	TRZ 1,1B18
	CALL MAPINF		;DO INDIRECT FREEZE OF INFERIORS
	 CALL FFORK3
	HLRZ T1,0(P)		;GET CURRENT FORKN
	TRZ T1,1B18
	LOAD T2,FRKTTY,(T1)	;THIS FORK'S CURRENT SOURCE OF PSI'S
	PUSH P,Q1		;SAVE A COUPLE AC'S
	PUSH P,Q2		; ..
	MOVEI Q1,0(T1)		;FIND SUPERIOR OF THIS FORK
	ADD Q1,SUPERP		; ..
	LDB Q1,Q1		;GET FORK NUMBER
	LOAD T1,FRKTTY,(Q1)	;GET CONTROLLING TERMINAL
	CAMN T2,T1		;SAME AS FOR FORK BEING FROZEN?
	JRST FFORK4		;YES, SKIP THE PSI UPDATE
	MOVEI T1,0(T2)		;NO, DIFFERENT. SO UPDATE PSI INFO
	CALL UPDTI		; FOR THAT TTY
FFORK4:	POP P,Q2		;RESTORE AC'S USED JUST ABOVE
	POP P,Q1		; ..
	HLRZ 1,0(P)		;RESTORE FORK PLUS FLAG BIT
	XHLLI T2,20		;GET SECTION #
	HLLM T2,0(P)		;SET IT IN RETURN
	MOVX 2,FRZB1%		;RESTORE BIT
	TRZN 1,1B18		;B1?
	MOVX 2,FRZB2%		;NO, B2
	HRRZ 7,SYSFK(1)
	CALL SUSFK		;SUSPEND FORK
	OPSTR <IORM 2,>,FKINX,(FX)
	MOVEI 2,FRZWT
	STOR 2,FKSTR,(FX)	;SET FROZEN STATE
	CALL RECONC		;UPDATE LIST
	OKSKED			;MATCH NOSKED IN SUSFK
	RET

;(INDIRECTLY) FREEZE ALL INFERIORS

FALLI:	MOVE T1,FORKN
	CALL MAPINF
	 CALL FFORK3		;XCTED BY MAPINF
	RET

	RESCD

FRZWT::	JRST 0(4)		;FREEZE WAIT SCHED TEST

	SWAPCD
;RESUME FORK

.RFORK::MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	MOVEI 1,0(1)
	CAIN 1,-4		;ALL INFERIORS?
	JRST RFORK5		;YES
	CALL SETJFK
	MOVE P1,T1		;SAVE A COPY OF THE FORK INDEX
	CAME 1,FORKN		;CHECK RELATIVITY
	CALL SKIIF
	JRST FRKE1		;NOT INFERIOR
	CALL RFORK1
	LOAD T1,FRKTTY,(P1)	;GET CTTY
	CALLRET UPDTIR

RFORK5:	HRRZ 1,FORKN
	CALL MAPINF		;DO ALL IMMED INFERIORS
	 CALL RFORK1
	HRRZ T1,FORKN
	LOAD T1,FRKTTY,(T1)	;FIND THE FORK'S CTTY
	CALLRET UPDTIR

RFORK3:	SKIPA 2,[FRZB2%]	;INDIRECT FREEZE BIT
RFORK1:	MOVX 2,FRZB1%		;DIRECT FREEZE BIT
	HRRZ 7,SYSFK(1)
	OPSTR <TDNN 2,>,FKINX,(FX) ;FROZEN THIS WAY?
	RET			;NO
	OPSTRM <ANDCAB 2,>,FKINX,(FX) ;CLEAR THIS TYPE OF FREEZE
	TXNE 2,FRZBB%		;ALL TYPES OF FREEZE NOW CLEARED?
	RET			;NO, LEAVE FORK FROZEN
	HRLM 1,0(P)		;SAVE CURRENT FORK
	CALL MAPINF		;CLEAR INDIRECT FREEZE ON INFERIORS
	 CALL RFORK3
	HLRZ 1,0(P)
	HRRZ FX,SYSFK(T1)	;SYSTEM FORK INDEX
	XHLLI T2,.		;FIND CURRENT SECTION
	HLLM T2,0(P)		;SET IT IN RETURN PC
	JN FKFRJ,(FX),R		;RETURN IF FROZEN BY JSYS TRAP
	SETZRO FKFRA,(FX)	;CLEAR ADDRESS BREAK FREEZE
	CALL STPFK1		;SET TO UNFREEZE THIS FORK
	SKIPN 2,PIOLDS(1)	;WAS ON WTLST BEFORE FREEZE?
	JRST [	CALL UNBLK1	;UNBLOCK IT
		JRST RFORK4]
	STOR 2,FKSTX,(FX)
	CALL RECONC		;UPDATE WAIT LISTS
RFORK4:	CALL CLRSFK		;UNSUSPEND FORK
	OKSKED			;MATCH NOSKED IN STPFK1 (SUSFK)
	JRST CLRLFK

;(INDIRECTLY) RESUME ALL INFERIORS

RALLI:	MOVE T1,FORKN
	CALL MAPINF
	 CALL RFORK3		;XCTED BY MAPINF
	RET

;BREAKPOINT JSYS FOR IDDT

.BPT::	MCENT
	JRST HALTF1		;MAKE LIKE HALTF

;PERPETUAL WAIT - INTERRUPTABLE

.WAIT::	MCENT
WAIT1::	MOVEI 1,JRET
	MOVSI T2,FHV2		;LOWER BLOCK PRIORITY
	HDISMS
	JRST MRETN
;SPECIAL ROUTINES CALLED FROM HANG-UP CODE TO INDIRECTLY FRREZE OR
;UNFREEZE ALL INFERIORS. THIS TECHNIQUE IS USED (RATHER THAN FFORK
;AND RFORK) IN ORDER TO PRESERVE THE FROZENNESS OF FORKS ACROSS
;A HANGUP ATTATCH SEQUENCE.

;FORK FREEZE INDIRECT:

FFORKI::CALL FLOCK		;LOCK UP THE JOB FORK STRUCTURE
	HRRZ T1,FORKN		;GET RELATIVE HANDLE FOR THIS PROCESS
	CALL MAPINF		;MAP ALL INFERIORS
	 CALL FFORK3		;INDIRECTLY FREEZE THEM ALL
FORKI:	CALL UPDTI		;UPDATE TTY PI WORDS
	CALL FUNLK		;UNLOCK FORK STRUCTURE
	RET			;AND DONE

;RESUME FREEZE INDIRECT

RFORKI::CALL FLOCK		;LOCK UP FORK STRUCTURE
	HRRZ T1,FORKN		;GET JOB WIDE INDEX
	CALL MAPINF		;MAP ALL INFERIORS
	 CALL RFORK3		;INDIRECT RESUME OF ALL INFERIORS
	JRST FORKI		;AND DONE
;READ FORK STATUS

.RFSTS::MCENT
	TXNE T1,^-<RF%LNG!RF%PRH> ;ANY RESERVED BITS NON-0?
	 ITERR (DECRSV)
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	MOVE P1,[-1]		;ASSUME FORK HANDLE IS UNASSIGNED, STATUS=-1
	HRRZ T1,T1		;USE ONLY 18 BITS
	TRNE T1,200000		;LOCAL DESIGNATOR?
	JRST RFSTS5		;NO
	CAIN T1,400000		;SELF?
	JRST RFSTS5		;YES - DONT TRANSLATE HANDLE
	CALL RFHJFK		;CONVERT SINGLE FORK RFH TO JRFN
	 JRST ITFRKR		;ERROR - ERR CODE IN T1
	CAIGE T1,NUFKS		;ASSIGNED?
	SKIPG SYSFK(T1)
	JRST RFSTS7		;NO-- RETURN -1
	JRST RFSTS6		;YES

RFSTS5:	CALL SETJFK		;NOT MULTIPLE FORKS
RFSTS6:	HRRZ FX,SYSFK(T1)	;GET SYSTEM FORK INDEX
	MOVE P1,T1		;SAVE JOB INDEX
	CALL MRFSTS		;GET FORK STATUS WORD
	EXCH P1,T1		;SAVE STATUS. GET BACK JOB INDEX
	CALL SETLF1		;MAP PSB
RFSTS7:	UMOVE T2,1		;GET USER AC1
	TXNE T2,RF%LNG		;LONG FORM RFSTS?
	 JRST RFSLNG		;YES-- DO LONG FORM
	CAMN P1,[EXP -1]	;UNASSIGNED FORK HANDLE?
	 JRST RFSTSR		;YES-- JUST RETURN STATUS
	HLLZ T3,PFL(T1)		;GET FLAGS
	MOVE T2,PPC(T1)		;GET PC
	TXNN T3,UMODF		;USER MODE?
	JRST [	HLLZ T3,UPDL+1(T1) ;NO, USER FLAGS IS FIRST ON STACK
		MOVE T2,UPDL+0(T1) ;AND GET THE PC
		TXZ T3,UMODF	;BUT TURN OFF USER BIT FOR INFO
		JRST .+1]
	TXZ T2,PCX		;IGNORE UNUSED PC BITS
	TLNN T2,-1		;SECTION 0?
	IOR T2,T3		;YES. FORM SECTION 0 PC WORD THEN
	UMOVEM T2,2
	CALL CLRLFK
RFSTSR:	UMOVEM P1,1
	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	JRST MRETN
;HERE FOR LONG FORM OF RFSTS CALL
; T1/  PSB OFFSET FOR PROCESS TO READ STATUS

RFSLNG:	UMOVE Q1,2		;GET ADDRESS OF ARGUMENT BLOCK
	XCTU [HRRZ T2,.RFCNT(Q1)] ;GET USER'S MAX COUNT
	MOVEI T3,RFSMAX		;ASSUME MAX ENTRIES ARE LEGAL
	CAMN P1,[EXP -1]	;UNASSIGNED FORK HANDLE?
	 MOVEI T3,.RFPSW+1	;YES-- JUST RETURN STATUS WORD
	CAMLE T2,T3		;USER'S LENGTH TOO BIG?
	 MOVE T2,T3		;YES-- ONLY GIVE WHAT WE HAVE
	MOVN T2,T2		;FORM
	MOVE P2,Q1		;[7146]ACTUAL ADDRESS TO USER TABLE.
	HRL Q1,T2		; AOBJN POINTER TO USER TABLE
	MOVEI Q2,.RFPSW		;FIRST WORD IS PROCESS STATUS WORD
	AOBJP Q1,RFSLN2		;SKIP COUNT WORD, DO NOTHING IF ONLY COUNT!
	ADDI P2,1		;[7146]SKIP ALSO FOR ADDRESS TO USER TABLE.
RFSLN1:
	CALL @RFSLTB-.RFPSW(Q2)	;GET A WORD FOR TABLE INTO T2
	UMOVEM T2,0(P2)		;[7146]STORE THE WORD
	ADDI Q2,1		;BUMP TO NEXT ENTRY
	ADDI P2,1		;[7146]BUMP ADDRESS FOR USER TABLE
	AOBJN Q1,RFSLN1		;LOOP FOR ALL ITEMS TO BE RETURNED
RFSLN2:
	CAME P1,[-1]		;WAS A PSB MAPPED?
	CALL CLRLFK		;YES SO RESET PSB MAPPING
	CALL FUNLK		;UNLOCK FORK STRUCTURE
	UMOVE T2,2		;GET TABLE ADDRESS BACK
	XCTU [HRLM Q2,.RFCNT(T2)] ;STORE COUNT OF WORDS RETURNED
	JRST MRETN		;RETURN NOW

;DISPATCH TABLE FOR LONG RFSTS BLOCK ENTRIES
; CALL ROUTINE WITH T1/  PSB OFFSET
; RETURN WITH T2/  DATA WORD FOR THIS ITEM

RFSLTB:	DTBDSP (RFSLSW)		;.RFPSW -- PROCESS STATUS WORD
	DTBDSP (RFSLFL)		;.RFPFL -- PROCESS' PC FLAGS
	DTBDSP (RFSLPC)		;.RFPPC -- PROCESS' PC
	DTBDSP (RFSLSF)		;.RFSFL -- PROCESS STATUS FLAGS
RFSMAX==.-RFSLTB+.RFPSW

;PROCESS STATUS WORD

RFSLSW:	MOVE T2,P1		;GET STATUS WORD
	RET			;RETURN FROM RFSLSW

;PROCESS' PC FLAGS

;NOTE: This routine returns only those flags that should be visible
;to the user. Although the microcode has stored AC blocks and PCS, if
;the process did an SFM it would not see them. Thus the JSYS does not
;return them.

RFSLFL:	MOVE T2,PFL(T1)		;GET FLAGS
	TXNN T2,UMODF		;IN USER MODE?
	 JRST [	MOVE T2,UPDL+1(T1)	;NO-- GET FLAGS FROM STACK
		TXZ T2,UMODF		;BUT CLEAR USER AS FLAG
		JRST .+1]
	ANDX T2,EXFLBT		;RETURN ONLY THE FLAGS
	RET			;RETURN FROM RFSLFL

;PROCESS' PC

RFSLPC:	MOVE T2,PPC(T1)		;GET PROCESS' PC
	MOVE T3,PFL(T1)		;GET FLAGS
	TXNN T3,UMODF		;USER MODE?
	 MOVE T2,UPDL+0(T1)	;NO-- GET PC FROM STACK
	TXZ T2,PCX		;CLEAR UNUSED PC BITS
	RET			;RETURN FROM RFSLPC

;PROCESS STATUS FLAGS

RFSLSF:	MOVX T2,0		;ASSUME NONE
	MOVE T3,FORKN(T1)	;GET JRFN FOR THIS PROCESS
	JE SFEXO,(T3),RFSLS1	;NOT EXECUTE-ONLY-- GO ON
	TXO T2,RF%EXO		;EXECUTE-ONLY-- SET FLAG
RFSLS1:	RET			;RETURN FROM RSFLSF
;MONITOR READ FORK STATUS
;FX/ SYSTEM FORK INDEX
;	CALL MRFSTS
;RETURNS+1(ALWAYS):
;T1/ FORK STATUS
;**WARNING** IF FX POINTS TO A FORK IN A JOB DIFFERENT FROM THAT OF THE
;	CURRENT FORK, YOU MUST INSURE THE FORK CANNOT BE KILLED
;	OUT FROM UNDER YOU.(NOSKED IS ONE SOLUTION)

MRFSTS:	CAME FX,FORKX		;SAME AS CURRENT CONTEXT?
	JRST MRFST1		;NO - GO ON
	CHKINT			;INSURE UP TO DATE STATUS
	CONI PI,T1		;INSURE INTERRUPT ACCEPTED
	TLNE T1,1_<SCDCHN-7>	;REQUEST STILL PENDING?
	JRST .-2		;YES - WAIT

MRFST1:	SETZ T1,		;INITIALIZE T1
	JE FKBLK,,MRFSTX	;IF NOT WAITING, RETURN ZERO
	LOAD T2,FKSTR,(FX)	;IS WAITING, GET STATE
	CAIN T2,FRZWT		;FROZEN?
	JRST RFST4		;YES
RFST5:	CAIN T2,FORCTM		;FORCED TERMINATION?
	JRST RFST3		;YES
	CAIN T2,HALTT		;REGULAR TERMINATION?
	JRST RFST2		;YES
	CAIE T2,TRMTST		;WAITING FOR FORK TERMINATION
	CAIN T2,TRMTS1		;EITHER FLAVOR?
	JRST RFST6		;YES
	CAIE T2,BLOCKM		;IN A DISMS?
	CAIN T2,BLOCKW
	JRST RFST7		;YES
	CAIE T2,BLOCKT		;LONG BLOCK?
	CAIN T2,HIBERT		;OR HIBER JSYS?
	JRST RFST7		;YES
	CAIN T2,JRET		;WAITING INDEFINITELY?
	JRST RFST7		;YES
	TLO T1,.RFIO		;N.O.T.A., MUST BE I/O
	JRST MRFSTX
RFST2:	TLO T1,.RFHLT		;REGULAR TERMINATION GIVES 2
	JRST MRFSTX

RFST6:	TLO T1,.RFWAT
	JRST MRFSTX

RFST3:	PUSH P,T1
	MOVE T1,FX		;COPY FORK INDEX
	CALL SETLF3		;MAP PSB
	MOVE T2,FORCTC(T1)	;GET CHANNEL CAUSING FORCED TERM
	HRRM T2,0(P)		;PUT IN RH OF STATUS WORD
	CALL CLRLFK
	POP P,T1
	TLO T1,.RFFPT		;WITH 3 INDICATING FORCED TERM
	JRST MRFSTX

RFST4:	TLO T1,400000		;FROZEN, INDICATE IN BIT 0
	LOAD T2,FKINX,(FX)	;ADDRESS BREAK?
	TXNE T2,ABFRZ%		; ?
	JRST [	TLO T1,.RFABK	;YES, RETURN PROPER CODE
		JRST MRFSTX]	; ..
	TXNE T2,JTFRZ%		;NO, MAYBE JSYS TRAPPED?
	TLOA T1,.RFTRP		;IT IS, FLAG IT.
	CAIA
	JRST MRFSTX		;AND RETURN THAT
	LOAD T2,FKSTD,(FX)	;AND GET OLD STATUS
	CAIN T2,-1		;FROZEN BY A SIGNAL JFN?
	JRST RFSTS1		;YES - SAY THE JOB WANTS THE TTY
	JUMPE T2,MRFSTX
	JRST RFST5

RFSTS1:	TLOA T1,.RFSIG		;NOTE FROZEN BY A SIGNAL JFN
RFST7:	TLO T1,5		;DISMS'ING
MRFSTX:	RET			;COMMON EXIT
;START FORK VIA ENTRY VECTOR

.SFRKV::MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETJFK
	PUSH P,T1
	UMOVE T2,2		;Get user's start offset
	CAIGE T2,0		;Must be positive number
	 ERRJMP (SFRVX1,ITFRKR)
	HRRZ T3,T2		;Get position in vector
	CAILE T3,1		;Is offset 0 or 1?
	 CALL CHKNXS		;No-- make sure not execute-only
	CALL SETLF1
	MOVE T3,EVLNTH(T1)	;GET SIZE OF VECTOR IN DESTINATION FORK
	CAIE T3,<JRST>B53	;TOPS-10 style vector?
	 JRST SFKV01		;No-- go on
	MOVEI T3,2		;Yes-- length is 2
	CAMN T2,[XWD 1,0]	;This CCL start position?
	 JRST SFKV02		;Yes-- all checking done
SFKV01:	CAIL T3,1		;REASONABLE VECTOR LENGTH?
	CAIL T3,1000
	JRST SFRKV2		;NO
	CAIL T2,0(T3)		;LEGAL ARG?
	JRST SFRKV2		;NO
SFKV02:	MOVEM T2,FORCTC(T1)	;LEAVE FOR FOR TO START SELF
	CALL CLRLFK
	POP P,T1			;RECOVER JOB HANDLE
	HRRZ T2,FORKN		;GET JOB HANDLE FOR THIS FORK
	CAMN T1,T2		;SAME?
	JRST [	CALL FUNLK	;YES, UNLOCK AND CONTINUE IN SAME FORK
		CALL SFRKV5	;CONSTRUCT NEW PC
		MOVEM T1,0(P)	;STORE FLAGS
		MOVEM T2,-1(P)	;STORE ADDRESS
		JRST MRETN]	;RETURN TO IT
	CALL STPFK
	DMOVE T2,[MONENV	;SET NEW FLAGS TO START IN MONITOR
		MSEC1,,SFRKV1]
	CALLRET SFORK1

SFRKV2:	CALL CLRLFK
	ERRJMP(SFRVX1,ITFRKR)	;ILLEGAL RELATIVE NUMBER
;FORK STARTS HERE TO LOOK AT ENTRY VECTOR AND GO TO USER

SFRKV1:	MOVE P,UPP		;SETUP STACK
	CALL SFRKV5		;CONSTRUCT NEW PC
	DMOVEM T1,FFL		;SETUP FLAGS AND PC
	JRST GOUSR		;RETURN TO IT

;CONSTRUCT ADDRESS FROM ENTRY VECTOR PARAMETERS

SFRKV5:	MOVE T1,EVADDR		;ENTRY VECTOR ADDRESS
	SETPCS T1		;SET PCS TO SECTION NUMBER OF ENTRY VECTOR
	HRRZ T2,FORCTC		;RELATIVE ADDRESS
	MOVE T3,EVLNTH		;GET SIZE OF ENTRY VECTOR
	CAIE T3,<JRST>B53	;OLD STYLE?
	IFSKP.
	  HLLZ T1,T1		;GET SECTION OF PGM
	  CAIN T2,0		;YES, 0 MEANS .JBSA
	  XCTU [HRR T1,.JBSA(T1)]
	  CAIN T2,1		;1 MEANS .JBREN
	  XCTU [HRR T1,.JBREN(T1)]
	  HLRZ T2,FORCTC	;Get start offset (non-0 only for .JBSA)
	ENDIF.
	ADD T2,T1		;COMPLETE ADDRESS
	MOVX T1,USRCTX		;MAKE IT A USER PC
	RET
;Start fork at specific starting address
;
;Accepts from user space:
;		T1/	control flags,,fork handle
;		T2/	PC flags
;		T3/	PC address

.XSFRK::MCENT
	UMOVE T1,T1		;GET CONTROL FLAGS AND FORK HANDLE
	XCTU [DMOVE T2,T2]	;GET PC FLAGS AND ADDRESS
	CALLRET SFORK0		;EXIT THROUGH COMMON CODE

;Start fork in starting address section
;
;Accepts from user space:
;		T1/	control flags,,fork handle
;		T2/	PC flags,,PC address without section

.SFORK::MCENT
	UMOVE T1,T1		;GET CONTROL FLAGS AND FORK HANDLE
	XCTU [HLLZ T2,T2]	;GET PC FLAGS FROM LH OF USER'S AC2
	XCTU [HRRO T3,T2]	;USE STARTING ADDRESS SECTION AND 18-BIT ADDRESS FROM USER'S AC2
	CALLRET SFORK0		;FINISH WITH COMMON ROUTINE
;SFORK0 is the worker routine for both SFORK and XSFRK jsyses.
;
;Accepts:	T1/	control flags and fork handle
;		T2/	PC flags
;		T3/	PC address, -1 in left half means use s.a. section

SFORK0:	TRVAR <CFLAGS,PCFLGS,PCADDR>
	MOVEM T1,CFLAGS		;SAVE ARGS
	MOVEM T2,PCFLGS
	MOVEM T3,PCADDR
	TXNE T1,^-<SF%CON!SF%PRH> ;ANY UNKNOWN BITS SET?
	 ITERR (DECRSV)		;YES-- GIVE ERROR
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	HRRZ T1,CFLAGS		;GET FORK HANDLE
	CALL SETJFK
	MOVE T2,CFLAGS		;GET FLAGS/PROCESS HANDLE FROM USER
	TXNE T2,SF%CON		;CONTINUE PROCESS ONLY?
	JRST [	PUSH P,T1	;SAVE JOB-WIDE HANDLE
		OPSTR <SKIPN>,SFSRT,(T1)	;HAS FORK BEEN STARTED?
		 ITERR (FRKHX5,<CALL FUNLK>)	;NO, UNLOCK AND GIVE ERROR
		HRRZ FX,SYSFK(T1) ;GET SYSTEM HANDLE
		CALL MRFSTS	;GET STATUS OF FORK
		LOAD T2,RF%STS,T1 ;GET STATUS
		POP P,T1	;RESTORE HANDLE
		CAIE T2,.RFHLT	;HALTED?
		CAIN T2,.RFFPT	;OR FORCED TERMINATION?
		SKIPA		;YES
		JRST CLFLK0	;NO. RETURN NOW
		CALL STPFK	;YES. STOP IT BEFORE STARTING IT
		JRST SFORK2]	;AND PROCEED
				;PROCESS TO BE STARTED-- MUST SETUP CONTEXT
	CALL CHKNXS		;Check for execute-only
	CALL STPFK		;STOP FORK
	MOVE T3,PCADDR		;IF XSFRK JSYS, CALLER SUPPLIED SECTION
	SKIPGE PCADDR
	HLL T3,EVADDR(T1)	;IF SFORK JSYS, USE STARTING ADDRESS SECTION
	HLLZ T2,PCFLGS		;GET PC FLAGS
	TLZ T2,(UIOF+2037B17)	;USER I/O, CALFRMMON, IDX AND IND OFF
	TXO T2,USRCTX		;SET USER MODE FLAGS AND AC BLOCKS
	CALLRET SFORK1		;DO COMMON CODE
;COMMON CODE FRO SFRKV%, SFORK%, XSFRK%, MSFRK%
; T1/ OFFSET ADDRESS TO OBJECT FORK PSB
; T2/ NEW FLAGS
; T3/ NEW PC

SFORK1:	SETOM SLOWF(T1)		;NORMALIZE FLAG
	PUSH P,PFL(T1)
	MOVEM T2,PFL(T1)		;PUT FLAGS
	MOVEM T3,PPC(T1)	;AND PC
	HRRZ T2,FORKN(T1)	;GET JOB FORK NUMBER
	SETONE SFSRT,(T2)	;FLAG THAT FORK HAS BEEN STARTED
	POP P,T2		;OLD FLAGS
	TXNE T2,UMODF		;FORK WAS IN USER MODE?
	JRST SFORK2		;YES, ACS ALREADY IN RIGHT PLACE
	HRRZ T2,ACBAS(T1)
	CAIGE T2,<UACB>B39	;IN NESTED MONITOR CALL?
	JRST SFORK2		;NO, ACS ALREADY IN RIGHT PLACE
	MOVSI T2,UACB(T1)	;MUST MOVE ACS FROM AC STACK
	HRRI T2,UAC(T1)		; TO SAVED BLOCK 1
	BLT T2,UAC+17(T1)
SFORK2:	SETZRO FKSTD,(FX)	;CLEAR LH IN CASE FROZEN
	SETZM PIOLDS(T1)	;SET PRE-FREEZE STATE TO RUNNING
	PUSH P,T1		;SAVE PSB POINTER
	HLLZ T2,PSIBIP(T1)	;PASS FORK'S CURRENT INTERRUPT STATE
	HRRZ T1,FORKN(T1)	;GET THIS FORKS JOB ID
	HRRZ T1,SYSFK(T1)	;GET SYSTEM ID
	PUSH P,T1		;SAVE FORK
	PUSH P,T2		;SAVE PSB STATE
	OKSKED			;MUST DO THIS IN CASE JSBSTF OR GOKFRE BLOCK
	CALL JSBSTF		;GO DO ANY DEALLOCATIONS
	POP P,T2		;RESTORE T2
	POP P,T1		;GET FORK AGAIN
	CALL GOKFRE		;FREE GETOK REQUESTS
	CALL SUSFK		;MAKE SURE FORK STILL SUSPENDED
	POP P,T1		;RECOVER PSB POINTER
	JN FKFRZ,(FX),SFORK3	;IF FROZEN, DON'T START FORK
	PUSH P,T1
	CALL UNBLK1		;UNBLOCK IT
	POP P,T1
	CALL CLRSFK		;NOW CLEAR SUSPENSION
SFORK3:	MOVE T2,FORKN(T1)	;FIND THAT FORK'S CTTY
	ADD T2,T1		;GET OFFSET (T1 MIGHT CONTAIN MORE THAN 18 BITS)
	OKSKED			;MATCH NOSKED IN STPFK (SUSFK)
	LOAD T1,FRKTTY,(T2)	;GET CONTROLLING TERMINAL
	CALL UPDTI
	CALLRET CLFRET
;MONITOR SFORK, CAN START IN MONITOR SPACE
; T1/ FORK HANDLE
; T2/ EXTENDED START ADDRESS

.MSFRK::MCENT
	MOVE 3,0(P)		;THIS IS LEGAL IF CALLED FROM
	MOVE 4,CAPENB		;MONITOR MODE, OR IF SC%WHL OR
	TLNE 3,(UMODF)		;OPERATOR CAPABILITIES ARE PRESENT
	TXNE 4,SC%WHL+SC%OPR	;TEST CAPS
	JRST .+2
	ITERR(CAPX1)		;USER LACKS CAPABILITY
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETJFK
	CALL STPFK		;SAME STUFF AS SFORK
	MOVEI T2,MFRKWD		;GET PRIORITY WORD FOR MONITOR FORKS
	SKIPN JOBSKD		;DOES JOB HAVE PRIORITY?
	SKIPE JOBBIT(T1)	;NO. DOES THE PROCESS ALREADY HAVE SOME?
	SKIPA			;YES. DON'T SET IT
	MOVEM T2,JOBBIT(T1)	;DOESN'T
	MOVX T2,MONENV		;NEW FLAGS
	UMOVE T3,T2		;NEW PC
	CALLRET SFORK1
;STOP FORK, USED BY SEVERAL FORK JSYS'S

STPFK:	CALL SKIIF		;JOB FORK NUMBER IN 1, IS INFERIOR?
	JRST FRKE2		;NO
STPFK1:	MOVE 6,1
	HRRZ 7,SYSFK(6)
	CAMN 7,FORKX		;THIS SAME FORK?
	JRST FRKE1		;YES, ILLEGAL
	CALL SETLF1		;MAP PSB
	CALLRET SUSFK		;SUSPEND FORK
;READ/SET FORK AC'S

.RFACS::MCENT
	XCTU [MOVES 0(2)]	;Test existence/writeability before NOSKED
	XCTU [MOVES 17(2)]	; of whole block
	CALL FACS
	MOVEI T1,20		;ALL ACS
	EXCH T2,T3		;GET ARGS IN RIGHT  ORDER
	CALL BLTMU1		;DO BLT TO USER
	JRST FACSR		;RETURN

.SFACS::MCENT
	XCTU [SKIP 0(2)]	;Test existnece before NOSKED
	XCTU [SKIP 17(2)]	; of whole block
	CALL FACS
	MOVEI T1,20		;MOVE ACS
	CALL BLTUM1		;MOVE ACS TO MONITOR
;	JRST FACSR		;RETURN
FACSR:	OKSKED
	JRST CLFRET

;COMMON AC ROUTINE

FACS:	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETJFK		;ONE FORK ONLY
	CALL SKIIF		;AND IT MUST BE INFERIOR
	 JRST FRKE2		;NOT INFERIOR
	CALL CHKNXS		;Check for execute-only process
	MOVE 6,1
	HRRZ 7,SYSFK(6)
	CALL SETLF1		;MAP PSB
	NOSKED
	TMNN FKBLK		;FORK BLOCKED?
	ERRJMP(FRKHX4,FACSE)	;NO
	MOVE T2,PFL(T1)		;GET CURRENT PC
	HRRZ T3,ACBAS(T1)		;GET AC STACK PTR
	TXNN 2,UMODF		;IN USER MODE?
	CAIGE 3,<UACB>B39	;OR TOP-LEVEL MON CALL?
	SKIPA 3,[UAC]		;YES, ACS IN SAVED BLOCK 1
	MOVEI 3,UACB		;NO, ACS IN TOP OF AC STACK
	ADDI 3,0(1)		;ADJUST INTO OTHER PSB
	XCTU [MOVE 2,2] 	;GET ADDRESS FROM USER
	RET

FACSE:	OKSKED
	PUSH P,1		;SAVE THE ERROR CODE
	CALL CLRLFK
	POP P,1			;RESTORE ERROR CODE
	JRST ITFRKR
;HALT FORK

.HFORK::MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	HRRZ 1,1
	CAIN 1,-4		;ALL INFERIORS?
	JRST [	MOVX T2,<CALL HFORK1> ;ROUTINE TO EXECUTE
		CALL MAPFKH	;MAP OVER ALL FORKS
		 NOP		;WON'T BLOCK
		JRST HFORK4]
	CALL SETJFK		;NO, SOME ONE FORK
	CAMN 1,FORKN		;SELF?
	ERRJMP(HFRKX1,EFRKR)	;YES, RETURN ERROR
	CALL SKIIF		;IS DESIGNATED FORK AN INFERIOR?
	 JRST FRKE2		;NO, ILLEGAL
	CALL HFORK1		;DO THE WORK
HFORK4:	CALL FUNLK
	JRST MRETN

HFORK1:	PUSH P,1		;SAVE FORK NUMBER
	CALL STPFK		;STOP THE FORK
	MOVEI 2,HALTT
	IFQN. FKFRZ,(FX)	;FROZEN?
	  STOR T2,FKSTD,(FX)	;YES. UPDATE PRE-FREEZE STATE
	  MOVEM T2,PIOLDS(1)
	ELSE.
	  STOR T2,FKSTX,(FX)	;TERMINATED STATE
	  CALL CLRSFK		; BUT INTERRUPTIBLE
	ENDIF.

HFORK2:	MOVE 1,0(P)
	ADD 1,SUPERP		;GET SUPERIOR
	LDB 1,1
	HRRZ 1,SYSFK(1)		;GET SYSTEM INDEX
	CALL SUPUB0		;WAKEUP SUPERIOR IF NECESSARY
HFORK3:	MOVE T1,0(P)
	OKSKED			;MATCH NOSKED IN STPFK (SUSFK)
	CALL CLRLFK
	POP P,T3		;FORKN OF OTHER FORK
	LOAD T1,FRKTTY,(T3)	;GET CONTROLLING TERMINAL
	CALLRET UPDTI		;UPDATE TERM INT WORD
;CALL FROM TTY SERVICE TO RESOLVE FORK CONFLICT

TTFRKT::SKIPGE FKPT(1)		;FORK STILL EXISTS?
	RET			;NO
	LOAD 2,FKSTR,(T1)	;GET ITS STATUS
	CAIE 2,TCITST		;STILL WAITING FOR TTY?
	RET			;NO
	MOVSI 3,-NUFKS		;SETUP TO SEARCH FOR FORK
	SKIPL 2,SYSFK(3)	;THIS SLOT IN USE?
	CAIE 1,0(2)		;AND HAS CORRECT FORKX?
	AOBJN 3,.-2		;NO
	JUMPGE 3,R		;RETURN IF NOT FOUND IN THIS JOB
	PUSH P,A		;SAVE FORK HANDLE IN CASE
	MOVEI 1,0(3)		;FORKN OF OTHER FORK
	CALL SKIIF		;IS IT INFERIOR
	 JRST [	MOVEI T1,^D1000	;NO, WAIT AWHILE
		DISMS
		POP P,A		;GET BACK HANDLE OF THE FORK
		JRST TTFRKT]	;TRY AGAIN
	POP P,0(P)		;CLEAN UP STACK
	SAVEPQ			;SAVE ALL PERMANENT REGS
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL HFORK1		;HALT THE OTHER GUY
	CALLRET FUNLK		;UNLOCK AND RETURN
;WAIT FOR FORK TO TERMINATE

;TRMTST IS USED TO TEST THE STATE OF THE FORK BASED ON ITS SYSTEM-WIDE
;FORK-ID. **NOTE WELL** THAT ANY SCHEDULER TEST OF THIS KIND MUST USE
;THE SUPERIOR'S FKSPL AND BE PREPARED TO RE-EVALUATE THE JOB-WIDE HANDLE IN
;CASE A SPLICE OCCURS. A SPLICE CAUSES THE FORK TO BECOME ANOTHER. DO NOT
;FORGET TO TEST FKSPL IN THE SCHEDULER TEST AS WELL.

.WFORK::MCENT
	CAIN 1,-4		;ALL INFERIORS?
	JRST WFORKA		;YES
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	MOVE T2,FORKX
	SETZRO FKSPL,(T2)	;RESET INFERIOR SPLICED EVENT.
	CALL SETJFK		;ONE FORK, GET ITS JOB HANDLE
	HRLZ 1,SYSFK(1)		;SETUP TEST ON FORK INDEX
	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	HRRI 1,TRMTST
	MOVSI T2,FHV1		;LOW BLOCK PRIORITY
	HDISMS
	MOVE T1,FORKX
	JE FKSPL,(T1),MRETN	;NOT DUE TO INFERIOR SPLICE, A GENUINE RETURN 
	UMOVE T1,T1
	JRST .WFORK		;RE-EVALUATE FORK HANDLE AND DO AGAIN.

WFORKA::MOVSI D,-NLFKS+1	;NUMBER TO DO
	MOVE C,FKPTAB		;GET POINTER TO HANDLES
WFORK3:	ILDB A,C		;GET NEXT HANDLE
	CAIN A,-1		;ASSIGNED?
	JRST WFORK4		;NO. LOOP TO NEXT THEN
	MOVEI A,.FHSLF+1(D)	;GET NEXT HANDLE
	RFSTS			;GET STATUS
	CAMN A,[-1]		;IS IT DELETED?
	JRST WFORK4		;YES. GO DO NEXT THEN
	LOAD A,RF%STS,A		;GET STATUS
	CAIE A,.RFHLT		;HALTED?
	CAIN A,.RFFPT		;NO. ERROR ABORT?
	JRST MRETN		;YES. RETURN GOOD
WFORK4:	AOBJN D,WFORK3		;NO. LOOK AT ALL LOCALS
	MOVEI A,TRMTS1		;SETUP TEST TO WAIT UNTIL CHANGED
	MOVSI T2,FHV1		;LOW BLOCK PRIORITY
	HDISMS
	JRST MRETN

	RESCD

TRMTST::
	JN FKSPL,(FX),1(T4)	;GET OUT IF AN INFERIOR HAS SPLICED.
	JE FKBL%,(T1),0(T4)	;DON'T WAKE UP IF FORK IS BLOCKED
	LOAD 2,FKSTR,(1)	;GET SCHEDULER TEST
	CAIE 2,HALTT		;WAITING BECAUSE TERMINATION?
	CAIN 2,FORCTM		;OR FORCED TERM?
	JRST 1(4)		;YES
	CAIE T2,FRZWT		;FROZEN?
	JRST 0(4)		;NO WAIT
	LOAD 2,FKSTD,(1)	;GET PRE FREEZE STATE
	CAIE 2,HALTT		;HALTED?
	CAIN 2,FORCTM		;OR FORCED TERM?
	JRST 1(4)		;YES
;	JRST TRMTS1		;WAIT LONGER

TRMTS1::JRST 0(4)

	SWAPCD
;SUSPEND FORK SO IT CAN BE DIDDLED
; RETURNS NOSKED SO THAT CALLER CAN FINISH CHANGING STATE RACE-FREE

SUSFK:	SAVEAC <T1,T2>
	CAMN 7,FORKX
	BUG.(HLT,FRKSLF,FORK,SOFT,<SUSFK - Given self as argument>,,<

Cause:	Some routine in the monitor has erroneously tried to suspend
	itself with SUSFK.
>)
SUSF6:	NOSKED
	JE FKBLK,,SUSF4		;IS FORK BLOCKED NOW?
	LOAD 2,FKSTR,(FX)	;YES. GET WAITING STATUS
	CAIE 2,SUSWT		;ALREADY SUSPENDED OR FROZEN?
	CAIN 2,FRZWT
	RET
	CAIN 2,TCITST		;WAS IN TTYIN WAIT?
	JRST [	LOAD 2,FKSTD,(FX) ;YES, GET TERMINAL NUMBER
		CALL TTCLFK	;INDICATE NO FORK WAITING
		JRST .+1]
SUSF5:	SETONE <FKPS0,FKSUS>,(FX) ;SUSPEND FORK REQUEST BIT FOR PSI
	MOVEI 2,0(7)
	CALL PSIR4		;INTERRUPT THE FORK
	OKSKED
	MOVSI 1,0(7)		;SETUP SCHEDULER TEST TO WAIT
	HRRI 1,SUSFKT		;UNTIL FORK HAS SUSPENDED ITSELF
	MOVSI T2,FHV5		;HIGHER BLOCK PRIORITY
	HDISMS
	JRST SUSF6		;NOW CHECK IT AGAIN

;Here if fork is not blocked now. Request interrupt and loop back to check
;status

SUSF4:	JE FKINX,(FX),SUSF5	;TRANSITIONAL STATE?
	SETONE <FKPS0,FKSUS>,(FX) ;YES. REQUEST INTERRUPT FOR SUSPENSION
	MOVEI 2,0(7)
	CALL PSIR4
	OKSKED			;THEN WAIT TO BE SURE IT WAS RECEIVED
	MOVEI 1,^D50
	DISMS
	JRST SUSF6		;AND CHECK AGAIN
;SCHEDULER TEST FOR SUSPENSION

	RESCD

SUSFKT::JE FKBL%,(T1),0(T4)	;DON'T WAKE UP IF FORK ISN'T BLOCKED
	LOAD 2,FKSTR,(1)	;GET SCHEDULER TEST
	CAIE 2,SUSWT		;SUSPENSION?
	CAIN 2,FRZWT
	JRST 1(4)
	JRST 0(4)

	SWAPCD

;CLEAR FORK WHICH HAD BEEN SUSPENDED

CLRSFK:	SETZRO FKPS1,(FX)	;CLEAR "PSI STARTING" STATE
	PUSH P,1
	SETZ 1,
	MOVE 2,FX
	CALL PSIRQB		;REQUEST TO RECHECK PENDING PSI'S
	POP P,1
	RET

;MAP ALL IMMEDIATE INFERIORS OF FORK IN 1
; EXECUTES +1 FOR EACH FORK
; RETURNS +2

MAPINF:	ADD 1,INFERP
MAPIF1:	LDB 1,1
	JUMPE 1,MAPIF2
	HRLM 1,0(P)
	HRRZ T2,0(P)		;GET CALLER PC
	XCT 0(T2)		;EXECUTE INSTRUCTION AT CALL+1
	HLRZ 1,0(P)
	ADD 1,PARALP
	JRST MAPIF1

MAPIF2:	XHLLI 2,20		;FIND CURRENT SECTION
	HLLM 2,0(P)		;RESTORE IT FOR RETSKP
	JRST RSKP		;RETURN
;GET FORK STRUCTURE
;RETURNS A COPY OF THE JOB FORK STRUCTURE FROM A SPECIFIED
;STARTING POINT DOWNWARD.

;CALL
;1/ HANDLE ON INITIAL FORK
;2/ FLAGS - GF%GFH TO GET RELATIVE FORK HANDLES, GF%GFS TO DO RFSTS
;3/ -LENGTH,,START ADDR OF USER AREA TO RETURN FORK STRUCTURE IN

;EACH FORK IS REPRESENTED IN THE STRUCTURE BY A 3 WORD BLOCK:
;WD0:	PARALLEL PTR,,INFERIOR PTR
;WD1:	SUPERIOR PTR,,RELATIVE FORK HANDLE(IF REQUESTED)
;WD3:	STATUS WORD (IF REQUESTED - ELSE -1)

;NOTE: EVEN IF GF%GFH IS OFF,PREVIOUSLY ACQUIRED FORK HANDLES WILL BE
;	GIVEN FOR FORKS APPEARING IN THE RETURNED STRUCTURE.

;AC USAGE
;GLOBALS
;Q1/ REMAINING FREE AREA,,NEXT FREE CELL (USER ADDR)
;Q2/ GF%GFH!GF%GFS - COPIES OF UAC2; B17 - LOCAL FLAG
;    FOR RFH SPACE EXHAUSTED. RH CONTAINS JRFN OF STARTING FORK
;RECURSIVE VARIABLES
;P1/ CURRENT JRFN,,USER ADDR OF CORRESPONDING BLOCK

.GFRKS::MCENT
	HRRZ T1,T1		;IGNORE LH T1
	MOVE Q1,T3		;INITIALIZE FREE POINTER
	SUB Q1,BITS+^D17	;SUBTRACT [1,,0] FOR CORRECT COUNTING
	MOVSI Q2,(GF%GFH!GF%GFS) ;COPY OPTIONAL COMMAND BITS
	AND Q2,T2		; ...
	MOVE T2,T1		;COPY SPECIFIED HANDLE
	CALL FLOCK		;FREEZE FORK DATABASE
	CALL STJFKR		;CONVERT RFH IN T1 TO JRFN
	 JRST [CAIE T2,.FHTOP	;TOP FORK?
		JRST EFRKR	;NO - ERROR CODE STILL IN T1
		HLRZ T1,FORKN	;YES - UNPRIVLEDGED REF TO TOP FORK
		TLZ Q2,(GF%GFH)	;PROHIBIT ACQUISITION OF HANDLES
		JRST .+1]
	HRR Q2,T1		;SET STARTING FORK JRFN
	HRLZ P1,T1		;SET INITIAL CURRENT FORK
	PUSH P,[0]		;DUMMY UP SUPERIOR
	CALL GFRKS1		;WALK THE TREE
	POP P,(P)		;SCRAP DUMMY SUPERIOR
	CALL FUNLK		;RELEASE FORK LOCK
	TLNN Q2,(1B17)		;WERE THERE ENOUGH RFH?
	SMRETN			;YES - SKIP RETURN
	RETERR(FRKHX6)		;NO - RETURN ERROR CODE
;PREORDER TRANSITION OF A N-ARY TREE

GFRKS1:	HLRZ T1,P1		;GET CURRENT JRFN
	HRRZ T2,Q1		;SAVE NEW BASE ADDR
	ADD Q1,BHC+2		;ALLOCATE NEW BLOCK
	AOBJP Q1,[MOVEI T1,GFKSX1 ;SPACE EXHAUSTED
		JRST EFRKR]	;ERROR RETURN
	XCTU [SETZM (T2)]	;CLEAR OUT NEW BLOCK
	XCTU [SETZM 1(T2)]	; ...
	XCTU [SETOM 2(T2)]	; ...
	XCTU [HRLM P1,(T2)]	;STORE PARALLEL POINTER
	HRR P1,T2		;UPDATE CURRENT POINTER
	MOVE T2,-1(P)		;GET SUPERIOR POINTER
	HRRZ P2,P1		;GET ADDRESS ONLY
	XCTU [HRLM T2,1(P2)]	;STORE SUPERIOR POINTER
	CALL JFKRFH		;SEE IF A HANDLE ALREADY EXISTS
	XCTU [HRRM T2,1(P2)]	;RETURN HANDLE OR ZERO
	TLNN Q2,(GF%GFH)	;ASSIGN RFH?
	JRST GFRKS2		;NO - GO ON
	CALL SKIIF		;IS JRFN IN T1 INFERIOR?
	 JRST GFRKS2		;NO - DONT GIVE OUT HANDLE
	CALL GFKH		;JRFN STILL IN T1, RETURNS RFH IN T1
	  TLOA Q2,(1B17)	;ERROR RETURN - RFH EXHAUSTED
	XCTU [HRRM T1,1(P2)]	;RETURN RELATIVE FORK HANDLE
GFRKS2:	TLNN Q2,(GF%GFS)	;FORK STATUS REQUESTED?
	JRST GFRKS3		;NO - GO ON TO INFERIORS
	HLRZ T1,P1		;YES - GET JRFN
	HRRZ FX,SYSFK(T1)	;GET SYSTEM FORK INDEX
	CALL MRFSTS		;DO RFSTS
	UMOVEM T1,2(P2)		;STORE STATUS.
GFRKS3:	HLRZ T1,P1		;GET JRFN AGAIN
	ADD T1,INFERP		;CHECK FOR INFERIORS
	LDB T1,T1		; ...
	JUMPE T1,GFRKS4		;NONE - GO ON TO PARALLEL
	PUSH P,P1		;SAVE RECURSIVE VARIABLES
	HRLZ P1,T1		;GET INF JRFN & CLEAR PAR. PTR
	CALL GFRKS1		;DO ALL INFERIORS
	HRRZ P2,(P)		;GET CURRENT BLOCK BACK
	XCTU [HRRM P1,(P2)]	;STORE INFERIOR LIST
	POP P,P1		;RESTORE RECURSIVE VARS
GFRKS4:	HLRZ T1,P1		;GET CURRENT JRFN BACK
	CAIN T1,(Q2)		;TOP SPECIFIED FORK?
	RET			;YES - DONT DO PARALLEL
	ADD T1,PARALP		;SEE IF ANY PARALLEL
	LDB T1,T1		; ...
	JUMPE T1,R		;NONE - DONE WITH THIS LEVEL
	HRL P1,T1		;LOOP FOR THIS LEVEL
	JRST GFRKS1		; ...

;ROUTINE TO MAP A JRFN TO RFH FROM CURRENT FORK
;T1/ JRFN
;	CALL JFKRFH
;RETURNS+1(ALWAYS):
;T1/ JRFN (UNCHANGED)
;T2/ RFH OR 0 IF NONE
;T3/ BYTE POINTER TO FKTAB ENTRY CORRESPONDING TO RFH

JFKRFH:	CAIGE T1,NUFKS		;REASONABLE JRFN?
	JRST JFKRH1		;YES - MAP IT
	BUG.(CHK,ILJRFN,FORK,SOFT,<JFKRFH - Bad JRFN, ignored>,,<

Cause:	Routine JFKRFH was erroneously called with a fork number which
	is out of range.  The correct range is a value less than NUFKS.
	JFKRFH changes a fork number into a fork handle.

Action:	If this BUG persists, make it dumpable and submit an SPR with the
	dump and a copy of MONITR.EXE.  If possible, include any known
	method for reproducing the problem and/or the state of the system
	at the time the BUG was observed.
>)
	JRST JFKRH3		;ACT AS IF NOT FOUND
JFKRH1:	MOVEI T2,.FHSLF		;CHECK IF SELF FIRST
	HRRZ T3,FORKN		; ...
	CAMN T1,T3		;SELF?
	RET			;YES - RETURN
	MOVE T4,[-NLFKS+1,,1]	;SETUP COUNT
	MOVE T3,FKPTAB		;SETUP INIITAL POINTER
JFKRH2:	ILDB T2,T3		;GET JRFN CORRESPONDING TO RFH IN T4
	CAIN T2,(T1)		;MATCH?
	JRST JFKRH4		;YES - RETURN RFH
	AOBJN T4,JFKRH2		;NO - LOOP
JFKRH3:	SETZ T2,		;NO MATCH - RETURN 0
	RET

JFKRH4:	MOVEI T2,400000(T4)	;BUILD CORRESPONDING RFH
	RET
;ROUTINE TO MAP A SINGLE LOCAL RFH TO A JRFN
;NOTE THE DIFFERENCE BETWEEN RFHJFK AND SETJFK/STJFKR.
;RFHJFK ALLOWS ONLY LOCAL FORK HANDLES AND IGNORES THE ISSUE
;OF HAVING A HANDLE ON A PREVIOUSLY KILLED FORK. RFHJFK SHOULD
;ONLY BE USED WHEN THE CALLER IS PREPARED TO HANDLE THIS
;CASE (RFSTS, RFRKH FOR EXAMPLE). SETJFK/STJFKR ARE INTENDED FOR
;MOST USES. THEY ALLOW ALL NON MULTIPLE HANDLES AND SUCCEED ONLY
;IF THERE IS A LIVE FORK UNDER THE GIVEN HANDLE.

;T1/ RFH
;	CALL RFHJFK
;RETURNS+1(ERROR):
;T1/ ERROR CODE
;RETURNS+2(SUCCESS):
;T1/ JRFN
;ALL OTHER ACS UNCHANGED

RFHJFK:	CAIL T1,400001		;REASONABLE LOCAL HANDLE?
	CAIL T1,400000+NLFKS	; ...
	JRST FRKESR		;NO - FIGURE OUT ERROR CODE
	TRZ T1,400000		;YES - GET LOCAL INDEX
	PUSH P,T2		;BE TRANSPARENT WRT ACS
	IDIVI T1,2		;BUILD BYTE POINTER
	ADD T1,FKPTAB(T2)	; ...
	POP P,T2		;RESTORE T2
	LDB T1,T1		;GET JRFN
	CAIN T1,-1		;IN USE?
	JRST FRKE1R		;NO, GIVE ERROR RETURN
	RETSKP			;SUCCESS RETURN
;GET FORK HANDLE.

;CALL WITH T1/ HANDLE ON KNOWING FORK, T2/ HANDLE IN
; KNOWING FORK ON DESIRED FORK
;
;RETURNS A (POSSIBLY NEW) HANDLE IN T1 USABLE BY CALLER.

.GFRKH:: MCENT			;ESTABLISH CONTEXT
	CALL FLOCK		;LOCK FORK STRUCTURE
	ANDI T2,377777
	CAIL T2,0		;NEGATIVE IS ILLEGAL
	CAIL T2,NLFKS		;A LEGIT FORK HANDLE?
	 ERRJMP (GFRKX1,EFRKR)	;NO. FAIL RETURN NONSKIP
	CALL SETLF0		;OK, SET UP THE PSB OF KNOWER
	CAIE T2,0		;WANT "SELF" OF KNOWER?
	IFSKP.
	  MOVE T2,FORKN(T1)	;OH YEAH, COVER THIS SPECIAL CASE
	ELSE.			;NO, NORMAL CASE
	  IDIVI T2,2		;BUILD A POINTER TO JOB F INDEX
	  ADD T2,FKPTAB(T3)	; IN THE MAPPED PSB
	  TLO T2,1		;OFFSET TO MAPPED PSB BY INDEXING PNTR
	  LDB T2,T2		;GET THE DESIRED FORK'S JOB FORK INDEX
	ENDIF.
	CAIGE T2,NUFKS		;MAKE SURE IT'S ASSIGNED
	SKIPGE SYSFK(T2)	;FORK STILL EXIST?
	 ERRJMP (GFRKX1,EFRKRC)	;NO, RETURN ERROR
	MOVEI T1,(T2)		;OK, HERE'S THE DESIRED JOB FORK INDEX
	CALL GFKH		;GET A FORK HANDLE IN THIS FORK FOR IT.
	 ERRJMP (FRKHX6,EFRKRC)	;COULDN'T. NO SPACE LEFT.
	UMOVEM T1,T1		;OK. RETURN H-PRIME TO USER.
	CALL CLRLFK
	CALL FUNLK		;UNLOCK FORK STRUCTURE
	SMRETN			;AND SKIP RETURN TO HIM.
;RELEASE FORK HANDLE JSYS

;CALL
;1/ FORK HANDLE TO BE RELEASED
;	RFRKH

;RETURNS+1:
;1/ ERROR CODE
;RETURNS+2:
;SUCCESS - AC UNCHANGED

.RFRKH::MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CAMN A,[-1]		;WANT TO DO ALL OF THEM?
	JRST RFRKH2		;YES. GO DO IT THEN
	CALL RFRKH0		;GO DO THE WORK
	 JRST EFRKR		;FOUND AN ERROR. GO REPORT IT
	CALL FUNLK		;FREE THE STRUCTURE
	SMRETN			;AND RETURN GOOD

;INTERNAL ROUTINE TO RELEASE A FORK HANDLE
;ACCEPTS:	A/ PROCESS RELATIVE FORK HANDLE
;RETURNS:	+1 / CAN'T RELEASE HANDLE. REASON IN A
;		+2/ HANDLE RELEASED AND ALL RELEVANT JOB FORK
;			TABLES CLEANED UP
;WARNING: MUST BE CALLED WITH JOB FORK LOCK LOCKED

RFRKH0:	CALL RFHJFK		;MAP RFH IN T1 TO JRFN
	 RET			;ERROR. CODE IN A
	SKIPGE SYSFK(A)		;NOW ASSIGNED?
	JRST RFRKH1		;NO,IS OKAY TO DO IT.
	LOAD B,FKHCNT,(A)	;IS INFERIOR. SEE ABOUT COUNT
	CAIG B,1		;NOW BEING SHARED?
	JRST [	MOVEI A,FRKHX1	;CAN'T RELEASE IT
		RET]		;SO RETURN AN ERROR
RFRKH1:	CALL DASFKH		;DEASSIGN FORK HANDLE
	RETSKP			;GOOD RETURN

;ROUTINE TO RELEASE ALL HANDLES

RFRKH2:	MOVE D,[-NLFKS+1,,1]
	MOVE C,FKPTAB		;BEGINNING POINTER
RFRKH3:	ILDB A,C		;GET POINTER
	CAIN A,-1		;IN USE?
	JRST RFRKH4		;NO
	MOVEI A,.FHSLF(D)	;YES. GET RELATIVE HANDLE
	PUSH P,C		;SAVE POINTER
	PUSH P,D		;SAVE COUNTER
	CALL RFRKH0		;GO RELEASE IT
	 JFCL			;DON'T CARE
	POP P,D
	POP P,C			;RESTORE REGISTERS
RFRKH4:	AOBJN D,RFRKH3		;DO ALL HANDLES
	CALL FUNLK		;FREE THE STRUCTURE
	SMRETN			;AND DONE
;PERFORM FORK CONTROL FUNCTION FOR EACH FORK OF MULTIPLE FORK
;HANDLE (I.E. MAP A FUNCTION ONTO ALL FORKS)
; 1/ USER FORK HANDLE (SINGLE OR MULTIPLE)
; 2/ INSTRUCTION TO DO FOR EACH FORK
;	CALL MAPFKH
;				;EXECUTE INSTRUCTION WITH JOB-WIDE
;				HANDE IN T1
;RETURNS:	+1 COROUTINE NEEDS TO BLOCK
;	+2 ALL DONE

MAPFKH::CAIL 1,-5		;IS IT A MULTIPLE FORK DESIGNATOR?
	CAILE 1,-3
	JRST [	PUSH P,T2	;SAVE INST
		CALL SETJFK	;GET HANDLE
		POP P,T2	;GET INST
		XCT T2		;DO IT
		 RETSKP		;DONE
		RET]		;BLOCK
	PUSH P,P6		;SAVE FRAME POINTER
	MOVE P6,P		;ESTABLISH FRAME
	PUSH P,T2		;SAVE INSTRUCTION
	CALL MAPFT+5(1)		;DISPATCH TO APPROPRIATE FUNCTION
	 NOP			;NEVER GETS HERE
	MOVE P,P6		;RESTORE STACK
	POP P,P6		;RESTORE REG
	RETSKP			;AND DONE

MAPFT:	JRST MAPF5		;-5, ALL FORKS IN JOB
	JRST MAPF4		;-4, ALL INFERIORS
	JRST MAPF3		;-3, SELF AND ALL INFERIORS

MAPF3:	HRRZ 1,FORKN		;SELF
MAPF51:	PUSH P,1
	XCT 1(P6)		;DO INSTRUCTION
	 SKIPA			;DONE
	JRST MAPBLW		;NEEDS TO BLOCK
	POP P,1
MAPF41:	ADD 1,INFERP		;DO INFERIORS
MAPF42:	LDB 1,1			;GET NEXT IN LIST
	JUMPE 1,MAPF43		;END OF LIST, RETURN AND SKIP INSTR
	HRLM 1,0(P)		;SAVE THIS FORK NUMBER
	CALL MAPF41		;DO INFERIORS OF IT
	BUG.(HLT,MAP41F,FORK,SOFT,<MAPF41 failed to skip>,,<

Cause:	The MAPFKH routine calls itself recursively in order to
	find every fork in a specified tree.  For each fork found, the
	instruction following the call to MAPFKH is executed.  MAPFKH
	finally skip-returns in order not to fall into that coinstruction
	at .+1.  The recursive calls skip-return too, merely because they
	fall through the same RETSKP instruction.

	The MAP41F BUGHLT should never happen, and is merely a placeholder
	for the impossible non-skip return from the recursive call to
	MAPFKH.
>)
	HLRZ 1,0(P)		;GET FORK NUMBER BACK
	XCT 1(P6)		;DO THIS FORK
	 SKIPA			;DONE
	JRST MAPBLW		;NEEDS TO BLOCK
	HLRZ 1,0(P)
	ADD 1,PARALP		;POINT TO NEXT IN LIST
	JRST MAPF42


MAPF43:	XHLLI T2,20		;GET CURRENT SECTION
	HLLM T2,0(P)
	RETSKP

MAPF4:	HRRZ 1,FORKN		;GET SELF
	JRST MAPF41		;DO INFERIORS

MAPF5:	HLRZ 1,FORKN		;GET TOP
	JRST MAPF51		;DO THAT AND INFERIORS

;COROUTINE INDICATED TO BLOCK

MAPBLW:	MOVE P,P6		;GET PROPER FRAME
	POP P,P6		;RESTORE P6
	RET			;AND INDICATE BLOCK UP
;FORK RELATIVITY TESTS

;SKIP IF FORK IN 1 IS SELF OR INFERIOR TO SELF

SKIIF::	PUSH P,2
	HRRZ 2,FORKN		;GET SELF
	CALL SKIIFA		;DO TEST
	JRST PB2		;RETURN NO SKIP
SKISF2:	POP P,2
	JRST RSKP

;SKIP IF FORK IN 1 IS SAME AS OR INFERIOR TO FORK IN 2

SKIIFA::HRLM 2,0(P)		;SAVE FORK NUMBER
SKIIF4:	CAIN 1,0(2)		;SAME?
	JRST SKIIF1		;YES
	ADD 2,INFERP		;NO, GET POINTER TO INFERIOR LIST
SKIIF2:	LDB 2,2			;NEXT INFERIOR
	JUMPE 2,SKIIF6		;END OF LIST
	CALL SKIIFA		;IS THIS FORK OR INFERIOR?
	JRST SKIIF5		;NO
SKIIF1:	HLRZ 2,0(P)		;SUCCEEDS, RETURN +2
	XHLLI T4,20		;FIND CURRENT SECTION
	HLLM T4,0(P)		;SET IN RETURN
	RETSKP			;AND RETURN +2

SKIIF6:	HLRZ 2,0(P)
	XHLLI T4,20		;RESTORE SECTION NUMBER
	HLLM T4,0(P)
	RET			;FAILS RETURN +1

SKIIF5:	ADD 2,PARALP		;LOOK PARALLEL
	JRST SKIIF2

;SKIP IF FORK IN 1 IS SUPERIOR OF THIS FORK

SKISF::	PUSH P,2
	HRRZ 2,FORKN
SKISF1:	CAIN 1,0(2)
	JRST SKISF2		;SAME, RETURN GOOD
	JUMPE 2,PB2		;END OF LIST, RETURN BAD
	ADD 2,SUPERP		;GET SUPERIOR POINTER
	LDB 2,2
	JRST SKISF1

;SKIMIF - SKIP IF FORK IN T1 IS IMMED INF OF EXECUTING FORK

SKIMIF:	PUSH P,T1		;MAKE TRANSPARENT TO T1
	ADD T1,SUPERP		;GET SUPERIOR OF FORK IN T1
	LDB T1,T1
	CAMN T1,FORKN		;IS IT ME?
	AOS -1(P)		;YES, SKIP RETURN.
	POP P,T1		;RESTORE CALLER'S ARG
	RET
;Execute-Only process tests

; CHKNXS - Check for SELF or not execute-only
;
; Call:
;	Fork structure is locked
;	T1/	Job-relative fork number (JRFN) to be tested
;	CALL CHKNXS
;
; Returns:
;	+1:	Always
;		Process is now non-virgin
;
; ITRAPs if fork cannot be manipulated because it is execute-only
;
CHKNXS::
	CALL CKNXSR		;Skip if OK
	 JRST ITFRKR		;Invalid-- ITRAP
	RET			;Return from CHKNXS
;
;
; CKNXSR - Skip if not execute-only or SELF
; CKNXOR - Skip if not execute-only
;
; Call:
;	Fork structure is locked
;	T1/	Job-relative fork number (JRFN) to be tested
;	CALL CKNXSR/CKNXOR
;
; Returns:
;	+1:	Check failed,
;		T1/	Error code (FRKHX8)
;	+2:	Not execute-only (or SELF)
;		Process is now non-virgin
;
CKNXSR:
	CAMN T1,FORKN		;This SELF?
	 JRST CHKNX2		;Yes, it's OK
CKNXOR::
	JE SFEXO,(T1),CHKNX2	;Jump if not execute-only
	PUSH P,T1		;Save the JRFN
	MOVE T1,CAPENB		;Get enabled capability mask
	TXNE T1,SC%WHL		;Is calling process a WHEEL?
	 JRST CHKNX1		;Yes-- let him play
	MOVE T1,FORKN		;GET OUR INDEX
	JN SFGXO,(T1),[	POP P,T1	;XONLY GET JSYS, SO ALLOW
			RETSKP]
	POP P,T1		;Clean JRFN from stack
	MOVEI T1,FRKHX8		;Can't manipulate execute-only process
	RET			;Return +1 with error code in T1
;
CHKNX1:
	POP P,T1		;Restore JRFN
CHKNX2:
	CALL CLRVGN		;No longer virgin process
	RETSKP			;Return +2 from CHKNXS/CHKNXO
;
;
; SETEXO - Set execute-only process
;
; Call:
;	Fork structure is locked
;	T1/	Job-relative fork number (JRFN) to be made execute-only
;	CALL SETEXO
;
; Returns:
;	+1:	Cannot set execute-only becuase process is not virgin
;	+2:	Process is now execute-only
;
SETEXO::
	JN SFNVG,(T1),R		;If not virgin, then can't be execute-only
	SETONE SFEXO,(T1)	;Now process is execute-only
	CALL CLRVGN		;No longer virgin
	RETSKP			;Return +2 from SETEXO
;
;
; CLRVGN - Make process non-virgin
; SETVGN - Restore virginity
;
; Call:
;	T1/	Job-relative fork number (JRFN) to be made non-virgin
;	CALL CLRVGN or SETVGN
;
; Returns:
;	+1:	Always, process virginity set or cleared
;
CLRVGN:
	SETONE SFNVG,(T1)	;No longer a virgin fork!!
	RET			;Return from CLRVGN

SETVGN::SETZRO SFNVG,(T1)	;RESTORE VIRGINITY!!
	RET
;
;
; SETGXO/CLRGXO - Enable/Disable for execute-only GET
;
; Call:
;	CALL SETGXO/CLRGXO
;
; Returns:
;	+1:	Always
;
SETGXO::
	PUSH P,T1		;Save register
	MOVE T1,FORKN		;Get current JRFN
	SETONE SFGXO,(T1)	;Set execute-only GET flag
	JRST CLRGX1		;Restore T1 and return
;
CLRGXO::
	PUSH P,T1		;Save register
	MOVE T1,FORKN		;Get current JRFN
	SETZRO SFGXO,(T1)	;Reset execute-only GET bit
CLRGX1:
	POP P,T1		;Restore T1
	RET			;Return from SETGXO/CLRGXO
;
;
; SETLFX - Map PSB and check for execute-only
;
; This routine is available for a common sequence of functions:
;	- Convert RFH to JRFN
;	- Check for execute-only
;	- Map PSB of process
;
; Call:
;	Fork structure is locked
;	T1/	Process relative fork handle (RFH)
;	CALL SETLFX
;
; Returns:
;	+1:	Always,
;		T1/	Address of PSB
;
; ITRAPs under a variety of fork-handle conditions
;
SETLFX::
	CALL SETJFK		;Convert RFH to JRFN
	CALL CHKNXS		;Make sure not execute-only or SELF
	CALLRET SETLF1		;Map PSB of process, and return from SETLFX
	SUBTTL MISCELLANEOUS ROUTINES

;MAP PSB OF FORK, GIVEN USER HANDLE IN 1
;RETURN WITH OFFSET TO MAPPED PSB IN 1
;DOES NOT CLOBBER T2 OR T3

SETLFK::
REPEAT 0,< ;This is antiquated by capability checking
	TRNE 1,200000		;SPECIAL DESIGNATOR?
	JRST FRKES		;NOT ALLOWED
> ;End of REPEAT 0
SETLF0:	CALL SETJFK		;GET JOB FORK INDEX
SETLF1::HRRZS T1
	HRRZ 1,SYSFK(1)		;GET SYSTEM FORK INDEX
SETLF3:	NOINT
	EA.ENT
	CAMN 1,FORKX		;CURRENT FORK?
	JRST SETLF2		;YES
	LOAD T1,FKPS%,(T1)	;GET SPT INDEX OF PSB
	HRLS T1			; INTO LEFT HALF
	HRRI T1,PSBM0-PSBPGA+PSBPG ;GET MAP OFFSET FOR THE PSB
	PUSH P,2
	PUSH P,T3		;SAVE T3 AS WELL
	MOVE 2,[PTRW+FPG1A]
	MOVEI T3,2		;MAP PSB AND STACK PAGE
	CALL MSETMP		;DO IT
	MOVEI 1,FPG1A-PSBPGA	;RETURN OFFSET USUAL PSB TO MAP PSB
	JRST PB3

SETLF2:	SETZ 1,			;USE CURRENT PSB, NO OFFSET
	RET

;CLEAR MAPPING OF FPG1.  USED BY LFK, PSB, JSB.

CLRJSB::
CLRPSB::
CLRLFK::SKIPN PSBM0+FPG1		;NOW MAPPED?
	JRST CLRLFX		;NO
	SETZ 1,
	MOVEI 2,FPG1A
	MOVEI T3,2		;CLEAR FPG1 AND FPG2
	CALL MSETMP		;DO IT
CLRLFX:	OKINT
	RET
;MAPJSB - ROUTINE TO MAP ANOTHER JOB'S JSB
;
;ACCEPTS IN T1/	JOB NUMBER
;		CALL MAPJSB
;RETURNS: +1	 FAILED, NO SUCH JOB
;	  +2	SUCCESS, WITH T1/ OFFSET SUCH THAT JSB(T1) REFERS TO
;				  'JSB' IN OTHER JOB'S JSB.

MAPJSB:: NOSKED			;PREVENT JOB FROM LOGGING OUT
	SKIPGE JOBRT(T1)	;THIS JOB EXIST ?
	RETBAD (,<OKSKED>)	;NO, FAIL
	CALL SETJSB		;YES, MAP THE JSB
	OKSKED			;PERMIT SCHEDULING AGAIN
	RETSKP			;DONE, RETURN SUCCESS


;SETUP JSB FOR ANOTHER JOB
; 1/ JOB NUMBER
; RETURN +1 WITH JSB MAPPED INTO FPG1A,
;  1/ OFFSET SUCH THAT JSB(1) REFERS TO 'JSB' IN OTHER JOB'S JSB
;
;[7456] CAUTION: Routine DETREC in MEXEC depends on SETJSB mapping into FPG1A!
;[7456]          Don't change where the JSB is mapped unless you change DETREC!

SETJSB::NOINT
	CAME A,JOBNO		;SEE IF SETJSB'ING OURSELVES
	IFSKP.
	  SETZ A,		;YES, ZERO THE INDEX
	  RET			;AND JUST RETURN
	ENDIF.
	PUSH P,FX		;NO, PREPARE TO DO THE MAP
	HRRZ FX,JOBPT(A)	;GET TOP FORK OF OTHER JOB
	LOAD A,FKJSB		;GET JSB OF OTHER JOB
	MOVE B,[PTRW+FPG1A]
	CALL SETMPG		;MAP JSB INTO FPG1
	LOAD A,FKJSB		;[7433]GET BACK SPTX OF JSB
	HRLS A			;[7433] IN LEFT HALF
	HRRI A,1		;[7433]JOBMAP OFFSET OF 2ND PAGE
	MOVE B,[PTRW+FPG2A]	;[7433]ADDRESS TO MAP IT TO
	CALL SETMPG		;[7433](A,B/)MAP JSB PAGE 2 INTO FPG2
	MOVEI A,FPG1A-JSBPGA
	POP P,FX
	RET

;SETUP TOP FORK PSB FOR ANOTHER JOB
; 1/ JOB NUMBER
; RETURN +1 WITH PSB MAPPED INTO FPG1,
;  1/ OFFSET SUCH THAT PSB(1) REFERS TO 'PSB' IN OTHER JOB'S PSB

SETPSB::HRRZ A,JOBPT(A)		;GET TOP FORK OF OTHER JOB
	JRST SETLF3		;GO DO THE REST

;GET CAPABILITIES OF ANOTHER JOB
; 1/ JOB NUMBER
; RETURN +1,
; 1/ CAPMSK OF DESIGNATED JOB FROM TOP FORK

GJCAPS::CALL SETPSB		;GET OTHER JOB'S PSB
	MOVE B,CAPENB(A)	;GET ENABLED CAPABILITES
	AND B,CAPMSK(A)		;MASK OFF "TEMPORARY" BITS
	PUSH P,B		;Save the value
	CALL CLRPSB		;UNDO PSB MAPPING
	CALLRET PA1		;RETURN CAPS IN A
;GET SYSTEM WIDE FORK NUMBER (FORKX) GIVEN RELATIVE FORK HANDLE
;
;	1/ RELATIVE FORK HANDLE (NOT MULTIPLE)
;
;	CALL GSWFRK
;
;RETURNS:	+1 FAILURE WITH:  T1/ ERROR CODE
;		+2 SUCCESS WITH:  T1/ SYSTEM WIDE FORK NUMBER

GSWFRK::CALL STJFKR		;(T1/T1) Get job relative fork number
	 RET			;Error, return failure with error code in T1
	HRRZ T1,SYSFK(T1)	;Get system wide fork number
	RETSKP			;Return success

;GET JOB FORK HANDLE GIVEN USER HANDLE IN 1
;FOR SINGLE (NOT MULTIPLE) FORK HANDLES ONLY

SETJFK::CALL STJFKR		;DO ACTUAL TRANSLATION
	 JRST ITFRKR		;ERROR - ITRAP
	RET			;SUCCESS

STJFKR::HRRZ T1,T1		;USE ONLY 18 BITS FOR FORK HANDLE
	CAIL T1,-2		;-1 OR -2?
	XCT SETJFT+2(T1)	;YES - TRANSFER TO CORRECT ROUTINE
	TXZ T1,FH%EPN		;FLUSH FLAG
	CAIN T1,.FHSLF		;SELF?
	JRST [	HRRZ T1,FORKN	;YES
		RETSKP]
	CALL RFHJFK		;LOCAL HANDLE - CONVERT TO JRFN
	  RET			;ILL FORMED - ERR CODE IN T1
	CAIGE T1,NUFKS		;FORK HANDLE ASSIGNED?
	SKIPGE SYSFK(T1)	;FORK KILLED?
	JRST FRKE1R		;NO TO EITHER QUESTION
	RETSKP			;RETURN

SETJFT:	JRST GETTPF		;-2, TOP FORK
	JRST GETSPF		;-1, SUPERIOR

GETSPF:	MOVE T1,[1B9+SC%WHL+SC%OPR] ;DOES USER HAVE CAPABILITY TO
	TDNN T1,CAPENB		; REFERENCE SUPERIOR FORK?
	JRST FRKE2R		;NO
	HRRZ T1,FORKN		;GET SUPERIOR FORK
	MOVE T1,FKPTRS(T1)
	LSH T1,-^D24
	RETSKP

GETTPF:	MOVEI T1,SC%WHL+SC%OPR	;DOES USER HAVE CAPABILITY TO
	TDNN T1,CAPENB		; REFERENCE TOP FORK?
	JRST FRKE2R		;NO
	HLRZ T1,FORKN		;YES, GET TOP FORK
	RETSKP
;COMMON ROUTINE TO LOCK FORK STRUCTURE
;	CALL FLOCK
; RETURN +1: ALWAYS, CLOBBERS NO AC'S

;ALTERNATE ENTRY POINT, FLOCKN, ALLOWS NESTING OF THE LOCK.
;CALLING FLOCKN IMPLIES THAT A CALLER TO EITHER ENTRY THAT FINDS
;THE LOCK ALREADY LOCKED CAN FURTHER LOCK IT IF THE CALLING PROCESS
;IS THE ONE THAT LOCKED IT. A COUNT IS KEPT IN FLKCNT, AND THE
;LOCK IS UNLOCKED ONLY WHEN THE COUNT GOES TO 0. THE LEFT HALF OF
;FLKOWN IS -1 IF NESTING IS ALLOWED, 0 OTHERWISE.

FLOCK::
FLOCKN::			;DEFINE THIS ENTRY AS WELL
	ACVAR <W1,W2>

FLOCK1:	CSKED			;BE CRITICAL IF LOCK WORKS
	AOSN FKLOCK		;LOCK SUCCESSFUL?

;THE LOCK WAS PREVIOUSLY UNLOCKED. SAVE THIS FORK INDEX AND INCREMENT
;THE NEST COUNT

	JRST [	HRRZ W2,FORKN	;GET OUR JOB-WIDE FORK HANDLE
		MOVEM W2,FLKOWN	;SAVE IT AS THE OWNER
		SKIPE FLKCNT	;IF NOT ZERO, SOMETHING IS WRONG
		CALL [	BUG.(CHK,FKCTNZ,FORK,SOFT,<Fork lock nest count non-zero>,<<JOBNO,JOB>,<FORKN,JBFORK>>,<

Cause:	The FLOCK routine has encountered the nest count for the fork lock
	being non-zero, which should not be, since the lock has just been
	locked for the first time.  This is probably due to some other
	software not having cleared the nest count from some previous lock.

Action:	If this BUG persists, make it dumpable and submit an SPR with the
	dump and a copy of MONITR.EXE.  If possible, include any known
	method for reproducing the problem and/or the state of the system
	at the time the BUG was observed.

Data:	JOB    - Internal Job number whose fork discovered the non-zero
	         nest count.
	JBFORK - Jobwide fork index of the discovering fork.
>)
			SETZM FLKCNT
			RET]
		AOS FLKCNT	;INCREMENT NEST COUNT
		MOVE W1,TODCLK	;GET NOW
		ADDX W1,FLKTMV ;WHEN IT WILL TIMEOUT
		MOVEM W1,FKTIMW	;SET IT
		CALLRET FLKITT]	;SUCCESS. CHECK INTERRUPTABILITY AND RETURN

;SOMEONE HAS IT INCREMENTED. SUCCEED IF IT IS OUR FORK, AND INCREMENT
;THE NEST COUNT

	ECSKED			;LOCK NOT SUCCESSFUL, ALLOW INTERRUPTS
	HRRZ W1,FORKN		;GET US
	CAME W1,FLKOWN		;ARE WE THE OWNER?
	JRST FLOCK3		;NO. GO WAIT THEN
	AOS FLKCNT		;YES. INCREMENT NEST COUNT
	SOS FKLOCK
	RET			;SUCCESS
;SOMEONE ELSE HAS THE LOCK. WAIT A WHILE.

FLOCK3:	CALL FLKITT		;CHECK INTERRUPTABILITY
	MOVE W1,T1		;PRESERVE T1
	MOVEI T1,^D200		;WAIT 200 MS BEFORE RECHECKING
	DISMS
	MOVE T1,W1		;RESTORE T1
	MOVE W1,TODCLK		;GET NOW
	CAMG W1,FKTIMW		;HAS THE LOCK TIMED OUT YET?
	JRST FLOCK1		;NO, TRY AGAIN

;WE'VE BEEN WAITING A LONG TIME FOR THIS LOCK. BUGCHK AND THEN
;FORCE IT TO BE UNLOCKED

	BUG.(CHK,FLKTIM,FORK,SOFT,<FLOCK - Fork lock timeout>,<<FORKN,JOBFRK>,<JOBNO,JOB>,<FLKOWN,OWNER>>,<

Cause:	A fork has been waiting a "long time" for the fork lock.
	This BUGCHK announces that the system is assuming that some fork has
	neglected to unlock the fork lock and the waiting fork is being
	given the lock even though someone else still has it.

	The code could be in error here.  The measure of a "long time" is
	calculated arbitrarily and can be changed. It is parameter FLKTMV.

Action:	This BUG appears if the fork owning the lock is hung due
	to some other event (unit offline, CFS voting freeze, etc.).  Usually,
	this is not evidence of a real problem but just a temporary system
	event which caused the fork timeout value to expire.  This BUG is
	usually followed by a FLKNS BUGCHK since this fork acquires and
	unlocks the lock and then the fork which had it before attempts
	to unlock the lock and finds it already unlocked.  

	There is no need to take any action due to this BUG unless a real
	problem in the fork lock logic is suspected.  If action is desired,
	first, try increasing FLKTMV in STG.MAC and rebuilding the monitor.
	If this BUG persists, make it dumpable and submit an SPR with the
	dump and a copy of MONITR.EXE.  If possible, include any known
	method for reproducing the problem and/or the state of the system
	at the time the BUG was observed.

Data:	JOBFRK - Job fork number of fork desiring the lock
	JOB    -  Internal Job number desiring the lock
	OWNER  - Job fork number of fork currently holding the lock
>)
IFE DEBUG,< ;IF NOT DEBUGGING
	SKIPE DBUGSW		;DEBUG SWITCH NON-ZERO?
	IFSKP.
	  SETZM FLKCNT		;ZERO THE NEST COUNT
	  SETOM FLKOWN		;CLEAR THE OWNER
	  SETOM FKLOCK		;TIMEOUT, CLEAR LOCK AND PROCEED
	  JRST FLOCK1		;AND GO GET IT
	ENDIF.
> ;END IFE DEBUG

	MOVE W1,T1
	MOVEI T1,^D50000
	DISMS			;DON'T COMPLAIN FOR A WHILE
	MOVE T1,W1
	JRST FLOCK1

;TEST FOR INTERRUPTABILITY

FLKITT:	SKIPN FORKN		;TOP FORK?
	RET			;INTERRUPTABILITY NOT IMPORTANT IF TOP FORK
	SKIPLE INTDF		;INTERRUPTABLE NOW OR WHEN LOCKING?
	BUG.(INF,FLKINT,FORK,SOFT,<FLOCK - Called while NOINT>,,<

Cause:	The routine FLOCK was called while the calling process was
	unable to be interrupted. The calling fork was not nesting the lock
	nor was it the top fork of the job. This indicated a logic error
	because if this fork was unable to aquire the lock it will DISMS
	while NOINT. This can cause a deadly embrace where the fork which
	owns the lock is not relenquish it until the fork which has dismissed
	is interrupted which never happens because the fork is NOINT.

Action:	If this BUG persists, make it dumpable and submit an SPR with the
	dump and a copy of MONITR.EXE.  If possible, include any known
	method for reproducing the problem and/or the state of the system
	at the time the BUG was observed.
>)
	RET			;RETURN

	ENDAV.			;END ACVAR
;FUNLK - COMMON ROUTINE TO UNLOCK FORK STRUCTURE
;	CALL FUNLK
; RETURN +1: ALWAYS, CLOBBERS NO AC'S

;NOTE: THIS CODE COULD CAUSE FLKCNT TO GO NEGATIVE IN THE FOLLOWING
;CASE: FORK 1 LOCKS FKLOCK AND INCREMENTS FLKCNT TO 1, FORK 2 TIMES
;OUT THE LOCK AND SETS FLKCNT TO 0, FORK 2 LOCKS THE LOCK AND LATER
;UNLOCKS IT. WHEN FORK 1 FINALLY UNLOCKS THE LOCK, THE COUNT IS ALREADY
;ZERO. THIS CODE FORCES THE COUNT TO BE NO LESS THAN ZERO.

FUNLK::	PUSH P,1		;BE TRANSPARENT TO ALL AC'S
	SOSLE FLKCNT		;DECREMENT THE NEST COUNT
	JRST [	POP P,T1
		RET]		;NOT THE LAST TIME. DONE
	SETOM FLKOWN		;CLEAR OWNER OF LOCK
	SETZM FLKCNT		;MAKE SURE THE COUNT IS ZERO
	MOVX T1,1B1		;GET VERY LARGE TIME
	MOVEM T1,FKTIMW		;AND SAY IT NEVER TIMES OUT
	SETO 1,
	EXCH 1,FKLOCK		;CLEAR LOCK, GET PREVIOUS VALUE
	ECSKED			;NO LONGER CRITICAL
	JUMPL 1,FUNLK3		;IF LOCK < 0 ERROR
FUNLK2:	POP P,1			; WAS MADE TO LOCK IT WHILE THIS FORK
	RET

REPEAT 0,<			;FOLLOWING WASTES TIME AND IS USLESS

;IF LOCK WAS .G. 0, SOME OTHER FORK IS/WAS TRYING TO LOCK IT.  THIS
;FORK WILL DO A BRIEF WAIT SO AS TO PREVENT HOGGING THE LOCK.

FUNLK1:	JUMPL 1,FUNLK3		;BUG IF LOCK NOT SET AT ALL
	MOVEI 1,^D200		;WAIT FOR 200 MS
	DISMS
	JRST FUNLK2
>

FUNLK3:	BUG.(CHK,FLKNS,FORK,SOFT,<FUNLK - Lock not set>,<<FORKN,JOBFRK>>,<

Cause:	The FUNLK routine, which unlocks the fork lock, detected that the
	lock was already unlocked.  This should not be, since anyone
	calling FUNLK to unlock the lock presumably first called FLOCK to
	lock it.  This BUG is usually preceded by a FLKTIM BUGCHK.  See
	the description of FLKTIM for more details.

Action:	No action is required for this BUG, especially if it was preceded
	by a FLKTIM BUGCHK, unless a real problem in the fork lock logic is
	suspected.  If this is the case, make the BUG dumpable and submit an 
	SPR with the dump and a copy of MONITR.EXE.  If possible, include 
	any known method for reproducing the problem and/or the state of the 
	system at the time the BUG was observed.

Data:	JOBFRK - Job fork number of fork desiring the lock
>)
	JRST FUNLK2

;ENTRY FROM PMAP ERROR TO UNLOCK FKLOCK IF THIS PROCESS HAS IT

FUNLKI::SKIPL INTDF		;MUST BE NOINT
	SKIPGE FKLOCK		;AND LOCK MUST BE LOCKED
	RET			;NOT. WE CAN'T HOLD IT THEN
	HRRZ CX,FORKN		;GET US
	CAME CX,FLKOWN		;ARE WE THE OWNER?
	RET			;NO
	CALLRET FUNLK		;YES. UNLOCK IT AND RETURN
;COMMON EXIT FROM FORK JSYS.  CLEAR LOCAL PSB MAPPING, DO UNLOCK AND MRETN

CLFRET::CALL CLRLFK
CLFLK0:	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	JRST MRETN

;COMMON ERROR EXITS FROM FORK JSYS'S

FKLERR:	CALL CLRLFK
	CALLRET FUNLK

FRKE1:	MOVEI 1,FRKHX1		;'ILLEGAL FORK HANDLE'
	JRST ITFRKR		;GO UNLOCK AND ITRAP

FRKE2:	MOVEI 1,FRKHX2		;'ILLEG REF TO SUPERIOR'
	JRST ITFRKR		;GO UNLOCK AND TRAP

FRKE3:	MOVEI 1,FRKHX3		;'MULTIPLE FORK HANDLE NOT LEGAL'
	JRST ITFRKR

FRKE4:	MOVEI A,FRKHX7		;RELATIVE PAGE NUMBER TOO LARGE
	JRST ITFRKR		;GO UNLOCK AND TRAP

;ERROR RETURN FROM FORK JSYS

EFRKRC:	PUSH P,T1		;SAVE ERROR
	CALL CLRLFK		;CLEAR MAPPED PAGE
	POP P,T1		;SNAG ERROR AGAIN
EFRKR:	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	RETERR()		;RETURN ERROR CODE ALREADY IN 1

FRKES:	CALL FRKESR		;DETERMINE ERROR CODE
;;	JRST ITFRKR		;ITRAP

;ITRAP RETURN FROM FORK JSYS

ITFRKR:	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	ITERR()			;RETURN ERROR CODE ALREADY IN 1

;COMMON NON-SKIP ERROR RETURNS FROM FORK JSYS'S

FRKE1R:	MOVEI T1,FRKHX1		;ILLEGAL FORK HANDLE
	RET

FRKE2R:	MOVEI T1,FRKHX2		;ILLEGAL REFERENCE TO SUPERIOR
	RET

FRKE3R:	MOVEI T1,FRKHX3		;MULTIPLE FORK HANDLE ILLEGAL
	RET

;HERE TO FIGURE OUT WHICH OF THE ABOVE TO RETURN

FRKESR:	HRRZ T1,T1		;USE ONLY RH
	CAIE T1,-1		;CHECK SUPERIOR OR TOP FORK
	CAIN T1,-2		; ...
	JRST FRKE2R		;ILLEGAL SUPERIOR
	CAIL T1,-5		;MULTIPLE FORK HANDLE?
	CAILE T1,-3		; ...
	JRST FRKE1R		;NO, RANDOMNESS
	JRST FRKE3R		;SUPERIOR ILLEGAL
;TRANSLATE FKH.PN TO PTN.PN
; FKHPTX - return error if execute-only and not SELF
; FKHPTN - normal entry

;ACCEPTS:
;	T1/ FORK HANDLE,,PAGE NUMBER
;	T2/ ACCESS BITS (PM%EPN) IF .FHSLF OR SECTION 0

;	CALL FKHPTN
;		OR
;	CALL FKHPTX

;RETURNS +1: ERROR
;		T1/ ERROR CODE
;	 +2: SUCCESS
;		T1/ PTN,,PN
;		T3/ SECTION ACCESS BITS IF NON-ZERO SECTION

;PRESERVES T2

FKHPTX::STKVAR <SAV3,SAV2,SAV1>
	MOVEM T2,SAV2		;SAVE T2
	SETO T2,		;Flag to check execute-only
	JRST FKHP1		;Continue . . .

FKHPTN::STKVAR <SAV3,SAV2,SAV1>
	MOVEM T2,SAV2		;SAVE T2
	SETZ T2,		;Flag no execute-only check

;FKHP1 - COMMON ENTRY
;	T2/ -1 IF WANT TO RETURN ERROR FOR EXECUTE-ONLY
;	     0 OTHERWISE

FKHP1:	CALL FLOCK
	TLNN T1,^-<.FHSLF>	;IS THIS MY FORK?
	TRNE T1,777000		;YES. IS THERE A SECTION NUMBER
	JRST FKHP0		;ANOTHER FORK OR SECTION NO. WAS SPECIFIED
	MOVE T3,SAV2		;GET ACCESS BITS (PM%EPN)
	TXNE T3,PM%EPN		;EIGHTEEN BIT PAGE NUMBERS SUPPLIED BY USER?
	JRST FKHP0		;YES, DON'T USE PC SECTION
	LOAD T3,VSECNO,UPDL	;GET USER'S PC SECTION
	DPB T3,[POINT 9,T1,26]	;PUT IT INTO THE PAGE NUMBER
FKHP0:	MOVEM T1,SAV1		;SAVE PAGE NO. INCLUDING SECTION
	LDB T3,[POINT 9,T1,26]	;GET SECTION NUMBER FROM ARG
	CAILE T3,(VSECNO)	;A VALID SECTION?
	JRST FKHPE1		;NO
	HLRZ T1,T1
	CALL STJFKR		;GET JOB FORK INDEX
	 JRST FKHPER		;ILLEGAL - ERROR CODE IN 1
	JUMPE T2,FKHP2		;Skip check if call to FKHPTN
	CALL CKNXSR		;Execute-only process?
	 JRST FKHPER		;Yes, return error
	;..
	;..
FKHP2:	CALL SKIIF		;SELF OR INFERIOR TO SELF?
	 JRST [	MOVSI T2,(1B9)	;NOT INFERIOR
		TDNN T2,CAPENB	;ALLOWED TO MAP SUPERIOR?
		JRST FKHPE2	;NO
		MOVE T2,T1	;YES, SAVE OBJECT FORK
		CALL GETSPF	;GET HANDLE OF SUPERIOR
		EXCH T1,T2
		CAME T1,T2	;IS OBJECT FORK IMMED SUPERIOR?
		JRST FKHPE2	;NO
		JRST .+1]
	HRRZ T2,SAV1		;GET PAGE NUMBER FROM ARG
	CAIGE T2,1000		;NON-ZERO SECTION WANTED?
	JRST [	HRRZ T1,SYSFK(T1) ;NO. GET SYSTEM FORK HANDLE
		LOAD T1,FKUP%,(T1) ;GET PT OF SECTION 0
		HRLS T1		; INTO LEFT HALF
		HRR T1,T2	;AND COPY PAGE NUMBER AS WELL
		MOVEM T1,SAV1	;SAVE ANSWER
		MOVX T1,PTWR	;ALL ACCESS ALLOWED TO SECTION 0
		MOVEM T1,SAV3	;SAVE THAT
		JRST FKHP3]	;AND DONE
	CALL SETLF1		;MAP FORK'S PSB
	MOVE T2,SAV1		;GET BACK ORIGINAL ARG
	LDB T3,[POINT 9,T2,26]	;GET SECTION # FROM ARG
	ADD T1,T3		;COMPUTE INDEX INTO OTHER PSB
	CALL SECIND		;GET SECTION POINTER
	JUMPE T1,[		;IF NONE,
		CALL CLRLFK	;UNMAP PSB
		JRST FKHPE1]	;GIVE PROPER ERROR
	MOVEM T1,SAV3		;SAVE SECTION POINTER
	LOAD T3,SPTX,T1		;GET SPT INDEX OF PAGE TABLE
	ANDI T2,777		;GET PAGE OFFSET IN SECTION
	HRL T2,T3		;FORM PTN.PN
	MOVEM T2,SAV1		;SAVE RESULT
	CALL CLRLFK		;UNMAP PSB
FKHP3:	MOVE T1,SAV3		;GET SECTION POINTER
	TXO T1,PTCPY		;PAGE ACCESS DETERMINES COPY ON WRITE
	CALL GPAC		;CONVERT HARDWARE ACCESS BITS TO USER BITS
	MOVE T3,T1		;RETURN ANSWER IN T3
	MOVE T1,SAV1		;GET BACK ARG
	CALL FUNLK		;CAN CHANGE FORK STRUCTURE
	MOVE T2,SAV2		;RESTORE AC
	RETSKP			;SUCCESS RETURN

FKHPE1:	SKIPA T1,[ARGX06]	;ILLEGAL PAGE NUMBER
FKHPE2:	MOVEI T1,FRKHX2		;ILLEGAL SUPERIOR MANIPULATION
FKHPER:	MOVE T2,SAV2		;RESTORE AC
	CALL FUNLK		;UNLOCK FORK STRUCTURE
	RETBAD ()		;ERROR RETURN
;PTNFKH - TRANSLATE PTN TO FKH

;ACCEPTS:
;	T1/ PTN,,PN FOR A FORK'S PAGE

;	CALL PTNFKH

;RETURNS +1: ERROR
;		T1/ ERROR CODE
;	 +2: SUCCESS,
;		T1/ LOCAL FORK HANDLE,,PAGE NUMBER IF PAGE CAN BE IDENTIFIED
;			OR
;		T1/ -1 IF PAGE CAN'T BE IDENTIFIED

;THIS ROUTINE IS CALLED BY THE RMAP JSYS WHEN IT HAS ALREADY
;DETERMINED THAT THE PAGE OF INTEREST IS OWNED BY A FORK.
;THE PAGE TABLE MAY BE A PAGE TABLE FOR ANY SECTION IN THE USER'S
;ADDRESS SPACE

PTNFKH::STKVAR <PTNFPT,PTNFPS,PTNFPN>
	HRRZM T1,PTNFPN		;SAVE PAGE NUMBER
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	HLRZ T2,T1		;GET PTN
	MOVEM T2,PTNFPT		;SAVE IT
	HRRZ T1,SPTH(T2)	;GET THE OWNING FORK
	LOAD T3,FKUP%,(T1)	;GET SECTION 0 PAGE TABLE
	CAME T3,PTNFPT		;THE ONE WE WERE GIVEN?
	JRST PTNF6		;NO. GO TRY FOR NON-ZERO SECTION

;HERE WHEN IT IS THE FORK'S SECTION 0 PAGE TABLE. GET ITS
;JOB-WIDE INDEX

	MOVSI 3,-NUFKS		;SETUP FOR SCAN OF JOB FORK TABLE
PTNF3:	SKIPGE T2,SYSFK(3)	;HAVE A USABLE HANDLE?
	JRST PTNF2		;NO. SKIP IT THEN
	CAIN T1,0(T2)		;IS IT THE FORK WE WANTED?
	JRST [	HRRZ T1,T3	;YES. GET HANDLE INTO AC
		JRST PTNF1]	;GO CONVERT IT
PTNF2:	AOBJN 3,PTNF3
	SETOB T1,PTNFPN		;NOT FOUND, RETURN -1
	JRST PTNF4
	;..
	;..

;HERE WHEN IT'S NOT THE FORK'S SECTION 0 PAGE TABLE
;SEE IF IT'S A NON-ZERO SECTION TABLE

PTNF6:	CALL SETLF3		;MAP THAT FORK'S PSB
	MOVEM T1,PTNFPS		;SAVE INDEX TO PSB
	MOVE T3,T1		;FORM AN AOBJN POINTER TO SECTION TABLE
	HRLI T3,-MXSECN-1
PTNF8:	HRRZ T1,T3		;SET SECIND ARGUMENT
	CALL SECIND		;GET POINTER (FOLLOW INDIRECT POINTERS)
	ANDX T1,STGADM		;GET SPT INDEX
	CAMN T1,PTNFPT		;IS THIS THE ONE WE WANTED?
	JRST [	HRRZ T2,T3	;YES. CLEAR LEFT HALF
		SUB T2,PTNFPS	;COMPUTE SECTION NUMBER
		LSH T2,PGSFT	;MOVE IT TO PAGE NUMBER
		ADDM T2,PTNFPN	;COMPUTE NEW PAGE NUMBER
		MOVE T1,PTNFPS	;GET OFFSET INTO OTHER PSB
		MOVE T1,FORKN(T1) ;GET JOB-WIDE FORK HANDLE
		MOVEM T1,PTNFPS	;SAVE FORK HANDLE
		CALL CLRLFK	;UNMAP THE PSB
		MOVE T1,PTNFPS	;RESTORE FORK HANDLE
		JRST PTNF1]	;GO CONVERT
	AOBJN T3,PTNF8		;TRY THE NEXT FORK

;DIDN'T FIND IT. PROBABLY THIS SPT SLOT WAS A SECTION TABLE
;FOR A FORK THAT HAS SINCE UNSMAP'D IT. THERE IS STILL A POINTER
;TO IT IN THE FORK OF INTEREST, AND THE OWNING FORK HAS BEEN
;CHANGED TO BE THE TOP FORK OF THE JOB.

	CALL CLRLFK		;UNMAP THE PSB
	SETOM T1		;INDICATE UNKNOWN
	JRST PTNF9		;GO FINISH

;HERE WHEN FORK HAS BEEN FOUND. T1/ JOB-WIDE HANDLE. CONVERT
;TO LOCAL HANDLE AND FINISH

PTNF1:	CALL GFKH		;CONVERT TO LOCAL HANDLE
	RETBAD(FRKHX6,<CALL FUNLK>)
	HRLS T1			;GET PTN INTO LEFT HALF
PTNF4:	HRR T1,PTNFPN		;PN INTO RIGHT HALF
PTNF9:	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	RETSKP
;FIND OR INSERT LOCAL FORK HANDLE
; 1/ PSB OFFSET (GRFKH ONLY) ,, JOB FORK INDEX
;GFKH GETS HANDLE RELATIVE TO SELF
;GRFKH GET HANDLE RELATIVE TO FORK WHOSE PSB IS IN LH 1

GFKH:	MOVEI 1,0(1)		;LEAVE LH 0 FOR SELF
GRFKH:	PUSH P,2
	PUSH P,3
	PUSH P,4
	HLRE 3,1		;GET PSB OFFSET
	HRRZ 2,FORKN(3)		;GET JOB HANDLE FOR F1
	PUSH P,3		;SAVE PSB OFFSET
	ADD 3,FKPTAB		;MAKE PTR TO FKTAB
	MOVE 4,[XWD -NLFKS+1,1]
	CAIN 2,0(1)		;IS IT SELF?
	SOJA 4,GFKH4		;YES, 0
	HRLI 1,400000		;USE LH TO REMEMBER ANY EMPTY ENTRIES
GFKH1:	ILDB 2,3		;LOOK AT NEXT HALF-WORD
	CAIN 2,-1		;ASSIGNED?
	JRST GFKH2		;NO
	CAIN 2,0(1)		;IS GIVEN?
	JRST GFKH4		;YES
GFKH3:	AOBJN 4,GFKH1
	HRRZ 3,1
	SKIPL SYSFK(3)		;FORK STILL EXTANT?
	TLNE 1,400000		;NOT FOUND, ROOM TO ADD ENTRY?
	JRST POP41		;NO, RETURN NOSKIP
	HLRZ 3,1		;GET INDEX OF FIRST FREE ENTRY
	IDIVI 3,2		;CONSTRUCT POINTER TO IT
	ADD 3,FKPTAB(4)
	ADD 3,0(P)		;OFFSET TO PROPER PSB
	DPB 1,3			;STORE JOB INDEX IN ENTRY
	HRRZ 2,1		;GET REQUESTED JRFN
	CAIN 2,-1		;FREE ENTRY REQUESTED?
	JRST GFKH5		;YES - DONT UP COUNT
	HRRZ 4,1
	LOAD 2,FKHCNT,(4)	;NO - INCR COUNT OF HANDLES ON THIS FORK
	ADDI 2,1		; ...
	STOR 2,FKHCNT,(4)	;UPDATE COUNT
GFKH5:	HLRZ 4,1
GFKH4:	MOVEI 1,400000(4)	;RETURN LOCAL HANDLE WITH BIT
	AOS -4(P)
POP41:	ADJSP P,-1		;FLUSH OFFSET
	JRST PB4

GFKH2:	TLNE 1,400000		;FIRST EMPTY SLOT?
	HRLI 1,0(4)		;YES, SAVE INDEX
	JRST GFKH3
;DEASSIGN LOCAL FORK HANDLE GIVEN JOB HANDLE IN 1

DASFKH:	PUSH P,2
	PUSH P,3
	PUSH P,4
	CALL JFKRFH		;SEE IF A HANDLE EXISTS
	JUMPN T2,DASFK1		; ...
   REPEAT 0,<
	BUG.(CHK,NOXRFH,FORK,HARD,<DASFKH - Attempt to deassign nonexistant RFH, ignored>,,<

Cause:	This BUG is not assembled into the monitor.  When it is, complete 
	documentation should be provided.

>)  >	;END REPEAT 0
	JRST PB4		;IGNORE ATTEMPT

DASFK1:	MOVEI 2,-1		;PUT A -1 WHERE ENTRY WAS
	DPB 2,3
	LOAD T2,FKHCNT,(T1)	;GET COUNT OF HANDLES ON THIS FORK
	SUBI T2,1		;DECREMENT
	STOR T2,FKHCNT,(T1)	; ...
	SKIPGE SYSFK(T1)	;WAS THIS FORK KILLED?
	SKIPE T2		;AND NO REMAINING HANDLES?
	JRST PB4		;NO - RETURN
	MOVEI T2,FKPTRS(T1)	;YES - RELEASE JRFN NOW
	EXCH T2,FREJFK		; ...
	MOVEM T2,@FREJFK	; ...
	SETOM SYSFK(T1)
	JRST PB4

;TABLE OF BYTE POINTERS, HALF WORD

	POINT 18,FKTAB,-1
FKPTAB:	POINT 18,FKTAB,17
	POINT 18,FKTAB,35
	SUBTTL JSYS'S FOR SOFTWARE INTERRUPT SYSTEM

;SIR JSYS

;ACCEPTS:
;	T1/ FORK HANDLE
;	T2/ (ADDRESS OF LEVEL TABLE,,ADDRESS OF CHANNEL TABLE)

;	SIR

;RETURNS +1: ALWAYS
;	ILLEGAL INSTRUCTION INTERRUPT ON FAILURE

.SIR::	MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFX		;Map PSB and check execute-only
	XSFM T4			;GET FLAGS WORD, INCLUDING PCS
	TXNE T4,EXPCS		;IS PCS NON-ZERO?
	ERRJMP(SIRX2,ITFRKR)	;NO. DON'T ALLOW OLD STYLE SIR
	JUMPE 2,SIR1		;ALL 0 IS LEGAL
	HLRZ 3,2		;GET ADDRESSES GIVEN
	MOVEI 4,0(2)
	CAIL 3,20		;BOTH .GE. 20?
	CAIGE 4,20
	ERRJMP(SIRX1,ITFRKR)	;NO
SIR1:	HRRZM T2,PSCHNT(1)	;SAVE ADDRESS OF CHNTAB
	HLRZM T2,PSLEVT(T1)	;SAVE ADDRESS OF LEVTAB
	SETZRO PSXSIR,(T1)	;INDICATE NOT EXTENDED SIR
	JRST CLFRET
;XSIR JSYS

;ACCEPTS:
;	T1/ FORK HANDLE
;	T2/ ADDRESS OF ARGUMENT BLOCK

;ARGUMENT BLOCK:
;	LENGTH OF THIS BLOCK (3)
;	ADDRESS OF LEVEL TABLE
;	ADDRESS OF CHANNEL TABLE

;	XSIR

;RETURNS +1: ALWAYS,
;	ILLEGAL INSTRUCTION INTERRUPT ON FAILURE

;THIS IS AN EXTENDED SIR JSYS. IT IS USED BY PROGRAMS THAT WILL
;RUN IN NON-ZERO SECTIONS.

.XSIR::	MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFX		;MAP PSB AND CHECK EXECUTE-ONLY
	UMOVE T4,2		;GET ADDRESS OF ARGUMENT BLOCK
	UMOVE T3,0(T4)		;GET SIZE OF THIS TABLE
	TLNE T3,-1		;CAN'T BE THIS BIG
	ERRJMP (ARGX05,ITFRKR)	;ARGUMENT BLOCK TOO BIG
	CAIGE T3,.SICHT+1	;CAN'T BE TOO SMALL EITHER
	ERRJMP(ARGX04,ITFRKR)	;ARGUMENT BLOCK TOO SMALL
	UMOVE T2,.SILVT(T4)	;GET ADDRESS OF LEVEL TABLE
	UMOVE T3,.SICHT(T4)	;GET ADDRESS OF CHANNEL TABLE
	SKIPN T2		;OK FOR BOTH TO BE ZERO
	SKIPE T3
	SKIPA			;NOT BOTH ZERO. CONTINUE
	JRST [	SETZRO PSXSIR,(T1) ;BOTH ZERO. CLEAR EXTENDED SIR FLAG
		JRST XSIR4]	;GO FINISH

;DON'T ALLOW CHNTAB OR LEVTAB TO BE IN THE AC'S

	HRRZ P2,T2		;GET OFFSET IN THE SECTION FOR LEVTAB
	CAIGE P2,20		;IS IT LESS THAN 20?
	TLNE T2,777776		;YES. SECTION 0 OR 1?
	SKIPA			;OK
	ERRJMP(SIRX1,ITFRKR)	;YES. INDICATE ERROR
	HRRZ P3,T3		;GET OFFSET IN SECTION FOR CHNTAB
	CAIGE P3,20		;IT IS LESS THAN 20?
	TLNE T3,777776		;YES. SECTION 0 OR 1?
	SKIPA
	ERRJMP(SIRX1,ITFRKR)	;YES. INDICATE ERROR
	;..
;DON'T LET THE CHANNEL TABLE OR THE LEVEL TABLE GO BEYOND THE
;END OF ITS SECTION.

	;..
	MOVE P2,T3
	ADDI P2,^D35		;GET ADDRESS OF LAST WORD IN CHAN TABLE
	XOR P2,T3		;SEE IF START AND END ARE IN SAME SECTION
	TLNE P2,-1		;ARE THEY?
	ERRJMP(XSIRX1,ITFRKR)	;NO. ERROR
	MOVE P2,T2
	ADDI P2,2		;GET ADDRESS OF LAST WORD IN LEVEL TABLE
	XOR P2,T2		;SEE IF START AND END ARE IN SAME SECTION
	TLNE P2,-1		;ARE THEY?
	ERRJMP(XSIRX2,ITFRKR)	;NO. ERROR
	SETONE PSXSIR,(T1)	;INDICATE EXTENDED SIR WAS DONE
XSIR4:	MOVEM T2,PSLEVT(T1)	;SAVE ADDRESS OF LEVEL TABLE
	MOVEM T3,PSCHNT(T1)	;SAVE ADDRESS OF CHANNEL TABLE
	JRST CLFRET		;RETURN SUCCESS
.EIR::	MCENT
REPEAT 0,< ;This is antiquated by capability checking
	TRNE 1,200000		;SPECIAL?
	ITERR(FRKHX1)		;ILLEGAL
> ;End of REPEAT 0
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETJFK
	CALL CHKNXS		;Check if specified process is execute-only or not SELF
	PUSH P,SYSFK(1)		;REMEMBER FORK INDEX
	CALL SETLF1		;MAP PSB
	SETZM PSISYS(1)		;0 IS ON
	POP P,2
	SKIPN PSIBW(1)		;ANY BREAKS WAITING?
	JRST CLFRET		;NO
	SETZ 1,			;YES, INITIATE SERVICE
	NOSKED
	CALL PSIRQB
	OKSKED
	CHKINT			;GET ANY PENDING BREAKS TO BE SEEN
	JRST CLFRET
;SKIP IF PSI SYSTEM ENABLED

.SKPIR::MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFK
	MOVE P1,PSISYS(1)	;GET STATE OF PI SYSTEM
	CALL CLRLFK		;UNLOCK THE FORK STRUCTURE
	CALL FUNLK
	JUMPN P1,EMRET1		;TAKE NO SKIP RETURN
	SMRETN			;SKIP

.DIR::	MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFX		;Map PSB and check execute-only
	SETOM PSISYS(1)
	JRST CLFRET

.AIC::	MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFX		;Map PSB and check execute-only
	IORM 2,PSICHM(1)
ICR:	CALL SETAOV		;SET ARITHMETIC OVERFLOW TRAP LOCATION IN UPT
	CALL SETPOV		;SET PDL OVERFLOW TRAP LOCATION IN UPT
	JRST CLFRET

.DIC::	MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFX		;Map PSB and check execute-only
	ANDCM 2,MONCHN(1)	;DISALLOW MONITOR RESERVED CHANNELS
	ANDCAM 2,PSICHM(1)
	JRST ICR
;INITIATE INTERRUPT ON CHANNEL
; 1/ FORK HANDLE
; 2/ CHANNEL MASK
;	IIC
; RETURN +1 ALWAYS

;FOR MONITOR USE, SEE IICSLF IN SCHED

.IIC::	MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETJFK
	CALL CHKNXS		;Check if specified process is execute-only or not SELF
	PUSH P,1
	CALL SETLF1		;MAP DEST PSB
	UMOVE 2,2
	ANDCM 2,MONCHN(1)	;DISALLOW MON RESERVED CHANS
	PUSH P,2
	CALL CLRLFK
	POP P,2
	POP P,1
	MOVE 1,SYSFK(1)
	EXCH 1,2
	NOSKED
	CALL PSIRQB
	OKSKED
	CHKINT			;GET IT SEEN
	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	JRST MRETN

.RCM::	MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFK
	MOVE 1,PSICHM(1)
	JRST RETA1
;READ PSI IN PROGRESS AND WAITING MASKS

.RWM::	MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFK
	MOVE 2,PSIBIP(1)
	UMOVEM 2,2		;REPORT BREAKS IN PROGRESS IN 2
	MOVE 1,PSIBW(1)
RETA1:	UMOVEM 1,1		;RETURN VALUE IN 1
	JRST CLFRET

.SIRCM::MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFX		;Map PSB and check execute-only
	CAIN 1,0		;SELF?
	JRST FRKE1		;ILLEGAL
	MOVEM 2,SUPCHN(1)
	JRST CLFRET

.RIRCM::MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFK
	MOVE 2,SUPCHN(1)
RETA2:	UMOVEM 2,2
	JRST CLFRET
;RIR JSYS

;ACCEPTS:
;	T1/FORK HANDLE

;	RIR

;RETURNS +1: ALWAYS
;	T2/ (ADDRESS OF LEVEL TABLE,,ADDRESS OF CHANNEL TABLE)
;	ILLEGAL INSTRUCTION INTERRUPT ON FAILURE

;IT IS ILLEGAL TO DO THIS JSYS IF THE INTERRUPT SYSTEM WAS SET
;UP VIA XSIR.

.RIR::	MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFK
	JN PSXSIR,(T1),[ ERRJMP(RIRX1,ITFRKR)] ;XSIR WAS DONE PREVIOUSLY
	HRL T2,PSLEVT(T1)	;GET LEVEL TABLE
	HRR T2,PSCHNT(T1)	;GET CHANNEL TABLE
	JRST RETA2

;XRIR JSYS

;ACCEPTS:
;	T1/ FORK HANDLE
;	T2/ ADDRESS OF ARGUMENT BLOCK

;	XRIR

;RETURNS +1: ALWAYS

;ARGUMENT BLOCK:
;	UNCHANGED
;	ADDRESS OF LEVEL TABLE
;	ADDRESS OF CHANNEL TABLE

;ILLEGAL INSTRUCTION INTERRUPT ON FAILURE

.XRIR::
	MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFX		;MAP PSB AND CHECK EXECUTE-ONLY
	UMOVE T4,2		;GET ADDRESS OF ARGUMENT BLOCK
	UMOVE T3,0(T4)		;GET SIZE OF THIS TABLE
	TLNE T3,-1		;CAN'T BE THIS BIG
	ERRJMP (ARGX05,ITFRKR)	;ARGUMENT BLOCK TOO BIG
	CAIGE T3,.SICHT+1	;CAN'T BE TOO SMALL EITHER
	ERRJMP(ARGX04,ITFRKR)	;ARGUMENT BLOCK TOO SMALL
	MOVE T2,PSLEVT(T1)	;GET LEVEL TABLE
	UMOVEM T2,1(T4)		;RETURN TO USER
	MOVE T2,PSCHNT(T1)	;GET CHANNEL TABLE
	UMOVEM T2,2(T4)		;RETURN TO USER
	JRST CLFRET		;RETURN
;ACTIVATE TERMINAL INTERRUPT
; 1/ TERMINAL CODE ,, CHANNEL NUMBER
;	ATI
; RETURN +1: ALWAYS.

.ATI::	MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	HLRZ 1,1
	CAIL 1,^D36		;REASONABLE TERM CODE?
ATIE1:	ERRJMP(TERMX1,ITFRKR)	;NO
	CAIN 1,.TICCC		;CONTROL-C?
	JRST [	MOVE 3,CAPENB	;YES, SEE IF LEGAL
		TXNN 3,SC%CTC
		JRST ATX2E
		JRST .+1]
	CALL GETCHA
	XCTU [HRRZ 3,1]	;GET CHANNEL NUMBER
	CAIG 3,^D5		;LEGAL CHANNEL NUMBER?
	JRST ATI3		;YES
	CAIL 3,^D23		;ALLOW CH23 AND ABOVE ALSO
	CAILE 3,^D35
	ERRJMP(ATIX1,ITFRKR)	;NO
ATI3:	DPB 3,2			;ASSIGN IT TO THIS CODE
	HRRZ 4,FORKN
	MOVE 3,BITS(1)
	IORM 3,FKPSIE(4)
	LOAD T1,FRKTTY,(T4)	;GET CONTROLLING TERMINAL
	CALL UPDTI		;UPDATE JOB WORD
	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	MRETNG

ATX2E:	ERRJMP(ATIX2,ITFRKR)	;USER LACKS ^C CAPABILITY
;DEACTIVATE TERMINAL INTERRUPT
; 1/ TERMINAL CODE
;	DTI
; RETURN +1: ALWAYS, UNLESS ITRAP

.DTI::	MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CAIL 1,0
	CAIL 1,^D36		;REASONABLE CODE?
	JRST ATIE1		;NO
	HRRZ 2,FORKN
	MOVE 6,BITS(1)
	ANDCAM 6,FKPSIE(2)	;CLEAR FROM THIS FORK
	LOAD T1,FRKTTY,(T2)	;GET CONTROLLING TERMINAL
UPDTIR:	CALL UPDTI		;UPDATE JOB WORDS
	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	JRST MRETN

;UPDATE JOB TPSI WORDS BY SCANNING FORK WORDS
;TTY DESIGNATOR IN T1 AT CALL

UPDTI:	TRNN T1,1B18		;IS IT A TTY DESIGNATOR?
	RET			;NOPE, DO NOTHING.
	SAVEQ			;GET SOME MORE WORK AC'S
	MOVSI T3,-NUFKS		;SETUP TO SCAN ALL FORKS OF JOB
	SETZB T4,Q1		;IOR PSI AND DPSI WORDS
UPDT0:	HRRZ Q2,SYSFK(T3)	;GET FORKX OF THE FORK
	CAIN Q2,-1		;DOES THE FORK EXIST?
	JRST UPDT2		;NO, SKIP OVER IT
	LOAD Q2,FRKTTY,(T3)	;GET CONTROLLING TERMINAL
	CAIN Q2,0(T1)		;IS IT THE ONE WE WERE CALLED WITH?
	JRST UPDT1		;YES! GO UPDATE THE PSI WORDS
UPDT2:	AOBJN T3,UPDT0
	MOVEI T2,(T1)		;MOVE TO AC FOR TTYSRV
	CAIN T2,-1		;IS THE CALLING ARG THE JOB CTTY?
	JRST UPDT4		;YES.
	TRZ T2,1B18		;MAYBE NOT
	CAMN T2,CTRLTT		;CHECK IN LINE NUMBER FORM
	JRST UPDT4		;IT IS.
	CAIGE T2,NLINES		;NOPE. THIS THING IS A LEGAL TTY, I HOPE?
	CAIGE T2,0
	 RET			;NO, IT WASN'T. ALL FOR NOW.
	JRST UPDT5		;YES, GO STORE PSI WORDS

UPDT4:	AND T4,TTJTIW		;ALLOW ONLY ENABLED BITS
	MOVEM T4,TTSPSI
	AND Q1,TTJTIW
	MOVEM Q1,TTSDPS		;DEFERRED CODES
	SKIPGE T2,CTRLTT	;IF ATTACHED
	RET
UPDT5:	MOVEM T4,T1		;SET LINE'S PSI WORDS
	MOVEM Q1,T3		; ..
	CALLRET TTSINT

UPDT1:	HRRZ FX,SYSFK(T3)	;GET THE SYSTEM FORKX
	MOVEI T2,(FX)		;KEEP A COPY
	CALL CHKWT		;IS THE FORK DISMISSED?
	 JRST UPDT3		;NO
	LOAD Q2,FKSTR,(FX)	;YES, SEE HOW.
	CAIE Q2,FRZWT		;FROZEN?
	JRST UPDT8		;NO
	JE FKFRJ,(FX),UPDT2	;YES. IS IT JSYS TRAP?
	JN FKEFR,(FX),UPDT2	;YES. JSYS TRAP AND ALSO OTHER FREEZE?

UPDT8:	CAIE Q2,HALTT		;WHAT OTHER KIND OF WAIT IS IT?
	CAIN Q2,FORCTM		;HALT OR FORCED TERMINATION?
	JRST UPDT2		;YES. DON'T INCLUDE THIS FORK'S PSI BITS
UPDT3:	IOR T4,FKPSIE(T3)	;INCLUDE THESE BITS. THIS FORK COUNTS FOR
	IOR Q1,FKDPSI(T3)	; PSI COLLECTION PURPOSES
	JRST UPDT2		;ON TO MORE FORKS

;DEASSIGN ALL TERMINAL INTERRUPTS FOR THIS FORK

DTIALL::HRRZ T1,FORKN
	SETZM FKPSIE(T1)
	LOAD T1,FRKTTY,(T1)	;GET CONTROLLING TERMINAL
	CALLRET UPDTI		;UPDATE AND RETURN
;CLEAR PSI SYSTEM

.CIS::	MCENT
	NOINT			;PREVENT INTERRUPTION
	SETZM PSIBIP
	SETZM PSIBW
	MOVE T1,[IOWD NPSIPG*PGSIZ,PSIPGA] ;SET UP STACK POINTER
	MOVEM 1,PSIPT		;RESET PSI STORAGE
	MOVE T1,FORKX		;GET ID OF THIS PROCESS
	SETZ 2,			;CLEAR ALL FORK'S ENTRIES ON STACK
	CALL JSBSTF		;GO MAKE SURE IT IS CLEAN
	MOVE T1,FORKX		;GET ID OF THIS PROCESS
	SETZ T2,0
	CALL GOKFRE		;FREE GETOKK REQUESTS
	OKINT			;ALLOW INTS NOW
	JRST MRETN
;READ/SET TERMINAL INTERRUPT WORD

.RTIW::	MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	HRRZS T1
	CAIN 1,-5		;WHOLE JOB?
	JRST [	MOVE 2,TTJTIW	;YES
		JRST RTIW1]
	CALL SETJFK		;GET JOB INDEX
	MOVE 2,FKDPSI(1)	;DEFERRED CODES
	UMOVE T3,T1		;Get the user flags
	TXNE T3,RT%DIM		;User want to get deferred mask?
	UMOVEM T2,T3		;Yes, return in T3
	MOVE 2,FKPSIE(1)
RTIW1:	UMOVEM 2,2
	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	JRST MRETN

.STIW::	MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	HRRZS T1
	CAIN 1,-5
	JRST [	MOVE 3,CAPENB
		TXNN 3,SC%CTC	;^C CAPABILITY?
		JRST ATX2E	;NO, DON'T PERMIT CHANGE TO JOB TI
		MOVEM 2,TTJTIW	;SET JOB MASK WORD
		MOVEI T1,-1	;JOB CONTROLLING TERMINAL
		JRST STIW2]	;GO UPDATE AND RET
	CALL SETJFK
	CALL CHKNXS		;Check if specified process is execute-only or not SELF
	UMOVE 3,3		;GET DEFERRED CODES
	UMOVE 4,1		;GET THE FLAGS
	TXNE 4,ST%DIM		;USER WANT TO SET DEFERRED MASK?
	MOVEM 3,FKDPSI(1)	;YES, SET THE DEFERRED CODES
	EXCH 2,FKPSIE(1)	;SET NEW, REMEMBER OLD
	XOR 2,FKPSIE(1)		;DIFFERENCES
	SKIPE MONCHN(1)		;RESERVED MON CHANS EXIST?
	TLZN 2,(1B16)		;AND ^P BEING CHANGED?
	JRST STIW1		;NO
	MOVE 3,BITS+20		;YES, PUT ^P BACK LIKE IT WAS
	XORM 3,FKPSIE(1)
STIW1:	LOAD T1,FRKTTY,(T1)	;GET CONTROLLING TERMINAL
STIW2:	CALL UPDTI		;UPDATE JOB TIW
	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	JRST MRETN
;SPECIAL CAPABILITIES CONTROL

.RPCAP::MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETJFK
	CALL SETLF1
	MOVE 2,CAPMSK(1)
	UMOVEM 2,2		;RETURN POSSIBLE IN 2
	MOVE 3,CAPENB(1)
	UMOVEM 3,3		;ENABLED IN 3
	JRST CLFRET

.EPCAP::MCENT
	HRRZ Q1,CAPENB		;CHECK FOR CHANGE
	HRRZ Q2,T3		;REQUESTED
	CAMN Q1,Q2
	JRST EPCNGO		;NO
	CAME T3,[-1]		;Are they asking for all caps?
	IFSKP.			; -yes, make it easier for ACJ to determine
	  MOVE T3,CAPMSK	;  Get possible caps
	  CAIN T1,.FHSLF	;  Enabling ourselves?
	ANSKP.			; -no,
	  TLO T3,(777B17)	;  so set all bits determined by superior
	  AND T3,T2		;   and with the "possible mask" supplied
	ENDIF.			;T3 now has caps the user is enabling
	GTOKM (.GOCAP,<T3>,MRETN)
EPCNGO:	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETJFK
	CALL SKIIF
	ERRJMP(FRKHX2,ITFRKR)	;INFERIORS ONLY
	CALL SETLF1
	JUMPE 1,[XOR 3,CAPMSK(1) ;IF SELF, DON'T MODIFY 14-17
		TLZ 3,(17B17)
		XOR 3,CAPMSK(1)
		JRST EPC1]
	MOVE 4,CAPMSK
	TLO 4,(777B17)		;9-17 DETERMINED BY SUPERIOR
	AND 2,4
	MOVEM 2,CAPMSK(1)
EPC1:	AND 3,CAPMSK(1)		;ONLY ALLOW MODES IN MASK
	MOVEM 3,CAPENB(1)
	JRST CLFRET
;SWTRP JSYS. SET AND READ USER-MODE TRAPS. CALLING SEQUENCE IS:
;	T1/ FORK HANDLE
;	T2/ FLAGS,,FUNCTION
;	T3/ FUNCTION DEPENDENT ARG
;ITRAP ON ANY ILLEGAL ACT

SWTBIT==SW%NMI			;LEGAL BITS
SWTMSK==<-1,,0>^!SWTBIT		;ILLEGAL BITS IN LEFT HALF

.SWTRP::MCENT			;ESTABLISH CONTEXT
	UMOVE T1,1		;GET FORK HANDLE
	CALL FLOCK		;LOCK FORK STURCTURE
	CALL SETLFK		;MAP FORK
	UMOVE T2,2		;GET ARG
	HRRZ T3,T2		;GET FUNCTION WITHOUT BITS
	CAILE T3,.SWRPD		;VALID FUNCTION?
	ITERR (ARGX02,<CALL CLRLFK
			CALL FUNLK>)
	CAIE T3,.SWART		;IS THIS SET ARITHMETIC OVERFLOW?
	CAIN T3,.SWSPD		;OR SET PDL OVERFLOW?
	JRST [	TXNE T2,SWTMSK	;YES. ANY ILLEGAL BITS IN LEFT HALF?
		ITERR (ARGX22,<CALL CLRLFK
		       CALL FUNLK>)
		JRST SWTR2]
	TLNE T2,-1		;NO. DON'T ALLOW ANYTHING IN LEFT HALF
	ITERR (ARGX22,<CALL CLRLFK
		       CALL FUNLK>)
SWTR2:	TRNN T2,1		;IS THIS A "SET" FUNCTION?
	JRST [	UMOVE T3,3	;YES. GET ADDRESS OF BLOCK
		HLRZ T4,T3	;GET SECTION NUMBER
		CAIL T4,7777	;MUST BE LESS THAN 7777
		ITERR (ARGX23,<CALL CLRLFK
			       CALL FUNLK>)
		JRST .+1]
	CALL @SWTRPT(T2)	;DO THE FUNCTION
	JRST CLFRET		;AND DONE

;DISPATCH TABLE FOR SWTRP ARGS

SWTRPT:	IFIW!ARTSET		;.SWART - SET ARITHMETIC TRAP
	IFIW!ARTGET		;.SWRAT - READ ARITHMETIC TRAP
	IFIW!LUUSET		;.SWLUT - SET LUUO BLOCK
	IFIW!LUUGET		;.SWRLT - READ LUUO BLOCK
	IFIW!PDLSET		;.SWSPD - SET PDL OVERFLOW BLOCK
	IFIW!PDLGET		;.SWRPD - READ PDL OVEFLOW BLOCK
;SET ARITHMETIC TRAP

ARTSET:	CALL SETART		;SAVE BLOCK ADDRESS AND SET UP UPT
	RET			;AND DONE

;READ ARITHMETIC TRAP

ARTGET:	MOVE T3,ARTHTR		;GET TRAP VALUE
	UMOVEM T3,3		;STASH IT
	RET			;DONE

;SET LUUO DISPATCH ADDRESS

LUUSET:	CALL SETLUU		;STORE ADDRESS IN UPT
	RET

;READ LUUO DISPATCH ADDRESS

LUUGET:	CALL GTLUUB		;GET LUUO BLOCK ADDRESS
	UMOVEM T3,3		;RETURN VALUE
	RET			;AND DONE

;SET PDL OVERFLOW TRAP

PDLSET:	CALL SETPDL		;SAVE ADDRESS OF BLOCK AND SET UP UPT
	RET

;READ PDL OVERFLOW TRAP

PDLGET:	MOVE T3,PDOVTR		;GET ADDRESS OF BLOCK
	UMOVEM T3,3		;RETURN TO USER
	RET

;CLRTRP - Routine to clear all functions set by SWTRP. Called by RESET JSYS

;	CALL CLRTRP

;Returns +1: always

;Works only on this fork

CLRTRP::SETZM T1		;OFFSET FOR PSB ADDRESSING FOR THIS FORK
	SETZM T3		;INDICATE "CLEAR FUNCTION"
	CALL SETART		;CLEAR ARITHMETIC OVERFLOW TRAP WORD
	SETZM T3		;INDICATE "CLEAR FUNCTION"
	CALL SETLUU		;CLEAR LUUO BLOCK ADDRESS
	SETZM T3		;INDICATE "CLEAR FUNCTION"
	CALL SETPDL		;CLEAR PDL OVERFLOW TRAP WORD
	RET
; Jsys Traps jsyses (TFORK, RTFRK and UTFRK)

;TFORK JSYS - FOR SETTING AND REMOVING TRAPS
;1: XWD function code, fork handle
;2: XWD channel #, number of bits in bit table
;3: Address of bit table
;FUNCTION CODES:
; 0: (.TFSET) Set traps as specified by bit table
; 1: (.TFRAL) Remove all traps set by this fork
; 2: (.TFRTP) Remove traps set by this fork as specified by bit table
; 3: (.TFSPS) Set JSYS trap PSI chan from LH(2); 77=>Don't PSI on trap
; 4: (.TFRPS) Read JSYS trap PSI chan into LH(2)
; 5: (.TFTST) Test if self is monitored: Ret with 2=-1/0 for yes/no
; 6: (.TFRES) Trap reset-remove traps from all inferiors, clear PSI chan
; 7: (.TFUUO) Set UUO traps for fork
; 8: (.TFSJU) Set both UUO and JSYS traps (combine 1 & 7)
; 9: (.TFRUU) Remove UUO traps
; Returns +1 always


.TFORK::MCENT
	MOVE Q2,T2		; Get chan #, # bits set in bit tbl
	MOVE P4,T3		; Bit tbl addr
	HRR Q2,T1		; Make channel, fork handle
	HLRZ Q1,T1		; Function code
	CAIL Q1,0		; Range check the function code
	CAILE Q1,.TFRUU
	 ITERR TFRKX1		; Bad code, abort
	CALL @TFFUN(Q1)		;DO USER'S FUNCTION
	MRETNG			; Return a success


TFFUN:	IFIW!TFRKSR		; 0 set traps
	IFIW!TFRKSR		; 1 remove traps
	IFIW!TFRKSR		; 2 remove all
	IFIW!TFORK3		; 3 set channel
	IFIW!TFORK4		; 4 read channel
	IFIW!TFORK5		; 5 test if trapped
	IFIW!TFORK6		; 6 Reset
	IFIW!TFRKSR		; 7 UUO traps set
	IFIW!TFRKSR		; 8 combine 1 & 7
	IFIW!TFRKSR		; 9 Remove UUO traps
TFRKSR:	CALL FLOCK		;LOCK FORK STRUCTURE
	MOVEI T1,(Q2)		;FORK HANDLE
	CAIN T1,-4		;ALL INFERIORS?
	 JRST TFSRA		;YES
	CALL STJFKR		;CONVERT REL. HANDLE TO  JOB FORK INDEX
	 ITERR TFRKX2,<CALL FUNLK>
	CALL SKIMIF		;IS IT AN IMMEDIATE INFERIOR?
	 ITERR TFRKX2,<CALL FUNLK> ;NO, ERROR
	CALL CHKNXS		;Check if specified process is execute-only or not SELF
	HRRZ T2,SYSFK(T1)	;SYSTEM FORK INDEX
	TMNN FKEFR,(T2)		;IS THE FORK FROZEN?
	 ITERR TFRKX3,<CALL FUNLK> ;NO, TELL THE USER
	CALL TFSR		;SET OR REMOVE THE TRAPS
	CALLRET FUNLK		;UNLOCK FORK STRUCTURE AND RET

TFSRA:	HRRZ T1,FORKN
	CALL MAPINF
	 CALL TFFRZ		;CHECK ALL FORKS FOR FROZENNESS
	HRRZ T1,FORKN
	CALL MAPINF
	 CALL TFSR
	CALLRET FUNLK

TFFRZ:	HRRZ T1,SYSFK(T1)	;JOB FORK NO. TO SYSTEM FORK INDEX
	JN FKEFR,(T1),R		;RETURN IF FORK FROZEN DIRECTLY OR INDIRECTLY
	ITERR TFRKX3,<CALL FUNLK> ;NOT FROZEN, LET USER KNOW IT
	RET			;YES, FORK IS FROZEN; DIRECT OR INDIRECT
;SET OR REMOVE TRAPS FOR A FORK
;T1/	FORKN OF FORK TO TRAP OR UNTRAP

TFSR:	MOVE P1,T1		;copy forkn
	MOVE P3,SUPERP
	ADD P3,P1
	LDB P3,P3		;forkn of superior
	SKIPN T2,FKJTB(P1)	;do we have a monitor at all?
	 JRST [ CALL TFIFST	; Some form of setting?
		 RET		; No, and no monitor so done
		CALL NEWJTB	;yes, ret addr. in T2
		JRST .+1]
	LOAD P2,JTIMP,(T2)	;forkn of our immed. monitor

;P1/	FORKN OF IMMEDIATE INF. TO SET/REMOVE TRAPS FOR
;P2/	FORKN OF P1'S MONITOR
;P3/	FORKN OF P1'S SUPERIOR

	CAME P2,P3		;is my monitor my superior?
	 JRST [ CALL TFIFST	; A form of set?
		 RET		; No, & sup. not my mon. so done
		CALL NEWJTB	;yes, assign new JTB, ret addr. in T2
		LOAD P2,JTIMP,(T2) ;forkn of ITS immed. monitor
		JRST .+1]
	CAIN Q1,.TFRAL		; Removing all?
	 JRST [	CALL RELJTB	;yes, release block
	 	CALLRET TFINF3]	;take superior's block and update inf's
	CALL TFUBIM		;update JTBIM (im. mon.'s bit table)
	CALL TFUALL		;update JTALL

TFINF:	MOVE T1,P1		;pass starting point to mapinf
	CALL MAPINF		;do all of his immediate inferiors
	 CALL TFINF1		;trap forks inferiors
	RET

TFINF1:	MOVE P1,T1		;copy forkn (of inf. fork)
	MOVE P3,SUPERP		;get superior pointer
	ADD P3,P1
	LDB P3,P3		;get forkn of superior fork
	SKIPN T2,FKJTB(P1)	;does this fork have a monitor?
	 JRST TFINF3		;no, point to superior's JTB
	LOAD P2,JTIMP,(T2)	;P2=forkn of immediate mon for this fork
	CAME P2,P3		;is my monitor my immed. superior?
	 JRST TFINF3		;no, point to superior's JTB

	CALL TFUALL		;yes, update JTBAL
	CALLRET TFINF		;do this forks inferiors, etc.

TFINF3:	MOVE T1,FKJTB(P3)	;superior's JTB
	MOVEM T1,FKJTB(P1)	;equals inferiors JTB
	CALLRET TFINF		;do this forks inferiors, etc.
;UPDATE JTBAL, CALLED WHEN IMMED. MONITOR OF FORK IN P1 IS IT'S SUPERIOR
;P1/	FORKN OF INFERIOR TO SET/REMOVE TRAPS FOR
;P2/	FORKN OF P1'S IMMEDIATE MONITOR (ALSO IT'S SUPERIOR)

TFUALL:	MOVSI T4,-JTBTL
	HRR T4,FKJTB(P1)	;addr. of inf's JTB
	HRRZ T3,FKJTB(P2)	;addr. of monitor's JTB (possibly null)
	JUMPE T3,[MOVSI T1,JTBIM(T4) ;this forks JTBIM
		  HRRI T1,JTBAL(T4) ;equals this forks JTBAL
		  BLT T1,JTBAL+JTBTL-1(T4)
		  RET]
TFUAL1:	MOVE T1,JTBAL(T3)	;monitor's JTBAL
	IOR T1,JTBIM(T4)	;this fork's JTBIM
	MOVEM T1,JTBAL(T4)	;this fork's JTBAL
	AOS T3
	AOBJN T4,TFUAL1
	RET


;UPDATE JTBIM, CALLED FOR IMMED. INF. OF EXECUTING FORK ONLY
;P1/	FORKN OF THE IMMED. INF. FORK TO UPDATE

TFUBIM:	MOVSI T4,-JTBTL
	HRR T4,FKJTB(P1)	;addr. of inf's JTB
	MOVE T3,P4		;addr. of user table
	MOVSI T2,(1B0)		; JSYS 0, or UUO trap bit
	UMOVE T1,(T3)		; Get word that would be in
	CALL TFIFST		; Form of set?
	 JRST TFUBI2		; No
	CAIE Q1,.TFSJU
	CAIN Q1,.TFUUO		; Either form that allows B0 W0?
	 JRST [ IOR T1,T2	; Yes, do that
		CAIN Q1,.TFUUO	; UUO's only?
		 MOVE T1,T2	; Then ignore that from bit tbl
		JRST TFUB10]
	ANDCAM T2,T1		; No, remove it
	CAIA
TFUBI1:	UMOVE T1,(T3)		;user's table
TFUB10:	IORM T1,JTBIM(T4)	;ored with existing table (maybe zero)
	AOS T3
	CAIE Q1,.TFUUO		; If UUO's only, get out
	AOBJN T4,TFUBI1
	RET

TFUBI2:	CAIN Q1,.TFRUU		; Removing UUO traps?
	 JRST [ MOVE T1,T2	; Then UUO's only
		JRST TFUB20]
	ANDCAM T2,T1		; Can't remove UUO traps this way
	CAIA
TFUB21:	UMOVE T1,(T3)		;user's table
TFUB20:	ANDCAM T1,JTBIM(T4)	;remove from JTB
	AOS T3
	CAIE Q1,.TFRUU		; If UUO's only, get out
	AOBJN T4,TFUBI2
	RET

TFIFST:	CAIE Q1,.TFSET		; Check if function code is form of set
	CAIN Q1,.TFSJU
	 JRST RSKP
	CAIN Q1,.TFUUO
	 JRST RSKP
	RET			; No form of set
;ASSIGN A NEW Jsys Trap Block (JTB)
;P1/	FORKN OF FORK TO ASSIGN TABLE
;RETURNS: +1 ALWAYS
;T2/	ADDRESS OF JTB

NEWJTB:	MOVE T1,JTBFRE		;FREE STORAGE BIT TABLE
	JFFO T1,.+2
	BUG.(CHK,NWJTBE,FORK,SOFT,<No free JTB blocks>,,<

Cause:	Word JTBFRE in the JSB has bit n on if JSYS trap block n is
	available.  The NEWJTB routine assigns trap blocks, looking in JTBFRE
	for a bit on.  If no bit is found to be on in JTBFRE, the NWJTBE BUGCHK
	occurs.

Action:	If this BUG persists, make it dumpable and submit an SPR with the
	dump and a copy of MONITR.EXE.  If possible, include any known
	method for reproducing the problem and/or the state of the system
	at the time the BUG was observed.
>)
	MOVE T3,BITS(T2)	;MARK BLOCK AS ASSIGNED
	ANDCAM T3,JTBFRE
	IMULI T2,JTBSIZ		; Adr=(blk #*size)+ JTB pg adr+1
	ADDI T2,JTBOFF		;FIRST WORD IS FREE BIT TABLE
	HRLZI T1,JTBAL(T2)
	HRRI T1,JTBAL+1(T2)
	SETZM JTBAL(T2)
	BLT T1,JTBSIZ-1(T2)	;CLEAR BOTH BIT TABLES
	HRRZ T1,FORKN
	MOVEM T1,JTBMN(T2)	;SET JTIMP TO FORK EXECUTING TFORK
	MOVEM T2,FKJTB(P1)	;MAKE INF. FORK POINT TO JTB
	RET


;RELEASE Jsys Trap Block
;P1/	FORKN OF FORK THAT HAS BLOCK ASSIGNED (TO BE RELEASED)

RELJTB:	SKIPN T1,FKJTB(P1)	;GET ADDRESS OF JTB
	RET			;IF THERE ISN'T A BLOCK ASSIGNED, RETRUN
	SETZM FKJTB(P1)		;SAY FORK IS NO LONGER TRAPPED
	SUBI T1,JTBOFF
	IDIVI T1,JTBSIZ
	MOVE T1,BITS(T1)
	IORM T1,JTBFRE		;RELEASE BLOCK
	RET
TFORK3:	HLRZ T2,Q2		;GET CHANNEL FROM COPY OF USER'S AC2
	CAILE T2,^D35		;LEGAL CHANNEL?
	MOVEI T2,77		;NO, ASSUME NO PSI'S WANTED
	STOR T2,JTMCN		;SET THE CHANNEL
	RET

TFORK4:	LOAD T2,JTMCN		;GET CHANNEL NUMBER
	XCTU [HRLM T2,2]	;RETURN IT IN LEFT HALF OF USER'S AC2
	RET

TFORK5:	SETZ T2,		;ASSUME NOT MONITORED
	SKIPE @JTBLK		;ARE WE MONITORED?
	SETO T2,		;YES, THEN SAY SO
	UMOVEM T2,2		;RETURN IN USER'S AC2
	RET

TFORK6:	CALL FLOCK		;TFORK RESET
	MOVSI T1,77		;CLEAR PSI CHANNEL FOR TRAPS
	STOR T1,JTMCN		;CAUSE MONITORED FORKS TO BYPASS US
	MOVE T1,[XWD .TFRAL,-4]	;REMOVE TRAPS FROM ALL INFERIORS
	TFORK			; Forks must be frozen; this has side
				; effect of forcing forks queued with
				; traps to this fork to bypass it
	 ERJMP [CALL FUNLK	; Not all forks frozen
		ITERX]		; LSTERR is already set from last ITERR
; At this point should scan the JSYS trap Q (FKJTQ) & deQ forks waiting
; on this fork and force them to resume at JTRLCK. If the forks are all
; frozen, then this should have happened already (in susend PSI code)
	RTFRK
	 ERJMP [CALL FUNLK	; Can't buy a handle
		ITERX]		; LSTERR is already set from last ITERR
	JUMPE T1,TFOR61		;WAS A TRAP PENDING?
	UTFRK
TFOR61:	MOVE T2,FORKX		;CLEAR PENDING TRAP PSI (IF ANY)
	SETZRO FKIJT,(T2)	;WHICH MAY HAVE OCCURED AFTER
				;NOINT AND BEFORE TFORK
	SETOM JTLCK		;CLEAR THE LOCK
	CALLRET FUNLK
;RTFRK JSYS - READ TRAPPED FORK
; Returns +1 always with:
; 1: Relative fork handle; 0=> no fork currently trapped
; 2: JSYS instruction or UUO that caused fork to be trapped

.RTFRK::MCENT
	LOAD T1,JTFRK		; Get job fork index
	MOVE T2,JTTRW		; Get trapped JSYS or UUO instruction
	JUMPE T1,RTFRK1		; T1=0 if no fork trapped
	PUSH P,T1		; Save it
	PUSH P,T2
	CALL GFKH		; Get relative fork handle
	 ITERR FRKHX6		; No handles left
	MOVEM T1,-1(P)		; Save relative handle
       NOSKED			; Prevent sched while clearing lock
	SETZRO JTFRK		; Clear trapped fork
	SETZM JTTRW		; And JSYS or UUO that we trapped on
	CALL JTULCK
       OKSKED
	POP P,T2		; JSYS or UUO
	POP P,T1		; Relative fork handle
RTFRK1:	UMOVEM T1,1		; Return stuff to user
	UMOVEM T2,2
	MRETNG
; UTFRK JSYS - Untrap fork
; Used to resume a trapped fork after a JSYS trap

; 1: Flags,,User handle for fork to untrap
; Flags: B0 (UT%TRP) ITRAP JSYS (or do ERJMP/ERCAL if present)
; Returns: +1 always
; NOOP if fork is not trapped or if executing fork is not permitted
; to untrap the fork (i.e. not forked trapped to or its superior).

.UTFRK::MCENT
	MOVE P2,1		; Get flags & fork handle
	MOVEI T1,(P2)		; Check fork handle
	TRNE T1,200000		; Multiple?
	 ITERR FRKHX3		; Not allowed
	CALL FLOCK		; Nail down structure
	CALL SETJFK		; Get job fork index
	CALL SKIIF		; Is it an inferior?
	 ITERR FRKHX2,<CALL FUNLK> ; No, tell user
	CALL CHKNXS		;Check if specified process is execute-only or not SELF
	HRRZ FX,SYSFK(T1)	; FORKX of fork
	CALL SETLF1		; Map PSB
	MOVEI P1,0(T1)		; Save offset to the PSB

	MOVES PSBPGA(P1)	; Touch to aviod NOSKED page fault
       NOSKED 			; Let no others run
	CALL CHKWT		; Fork waiting?
	 JRST UTFRK0		; No, NOOP
	LOAD T2,FKSTR,(FX)
	CAIE T2,FRZWT		; Is it frozen
	 JRST UTFRK0		; No, NOOP
	JE FKFRJ,(FX),UTFRK0	; NOOP if not trapped?

	LOAD T3,JTMNI,(P1)	; Job index of fork trapped to
	CAMN T3,FORKN		; Same as executing fork?
	 JRST UTFRK2		; Yes.

	HRRZ T1,T3		; Job index of fork trapped to
	MOVE T2,FORKN
	CALL SKIIFA		; Is that fork inf to ex. fork?
	 JRST UTFRK0		; No, NOOP

UTFRK2:	MOVEI T1,0(P1) 		; Offset to fork's PSB
	TLNN P2,(UT%TRP)	; Caller want us to bomb JSYS?
	IFSKP.
	  MOVE T2,PFL(T1)	;  Get the trapped process's flags
	  TXNN T2,UMODF		;  Is it a user mode PC?
	  IFSKP.
	    SETZM SLOWF(T1)	;    Yes, setup proper JSYS context
	    MOVEM T2,UPDL+1(T1)	;    Setup flags for return from ITRAP
	    MOVEM T2,UPDL+3(T1)	;    Gotta go here too
	    MOVE T2,PPC(T1)	;    Fetch user mode PC
	    MOVEM T2,UPDL+0(T1)	;    Setup PC for return from ITRAP
	    MOVEM T2,UPDL+2(T1)	;    Gotta go here too
	    MOVX T2,MONENV	;    Get flags for monitor mode startup
	    MOVEM T2,PFL(T1)	;    Install them in the other process
	  ENDIF.
	  XMOVEI T2,ITRAP	;  Get new PC to start process at
	  HRRM T2,PPC(T1)	;  Install it in the trapped processes PCB
	  XMOVEI T2,.		;FAKE PC AS IF JSP
	  MOVEM T2,PAC+T2
	ENDIF.
	MOVX T2,JTFRZ%
	OPSTRM <ANDCAB T2,>,FKINX,(FX) ; Clear JSYS trap freeze
	TXNE T2,FRZBB%		; Is fork still frozen?
	 JRST [SETOM INTDF(T1)	;YES, MAKE IT OKINT
	       JRST UTFRK0]	;AND FINISH UP
	SKIPN T2,PIOLDS(T1)	; No, resume it
	JRST [	CALL UNBLK1	; Unblock fork
		JRST UTFRK3]
	STOR T2,FKSTX,(FX)
	SETOM INTDF(T1)		; Since process not resumed, OKINT it
	CALL RECONC		; Update wait lists
UTFRK3:	CALL CLRSFK		; Clear FKINT bit 1

UTFRK0:	OKSKED 			; NOOP exit
	CALL CLRLFK
	CALL FUNLK
	MRETNG
; SCTTY - Set fork controlling TTY (Terminal PSI)
; 1: Function code,,fork handle
; 2: Source designator (only tty designator implemented)
;	Function codes:
; 0: (.SCRET) Return designator for fork in 2
; 1: (.SCSET) Set fork controlling TTY
; 2: (.SCRST) Clear fork controlling TTY (restores job CTTY)

.SCTTY::MCENT
	CALL FLOCK		; Prevent meddling
	HRRZ P1,1		; Get fork
	MOVE P2,2		; Get designator
	HLRZ P3,1		; Function number
	HRRZ T1,P1		; Fork
	CALL STJFKR		; Job fork number
	 ITERR(FRKHX1,<CALL FUNLK>)
	CALL SKIIF		; Is fork an inferior?
	 ITERR(FRKHX2,<CALL FUNLK>) ; No, that's not legal
	HRRZ P1,T1		; Update to Job fork number
	CAIL P3,0		; Check range on functions
	CAILE P3,.SCRST		; In range?
	 ITERR(SCTX1,<CALL FUNLK>) ; Undefined function code
	XCT SCTFUN(P3)		; Do it
	CALL FUNLK		; Returns here successful
	MRETNG

SCTFUN:	CALL SCTT0		; Return CTTY for fork
	CALL SCTSET		; Set CTTY
	CALL SCTCLR		; Clear it (reset to JOB's)

SCTT0:	LOAD T2,FRKTTY,(P1)	;GET CONTROLLING TERMINAL
	UMOVEM T2,2		; And hand to user
	RET

CHKSCT:	MOVX T1,SC%SCT		; Allowed to fiddle CTTY's?
	TDNN T1,CAPENB		; ..
	ITERR (SCTX4,<CALL FUNLK>)
	RET			; OK
; Function to set a new controlling TTY for a fork and its inferiors

SCTSET:	STKVAR <TTLNUM>
	CALL CHKSCT		; Quit if not allowed to do this
	MOVE T2,P2		; Get designator
	TRZN T2,1B18		; DES = 4XXXXX?
	 ITERR(DESX1,<CALL FUNLK>) ; No
	CAIGE T2,NLINES		; Check as a legal line #
	CAIGE T2,0
	 ITERR(DESX1,<CALL FUNLK>) ; Isn't
	LOKK DEVLKK
	MOVEM T2,TTLNUM
	MOVEI T1,.TTDES(T2)	;GET DESIGNATOR
	CALL CHKDEV		;VERIFY ACCESS
	 ITERR (,<UNLOKK DEVLKK
		 CALL FUNLK>)	;CAN'T
	TMNN DV%ASN,DEVCHR(T2)	;ASSIGNED BY THIS JOB?
	ITERR (DEVX2,<UNLOKK DEVLKK ;NO. NOT ASSIGNED AT ALL THEN
			CALL FUNLK>)
	MOVE T2,TTLNUM
	CAMN T2,CTRLTT		; Job CTTY?
	 ITERR(SCTX3,<UNLOKK DEVLKK
			CALL FUNLK>)
	CALL GTTOPF		; 3 := TOP FK FOR WHICH THIS TTY IS CTTY
	 CAIA			; CAN'T FAIL. GIVE ERROR IF IT DOES
	CAIE T3,-1		; Null fork?
	 ITERR(SCTX2,<UNLOKK DEVLKK
			CALL FUNLK>)
	MOVEI T1,-2		; This is just a "different" value
	CALL STTOPF		; SET TOP FORK TO "ASSIGNING"
	UNLOKK DEVLKK
	MOVE T3,P2		; Retrieve original designator
	JRST SCTT21		; Enter mainline
; Function to remove special controlling terminal from a fork and
; its inferiors. It reverts to the job's CTTY.

SCTCLR:	CALL CHKSCT		; Is process privileged to do this?
	MOVEI T3,-1		; Restore fork CTTY to job CTTY

;Here to set the designator in T3 to be the controlling terminal
; for the fork in P1.

SCTT21:	MOVE P3,T3		; New designator
	HRRZ T2,FORKN		; Fork number of self
	HRRZ T1,P1		; Job fork number we are setting
	CAIN T2,0(P1)		; Setting own CTTY?
	CALL MAPINF		; Yes, freeze inferiors only
	 CALL FFORK3		; Freeze forks (updates TTPSI words)
	HRRZ T1,P1		; Job number we are setting
	HLRZ T4,FORKN		; Top job fork
	MOVEI Q1,(T1)		; Compute pointer to its superior
	ADD Q1,SUPERP		; ..
	LDB Q1,Q1		; Job fork number of its superior
	MOVEI T2,377777		; NULL designator, just something that
				;  the previous CTTY won't be.
	CAIE T4,0(T1)		; Fork being changed=top job fork?
	LOAD T2,FRKTTY,(Q1)	; Get designator of superior's old CTTY
	HRRZ T3,P3		; New designator for desired fork's ctty
	CALL SCTT3		; Set new CTTY for fork and inferiors
	CAIN T3,-1		; Was that all set to job CTTY?
	JRST SCTT22		; Yes, skip following stuff
	MOVEI T2,-400000(T3)	; It's a real line. Must set it to know
	PUSH P,T1		;  what FORKX to poke on an interrupt char
	HRRZ T1,SYSFK(T1)	; Get system FORKX for that fork.
	CALL STTOPF		; Set top fork in TTYSRV data base
	POP P,T1		; Restore job fork number
SCTT22:	HRRZ T2,FORKN
	CAIN T2,0(P1)		; Resume the forks that we froze
	CALL MAPINF
	 CALL RFORK3		; Resume forks (updates TTPSI words)
	RET
; Change the CTTY for some fork and its inferiors
;1/ Job fork index
;2/ Superior fork's prev CTTY designator
;3/ New CTTY designator for fork in 1

SCTT3:	LOAD T4,FRKTTY,(T1)	;GET OLD CTTY
	STOR T3,FRKTTY,(T1)	; And store NEW
	CAIE T4,0(T3)		; New CTTY=old CTTY?
	CAIN T4,0(T2)		; Prev CTTY same as sup's prev CTTY?
	 JRST SCTT5		; Yes
;Here if this fork is getting a new CTTY, and it also used to have
; a CTTY which wasn't the same as its superior's CTTY.
	CAIN T4,-1		; Was prev CTTY job CTTY?
	 JRST SCTT4		; Yes, no need to fix TTFRK1
	MOVEI Q2,0(T4)		; No, prev des (assumed to be TTY des)
	TRZN Q2,1B18		; Convert to line #
	 JRST SCTT4		; Not a TTY designator
	CAIGE Q2,NLINES		; Is it valid?
	CAIGE Q2,0
	 JRST SCTT4		; No, don't touch TTFRK1
	PUSH P,T1		; Shuffle some AC's for TTYSRV calls
	PUSH P,T2		;  ..
	MOVEI T2,(Q2)		; Line number
	SETO T1,0		; CLEAR ALL BITS IN TERMINAL PSI WORD
	CALL CLRINT		; ..
	MOVEI T2,(Q2)		; Line number
	CALL STTOPF		; AND SET -1 AS TOP FORK FOR THIS TTY
	POP P,T2		; Restore ac's
	POP P,T1		;  ..

SCTT4:
;Here if a different "superior's CTTY" must be told to inferiors
	PUSH P,T2		; Save this fork's SUPERIOR's previous CTTY
	MOVEI T2,0(T4)		; Set prev CTTY for inferiors to be old
				;  CTTY of this fork.
	JRST SCTT6		; Go tell the inferiors

; Here if the "Superior's CTTY" to be told to inferiors is same as
;  the one this fork was told
SCTT5:	PUSH P,T2		; Save this fork's superior's previous CTTY
SCTT6:	HRLM T1,0(P)		; Save current fork
	CALL MAPINF
	 CALL SCTT3		; Do above for inferiors
	HLRZ T1,0(P)		; Restore current fork
	POP P,T2		; Restore previous CTTY os superior
	HRRZS T2		; Clear fork from LH (saving stack space)
	RET			; Done
	SUBTTL Program Data Vector (PDVOP% jsys)

;The PDVOP% jsys manipulates program data vectors.
;
;Accepts:	AC1/	function
;		AC2/	arg block address
;
;Returns+1:	always (unless error)	function performed

PD0LEN==1+.POADE		;SIZE BLOCK NEEDED TO HOLD ENTIRE ARG BLOCK

.PDVOP::MCENT			;DELCARE JSYS CONTEXT
	TRVAR <<OURBLK,PD0LEN>,OURSIZ,LOCUPT,LOCBLK,DATBLK,PPOMAR,POMAR,POLMAP,POPAGE,SAVPER,NREM,NEWPVS,ADRREM,PDFRKN,PONEW,FNDLOW,FNDHGH,PDVN,PDVLST,PSBOFF,PARLEN,PARAD,PCODE,<PD0,PD0LEN>>
	SETOM DATBLK		;NO BLOCK HERE YET
	SETOM LOCBLK		;NO BLOCK NEEDED TO RELEASE YET
	SETOM POLMAP		;NO MAPPED PAGE YET
	SETOM POPAGE		;NO WINDOW ADDRESS YET
	UMOVE D,A		;GET USER'S FUNCTION CODE
	CAIL D,0		;DISALLOW NEGATIVE ARG
	CAIL D,PDVAMX		;DISALLOW BLOATED ARG
	ITERR (ARGX02)		;"INVALID FUNCTION"
	UMOVE B,B		;GET USER'S ARGUMENT BLOCK ADDRESS
	MOVEM B,PARAD		;REMEMER IT
	UMOVE A,.POCT1(B)	;GET SIZE OF USER'S ARGUMENT BLOCK
	MOVEM A,PARLEN		;REMEMBER ARGUMENT BLOCK LENGTH
	LSH D,1			;ACCOUNT FOR TABLE BEING PAIRS
	MOVEM D,PCODE		;REMEMBER CODE
	CAILE A,PD0LEN		;MAKE SURE WE HAVE ROOM FOR ARGUMENT BLOCK
	ITERR (ARGX05)		;"ARGUMENT BLOCK TOO LONG" (PICKY PICKY!)
	HRRZ C,PDVTAB+1(D)	;GET REQUIRED OFFSET
	CAMG A,C		;MAKE SURE ARGUMENT BLOCK IS LONG ENOUGH
	ITERR (ARGX04)		;"ARGUMENT BLOCK TOO SMALL"
	XMOVEI C,PD0		;GET ADDRESS FOR OUR COPY OF ARG BLOCK
	CALL BLTUM		;COPY ARG BLOCK FROM USER SPACE TO OUR COPY
	MOVE A,.POADE+PD0	;GET POSSIBLE ENDING ADDRESS ARG
	MOVE B,PARLEN		;GET USER'S ARG BLOCK LENGTH
	CAIG B,.POADE		;DID USER SUPPLY AN ENDING ADDRESS?
	HRLOI A,377777		;NO, SO ASSUME NO LARGE BOUND
	SKIPN A			;YES, IS IT ZERO?
	HRLOI A,377777		;YES, SO ASSUME THE LARGEST BOUND
	CAILE B,.POADR		;NO ERROR POSSIBLE IF .POADR NOT SUPPLIED
	CAML A,.POADR+PD0	;MAKE SURE ENDING ADDRESS AS LARGE AS STARTING ADDRESS
	CAIA
	ITERR (PDVX01)		;"ENDING ADDRESS MUST BE AS LARGE AS STARTING ADDRESS"
	MOVEM A,.POADE+PD0	;IN CASE NO ENDING ADDRESS GIVEN, USE LARGE VALUE
	MOVE A,.POADR+PD0	;GET POSSIBLE LOW BOUND
	CAIG B,.POADR		;IS ONE SUPPLIED?
	MOVEI A,0		;NO, SO ASSUME 0.
	MOVEM A,.POADR+PD0
	CALL FLOCK		;DON'T LET FORK STRUCTURE CHANGE WHILE WE'RE DOING THINGS
	MOVE A,.POPHD+PD0	;GET FORK HANDLE
	CALL SETJFK		;GET FORK NUMBER
	MOVEM A,PDFRKN		;REMEMBER FORK NUMBER
	MOVE D,PCODE		;GET OFFSET INTO TABLE
	MOVX B,PDXOKF		;GET BIT SAYING EXECUTE-ONLY FORKS OK
	TDNN B,PDVTAB+1(D)	;DON'T WORRY ABOUT XONLY IF FLAG ON
	CALL CHKNXS		;MAKE SURE FORK ISN'T EXECUTE-ONLY
	MOVE A,.POPHD+PD0	;GET PROCESS HANDLE
	CALL SETLFK		;MAP IN PSB OF APPROPRIATE FORK
	MOVEM A,PSBOFF		;REMEMBER OFFSET FOR PSB
	MOVE B,PDVS(A)		;GET ADDRESS OF PDVA BLOCK (OR 0 IF NONE)
	CAIN B,0		;IS THERE ANY BLOCK YET?
	SKIPA A,[1]		;NO, PRETEND BLOCK ONLY HAS HEADER
	HRRZ A,(B)		;YES, GET LENGTH OF BLOCK
	SOJ A,			;SUBTRACT ONE FOR HEADER
	MOVEM A,PDVN		;REMEMBER NUMBER OF PDVAS IN BLOCK
	AOJ B,			;GET ADDRESS OF ACTUAL LIST OF PDVAS
	MOVEM B,PDVLST		;REMEMBER WHERE LIST OF PDVAS BEGINS
	MOVE A,PCODE		;GET VERIFIED FUNCTION CODE
	CALL @PDVTAB(A)		;DO THE SPECIFIED FUNCTION
	CALL POCLEN		;UNMAP WINDOW PAGE IF NECESSARY
	JRST CLFRET		;GIVE SUCCESS RETURN, UNLOCKING ALL.

DEFINE FEN (SYMBUL,HEISST)	;MACRO TO ALLOW ORDER-INDEPENDENT DISPATCH ASSIGNMENT
<	SYMNAM==.'SYMBUL	;;MAKE REAL SYMBOL
	RELOC PDVTAB+2*SYMNAM	;;GET TO CORRECT TABLE LOCATION
	DTBDSP SYMBUL		;;PUT DISPATCH ADDRESS IN TABLE
	HEISST			;;REMEMBER HIGHEST REQUIRED ARG OFFSET
	IFG SYMNAM-PDVAMX,<	;;KEEP TRACK OF LENGTH OF TABLE
		PDVAMX==SYMNAM+1>
	RELOC PDVTAB+2*PDVAMX	;;GET OUT OF TABLE IN CASE IT'S DONE
>

	PDVAMX==0		;;INITIALIZE TABLE SIZE TO 0

;As defined by the FEN macro, PDVTAB is organized like this:
;
;	PDVTAB:	address for function 0
;		flags,,highest arg block offset needed for function 0
;		address for function 1
;		flags,,highest arg block offset needed for function 1
;		. . .
;
;		address n
;		flags,,highest offset n
;
;		PDVAMX == n + 1 (i.e. PDVAMX is number of functions)

;The following flags may appear in PDVTAB entries:

	PDXOKF==1B0		;execute-only forks are O.K.

PDVTAB:	FEN POGET,PDXOKF!.PODAT	;GET LIST OF PDVA'S
	FEN POADD,.PODAT	;ADD SOME PDVAS TO THE LIST
	FEN POREM,.POPHD	;REMOVE SOME
	FEN POLOC,PDXOKF!.PODAT	;LOCATE PDVAS HAVING GIVEN NAME
	FEN POVER,PDXOKF!.POADR	;GET VERSION NUMBER
	FEN PONAM,PDXOKF!.POADR	;GET PROGRAM NAME

	;In all the function-specific routines, the following argument
	;block words have the same meaning when relevant:

	;	.POCT1/		total number of words in argument block
	;	.POPHD/		process handle

;POVER reads the version word out of a particular PDV.
;This function is needed for execute-only forks.
;
;Accepts:	.POADR/		PDVA of PDV being read
;		.POCT2/		must contain at least 1
;		.PODAT/		address in which to store version word
;
;Returns+1:	(user's .PODAT)/version word
;		user's .POCT2/	1

POVER:	CALL VERPDV		;VERIFY THAT WE'RE DEALING WITH A PDV
	SKIPG .POCT2+PD0	;IS THERE ROOM FOR THE ONE WORD
	JRST [	MOVE A,PARAD	;NO, GET USER'S ARG BLOCK ADDRESS
		XCTU [SETZM .POCT2(A)]	;TELL USER NOTHING WAS RETURNED
		RET]
	MOVE A,.POADR+PD0	;GET PDVA
	ADDI A,.PVVER		;GET ADDRESS OF VERSION WORD
	CALL GETWRD		;READ VERSION WORD
	MOVE B,.PODAT+PD0	;GET ADDRESS INTO WHICH RESULT SHOULD BE STORED
	UMOVEM A,0(B)		;GIVE USER THE RESULT
	MOVEI A,1
	MOVE B,PARAD
	UMOVEM A,.POCT2(B)	;TELL USER ONE WORD WAS RETURNED
	RET

;PONAM reads the ASCIZ program name from a particular PDV.
;This function is needed for execute-only forks.
;
;Accepts:	.POADR/		PDVA of PDV to be read
;		.POCT2/		maximum number of words we've room for
;		.PODAT/		address to store ASCIZ name in
;
;Returns+1:	user's .POCT2/	real length,,length of returned string

PONAM:	CALL VERPDV		;MAKE SURE WE'RE DEALING WITH A PDV
	MOVEI Q1,0		;NUMBER OF WORDS RETURNED SO FAR
	MOVE P1,.PODAT+PD0	;GET ADDRESS INTO WHICH NAME SHOULD BE STORED
	MOVE A,.POADR+PD0	;GET PDVA
	ADDI A,.PVNAM		;GET ADDRESS OF POINTER TO NAME
	CALL GETWRD		;READ ADDRESS OF PROGRAM NAME
	TXNE A,IFIW		;If section number of address of name string
	 HLL A,.POADR+PD0	; is IFIW then use section number of PDVA
	MOVE Q2,A		;REMEMBER ADDRESS OF STRING
PONAM1:	MOVE A,Q2		;GET ADDRESS OF NEXT PART OF STRING
	CALL GETWRD		;GET IT FROM OTHER FORK
	CAML Q1,.POCT2+PD0	;HAVE WE RETURNED MAXIMUM NUMBER OF WORDS YET?
	JRST PONAM3		;YES, DON'T STORE OR COUNT
	UMOVEM A,0(P1)		;NO, STORE PART OF STRING
	AOJ Q1,			;KEEP TRACK OF HOW MANY WORDS HAVE BEEN STORED
PONAM3:	AOJ P1,			;STEP TO NEXT DESTINATION ADDRESS
	TXNE A,177B6		;STRING NOT OVER UNTIL NULL SEEN SOMEWHERE IN IT
	TXNN A,177B13
	JRST PONAM2		;NULL IN ONE OF FIRST TWO SPOTS, STOP STORING
	TXNE A,177B20
	TXNN A,177B27
	JRST PONAM2		;NULL IN THIRD OR FOURTH SPOT
	TXNE A,177B34
	AOJA Q2,PONAM1		;NO NULL YET, KEEP READING NAME
PONAM2:	MOVE A,PARAD		;GET USER'S ARG BLOCK ADDRESS
	SUB P1,.PODAT+PD0	;CALCULATE LENGTH OF NAME
	HRL Q1,P1		;GIVE ACTUAL LENGTH IN LEFT HALF
	UMOVEM Q1,.POCT2(A)	;TELL USER HOW MANY WORDS WERE RETURNED
	RET

;POADD adds some PDVAs to a process.
;
;Accepts:	.POCT2/		number of PDVAs being added
;		.PODAT/		address of block of PDVAs

POADD:	MOVEI Q1,0		;NUMBER OF OVERLAPS
	MOVE Q2,.POCT2+PD0	;NUMBER OF PDVAS TO CHECK
	MOVX P2,1B0		;PREVIOUS PDVA CHECKED IN NEW BLOCK
	MOVE P1,.PODAT+PD0	;GET ADDRESS OF LIST OF PDVAS BEING ADDED
POAD1:	SOJL Q2,POAD2		;LEAVE LOOP IF ALL NEW PDVAS CHECKED
	UMOVE A,0(P1)		;GET A NEW PDVA
	MOVE B,A		;UPPERBOUND IS SAME AS LOWERBOUND
	CAMG B,P2		;MAKE SURE EACH NEW PDVA LARGER THAN PREVIOUS
	JRST [	MOVEI A,PDVX02	;ERROR IF NOT ASCENDING ORDER
		JRST POERR]
	MOVE P2,B		;REMEMBER LARGEST WE'VE SEEN SO FAR
	CALL POFND		;SEE IF THIS PDVA IS ALREADY IN THE LIST
	 AOJA P1,POAD1		;NO, GO SCAN THE REST
	AOJA Q1,.-1		;YES, REMEMBER HOW MANY OVERLAPS
POAD2:	MOVE A,.POCT2+PD0	;GET NUMBER OF NEW PDVAS GIVEN BY USER
	SUB A,Q1		;SUBTRACT OVERLAPS
	ADD A,PDVN		;ADD NUMBER ALREADY EXISTING TO GET NEW TOTAL
	CALL GETPBF		;GET A NEW BLOCK FOR THE EXPANDED LIST
	MOVEM A,PONEW		;REMEMBER POINTER TO NEW BLOCK
	AOJ A,			;GET FIRST ADDRESS INTO WHICH TO STORE A PDVA
	MOVE B,PDVLST		;GET FIRST ADDRESS OF A PDVA IN OLD LIST
	MOVE C,.PODAT+PD0	;GET USER ADDRESS OF FIRST NEW PDVA
	MOVE Q1,PDVN		;GET NUMBER OF OLD ONES TO SCAN
	MOVE Q2,.POCT2+PD0	;GET NUMBER OF NEW ONES TO SCAN
POAD3:	JUMPE Q1,POAD4		;PERHAPS NO OLD ONES LEFT TO MERGE
	MOVE D,(B)		;THERE IS AN OLD ONE LEFT, GET IT
	JUMPE Q2,POAD5		;JUMP IF NO NEW ONES LEFT TO SCAN
	UMOVE P2,0(C)		;THERE IS A NEW ONE LEFT, GET IT
	CAMLE D,P2		;SEE WHICH IS SMALLER
	JRST [	MOVEM P2,(A)	;NEW ONE SMALLER STORE IT IN NEW LIST
		AOJ C,		;REMEMBER THAT THIS NEW ONE HAS BEEN USED
		SOJ Q2,		;REMEMBER HOW MANY NEW ONES LEFT
		AOJA A,POAD3]	;KEEP MERGING LISTS
	CAMLE P2,D
	JRST [	MOVEM D,(A)	;OLD ONE SMALLER, STORE IT.
		AOJ B,		;STEP TO ADDRESS OF NEXT OLD ONE
		SOJ Q1,		;REMEMBER THAT ONE LESS OLD ONE TO SCAN
		AOJA A,POAD3]
	MOVEM D,(A)		;THEY'RE EQUAL, STORE ONE OF THEM.
	AOJ B,			;ADVANCE ADDRESS OF OLD
	AOJ C,			;ADVANCE ADDRESS OF NEW
	SOJ Q1,			;DECREASE NUMBER OF OLDS LEFT
	SOJ Q2,			;DECREASE NUMBER OF NEWS LEFT
	AOJA A,POAD3		;ADVANCE POINTER TO RESULT AND KEEP MERGING

POAD4:	MOVE B,C		;GET USER ADDRESS OF NEXT NEW ONE TO PICK UP
	MOVE C,A		;GET NEXT MONITOR ADDRESS INTO WHICH TO STORE
	MOVE A,Q2		;GET NUMBER OF NEW ONES LEFT TO STORE
	CALL BLTUM		;COPY REST OF NEW ONES INTO RESULT
	CALLRET POSWCH		;GO FINISH UP

POAD5:	MOVE C,A		;GET NEXT MONITOR ADDRESS INTO WHICH TO STORE
	MOVE A,Q1		;NEW LIST RAN OUT, GET NUMBER OF OLDS LEFT
	CALL XBLTA		;COPY REST OF OLD LIST INTO RESULT
	CALLRET POSWCH		;GO SWITCH BLOCKS AND RETURN

;POREM removes some PDVAs for a process.
;
;Accepts:	.POADR/		smallest address
;		.POADE/		largest address (optional)
;
;All PDVAs in the included address range are removed.

POREM:	MOVE A,.POADR+PD0	;GET LOWERBOUND
	MOVE B,.POADE+PD0	;GET UPPERBOUND
	CALL POFND		;DECIDE WHAT'S BEING REMOVED
	 RET			;NOTHING, SO BYE
	MOVEM A,NREM		;REMEMBER NUMBER BEING REMOVED
	MOVEM B,ADRREM		;REMEMBER ADDRESS OF BLOCK TO BE REMOVED
	SUB A,PDVN		;CALCULATE NEGATIVE PDVAS LEFT AFTER REMOVAL
	JUMPE A,POR0		;HANDLE CASE OF NONE LEFT
	MOVN A,A		;GET POSITIVE PDVAS LEFT
	CALL GETPBF		;GET NEW BLOCK
	MOVEM A,PONEW		;REMEMBER ADDRESS OF NEW BLOCK
	AOJ A,			;LOCATE BEGINNING OF PDVAS IN NEW BLOCK
	MOVEM A,NEWPVS
	MOVE A,ADRREM		;GET BEGINNING OF BLOCK TO REMOVE
	SUB A,PDVLST		;CALCULATE NUMBER OF ONES TO PRESERVE IN FRONT OF REMOVAL
	MOVE B,PDVLST		;COPY FROM OLD BLOCK
	MOVE C,NEWPVS		;COPY INTO NEW BLOCK
	CALL XBLTA		;COPY PRESERVED STUFF
	MOVE B,ADRREM		;GET ADDRESS OF FIRST REMOVAL
	ADD B,NREM		;GET ADDRESS OF FIRST ONE BEYOND REMOVAL
	MOVE A,PDVLST		;GET ADDRESS OF FIRST OLD ONE
	ADD A,PDVN		;GET SMALLEST ADDRESS BEYOND LIST
	SUB A,B			;CALCULATE NUMBER OF PDVAS AFTER REMOVAL
	CALL XBLTA		;COPY STUFF BEYOND REMOVAL INTO NEW BLOCK
	CALLRET POSWCH		;SWITCH BLOCKS AND RETURN

POR0:	SETZM PONEW		;SAY THERE'S NO BLOCK ANYMORE
	CALLRET POSWCH		;CLEAR OLD BLOCK AND RETURN

;POSWCH replaces an old PDV block with a new, releasing the space taken up
;by the old.
;
;Accepts:	PONEW/	pointer to new block

POSWCH:	MOVE B,PONEW		;GET NEW BLOCK ADDRESS
	MOVE Q1,PSBOFF		;GET OFFSET INTO PSB
	EXCH B,PDVS(Q1)		;STORE NEW POINTER, GET OLD
	MOVEI A,JSBFRE		;SAY JSB FREE SPACE
	JUMPE B,R		;DON'T TRY TO RELEASE NONEXISTENT BLOCK
	CALLRET RELFRE		;RELEASE OLD BLOCK AND RETURN


;POLOC gets the pdvas for pdvs having a specified program name.
;
;Accepts:	.POCT2/		maximum pdvas to return
;		.POADR/		smallest pdva of interest
;		.POADE/		largest pdva of interest
;		User's AC3/	pointer to ASCIZ string
;
;Returns:	User's .POCT2/	number found,,number returned
;		User's .PODAT/	the pdvas

POLOC:	MOVE A,.POADR+PD0	;LOCATE RANGE USER IS INTERESTED IN
	MOVE B,.POADE+PD0
	CALL POFND
	 NOP			;WE SHOULD BE ABLE TO HANDLE 0 IN NORMAL FASHION
	MOVE P1,B		;REMEMBER WHERE FIRST ONE IS
	MOVE Q2,A		;REMEMBER HOW MANY PDVS TO LOOK AT
	UMOVE A,C		;GET USER'S POINTER TO NAME
	CALL CPYFUS		;COPY NAME INTO OUR ADDRESS SPACE
	 JRST POX02		;CAN'T, JSB FULL
	HRRZM A,LOCBLK		;REMEMBER POINTER TO FREE SPACE BLOCK WE'RE TYING UP
	HRROI A,1(A)		;MAKE BYTE POINTER TO NAME
	MOVEM A,LOCUPT		;REMEMBER POINTER TO USER'S STRING
	HRRZ B,@LOCBLK		;GET SIZE BLOCK WE'LL NEED FOR READING NAMES INTO
	SOJ B,			;DISCOUNT HEADER TO GET SIZE DATA BLOCK
	MOVEM B,OURSIZ		;Save size of block
	AOJ B,			;INCLUDE HEADER TO GET OUR BLOCK
	CALL ASGJFR		;GET BLOCK FOR READING NAMES INTO
	 JRST POX02		;NO ROOM FOR THIS BLOCK
	MOVEM A,DATBLK		;REMEMBER POINTER TO OUR BLOCK
	AOJ A,			;GET OVER HEADER
	MOVEM A,.PODAT+OURBLK	;ESTABLISH WHERE OUR DATA BLOCK IS
	MOVE A,.POPHD+PD0	;GET FORK WE'RE LOOKING AT
	MOVEM A,.POPHD+OURBLK	;SET UP FOR OUR OWN PDVOP% JSYS
	MOVEI A,1+.POADR	;SPECIFY HOW MUCH OR OUR ARG BLOCK IS USED
	MOVEM A,.POCT1+OURBLK
	MOVE Q1,.POCT2+PD0	;GET MAXIMUM NUMBER OF PDVAS TO RETURN
	MOVE P2,.PODAT+PD0	;GET NEXT ADDRESS TO STORE A PDVA IN
	MOVEI P3,0		;NUMBER OF MATCHING PDVAS FOUND
POL1:	SOJL Q2,POL2		;LEAVE LOOP IF NO MORE PDVAS TO EXAMINE
	MOVE A,(P1)		;GET NEXT PDVA OF PDV TO READ
	MOVEM A,.POADR+OURBLK	;SAY WHICH PDVA WE WANT THE NAME OF
	MOVEI A,.PONAM		;SPECIFY THAT WE ARE READING A NAME
	MOVE B,OURSIZ		;Get block size
	MOVEM B,.POCT2+OURBLK	;Set it up
	MOVEI B,OURBLK		;TELL PDVOP% WHERE THE ARG BLOCK IS
	PDVOP%			;READ THE NAME IN THIS PDV
	 ERJMP [MOVE A,LSTERR	;FAILED, TELL CALLER WHY
		JRST POERR]
	MOVE A,LOCUPT		;GET POINTER TO USER'S STRING
	HRRO B,.PODAT+OURBLK	;POINT AT NAME OF CURRENT PDV
	STCMP%			;COMPARE THE TWO NAMES
	 ERJMP [MOVE A,LSTERR	;FAILED, SO SAY WHY AND DIE.
		JRST POERR]
	JUMPE A,[AOJ P3,	;REMEMBER HOW MANY HAVE BEEN FOUND
		SOJL Q1,.+1	;THIS ONE MATCHES, JUMP IF NO ROOM FOR IT
		MOVE A,.POADR+OURBLK	;ROOM, GET THE MATCHING ONE
		UMOVEM A,(P2)	;STORE IN USER SPACE
		AOJA P2,.+1]	;STEP TO NEXT SLOT IN WHICH TO STORE ONE
	AOJA P1,POL1		;LOOP TO EXAMINE REST OF PDVS

POL2:	MOVE A,PARAD		;DONE STORING, GET USER'S ARG BLOCK ADDRESS
	SUB P2,.PODAT+PD0	;CALCULATE QUANTITY ACTUALLY RETURNED
	HRL P2,P3		;GIVE NUMBER FOUND,,NUMBER RETURNED
	UMOVEM P2,.POCT2(A)	;GIVE TO USER
	RET			;DONE

;POGET gets the addresses of PDVs for the specified process.
;
;Accepts:	.POCT2/		maximum PDVAs to return
;		.POADR/		address to scan up from
;		.POADE/		largest address to return (optional)
;
;Returns:	user's .POCT2/	number found,,number returned

POGET:	MOVE A,.POADR+PD0	;GET RANGE TO SEARCH
	MOVE B,.POADE+PD0
	CALL POFND		;FIND INTERESTING SET OF PDVAS
	 NOP			;IF NONE FOUND, WE'LL "DO" 0
	MOVE D,PARAD		;GET USER'S ARG BLOCK ADDRESS
	HRL C,A		;GET COUNT BEFORE TRIMMING
	CAMLE A,.POCT2+PD0	;ARE THERE MORE GOOD PDVAS THAN USER WANTS?
	MOVE A,.POCT2+PD0	;YES, TRIM QUANTITY
	HRR C,A			;GET NUMBER REALLY BEING DELIVERED
	UMOVEM C,.POCT2(D)	;TELL USER HOW MANY PDVAS WE'RE REALLY GIVING.
	MOVE C,.PODAT+PD0	;GET ADDRESS WHERE USER WANTS PDVAS PUT
	CALLRET BLTMU		;GIVE USER THE PDVAS

;Come to POGET0 to explicitly return zero (0) PDVAs to the user

POGET0:	MOVE D,PARAD		;GET USER'S ARG BLOCK ADDRESS
	XCTU [SETZM .POCT2(D)]	;TELL HER NO PDVAS HAVE BEEN RETURNED
	RET

;VERPDV verifies that the given pdva is really a pdva.
;
;Accepts:	.POADR+PD0/	pdva being verified
;
;Returns+1:	yes

VERPDV:	MOVE A,.POADR+PD0	;GET PDVA BEING VERIFIED
	MOVE B,A		;WE ONLY WANT TO SEARCH FOR ONE
	CALL POFND		;TRY TO FIND THE SPECIFIED PDVA
	 CAIA			;GIVE ERROR IF NOT FOUND
	RET			;IT'S FOUND, SO IT'S O.K.
	MOVEI A,PDVX03		;SAY "NON-PDV GIVEN"
	CALLRET POERR		;GO GIVE ERROR

;POFND finds a subset of PDVAs in the stored list.
;
;Accepts:	A/		smallest PDVA of interest
;		B/		largest PDVA of interest
;		PDVLST/		address of first PDVA
;		PDVN/		total number of PDVAs in list
;
;Returns+1:	no interesting ones found, A/	0
;	+2:	A/		number of interesting ones found
;		B/		address of first interesting one

POFND:	MOVEM A,FNDLOW		;SAVE LOWERBOUND
	MOVEM B,FNDHGH		;SAVE UPPERBOUND
	MOVE A,PDVLST		;GET SMALLEST POSSIBLE BOUND
	MOVE C,PDVN		;GET TOTAL PDVAS TO SCAN
	MOVE B,FNDLOW		;GET SMALLEST INTERESTING POSSIBLE PDVA
POF0:	SOJL C,RFALSE		;IF COUNT RUNS OUT, WE FOUND NONE
	CAMLE B,(A)		;IS THIS PDVA LARGE ENOUGH?
	AOJA A,POF0		;NO, KEEP SCANNING
	MOVE B,FNDHGH		;GET LARGEST INTERESTING POSSIBLE PDVA
	MOVE D,A		;REMEMBER SMALL INTERESTING ADDRESS
	CAIA			;CONSIDER CURRENT WORD WITH UPPERBOUND
POF1:	SOJL C,POFDON		;IF COUNT RUNS OUT, WE'VE FOUND ENTIRE SET
	CAML B,(A)		;IS TEST PDVA SMALL ENOUGH?
	AOJA A,POF1		;YES, EXPAND RANGE
POFDON:	SUB A,D			;CALCULATE NUMBER OF GOOD ADDRESSES OF PDVAS
	JUMPLE A,RFALSE		;IF NONE, SAY SO
	MOVE B,D		;GET FIRST GOOD ADDRESS
	RETSKP			;SKIP TO SAY SOME FOUND

;POX02 is for handling failures from attempts to get free space, when
;the reason is that JSB free space is full.

POX02:	MOVEI A,MONX02		;SAY JSB FULL
	CALLRET POERR

;POERR causes ITRAP from PDVOP% jsys, unlocking what's necessary first.
;
;Accepts:	A/	error code

POERR:	MOVEM A,SAVPER		;SAVE ERROR CODE
	CALL POCLEN		;UNMAP POSSIBLE WINDOW
	CALL CLRLFK		;UNMAP FORK'S PSB
	CALL FUNLK		;UNLOCK FORK STRUCTURE
	MOVE A,SAVPER		;GET ERROR CODE
	ITERR			;CAUSE ERROR RETURN

;POCLEN does CLEAN up stuff.

POCLEN:	SKIPL A,POPAGE		;IS THERE A WINDOW?
	CALL RELPAG		;YES, RELEASE IT
	MOVEI A,JSBFRE		;PREPARE TO RELEASE FREE SPACE
	SKIPL B,LOCBLK		;BLOCK HERE TO RELEASE?
	CALL RELFRE		;YES, RELEASE IT
	MOVEI A,JSBFRE		;PREPARE TO RELEASE FREE SPACE
	SKIPL B,DATBLK		;BLOCK HERE TO RELEASE?
	CALL RELFRE		;YES, RELEASE IT
	RET

;GETPBF gets a PDV block from JSB free space.
;
;Accepts:	A/	number of PDVAs to be stored
;
;Returns+1:	A/	address of block, or 0 if none were to be stored

GETPBF:	JUMPE A,R		;IF NEED 0 WORDS, RETURN 0
	AOS B,A			;LEAVE ROOM FOR HEADER
	CALL ASGJFR		;ASSIGN JSB FREE SPACE
	 JRST POX02		;CAN'T, JSB FULL
	RET

;GETWRD reads a word from another fork in the job.
;
;Accepts:	.POPHD+PD0/	fork handle
;		A/		address whose contents is to be read
;				Note: should be a 30-bit address.
;				Callers should resolve IFIW words.
;		POLMAP/		number of page currently mapped, or -1
;		POPAGE/		page window, or -1 if not set up yet
;
;Returns+1:	A/	data from word, or 0 if can't read

GETWRD:	MOVEM A,POMAR		;REMEMBER ADDRESS BEING SOUGHT
	LSH A,-9		;MAKE PAGE NUMBER
	MOVEM A,PPOMAR		;REMEMBER PAGE
	CAMN A,POLMAP		;IS CORRECT PAGE MAPPED ALREADY?
	JRST GET1		;YES, PIECE OF CAKE.
	MOVEM A,POLMAP		;NO, SO REMEMBER THAT WE'RE MAPPING IT NOW
	SKIPL B,POPAGE		;IS THERE A WINDOW ESTABLISHED YET?
	JRST GET2		;YES
	CALL ASGPAG		;NO, GET A PAGE
	 JRST POX02		;CAN'T JSB FULL
	MOVEM A,POPAGE		;REMEMBER ADDRESS OF WINDOW PAGE
GET2:	HRL A,.POPHD+PD0	;GET FORK HANDLE
	HRR A,PPOMAR		;GET DESIRED PAGE
	MOVX B,PM%EPN		;Extended page numbers
	CALL FKHPTN		;GET PTN,,PAGE
	 JRST POERR		;FAILED, ERROR CODE IN A
	MOVE B,POPAGE		;GET ADDRESS TO MAP PAGE INTO
	TXO B,PM%RD		;SAY WE WANT TO READ IT
	CALL SETMPG		;SET UP THE MAPPING
GET1:	MOVE A,POPAGE		;GET ADDRESS INTO WHICH DATA IS NOW MAPPED
	LDB B,[001100,,POMAR]	;GET OFFSET INTO PAGE
	ADD B,A			;MAKE ADDRESS IN WINDOW
	MOVEI A,0		;GET 0 IN CASE DATA CAN'T BE READ
	MOVE A,(B)		;REFERENCE THE DATA
	 ERJMP .+1		;RETURN 0 IF PAGE UNREADABLE
	RET

	TNXEND
	END