Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - mit/monitor/new-fork.mac
There are no other files named new-fork.mac in the archive.
;1022 Allow .NULIO in SCTTY.  This can have problems - if a STIW or ATI
;	is done by the fork with the NULL controlling tty, the bits will 
;	not get set in the PSI mask for any TTY, so when a real TTY is 
;	restored, the interrupts won't happen.  Could fix by wandering
;	back up the tree looking for a real tty and arm the PSI bits
;	for that one, under the assumption that that is the TTY that
;	is going to get restored.  Should usually win.
;1001 Multinet merge
;1000 V5 merge

;293 Fix from WOHL@CMU for CRJOB bug
;267 Fix GTOK for enabling capabilities, 'cuz DEC does it at WRONG time!
;27 Added support for signal jfn

; UPD ID= 575, SNARK:<5.MONITOR>FORK.MAC.45,  13-Apr-82 17:01:28 by PAETZOLD
;TCO 5.1774 - Fix SCVEC% -1.
; UPD ID= 561, SNARK:<5.MONITOR>FORK.MAC.44,  24-Mar-82 09:19:57 by PAETZOLD
;TCO 5.1768 - Turn FLKTIM lock reset code back on
; UPD ID= 550, SNARK:<5.MONITOR>FORK.MAC.42,  18-Mar-82 03:20:39 by PAETZOLD
;TCO 5.1761 - Fix LOKK macro in SCTSET
; UPD ID= 533, SNARK:<5.MONITOR>FORK.MAC.41,  11-Mar-82 21:44:51 by PAETZOLD
;TCO 5.1751 - Zero PATLEV when zeroing PATADR in SEVC
; UPD ID= 447, SNARK:<5.MONITOR>FORK.MAC.40,  29-Jan-82 11:29:37 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= 443, SNARK:<5.MONITOR>FORK.MAC.39,  26-Jan-82 18:43:41 by MURPHY
;DITTO
; UPD ID= 439, SNARK:<5.MONITOR>FORK.MAC.38,  25-Jan-82 00:01:20 by MURPHY
;TCO 5.1697 - XSSEV%, etc.  Move GETPAT and GETDMS from MEXEC.MAC to here.
; UPD ID= 431, SNARK:<5.MONITOR>FORK.MAC.37,  22-Jan-82 07:03:52 by GRANT
;Typo in previous edit
; UPD ID= 430, SNARK:<5.MONITOR>FORK.MAC.36,  22-Jan-82 06:47:12 by GRANT
;TCO 5.1695 - Add "interruptable test" to WAIT JSYS
; UPD ID= 414, SNARK:<5.MONITOR>FORK.MAC.35,  19-Jan-82 08:03:49 by MILLER
;MORE OF THE SAME
; UPD ID= 412, SNARK:<5.MONITOR>FORK.MAC.33,  18-Jan-82 18:43:02 by MILLER
;TCO 5.1678 again. Release TTY if top fork and FRKTTY is set
; UPD ID= 411, SNARK:<5.MONITOR>FORK.MAC.32,  18-Jan-82 17:46:59 by MILLER
; UPD ID= 409, SNARK:<5.MONITOR>FORK.MAC.31,  18-Jan-82 14:27:07 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= 388, SNARK:<5.MONITOR>FORK.MAC.30,   9-Jan-82 19:37:19 by PAETZOLD
;TCO 5.1662 - Unlock FKLOCK during error processing for MSETPT in CFK4
; UPD ID= 313, SNARK:<5.MONITOR>FORK.MAC.29,   6-Nov-81 12:29:18 by MURPHY
;TCO 5.1608 - extended address for MSFRK.
; UPD ID= 306, SNARK:<5.MONITOR>FORK.MAC.27,   3-Nov-81 15:51:46 by FLEMMING
; UPD ID= 268, SNARK:<5.MONITOR>FORK.MAC.26,  16-Oct-81 17:15:21 by MURPHY
;More TCO 5.1265 - Ignore FH%EPN bit in fork handles.
; UPD ID= 267, SNARK:<5.MONITOR>FORK.MAC.25,  16-Oct-81 17:10:06 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= 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
;<4.MONITOR>FORK.MAC.237,  9-Nov-79 16:24:20, EDIT BY HALL
;CIS JSYS - DON'T CLEAR PSXSIR BECAUSE LEVTAB AND CHNTAB AREN'T CLEARED
;<4.MONITOR>FORK.MAC.236,  3-Nov-79 07:54:32, EDIT BY R.ACE
;FIX NON-ZERO SECTION DELETION IN KSELF
;<4.MONITOR>FORK.MAC.235, 29-Oct-79 10:44:21, EDIT BY MILLER
;FIX CODE AT MAPBLW
;<4.MONITOR>FORK.MAC.234, 20-Oct-79 14:03:28, EDIT BY MILLER
;TWO CHANGES. EDIT BY HALL: APPLY PCS IN FKHPTN IF
; FORK HANDLE IS SELF AND SECTION NUMBER IS 0. EDIT BY MILLER:
; FIX MAPFKH TO ALLOW COROUTINE TO SPECIFY BLOCKING
;<4.MONITOR>FORK.MAC.232, 12-Oct-79 13:28:27, EDIT BY MURPHY
;FURTHER REVISION OF SFORK TO PREVENT RACES
;<4.MONITOR>FORK.MAC.231,  9-Oct-79 15:36:26, EDIT BY MILLER
;BRACKET CODE IN SFORK THAT PROCESSES GETOK AND JSB STACK
; WITH OKSKED AND NOSKED
;<4.MONITOR>FORK.MAC.230,  1-Oct-79 15:43:34, EDIT BY HALL
;REMOVE ENTRY FKHPTA FROM ROUTINE FKHPTN -- NEED TO PROHIBIT PMAP
;AT A HIGHER LEVEL THAN THIS IF AT ALL
;<4.MONITOR>FORK.MAC.229,  1-Oct-79 15:34:03, EDIT BY HALL
;XSIR - FIX BUG IN XOR FOR LEVTAB
;CIS - CLEAR FLAG FOR EXTENDED SIR
;<4.MONITOR>FORK.MAC.228,  1-Oct-79 08:18:56, EDIT BY R.ACE
;FIX COMPUTATION OF END OF CHANNEL TABLE AND LEVEL TABLE
;<4.MONITOR>FORK.MAC.227, 29-Sep-79 14:51:06, EDIT BY HALL
;FKHPTN - REMOVE TEMPORARY COMMENT AND ALREADY-COMMENTED-OUT LITERAL
;RESTORE RIR, MAKE XRIR
;RESTORE SIR, MAKE XSIR
;<4.MONITOR>FORK.MAC.226, 28-Sep-79 18:50:17, EDIT BY HELLIWELL
;<4.MONITOR>FORK.MAC.225, 28-Sep-79 18:09:42, EDIT BY HELLIWELL
;TEST FOR PSUTPS IN KSELF AND CALLS TTDTPS IF SET
;THIS REMOVES THE FORK # FROM ANY TTY DATABASES WHICH MAY HAVE IT
;SET FOR NON-CONTROLLING TERMINAL INTERRUPTS
;<4.MONITOR>FORK.MAC.224, 26-Sep-79 15:47:14, EDIT BY HALL
;RFACS - CALL BLTMU1 INSTEAD OF BLTMU FOR EXTENDED ADDRESSING
;CFK1 AND .SFACS - CALL BLTUM1 INSTEAD OF BLTUM FOR EXTENDED ADDRESSING
;<4.MONITOR>FORK.MAC.223, 21-Sep-79 13:44:43, EDIT BY MURPHY
;MAKE SUSFK RETURN NOSKED LIKE IT USTA - PREVENTS RACES
;<4.MONITOR>FORK.MAC.222, 13-Sep-79 11:10:29, EDIT BY HALL
;FUNLK - IMPROVE EDIT 220 BY DETECTING OVERLY DECREMENTED FLKCNT
;<OSMAN.MON>FORK.MAC.1, 10-Sep-79 15:30:33, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>FORK.MAC.220,  7-Sep-79 17:24:31, EDIT BY HALL
;FUNLK - DON'T LET FLKCNT GO BELOW ZERO
;<4.MONITOR>FORK.MAC.219, 30-Aug-79 08:48:14, EDIT BY R.ACE
;FIX BAD FORK INDEX IN FFORK1
;<4.MONITOR>FORK.MAC.218, 17-Aug-79 10:55:49, EDIT BY HALL
;PTNFKH - CONVERT PAGE NUMBER IN NON-ZERO SECTION TO ABSOLUTE
;PAGE NUMBER, RETURN +1 AND +2
;<4.MONITOR>FORK.MAC.217, 11-Aug-79 07:55:29, EDIT BY HALL
;ADD NEW ENTRY POINT TO FLOCK TO ALLOW NESTED LOCKING.
;<4.MONITOR>FORK.MAC.216, 28-Jul-79 11:53:52, EDIT BY R.ACE
;RIR - INDEX BY T1 WHEN LOADING FROM CHNTAB AND LEVTAB
;<4.MONITOR>FORK.MAC.215, 26-Jul-79 15:22:19, EDIT BY HALL
;RIR - FIX LOADING OF LEVTAB INTO T2 FOR OLD STYLE RIR
;<4.MONITOR>FORK.MAC.214, 15-Jul-79 11:40:14, EDIT BY HALL
;FKHPTN - DON'T GIVE PMAPX4 ERROR WHEN NON-ZERO SECTION IS
;MAPPED TO AN OFN
;<4.MONITOR>FORK.MAC.213, 13-Jul-79 16:19:39, EDIT BY HALL
;PROVIDE EXTENDED VERSIONS OF SIR AND RIR
;<4.MONITOR>FORK.MAC.212, 21-Jun-79 14:44:05, EDIT BY DBELL
;MORE TCO 4.2283 - MAKE CFORK SET SFSRT IF CR%ST WAS SET
;<4.MONITOR>FORK.MAC.211, 14-Jun-79 12:13:54, EDIT BY DBELL
;FIX TCO 4.2283 BY CORRECTLY OBTAINING JOB FORK NUMBER
;<4.MONITOR>FORK.MAC.210, 11-Jun-79 19:53:24, EDIT BY DBELL
;TCO 4.2283 - DON'T ALLOW SFORK TO DO CONTINUES UNTIL FORK HAS BEEN STARTED
;<4.MONITOR>FORK.MAC.209,  8-Jun-79 14:07:18, EDIT BY DBELL
;TCO 4.2280 - FIX RACE IN CFORK CONCERNING ASSIGNMENT OF JOB FORK SLOTS
;<4.MONITOR>FORK.MAC.208, 10-May-79 15:35:45, EDIT BY HALL
;TCO 4.2243 - FIX TWO BUGS IN .FFORK - PRESERVE T1 OVER CALL
;TO FFORK1, AND FIX UP  T2 BEFORE GETTING THE CONTROLLING TERMINAL
;FOR CALLING FORK
;<4.MONITOR>FORK.MAC.207, 30-Apr-79 17:51:56, EDIT BY MILLER
;MAKE FLOCK WAIT TIME 200 MS
;<4.MONITOR>FORK.MAC.206, 23-Apr-79 13:58:36, Edit by MCLEAN
;RETURN EPCAP TO WHAT IT WAS EARLIER.....
;<4.MONITOR>FORK.MAC.205, 21-Apr-79 19:56:40, Edit by MCLEAN
;DUMB IDEA BUT MAKE .EPCAP QUIETLY RETURN ON GETOK FAILURE
;<4.MONITOR>FORK.MAC.204, 14-Apr-79 22:36:12, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.203, 14-Apr-79 22:16:42, Edit by MCLEAN
;ADD KILL FOR ACJ FORK
;<4.MONITOR>FORK.MAC.202, 11-Apr-79 12:53:33, Edit by MCLEAN
;FIX FORK COUNT IN CFORK TO BE EARLIER
;<4.MONITOR>FORK.MAC.201,  5-Apr-79 11:51:18, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.200,  5-Apr-79 11:47:19, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.199,  5-Apr-79 11:23:02, Edit by MCLEAN
;REMOVE 1ST ARG FROM GTOKM
;<4.MONITOR>FORK.MAC.198,  4-Apr-79 13:17:58, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.197,  4-Apr-79 13:16:58, Edit by MCLEAN
;FIX .CFORK SO GETOK IS EARLIER
;<4.MONITOR>FORK.MAC.196,  4-Apr-79 13:08:15, Edit by MCLEAN
;MAKE .GOCFK RETURN CURRENT NUMBER NOT NEXT NUMBER IF SUCCESS
;<4.MONITOR>FORK.MAC.195, 23-Mar-79 11:13:14, EDIT BY HALL
;FLOCK - PRINT FORK NUMBER AND JOB NUMBER IN FLKTIM BUGCHK
;<4.MONITOR>FORK.MAC.194, 22-Mar-79 13:10:42, Edit by MCLEAN
;FIX CALLS TO GOKFRE TO HAVE CORRECT ARGUMENTS AND MAKE NTCOFF NOT SKIP OVER MOVEI
;<4.MONITOR>FORK.MAC.193, 13-Mar-79 18:08:16, Edit by HURLEY
;REMOVE GETOK FROM FORK
;<4.MONITOR>FORK.MAC.192, 11-Mar-79 21:00:35, Edit by MCLEAN
;FIX GETOK IN EPCAP AND FORK
;<4.MONITOR>FORK.MAC.191,  4-Mar-79 17:18:08, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>FORK.MAC.190, 18-Feb-79 13:45:23, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.189, 18-Feb-79 13:33:29, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.188, 18-Feb-79 13:30:58, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.187, 18-Feb-79 13:27:05, Edit by MCLEAN
;MORE GETOK FIXES FOR FORK COUNT AND EPCAP
;<4.MONITOR>FORK.MAC.186, 17-Feb-79 13:41:25, EDIT BY DBELL
;IN KSELF, RELEASE PAGE USED BY MDDT
;<4.MONITOR>FORK.MAC.185,  8-Feb-79 13:47:31, EDIT BY MILLER
;FIX SFORK CONTINUE NOT TO LOSE BLOCKED STATE
;<4.MONITOR>FORK.MAC.184, 16-Jan-79 11:03:59, EDIT BY MILLER
;CHECK FOR SECTION ZERO PAGE IN FKHPTN AND DO FAST COMPUTATION OF PTN.PN
;<4.MONITOR>FORK.MAC.183, 15-Jan-79 14:06:18, Edit by KONEN
;ADD CHECK FOR ALLOWING USE OF STR, EVEN IF NOT INCREMENTED
;<4.MONITOR>FORK.MAC.182,  2-Jan-79 16:05:24, Edit by MCLEAN
;FIX EPCAP SO GETOK IS ONLY FOR A CHANGE
;<4.MONITOR>FORK.MAC.181, 21-Dec-78 11:23:45, EDIT BY ENGEL
;CLEAN UP NETWORK TOPOLOGY CHANGE INTERRUPT TABLES AT KSELF
;<4.MONITOR>FORK.MAC.180, 19-Dec-78 15:30:56, EDIT BY MURPHY
;ADD BLOCK PRIORITY TO VARIOUS SCHED CALLS
;<4.MONITOR>FORK.MAC.179, 17-Dec-78 01:26:31, Edit by MCLEAN
;FIX SUSFK SO IT RETURNS OKSKED
;<4.MONITOR>FORK.MAC.178, 11-Dec-78 18:45:38, Edit by MCLEAN
;FIX EPCAP TO GIVE CORRECT WORD TO GETOK
;<4.MONITOR>FORK.MAC.177,  7-Dec-78 14:29:05, EDIT BY MURPHY
;NEW SWAP LOGIC
;<4.MONITOR>FORK.MAC.176,  9-Nov-78 13:26:19, EDIT BY OSMAN
;ADD WAIT1::
;<KONEN>FORK.MAC.3, 10-Aug-78 11:15:17, Edit by KONEN
;ADD CODE TO KSELF TO CLEAR FORK STRUCTURE MOUNTS
;<4.MONITOR>FORK.MAC.174, 23-Oct-78 15:10:14, EDIT BY MILLER
;BE CKSED WITH FORK LOCK LOCKED
;<4.MONITOR>FORK.MAC.173, 13-Oct-78 13:36:35, EDIT BY R.ACE
;CHANGE SMAP TO SMAP%
;<4.MONITOR>FORK.MAC.172, 19-Sep-78 06:48:56, EDIT BY R.ACE
;TCO 4.2013 - ADDED CHKINT TO EIR JSYS
;<4.MONITOR>FORK.MAC.171, 16-Sep-78 13:46:58, EDIT BY MILLER
;MORE FIXES TO MSFRK
;<4.MONITOR>FORK.MAC.170, 16-Sep-78 13:37:18, EDIT BY MILLER
;MAKE ANY FORK STARTED WITH MSFRK HAVE PRIROITY
;<4.MONITOR>FORK.MAC.169, 15-Sep-78 11:02:42, EDIT BY MILLER
;ALLOW SJPRI IF CALL IS FROM MONITOR
;<4.MONITOR>FORK.MAC.168, 28-Aug-78 08:14:09, EDIT BY MILLER
;ADD FKHPTA TO ALLOW "MAPPING" OF ANY SECTION
;<4.MONITOR>FORK.MAC.167, 18-Aug-78 12:46:50, EDIT BY MILLER
;DISALLOW FKHPTN IF SECTION IS A "FILE SECTION"
;<4.MONITOR>FORK.MAC.166, 17-Aug-78 08:58:22, EDIT BY MILLER
;MAKE FKHPTN ACCEPT ANY VALID SECTION
;<4.MONITOR>FORK.MAC.165, 15-Aug-78 14:17:01, Edit by PORCHER
;MAKE SFORK-SF%CON LEAVE PRE-FREEZE STATE ALONE
; IF PROCESS NOT HALTED OR FORCED TERMINATION
;<4.MONITOR>FORK.MAC.164, 15-Aug-78 08:04:50, EDIT BY MILLER
;MAKE NOOP WITH SF%CON A NOOP IF FORK NOT HALTED
;<4.MONITOR>FORK.MAC.163, 31-Jul-78 13:26:35, EDIT BY MILLER
;<4.MONITOR>FORK.MAC.162, 28-Jul-78 13:42:23, EDIT BY MILLER
;MORE FIXES TO SMAP CODE
;<4.MONITOR>FORK.MAC.161, 28-Jul-78 09:25:45, EDIT BY MILLER
;FIX SMAP REFERECNE
;<4.MONITOR>FORK.MAC.160, 28-Jul-78 01:18:47, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.159, 25-Jul-78 15:02:48, Edit by PORCHER
;MORE...
;<4.MONITOR>FORK.MAC.158, 25-Jul-78 12:00:36, Edit by PORCHER
;TCO 1952 - ADD SF%CON FUNCTION TO SFORK - CONTINUE PROCESS
;ALLOW WHEELS TO DIDDLE EXECUTE-ONLY PROCESSES
;<4.MONITOR>FORK.MAC.157, 25-Jul-78 08:10:20, EDIT BY MILLER
;DO AN SMAP IN KSELF
;<4.MONITOR>FORK.MAC.156, 19-Jul-78 01:58:29, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.155, 18-Jul-78 00:12:27, Edit by MCLEAN
;TCO 1939 KILL MAGTAPE ONLINE/OFFLINE PSI'S ON KILLING FORKS
;<4.MONITOR>FORK.MAC.154,  6-Jul-78 16:52:11, EDIT BY MILLER
;TCO 1929 AGAIN. FIX SJPRI TO SCAN MAPPED JSB AND FIND ALL FORKS IN JOB
;<4.MONITOR>FORK.MAC.153,  6-Jul-78 07:26:34, EDIT BY MILLER
;MORE FIXES FOR LOW AND HIGH Q (TCO 1929)
;<4.MONITOR>FORK.MAC.152,  5-Jul-78 16:09:16, EDIT BY MILLER
;TCO 1929. INT PROCESS WHENVER PRIORITY MIGHT EFFECT FKMNQ
;<4.MONITOR>FORK.MAC.151, 19-Jun-78 21:54:32, EDIT BY BOSACK
;<1BOSACK>FORK.MAC.1000,  5-Jun-78 18:42:33, EDIT BY BOSACK
;<4.MONITOR>FORK.MAC.149, 19-Jun-78 14:48:45, Edit by MCLEAN
;TCO 1908 GETOK JSYS ADD OF GOKFRE
;<4.MONITOR>FORK.MAC.148, 18-Jun-78 17:32:29, Edit by MCLEAN
;REMOVE EXTRANEOUS CODE IN .CIS
;<4.MONITOR>FORK.MAC.147, 26-May-78 09:02:43, EDIT BY MILLER
;FIX ERROR IN RFSTS. NEED TO PRESERVE TO OVER CALL TO MRFSTS
;<4.MONITOR>FORK.MAC.146, 23-May-78 11:33:27, Edit by PORCHER
;MORE ON TCO # 1912 - LONG FORM OF RFSTS CALL
;<4.MONITOR>FORK.MAC.145, 24-Apr-78 16:15:26, Edit by BORCHEK
;MORE NSW FIXES
;<4.MONITOR>FORK.MAC.144, 22-Apr-78 18:27:20, Edit by BORCHEK
;NSW FIXES TO GFRKH FROM BBN
;<4.MONITOR>FORK.MAC.143, 22-Apr-78 15:50:30, Edit by BORCHEK
;DELETE EXTRA OKINT IN SCTT0:
;<4.MONITOR>FORK.MAC.141, 16-Apr-78 04:45:51, Edit by BORCHEK
;FIX TTY ASSIGNED TO OTHER JOB BUG IN SCTTY
;<4.MONITOR>FORK.MAC.140,  7-Apr-78 15:27:45, Edit by PORCHER
;TCO # 1912 - ADD LONG FORM OF RFSTS CALL
;<4.MONITOR>FORK.MAC.139, 10-Mar-78 10:17:27, EDIT BY MILLER
;TCO 1189. FIX SJPRI TO STORE WORD IN JOBSKD
;<4.MONITOR>FORK.MAC.138,  9-Mar-78 14:19:10, EDIT BY MILLER
;SURROUND MOST OF SJPRI WITH NOSKED AND OKSKED
;<4.MONITOR>FORK.MAC.137,  9-Mar-78 08:17:55, EDIT BY MILLER
;MAKE SURE UNSED PC BITS NOT RETURNED IN RFSTS
;<4.MONITOR>FORK.MAC.136, 17-Feb-78 13:40:13, Edit by PORCHER
;Allow CCL start offsets in SFRKV
;Fix NOSKED BLT to/from user space in RFACS/SFACS
;<4.MONITOR>FORK.MAC.135, 15-Feb-78 12:57:38, EDIT BY MILLER
;MODIFY RFSTS TO RETURN 30-BIT PC IF NOT SECTION 0
;<4.MONITOR>FORK.MAC.134, 30-Jan-78 15:00:25, EDIT BY MILLER
;ALLOW ANY FORK IN SWTRP
;<4.MONITOR>FORK.MAC.133, 30-Jan-78 14:38:30, EDIT BY MILLER
;MORE FIXES TO SWTRP
;<4.MONITOR>FORK.MAC.132, 30-Jan-78 13:32:25, EDIT BY MILLER
;MORE TCO 1880 FIXES
;<4.MONITOR>FORK.MAC.131, 30-Jan-78 13:23:42, EDIT BY MILLER
;TCO 1880 AGAIN. CHANGE ERROR CODES
;<4.MONITOR>FORK.MAC.130, 30-Jan-78 13:18:05, EDIT BY MILLER
;TCO 1880. ADD SWTRP JSYS
;<4.MONITOR>FORK.MAC.129, 28-Jan-78 23:14:44, Edit by PORCHER
;<4.MONITOR>FORK.MAC.128, 28-Jan-78 15:17:58, EDIT BY PORCHER
;<4.MONITOR>FORK.MAC.125, 27-Jan-78 11:17:34, EDIT BY PORCHER
;Add Execute-Only checks to JSYSes
;<4.MONITOR>FORK.MAC.124, 19-Jan-78 14:50:18, EDIT BY PORCHER
;Add bits and routines for Execute-Only


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

	SEARCH PROLOG
	TTITLE 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 2,PATADR(1)
	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
	  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:	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:	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::DMOVE P1,FFL		;SAVE PC AND MUUO WORD
	MOVE P3,KIMUEF
	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 PATADR		;FORCED INCOMPATABLILITY?
	ITERR(ILINS4)		;YES - GIVE ERROR.
	HRROI 2,[ASCIZ /SYS:PA1050.EXE/]
	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
	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.
	  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.
	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::DMOVE P1,FFL		;SAVE PC AND UUO WORD
	MOVE P3,KIMUEF
	MCENTR			;ENTER MONITOR CONTEXT
	HRROI T2,[ASCIZ/SYS:RMS.EXE/]
	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
	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.
	  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.
	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
;	CALL GETSEG
;
; Returns:
;	+1:	No such file (GTJFN failed)
;	+2:	Success, entry vector from file in T1
;
; Clobbers T1, T2
;
GETSEG:
	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
	GTJFN			;Get a JFN on file
	 RET			;Error-- return +1 from GETSEG
	PUSH P,EVLNTH		;Save old entry vector
	PUSH P,EVADDR
	HRLI T1,.FHSLF		;Get into this process
	GET			;Get it
	POP P,T2		;Restore old entry vector
	POP P,T1
	EXCH T1,EVLNTH		;Put old entry vector back, get one from file in T1
	EXCH T2,EVADDR
	RETSKP			;Return +2 from GETSEG
;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
	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
	MOVE 2,CAPENB
	CALL CKMMOD		;SEE IF MONITOR OR USER
	 TRNE 2,SC%WHL+SC%OPR	;USER. SEE IF PRIVILEGED
	SKIPA			;MONITOR OR PRIVILEGED
	ITERR(WHELX1)
	CALL FLOCK		;GET FORK LOCK IN CASE THIS JOB
	CAIL 1,0		;LEGAL JOB NUMBER?
	CAIL 1,NJOBS
	JRST SJPRI1		;NO
	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
;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/0,,fork handle
;	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
	MOVE T1,FKJOB(T1)	;GET JOB NO AND JSB
	MOVEM T1,FKJOB(FX)	;SET 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,JOBNO
	MOVEM 2,JOBNO(1)
	MOVE 2,PRIMRY
	MOVEM 2,PRIMRY(1)
	MOVE 2,JOBBIT
	MOVEM 2,JOBBIT(1)	;PASS PRIORITY
	SETZM CAPMSK(1)
	SETZM CAPENB(1)
	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
	MOVX 2,PSIIF%		;CHECK IF FORK WAS PROPERLY INITED
	TDNN 2,FKINT(7)		;WAS IT?
	JRST CFK5		;YES
	MOVE 2,BITS+.ICMSE	;GOT INT. SEE IF FATAL
	TDNN 2,FKINTB(7)	;WAS IT?
	JRST CFK5		;NO. LET IT GO ON
	NOINT			;PREVENT UNWANTED INTS
	CALL CLRLFK		;YES. CLEAR MAPPING
	CALL FUNLK		;RELEASE FORK LOCK
	POP P,1			;GET LOCAL INDEX
	KFORK			;ZAP THE FORK
	OKINT			;FORK PROPERLY KILLED. ALLOW INTS AGAIN
	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)
	HRLI T3,(UMODF)		;IN 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
	HLLZ 1,FKPGS(1)		;SOURCE IS THIS FORK
	HLLZ 2,FKPGS(7)		;DEST IS NEW FORK
	MOVSI 3,(PTRW)
	MOVEI 4,PGSIZ
	CALL MSETPT		;DO FOR ALL PAGES
	 JRST CFK42		;FAILURE SO PROPAGATE IT
	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
	HRLZ 1,FKPGS(1)		;PSB
	HRRI 1,1		;THIS FORK, SOURCE SECTION 1
	HRLZ 2,FKPGS(7)		;PSB
	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

CFK42:				;HERE TO UNLOCK FKLOCK AND DO ITRAP
	CALL FUNLK		;UNLOCK FORK LOCK
	 ITERR			;AND PASS DOWN ERROR

WAITFK:	HRRI 1,WTFKT
	MDISMS
	RET

	RESCD			;SCHEDULER TEST, MUST BE RESIDENT

;1001 Begin modification
WTFKT:	CALL TSTWT		;SCHEDULER TEST -- IS FORK WAITING?
	JRST 0(4)		;NO
	JRST 1(4)		;YES
TSTWT:	PUSH P,7
	MOVEI 7,(1)
	CALL CHKWT
	 CAIA			;NOT WAITING
	AOS -1(P)		;WAITING
	POP P,7			;RESTORE 7
	RET
;1001 End mod


	MOVE T2,FKSWP(T1)
	TXNN T2,FKBLK		;FORK BLOCKED?
	JRST 0(4)		;NO
	JRST 1(4)		;YES

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
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL FALLI		;FREEZE ALL OF CALLER'S INFERIORS
	XCTU [HRRZ T1,T1]	;GET RFH OF NEW SUPERIOR
	CALL SETJFK		;GET JOB FORK HANDLE OF 1
	PUSH P,T1
	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
	PUSH P,T1
	CAME T1,FORKN		;IS 2 STRICTLY INFERIOR TO SELF?
	CALL SKIIF
	 SPLERR(SPLFX2,EFRKR)	;NO
	MOVE T1,-1(P)		;GET 1
	MOVE T2,0(P)		;GET 2
	CALL SKIIFA		;IS 1 ALREADY EQ OR INFERIOR TO 2?
	 JRST .+2		;NO, OK
	SPLERR(SPLFX3,EFRKR)	;YES, ERROR
	MOVE T1,-1(P)		;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,0(P)		;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,-1(P)		;OR IS F1 THE IMMEDIATE MONITOR OF F2?
	CAIA			;YES, OK.
	 CALL SPLFK3		;NO. UPDATE TRAP ENVIRONMENTS
	NOSKED			;NOSKED WHILE CHANGING POINTERS
	MOVE T1,0(P)
	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,0(P)
	JRST SPLFK2		;FOUND IT
	MOVE T1,T2
	ADD T1,PARALP
	JRST SPLFK1		;CONTINUE SEARCH
; 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,-1(P)		;F2
	MOVE P2,-2(P)		;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
;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,0(P)
	MOVE T2,-1(P)
	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,0(P)
	ADD T1,SUPERP		;MAKE PTR TO SUPERIOR OF 2
	MOVE T2,-1(P)
	DPB T2,T1			;PUT 1 AS SUPERIOR OF 2
	OKSKED
	MOVE T1,-1(P)		;GET 1
	CALL SETLF1		;MAP PSB OF 1
	MOVSI T1,0(T1)		;SETUP ARG FOR GRFKH
	HRR T1,0(P)		;PSB OFFSET ,, JOB HANDLE
	CALL GRFKH		;GET RELATIVE HANDLE FOR 2 RELATIVE TO 1
	 SETZ T1,
	UMOVEM T1,T1
	CALL CLRLFK
	HRRZ T1,0(P)		;NEW INFERIOR
	HRRZ 7,SYSFK(T1)
	MOVX T2,FRZB1%
	IORM T2,FKINT(7)	;NEW INFERIORS ALWAYS BECOMES FROZEN
	CALL RALLI		;RESUME ALL INFERIORS
	SUB P,BHC+2
	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	SMRETN
;KILL FORKS

.KFORK::MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	MOVEI 1,0(1)
	CAIN 1,-4		;ALL INFERIORS?
	JRST KFORK2		;YES
	CALL SETJFK		;NO, ANY ONE FORK
	CAMN 1,FORKN		;SELF?
	ERRJMP(KFRKX2,ITFRKR)	;YES, NOT PERMITTED
	CALL SKIIF		;INFERIOR?
	JRST FRKE2		;NO, NOT PERMITTED
	CALL KFORK1		;KILL IT
	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	JRST MRETN

KFORK2:	HRRZ 1,FORKN
	CALL MAPINF		;FREEZE ALL TO INSURE INTERRUPTIBILITY
	 CALL FFORK1
	CALL KALLI		;KILL ALL INFERIORS
	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	JRST MRETN

KFORK1:	HRLM 1,0(P)
	CALL FFORK1		;FREEZE ALL TO INSURE INTERRUPTIBILITY
	HLRZ 1,0(P)
	XHLLI 6,20		;GET CURRENT SECTION
	HLLM 6,0(P)
KFORK0:	CALL DASFKH		;DEASSIGN LOCAL FORK HANDLE
	MOVE 6,1
	HRRZ 7,SYSFK(6)
	CAMN 7,FORKX		;THIS FORK?
	ERRJMP(KFRKX2,ITFRKR)	;CAN'T KILL SELF
	MOVE 5,6		;REMOVE FORK FROM STRUCTURE
	ADD 5,SUPERP
	LDB 5,5			;GET SUPERIOR
	ADD 5,INFERP
KFK01:	LDB 4,5			;GET NEXT PARALLEL
	CAIN 4,0(6)		;DESIRED FORK?
	JRST KFK02		;YES
	MOVE 5,4
	ADD 5,PARALP
	JRST KFK01
KFK02:	ADD 4,PARALP		;FOUND FORK TO BE KILLED IN LIST
	LDB 4,4
	DPB 4,5			;PUT NEXT IN LAST, REMOVING FORK FROM LIST
	MOVE 1,6
	CALL SETLF1		;MAP PSB
	CALL SUSFK		;SUSPEND FORK
	MOVE 2,FORKX		;GET SYSTEM FORK INDEX FOR SELF
	MOVEM 2,PAC+4(1)	;LEAVE IT IN AC4 OF VICTIM
	SETZM INTDF(1)		;MAKE VICTIM NON-INTERRUPTABLE
	SETZM PFL(1)
	MOVE 2,[MSEC1,,KSELF]
	MOVEM 2,PPC(1)		;START IT SO AS TO KILL ITSELF
	CALL UNBLK1
	OKSKED			;MATCH NOSKED IN SUSFK
	CALL CLRLFK
	SETZ 1,
	MOVEI 2,FPG0A
	MOVEI 3,FPG3+1-FPG0	;CLEAR FORK TEMP PAGES
	CALL MSETMP
	RET

;KILL ALL INFERIORS OF THIS FORK

KALLI:	HRRZ 1,FORKN
	ADD 1,INFERP
	LDB 1,1			;GET NEXT INFERIOR
	JUMPE 1,R		;NO MORE
	CALL KFORK0		;KILL ALL INFERIORS TOO
	JRST KALLI
;FORK KILL SELF
; 4/ FORK WHICH INITIATED KSELF

BP$021:				;(KSELF): BREAKPOINT FOR KFORK
				;ASSUMES FORKX HAS SUICIDAL FORK INDEX
KSELF::	MOVE 7,FORKX
	MOVX T1,FKPSI1
	MOVEM 1,FKINT(7)	;DISABLE ANY FURTHER INTERRUPTS
	MOVSI 1,(UMODF)
	MOVEM 1,FFL
	SETZM FPC
	MCENTR			;GET INTO REASONABLE MONITOR STATE
	MOVEI 1,0(7)		;GET FORK HANDLE
	PUSH P,2		;SAVE
	SETZ 2,			;CLEAR ALL FORK'S ENTRIES ON STACK
	CALL JSBSTF		;GO PROCESS DEALLOCATION LIST
	SKIPE T1,SYMPAG		;ANY PAGE USED BY MDDT?
	CALL RELPAG		;YES, RELEASE IT
	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]
	MOVEI T1,JSBFRE		;POINT TO POOL FOR PDVA STORAGE
	SKIPE T2,PDVS		;ANY PDVAS STORED?
	CALL RELFRE		;YES, RELEASE THEM
	SETZM PDVS		;SAY NO PDVAS STORED ANYMORE
	OKINT			;DONE WITH FREE SPACE STUFF, SO ALLOW INTERRUPTS AGAIN
	CALL NTCOFF		;CLEAR THE NETWORK CHANGE INTERRUPT TABLE
	JFCL			;IGNORE
	MOVEI 1,0(7)		;GET FORK HANDLE
	SETZ 2,0		;CLEAR ALL FORK'S ENTRIE
	CALL GOKFRE
	POP P,2			;RESTORE 2
	CAMN 7,ACJFN		;CHECK FOR ACJ FORK
	CALL ACJKIL		;KILL ACJ NOW
	SETOM INTDF
	MOVEM 4,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,(1) ;DOES THIS JOB HAVE DIAG RESOURCES?
	CALL DGFKIL		;YES. GO RELEASE THIS PROCESSES SET
	CALL NETKFK		;CLEAR FORK FROM NET TABLES
	CALL MTAKFK		;KILL MTA ONLINE/OFFLINE PSI INTERRUPTS
	HLRZ T1,DSPSFK		;GET DSK PSI FORK
	CAIN 7,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.
	 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
	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
	SOS FKCNT		;COUNT OF FORKS
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL KALLI
	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	CALL UNMAPD		;UNMAP THE DIRECTORY AND RELEASE ITS OFN
	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
repeat 0,<		;1000
	MOVE FX,FORKX
	HLRZ 1,FKPGS(7)
	LOAD 2,SPTSHC,(1)	;GET SHARE COUNT OF UPT
	PUSH P,2		;SAVE IT FOR LATER CHECK
>;1000 end repeat 0
	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:	HRRZ 4,FORKN		;GET JOB FORK HANDLE FOR SELF
	LOAD 1,FKHCNT,(4)	;GET NUMBER HANDLES OF THIS FORK
	JUMPN 1,[MOVSI 1,(1B0)	;NO. MARK IT DELETED THEN
		IORM 1,SYSFK(4)	;""
		JRST KSEF5]	;AND GO FINISH UP
	MOVEI 1,FKPTRS(4)	;NO OTHERS, PUT JOB SLOT BACK ON FREE LIST
	EXCH 1,FREJFK
	MOVEM 1,@FREJFK
	SETOM SYSFK(4)		;NOTE SLOT AVAILABLE
KSEF5:	CALL FUNLK
	LOAD T1,NOSTR
	SKIPE T1		;IF NO STRUCTURES MOUNTED, SKIP STR CODE
	CALL RELSTR		;RELEASE ALL STRUCTURE MOUNTS FOR FORK

;1000 Begin modification
;Do at least one pass through the UPT to be sure pages are gone
	JRST KSEF3A		; Skip the DISMS first time through

KSEF3:	MOVEI 1,^D5000
	DISMS			;WAIT FOR 5 SECS
KSEF3A:	MOVE FX,FORKX		; get our fork index
	HLRZ 1,FKPGS(FX)	; THEN CLEAR MAP AGAIN
	LOAD 2,SPTSHC,(1)	; SHARE COUNT OF UPT
	PUSH P,2
	SETZ 1,
	HLLZ 2,FKPGS(FX)
KSEF4:	HRRZ T3,T2		;MAKE A GOOD ADDRESS.
	SKIPE UPTPGA(T3)	;QUICK CHECK FOR ALREADY EMPTY
	 CALL SETPT		;BUT NOT USING PMAP
	MOVEI 6,0(T3)
	CAIGE 6,777
	AOJA 2,KSEF4
;1000 End of change


;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,2		;STILL SOME LEFT, FIX STACK
		JRST KSEF3]	;GO WAIT FOR A WHILE
	POP P,2			;SHARE COUNT OF UPT
	CAIE 2,1		;UNSHARED?
	JRST KSEF3
;1000	MOVE 7,FORKX
	HRLZ 2,FKPGS(7)		;1000 Now get PSB SPT slot
	SETZ 1,
	HRRI 2,PPLOW		;CLEAR PROCESS MAP FROM PPLOW
	MOVEI 4,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

repeat 0,<			;1000
KSEF3:	MOVEI 1,^D5000
	DISMS			;WAIT FOR 5 SECS
	HLRZ 1,FKPGS(7)		;THEN CLEAR MAP AGAIN
	LOAD 2,SPTSHC,(1)	;SHARE COUNT OF UPT
	PUSH P,2
	SETZ 1,
	HLLZ 2,FKPGS(7)
KSEF4:	HRRZ T3,T2		;MAKE A GOOD ADDRESS.
	SKIPE UPTPGA(T3)	;QUICK CHECK FOR ALREADY EMPTY
	CALL SETPT		;BUT NOT USING PMAP
	MOVEI 6,0(T3)
	CAIGE 6,777
	AOJA 2,KSEF4
	JRST KSEF2
>;1000 end repeat 0
;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 7,SYSFK(1)		;GET SYSTEM WIDE FORK INDEX
	TDNE 2,FKINT(7)		;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
	IORM 2,FKINT(7)
	MOVEI 2,FRZWT
	HRRM 2,FKSTAT(7)	;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)
	TDNN 2,FKINT(7)		;FROZEN THIS WAY?
	RET			;NO
	ANDCAB 2,FKINT(7)	;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
	MOVX T2,JTFRZ%		;FROZEN BY JSYS TRAP?
	TDNE T2,FKINT(FX)	; ?
	RET			;YES. DON'T RESUME.
	MOVX T2,ABFRZ%		;CLEAR ADDRESS BREAK FREEZE
	ANDCAM T2,FKINT(FX)	; ..
	CALL STPFK1		;SET TO UNFREEZE THIS FORK
	SKIPN 2,PIOLDS(1)	;WAS ON WTLST BEFORE FREEZE?
	JRST [	CALL UNBLK1	;UNBLOCK IT
		JRST RFORK4]
	MOVEM 2,FKSTAT(7)
	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::	MOVE T1,FORKX		;GET FORK NUMBER
	MOVE T1,FKINT(T1)	;GET INTERRUPT STATUS
	TXNN T1,FKPSI1		;MUST BE
	SKIPL INTDF		; INTERRUPTABLE
	JRST WAIT2		;WE'RE NOT
	MOVEI 1,JRET
repeat 0,<
	MOVSI T2,FHV2		;LOWER BLOCK PRIORITY
	HDISMS
>
	MDISMS			;1000
	JRST MRETN

WAIT2:	BUG (WAITNI,<<FORKX,FORK>>)
;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
	CAME FX,FORKX		;1000 use stack if current fork
	TXNN T3,UMODF		;USER MODE?
	JRST [	HLLZ T3,UPDL+1(T1) ;NO, USER PC 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
	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!
RFSLN1:
	CALL @RFSLTB-.RFPSW(Q2)	;GET A WORD FOR TABLE INTO T2
	UMOVEM T2,0(Q1)		;STORE THE WORD
	ADDI Q2,1		;BUMP TO NEXT ENTRY
	AOBJN Q1,RFSLN1		;LOOP FOR ALL ITEMS TO BE RETURNED
RFSLN2:
	CALL CLRLFK		;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

RFSLFL:	HLLZ 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]
	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
;1000	MOVE T2,FKSWP(FX)
;1000	TXNN T2,FKBLK		;FORK BLOCKED?
	CALL CHKWT		;1000
	JRST MRFSTX		;NOT WAITING, RETURN ZERO
	HRRZ T2,FKSTAT(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
	MOVE T2,FKINT(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
	HLRZ T2,FKSTAT(FX)	;AND GET OLD STATUS
	CAIN T2,-1		;27 FROZEN BY SIGNAL JFN?
	 JRST [	TLO T1,.RFSIG	;27 SAY JOB WANTS THE TTY
		JRST MRFSTX ]	;27 AND RETURN THAT
	JUMPE T2,MRFSTX
	JRST RFST5

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,[PCU		;NEW FLAGS, PC  - 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
	HLRZ T2,T1		;Get section number of entry vector
	XSFM T3			;Get flags and possibly bad PCS
	STOR T2,EXPCS,T3	;Store new PCS in flags-PC doubleword
	XMOVEI T4,SFRKV6	;Get continue address for flags-PC doubleword
	XJRSTF T3		;Set previous context section and continue
SFRKV6:	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,UMODF		;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
	TLO T2,(UMODF)		;AND USER ON
	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)
	HLLM 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:	HRRZS FKSTAT(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
	MOVX T2,FRZBA%
	TDNE T2,FKINT(FX)	;FORK FROZEN?
	JRST SFORK3		;YES, DON'T START IT NOW
	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)
	LOAD T1,FRKTTY,(T2)	;GET CONTROLLING TERMINAL
	CALL UPDTI
	OKSKED			;MATCH NOSKED IN STPFK (SUSFK)
	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,PCU		;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
;1000	MOVE T2,FKSWP(FX)
;1000	TXNN T2,FKBLK		;FORK BLOCKED?
	CALL CHKWT		;1000
	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
	MOVX 3,FRZBA%
	TDNE 3,FKINT(7)		;FROZEN?
	JRST [	HRLM 2,FKSTAT(7) ;YET, UPDATE PRE-FREEZE STATE
		MOVEM 2,PIOLDS(1)
		JRST HFORK2]
	MOVEM 2,FKSTAT(7)	;TERMINATED STATE
	CALL CLRSFK		;BUT INTERRUPTABLE
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
	HRRZ 2,FKSTAT(1)	;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

.WFORK::MCENT
	CAIN 1,-4		;ALL INFERIORS?
	JRST WFORKA		;YES
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	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
;1000	MOVSI T2,FHV1		;LOW BLOCK PRIORITY
;1000	HDISMS
	MDISMS			;1000
	JRST MRETN

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
;1000	MOVSI T2,FHV1		;LOW BLOCK PRIORITY
;1000	HDISMS
	MDISMS
	JRST MRETN

	RESCD

TRMTST::CALL TSTWT		;1000 Fork waiting?

;1000	MOVE T2,FKSWP(T1)
;1000	TXNN T2,FKBLK		;FORK BLOCKED?
	JRST 0(4)		;NO
	HRRZ 2,FKSTAT(1)
	CAIE 2,HALTT		;WAITING BECAUSE TERMINATION?
	CAIN 2,FORCTM		;OR FORCED TERM?
	JRST 1(4)		;YES
	JRST 0(4)		;NO, KEEP WAITING

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(FRKSLF)
SUSF6:	NOSKED
;1000	MOVE T2,FKSWP(FX)
;1000	TXNN T2,FKBLK		;FORK BLOCKED NOW?
	CALL CHKWT		;1000
	JRST SUSF4		;NO
	HRRZ 2,FKSTAT(7)	;GET WAITING STATUS
	CAIE 2,SUSWT		;ALREADY SUSPENDED OR FROZEN?
	CAIN 2,FRZWT
	RET
	CAIN 2,TCITST		;WAS IN TTYIN WAIT?
	JRST [	HLRZ 2,FKSTAT(7) ;YES, GET TERMINAL NUMBER
		CALL TTCLFK	;INDICATE NO FORK WAITING
		JRST .+1]
SUSF5:	MOVX 1,FKPSI0+SUSFK%	;SUSPEND FORK REQUEST BIT FOR PSI
	IORM 1,FKINT(7)		;LEAVE IT FOR SPECIFIED FORK
	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
;1000	MOVSI T2,FHV5		;HIGHER BLOCK PRIORITY
;1000	HDISMS
	MDISMS			;1000
	JRST SUSF6		;NOW CHECK IT AGAIN

SUSF4:	SKIPN FKINT(7)		;TRANSITIONAL STATE?
	JRST SUSF5		;NO
	MOVX 1,FKPSI0+SUSFK%	;YES, REQUEST INTERRUPT
	IORM 1,FKINT(7)
	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::
;1000	MOVE T2,FKSWP(T1)
;1000	TXNN T2,FKBLK		;FORK BLOCKED?
	CALL TSTWT		;1000
	JRST 0(4)
	HRRZ 2,FKSTAT(1)
	CAIE 2,SUSWT		;SUSPENSION?
	CAIN 2,FRZWT
	JRST 1(4)
	JRST 0(4)

	SWAPCD

;CLEAR FORK WHICH HAD BEEN SUSPENDED

CLRSFK:	MOVX T2,FKPSI1
	ANDCAM 2,FKINT(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
	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(ILJRFN)
	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
	HRROI T2,(T2)
	CAME T2,[-1,,.FHSUP]	;ASKING FOR HANDLE ON SUP?
	 JRST GFRKH1		;NO
	CALL STJFKR		;GET JOB FORK INDEX IN T1
	ERRJMP (GFRKX1,EFRKR)	;ERROR
	ADD T1,SUPERP		;FORK POINTER TO FKPTRS
	LDB T1,T1		;GET JOB HANDLE OF TARGET FORK
	CALL GFKH		;MAKE LOCAL HANDLE
	ERRJMP (FRKHX6,EFRKR)	;NONE LEFT
	UMOVEM T1,T1		;RETURN HANDLE TO USER
	JRST GFRKH3		;RETURN TO CALLER

GFRKH1:	TRNN T2,200000
	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
	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
	CAIL T2,NUFKS		;MAKE SURE IT'S ASSIGNED
	JRST GFRKH2		;CAN'T BE
	SKIPGE SYSFK(T2)	;FORK STILL EXIST?
GFRKH2:	 ERRJMP (GFRKX1,EFRKR)	;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,EFRKR)	;COULDN'T. NO SPACE LEFT.
	UMOVEM T1,T1		;OK. RETURN H-PRIME TO USER.
	CALL CLRLFK

GFRKH3:	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(MAP41F)
	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
;
; Call:
;	T1/	Job-relative fork number (JRFN) to be made non-virgin
;	CALL CLRVGN
;
; Returns:
;	+1:	Always, process is now not virgin
;
CLRVGN:
	SETONE SFNVG,(T1)	;No longer a virgin fork!!
	RET			;Return from CLRVGN
;
;
; 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
	SE1CAL
	CAMN 1,FORKX		;CURRENT FORK?
	JRST SETLF2		;YES
	HRL T1,FKPGS(T1)	;GET PSB OF DESIGNATED FORK
	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

SETJSB:: NOINT
	PUSH P,FX
	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
	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)	;293 Get enabled caps
	AND B,CAPMSK(A)		;293 Turn off any we don't really have
	PUSH P,B		;293 Save capabilities
;293	PUSH P,CAPENB(A)	;SAVE CAPABILITIES
	CALL CLRPSB		;UNDO PSB MAPPING
	POP P,A
	RET
;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
   REPEAT 0,<			;NOT CHECKED NOW BECAUSE MLKBLK PROBLEM
	SKIPN FORKN		;TOP FORK?
	JRST FLOCK1		;YES, INTERRUPTIBILITY NOT SIGNIFICANT
	SKIPL INTDF		;INTERRUPTABLE NOW?
	BUG(FLKINT)
   >
	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 (FKCTNZ,<<JOBNO,JOB>,<FORKN,JBFORK>>)
			SETZM FLKCNT
			RET]
		AOS FLKCNT	;INCREMENT NEST COUNT
		MOVE W1,TODCLK	;GET NOW
		ADDI W1,^D120000 ;WHEN IT WILL TIMEOUT
		MOVEM W1,FKTIMW	;SET IT
		RET]		;SUCCESS

;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:	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 FLOCK2		;NO, KEEP WAITING

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

	BUG(FLKTIM,<<FORKN,JOBFRK>,<JOBNO,JOB>,<FLKOWN,OWNER>>)
	SETZM FLKCNT		;ZERO THE NEST COUNT
	SETOM FLKOWN		;CLEAR THE OWNER
	SETOM FKLOCK		;TIMEOUT, CLEAR LOCK AND PROCEED
FLOCK2:	JRST FLOCK1

	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
	JUMPN 1,FUNLK1		;IF LOCK WAS 0, THEN NO ATTEMPT
FUNLK2:	POP P,1			; WAS MADE TO LOCK IT WHILE THIS FORK
	RET

;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(FLKNS,<<FORKN,JOBFRK>>)
	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

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		;LOCK THE FORK STRUCTURE
	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
		HLL T1,FKPGS(T1) ;GET PT OF SECTION ZERO
		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		;UNLOCK THE 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 LOCK
	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
	HLRZ T3,FKPGS(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:	SUB P,BHC+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		; ...
;	BUG(NOXRFH)
	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
	SKIPN PSISYS(1)
	TDZA P1,P1		;SET UP FOR SKIP RETURN
	SETO P1,
	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 SETOV0		;RECOMPUTE TRAP LOCATION
	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
	CAIE 1,3		;CONTROL-C?
	JRST .+4		;NO
	MOVE 3,CAPENB		;YES, SEE IF LEGAL
	TLNN 3,(1B0)
ATX2E:	ERRJMP(ATIX2,ITFRKR)	;USER LACKS ^C CAPABILITY
	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
;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
	HRRZ Q2,FKSTAT(FX)	;YES, SEE HOW.
	CAIE Q2,FRZWT		;FROZEN?
	JRST UPDT8		;NO
	PUSH P,Q2		;YES, SAVE STATE
	MOVX Q2,JTFRZ%		;IS IT A JSYS TRAP FREEZE?
	TDNN Q2,FKINT(FX)	; ..
	JRST UPDT6		;NO, ORDINARY FREEZE
	MOVX Q2,FRZBB%		;IS IT JSYS TRAP AND ALSO OTHER FREEZE?
	TDNN Q2,FKINT(FX)	; ..
	JRST UPDT7		;NO, JUST JSYS TRAP FREEZE
UPDT6:	POP P,Q2		;SOME OTHER FREEZE. EXCLUDE THIS FORK.
	JRST UPDT2		; ..

UPDT7:	POP P,Q2
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
	UMOVEM 2,3		;RETURNED IN 3
	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
		TLNN 3,(1B0)	;^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
;267	GTOKM (.GOCAP,<T3>)
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)
	GTOKM (.GOCAP,<3>,[jrst clfret]) ;267 Call ACJ with privs to be granted
	JRST CLFRET
;SWTRP JSYS. SET AND READ USER-MODE TRAPS. CALLING SEQUENCE IS:
;	T1/ FORK HANDLE
;	T2/ FUNCTION
;	T3/ FUNCTION DEPENDENT ARG
;ITRAP ON ANY ILLEGAL ACT

.SWTRP::MCENT			;ESTABLISH CONTEXT
	UMOVE T1,1		;GET FORK HANDLE
	CALL FLOCK		;LOCK FORK STURCTURE
	CALL SETLFK		;MAP FORK
	UMOVE T2,2		;GET ARG
	SKIPL T2		;VALID FUNCTION?
	CAILE T2,.SWRLT		;VALID FUNCTION?
	ITERR (ARGX02,<CALL CLRLFK
			CALL FUNLK>)
	CALL @SWTRPT(T2)	;YES. DO THE FUNCTION
	 ITERR (,<CALL CLRLFK
		CALL FUNLK>)
	JRST CLFRET		;AND DONE

;DISPATCH TABLE FOR SWTRP ARGS

SWTRPT:	IFIW!ARTSET
	IFIW!ARTGET
	IFIW!LUUSET
	IFIW!LUUGET

;SET ARITHMETIC TRAP

ARTSET:	UMOVE T3,3		;GET VALUE
	CALL SETART		;CHECK VALUE
	 RETBAD (ARGX20)	;CAN'T USE IT
	RETSKP			;AND DONE

;READ ARITHMETIC TRAP

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

;SET LUUO DISPATCH ADDRESS

LUUSET:	UMOVE T3,3		;GET IT
	CALL SETLUU		;VERIFY IT
	 RETBAD (ARGX21)	;BAD. CAN'T USE IT
	RETSKP			;AND DONE

;READ LUUO DISPATCH ADDRESS

LUUGET:	CALL GTLUUB		;GET LUUO BLOCK ADDRESS
	UMOVEM T3,3		;RETURN VALUE
	RETSKP			;AND DONE
; 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
	MOVE T2,FKINT(T2)
	TXNN T2,FRZBB%		;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
	MOVE T1,FKINT(T1)	;FORK'S  STATE
	TXNN T1,FRZBB%		;IS THE FORK FORZEN?
	 ITERR TFRKX3,<CALL FUNLK> ;NO, 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 (NWJTBE)
	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:	NOINT 			;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 [OKINT		; Not all forks frozen
		JSP T2,ITRAP]	; 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 [OKINT		; Can't buy a handle
		JSP T2,ITRAP]	; LSTERR is already set from last ITERR
	JUMPE T1,TFOR61		;WAS A TRAP PENDING?
	UTFRK
TFOR61:	MOVX T1,PSIJT%		;CLEAR PENDING TRAP PSI (IF ANY)
	MOVE T2,FORKX		;WHICH MAY HAVE OCCURED AFTER
	ANDCAM T1,FKINT(T2)	;NOINT AND BEFORE TFORK
	SETOM JTLCK		;CLEAR THE LOCK
	OKINT
	RET
;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
	HRRZ T2,FKSTAT(FX)
	CAIE T2,FRZWT		; Is it frozen
	 JRST UTFRK0		; No, NOOP
	MOVX T2,JTFRZ%
	TDNN T2,FKINT(FX)	; Fork trapped?
	 JRST UTFRK0		; No, NOOP

	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
	MOVEI T2,ITRAP
	TLNE P2,(UT%TRP)	; Caller want us to bomb JSYS?
	 HRRM T2,PPC(T1)	; Yes, do that
	MOVX T2,JTFRZ%
	ANDCAB T2,FKINT(FX)	; Clear JSYS trap freeze
	TXNE T2,FRZBB%		; Is fork still frozen?
	 JRST UTFRK0		; Yes, no further action then
	SKIPN T2,PIOLDS(T1)	; No, resume it
	JRST [	CALL UNBLK1	; Unblock fork
		JRST UTFRK3]
	MOVEM T2,FKSTAT(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
	CAIN P2,.NULIO		;1022 Is it null device?
	 JRST SCT.1		;1022 Yes, allow it and skip assign crud
	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
SCT.1:	MOVE T3,P2		;1022 add label ; 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>,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
	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
	TLNN A,777777		;If section number of address of name string
	 HLL A,.POADR+PD0	;  is zero 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,.POCT2+OURBLK	;SET UP OUR COUNT
	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
	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
;		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
	MOVEI B,0		;.NOT.PM%EPN
	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