Google
 

Trailing-Edge - PDP-10 Archives - BB-Y393A-SM - source/monitor/fork.mac
There are 53 other files named fork.mac in the archive. Click here to see a list.
;Edit 2943 by TSANG on Mon 4-Apr-83
;		Fix .EPCAP, no error message needed
;Edit 2928 by MOSER on Wed 30-Mar-83, for SPR #16525 - FIK FLKTIM, FLKNS, GLFNF
;EDIT 2928 - FIX FLKTIM, FLKNS, GLFNF
; UPD ID= 148, FARK:<4-1-WORKING-SOURCES.MONITOR>FORK.MAC.6,   8-Sep-82 15:18:03 by MOSER
;EDIT 2804 - CORRECT TYPO IN 2645.
; UPD ID= 128, FARK:<4-1-WORKING-SOURCES.MONITOR>FORK.MAC.5,  12-Aug-82 11:05:09 by MOSER
;EDIT 2645 - CHECK MINOR FORK STATE IN TRMTST
; UPD ID= 93, FARK:<4-1-WORKING-SOURCES.MONITOR>FORK.MAC.4,  11-Jun-82 13:04:00 by DONAHUE
;Edit 2627 - Prevent GJCAPS from returning privileges job shouldn't have
; UPD ID= 80, FARK:<4-1-WORKING-SOURCES.MONITOR>FORK.MAC.3,   6-May-82 15:45:00 by MOSER
;EDIT 2617 - OKINT FROZEN FORK WHEN UNTRAPPING.
; UPD ID= 51, FARK:<4-1-WORKING-SOURCES.MONITOR>FORK.MAC.2,   3-Apr-82 19:59:05 by ZIMA
;Edit 2607 - add ENDAV.s to ACVARs to use v5 MACSYM, change some to SAVEAC.
;<4-1-FIELD-IMAGE.MONITOR>FORK.MAC.2, 25-Feb-82 20:21:45, EDIT BY DONAHUE
;UPDATE COPYRIGHT DATE
; UPD ID= 951, FARK:<4-WORKING-SOURCES.MONITOR>FORK.MAC.6,  22-Jan-82 16:26:49 by MOSER
;EDIT 1974 - FIX FLKTIM BUGCHKs when nesting lock after failing.
; UPD ID= 836, FARK:<4-WORKING-SOURCES.MONITOR>FORK.MAC.5,  30-Sep-81 09:13:02 by SCHMITT
;Edit 1950 - OKINT Jsys trapped process if not resumed in UTFRK JSYS
; UPD ID= 521, FARK:<4-WORKING-SOURCES.MONITOR>FORK.MAC.4,   8-May-81 09:59:28 by DONAHUE
;Edit 1869 - Disregard nestable lock check at FLOCK1
;Edit 1868 - check fork handle at FFORK1 before freezing fork
; UPD ID= 478, FARK:<4-WORKING-SOURCES.MONITOR>FORK.MAC.3,  23-Apr-81 16:06:21 by SCHMITT
;Edit 1856 - Make process non-virgin if loading ACs with CFORK
; UPD ID= 471, FARK:<4-WORKING-SOURCES.MONITOR>FORK.MAC.2,  23-Apr-81 11:50:22 by ZIMA
;Edit 1852 - Have FLOCK account for self if nesting so no DISMS in FUNLK.
; UPD ID= 206, FARK:<4-WORKING-SOURCES.MONITOR>FORK.MAC.5,  15-Sep-80 17:24:07 by ZIMA
;Edit 1783 - fix SCTTY resuming directly frozen forks.
; UPD ID= 181, FARK:<4-WORKING-SOURCES.MONITOR>FORK.MAC.4,   2-Sep-80 17:46:15 by ZIMA
;Edit 1776 - make the KSELF PMAP have PM%ABT to avoid writing out to
; files with OF%DUD set.
; UPD ID= 105, FARK:<4-WORKING-SOURCES.MONITOR>FORK.MAC.3,  26-Jun-80 15:45:31 by SANICHARA
;EDIT 1752 - ALLOW CH 23 TO BE USER ASSIGNABLE.
; UPD ID= 18, FARK:<4-WORKING-SOURCES.MONITOR>FORK.MAC.2,   2-Jun-80 10:03:25 by ZIMA
;EDIT 1721 - FIX MSFRK SECURITY CHECK
; UPD ID= 218, SNARK:<4.MONITOR>FORK.MAC.242,  24-Jan-80 09:40:24 by GRANT
;TCO 4.2598 - ADD CHECK FOR PRARG JSB SPACE TO KSELF
;<4.MONITOR>FORK.MAC.241,  3-Jan-80 08:08:45, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
; UPD ID= 39, SNARK:<4.MONITOR>FORK.MAC.240,  28-Nov-79 11:08:50 by MILLER
;TCO 4.2582 AGAIN. FIX FUNLK TO SET FKTIMW VERY LARGE
; 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
;<4.MONITOR>FORK.MAC.238, 16-Nov-79 14:48:58, EDIT BY ENGEL
;PUT INTERNAL LINE NUMBER IN T2 BEFORE CALLING CLRINT AT 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 FKMXQ
;<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,1980,1981,1982 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
;GET/SET ENTRY VECTOR

.SEVEC::MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFX		;Map PSB and check for execute-only
	JUMPE 2,SEV1		;ALL-0 IS LEGAL
	HLRZ 3,2		;GET SIZE
	CAIN 3,<JRST>B53	;10/50 STYLE?
	JRST SEV1		;YES
	CAIL 3,1000
ESVX1:	ERRJMP(SEVEX1,ITFRKR)	;NOT LEGAL
SEV1:	MOVEM 2,ENTVEC(1)
	JRST CLFRET

.GEVEC::MCENT
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL SETLFK
	MOVE 2,ENTVEC(1)
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)
	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
	MOVEM 2,PATADR(1)
	HRRM 3,PATUPC(1)
	HLRM 3,PATU40(1)
	JRST CLFRET

;GET/SET 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
	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
	MOVEM T2,DMSADR(T1)	;SAVE DMS ENTRY VECTOR
	HRRZS T2
	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
;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
;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
	IDIVI T2,2		;FIND OUT WHERE THIS IS IN THE CTTY TABLE
	ADD T2,FKCTYP(T3)
	LDB T4,T2		;GET CTTY FOR CREATING FORK
	MOVEI T2,0(T1)		;NEW FORK'S FORKN
	IDIVI T2,2		;POINT TO ITS CTY FIELD
	ADD T2,FKCTYP(T3)
	DPB T4,T2		;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)
	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,FKMXQ		;GET LOCAL MAX Q
	MOVE 7,T2		;RESTORE INDEX OF CREATED FORK
	STOR T1,FKMXQ		;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
;**;[1856] Replace one line with 3 Lines at CFK1: +4L	RAS	23-APR-81
	CALL BLTUM1		;[1856] TRANSFER AC'S TO MONITOR
	MOVE T1,T4		;[1856] GET JRFN
	CALLRET CLRVGN		;[1856] CLEAR VIRGIN FLAG AND RETURN

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

WAITFK:	HRRI 1,WTFKT
	MDISMS
	RET

	RESCD			;SCHEDULER TEST, MUST BE RESIDENT

WTFKT:	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)
	MOVSI 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)
	MOVEI 2,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
	MOVSI 1,200000
	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
	SKIPE T2,PRARGP		;ANY JSB SPACE USED BY PRARG?
	JRST [NOINT		;YES, MUST BE NOINT TO CALL PRARGF
	      SETZM PRARGP	;ZERO OLD POINTER
	      CALL PRARGF	;RELEASE THE SPACE
	      OKINT
	      JRST .+1]
	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
	IDIVI T1,2		;BUILD POINTER TO MY CTTY
	ADD T1,FKCTYP(T2)
	LDB T2,T1		;GET MY CTTY
	CAIN T1,-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.
	LOCK DEVLCK		;REQUIRED DURING DEASSIGN OF TTY
	CALL TTYDAS		;YES, MAKE IT GO AWAY.
	 JUMPL T1,[HRL T1,T2
		UNLOCK DEVLCK	;FREE THE TTY DATA
		MDISMS
		JRST KSEFW]
	UNLOCK DEVLCK		;DONE WITH TTY DEVICE DATA
KSEF0:	SETO T1,
	RFRKH			;GO RELEASE ALL RELEASABLE HANDLES
	 JFCL
	MOVSI T2,.FHSLF
;**;[1776] Change one line at KSEF0: +4L	JGZ	2-SEP-80
	MOVE T3,[PM%CNT+PM%ABT+1000] ;[1776] 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
	MOVE FX,FORKX
	HLRZ 1,FKPGS(7)
	LOAD 2,SPTSHC,(1)	;GET SHARE COUNT OF UPT
	PUSH P,2		;SAVE IT FOR LATER CHECK
	CALL FLOCK
	SKIPN T2,@JTBLK		;DO WE HAVE A JSYS TRAB BLOCK?
	JRST KSEF1		;NO
	HRRZ T3,FORKN		;YES, SEE WHETHER IT SHOULD BE RELEASED
	ADD T3,SUPERP		;IDENTIFY MY SUPERIOR
	LDB T3,T3		; ..
	HRRZ P1,FORKN		;NEED MY FORK NUMBER FOR RELJTB
	LOAD T2,JTIMP,(T2)	;MY MONITOR
	CAIN T3,(T2)		;IS MY SUPERIOR MY MONITOR?
	CALL RELJTB		;YES. RELEASE THE JTB
KSEF1:	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

;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
	MOVE 7,FORKX
	HRLZ 2,FKPGS(7)
	SETZ 1,
	HRRI 2,PPLOW		;CLEAR PROCESS MAP FROM PPLOW
	MOVEI 4,PPHI-PPLOW+1	; TO PPHI
	CALL MSETPT		;CLEAR PROCESS MAP
	CALL WTFPGS		;WAIT FOR UPT AND PSB TO BE UNMAPPED
	JRST HLTFK1		;GO DELETE UPT AND PSB

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
;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
;**;[2607] Change one line at CLNZSC: +2L	JGZ	3-APR-82
	SAVEAC <Q1,Q2>		;[2607] 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#
	MOVEI T3,1		;COUNT
	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
	IDIVI T1,2		;DECIDE WHETHER TO UPDATE PSI WORDS
	ADD T1,FKCTYP(T2)	; WHICH SHOULD BE DONE IF SAME CTTY
	LDB T1,T1		;HERE'S ONE FORK'S CTTY
	HRRZ T2,FORKN		;NOW DO SAME FOR SELF
	IDIVI T2,2		;COMPUTE INDEX INTO FKCTTY
	ADD T2,FKCTYP(T3)	;POINT TO THE PROPER HALFWORD
	LDB T2,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
	IDIVI T1,2
	ADD T1,FKCTYP(T2)	;POINT TO THE TTY
	LDB T1,T1		;RETRIEVE IT
	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,[XWD FRZB2,0]	;INDIRECT FREEZE BIT
FFORK1:	MOVSI 2,FRZB1		;DIRECT FREEZE BIT
	HRRZ 7,SYSFK(1)		;GET SYSTEM WIDE FORK INDEX
;**;[1868] Add 1 line at FFORK1:+1L	PED	8-MAY-81
	CAIE 7,-1		;[1868] FORK EXIST?
	TDNE 2,FKINT(7)		;ALREADY DONE?
	RET			;YES
	TLNE 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
	MOVEI T2,0(T1)
	IDIVI T2,2		;COMPUTE UP ITS CTTY POINTER
	ADD T2,FKCTYP(T3)	;POINT TO FKCTTY TABLE
	LDB T2,T2		;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
	IDIVI Q1,2		;CONVERT TO GET ITS CTTY
	ADD Q1,FKCTYP(Q2)
	LDB Q1,Q1		;GET THE CTTY DESIGNATOR
	CAIN T2,0(Q1)		;SAME AS 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
	MOVSI 2,FRZB1		;RESTORE BIT
	TRZN 1,1B18		;B1?
	MOVSI 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
	IDIVI P1,2		;MAKE THE POINTER TO THE CTTY
	ADD P1,FKCTYP(P2)
	LDB T1,P1		;TTY. ARG TO UPDTI
	CALLRET UPDTIR

RFORK5:	HRRZ 1,FORKN
	CALL MAPINF		;DO ALL IMMED INFERIORS
	 CALL RFORK1
	HRRZ T1,FORKN
	IDIVI T1,2		;FIND THE FORK'S CTTY
	ADD T1,FKCTYP(T2)
	LDB T1,T1		;ARG TO UPDTI
	CALLRET UPDTIR

RFORK3:	SKIPA 2,[XWD FRZB2,0]	;INDIRECT FREEZE BIT
RFORK1:	MOVSI 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
	TLNE 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
	MOVSI T2,JTFRZB		;FROZEN BY JSYS TRAP?
	TDNE T2,FKINT(FX)	; ?
	RET			;YES. DON'T RESUME.
	MOVSI T2,ABFRZB		;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::	MOVEI 1,JRET
	MOVSI T2,FHV2		;LOWER BLOCK PRIORITY
	HDISMS
	JRST MRETN
;SPECIAL ROUTINES CALLED FROM HANG-UP CODE TO INDIRECTLY FRREZE OR
;UNFREEZE ALL INFERIORS. THIS TECHNIQUE IS USED (RATHER THAN FFORK
;AND RFORK) IN ORDER TO PRESERVE THE FROZENNESS OF FORKS ACROSS
;A HANGUP ATTATCH SEQUENCE.

;FORK FREEZE INDIRECT:

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

;RESUME FREEZE INDIRECT

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

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

RFSTS5:	CALL SETJFK		;NOT MULTIPLE FORKS
RFSTS6:	HRRZ FX,SYSFK(T1)	;GET SYSTEM FORK INDEX
	MOVE P1,T1		;SAVE JOB INDEX
	CALL MRFSTS		;GET FORK STATUS WORD
	EXCH P1,T1		;SAVE STATUS. GET BACK JOB INDEX
	CALL SETLF1		;MAP PSB
RFSTS7:	UMOVE T2,1		;GET USER AC1
	TXNE T2,RF%LNG		;LONG FORM RFSTS?
	 JRST RFSLNG		;YES-- DO LONG FORM
	CAMN P1,[EXP -1]	;UNASSIGNED FORK HANDLE?
	 JRST RFSTSR		;YES-- JUST RETURN STATUS
	HLLZ T3,PFL(T1)		;GET FLAGS
	MOVE T2,PPC(T1)		;GET PC
	TXNN T3,UMODF		;USER MODE?
	JRST [	HLLZ T3,UPDL+1(T1) ;NO, USER 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
	MOVE T2,FKSWP(FX)
	TXNN T2,FKBLK		;FORK BLOCKED?
	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?
	TLNE T2,ABFRZB		; ?
	JRST [	TLO T1,.RFABK	;YES, RETURN PROPER CODE
		JRST MRFSTX]	; ..
	TLNE T2,JTFRZB		;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
	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
	HLRZ T3,ENTVEC(T1)	;SIZE OF VEC IN DEST 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
	MOVE T2,[PCU+SFRKV1]	;START FORK IN MONITOR
	JRST SFORK1

SFRKV2:	CALL CLRLFK
	ERRJMP(SFRVX1,ITFRKR)	;ILLEGAL RELATIVE NUMBER

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:	HRRZ T1,ENTVEC
	HRRZ T2,FORCTC		;RELATIVE ADDRESS
	HLRZ T3,ENTVEC		;SIZE OR JRST
	CAIN T3,<JRST>B53	;OLD STYLE?
	 JRST [	CAIN T2,0	;YES, 0 MEANS .JBSA
		UMOVE T1,.JBSA
		CAIN T2,1	;1 MEANS .JBREN
		UMOVE T1,.JBREN
		HLRZ T2,FORCTC	;Get start offset
		JRST .+1]
	ADD T1,T2
	HRRZ T2,T1
	MOVX T1,UMODF		;MAKE IT A USER PC
	RET
;START FORK

.SFORK::MCENT
	TXNE T1,^-<SF%CON!SF%PRH> ;ANY UNKNOWN BITS SET?
	 ITERR (DECRSV)		;YES-- GIVE ERROR
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	UMOVE T1,1		;GET ARG AGAIN
	CALL SETJFK
	UMOVE T2,1		;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
	UMOVE T2,2
	TLZ T2,(UIOF+2037B17)	;USER I/O, CALFRMMON, IDX AND IND OFF
	TLO T2,(UMODF)		;AND USER ON
SFORK1:	SETOM SLOWF(T1)		;NORMALIZE FLAG
	PUSH P,PFL(T1)
	HLLZM T2,PFL(T1)	;FIND FLAGS
	HRRZM T2,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 PC
	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
	MOVSI T2,FRZBAL
	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 T1,FORKN(T1)	;FIND THAT FORK'S CTTY
	IDIVI T1,2
	ADD T1,FKCTYP(T2)	;POINTER TO CTTY
	LDB T1,T1		;GET THE CTTY
	CALL UPDTI
	OKSKED			;MATCH NOSKED IN STPFK (SUSFK)
	CALLRET CLFRET
;MONITOR SFORK, CAN START IN MONITOR SPACE

.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
;**;[1721] Change 1 line at .MSFRK: +4L	JGZ	2-JUN-80
	TXNE T4,SC%WHL+SC%OPR	;[1721]MAKE THE CHECK
	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
	UMOVE 2,2		;EXCEPT BELIEVE PC AND ALL FLAGS
	JRST 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
	MOVE T2,FKSWP(FX)
	TXNN T2,FKBLK		;FORK BLOCKED?
	ERRJMP(FRKHX4,FACSE)	;NO
	MOVE T2,PFL(T1)		;GET CURRENT PC
	HRRZ T3,ACBAS(T1)		;GET AC STACK PTR
	TXNN 2,UMODF		;IN USER MODE?
	CAIGE 3,<UACB>B39	;OR TOP-LEVEL MON CALL?
	SKIPA 3,[UAC]		;YES, ACS IN SAVED BLOCK 1
	MOVEI 3,UACB		;NO, ACS IN TOP OF AC STACK
	ADDI 3,0(1)		;ADJUST INTO OTHER PSB
	XCTU [MOVE 2,2] 	;GET ADDRESS FROM USER
	RET

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

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

HFORK1:	PUSH P,1		;SAVE FORK NUMBER
	CALL STPFK		;STOP THE FORK
	MOVEI 2,HALTT
	MOVSI 3,FRZBAL
	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
	IDIVI T3,2		;FIND THAT FORK'S CTTY
	ADD T3,FKCTYP(T4)	;POINT TO THE CTTY
	LDB T1,T3		;GET THE DESIGNATOR
	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
	MOVSI T2,FHV1		;LOW BLOCK PRIORITY
	HDISMS
	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
	MOVSI T2,FHV1		;LOW BLOCK PRIORITY
	HDISMS
	JRST MRETN

	RESCD

TRMTST::MOVE T2,FKSWP(T1)
	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
;**;[2645]ADD 6 LINES AT TRMTST:+7L	TAM	4-AUG-82
	CAIE T2,FRZWT		;[2645]FROZEN?
	JRST 0(4)		;[2645]NO WAIT
	HLRZ 2,FKSTAT(1)	;[2645]GET PRE FREEZE STATE
	CAIE 2,HALTT		;[2645]HALTED?
;**;[2804]CHANGE 1 [2645] LINE AT TRMTST:+12L	TAM	8-SEP-82
	CAIN 2,FORCTM		;[2645][2804]OR FORCED TERM?
	JRST 1(4)		;[2645]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
	MOVE T2,FKSWP(FX)
	TXNN T2,FKBLK		;FORK BLOCKED NOW?
	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:	MOVSI 1,400000+SUSFKR	;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
	MOVSI T2,FHV5		;HIGHER BLOCK PRIORITY
	HDISMS
	JRST SUSF6		;NOW CHECK IT AGAIN

SUSF4:	SKIPN FKINT(7)		;TRANSITIONAL STATE?
	JRST SUSF5		;NO
	MOVSI 1,400000+SUSFKR	;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::MOVE T2,FKSWP(T1)
	TXNN T2,FKBLK		;FORK BLOCKED?
	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:	MOVSI 2,200000
	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
	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
;**;[2627] Change 1 line, Add 2 at GJCAPS:+1L	PED	11-JUN-82
	MOVE B,CAPENB(A)	;[2627] GET ENABLED CAPABILITIES
	AND B,CAPMSK(A)		;[2627] MASK OFF ANY WE SHOULDN'T HAVE
	PUSH P,B		;[2627] SAVE THEM OVER CALL
	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
	CAIN T1,400000		;SELF?
	JRST [	HRRZ T1,FORKN	;YES
		RETSKP]
	CAIL T1,-2		;-1 OR -2?
	XCT SETJFT+2(T1)	;YES - TRANSFER TO CORRECT ROUTINE
	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::
   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>
	SETZM W1		;INDICATE NESTING NOT ALLOWED
	JRST FLOCK1
;**;[2607] Add one line at FLOCK: +10L	JGZ	3-APR-82
	ENDAV.			;[2607] END ACVAR

;HERE TO ALLOW NESTING OF THE LOCK

FLOCKN::ACVAR <W1>
;**;[1869] Change 1L at FLOCKN:+1L	PED	8-MAY-81
	SETZM W1		;[1869] INDICATE NESTING ALLOWED
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

;**;[1974]CHANGE 1 LINE AT FLOCK1: + 6l	TAM	22-JAN-82
	JRST [	HRRZ W1,FORKN	;[1974] GET OUR JOB-WIDE FORK HANDLE ONLY
		MOVEM W1,FLKOWN	;SAVE IT AS THE OWNER
		SKIPE FLKCNT	;IF NOT ZERO, SOMETHING IS WRONG
		CALL [	BUG (FKCTNZ,<<JOBNO,D>,<FORKN,D>>)
			SETZM FLKCNT
			RET]
		AOS FLKCNT	;INCREMENT NEST COUNT
		MOVE W1,TODCLK	;GET NOW
		ADDI W1,^D120000 ;TIMEOUT IS 2 MINUTES
		MOVEM W1,FKTIMW	;AND 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
;**;[1869] Delete 1L, Change 2L at FLOCK1:+22L	PED	8-MAY-81
	HRRZ W1,FORKN		;[1869] GET OWNING FORK
	CAME W1,FLKOWN		;[1869] IS IT THIS ONE?
	JRST FLOCK3		;NO. FAIL
	AOS FLKCNT		;YES. INCREMENT NEST COUNT
;**;[1852] Add one line at FLOCK1: +27L	JGZ	23-APR-81
	SOS FKLOCK		;[1852] DON'T COUNT US HERE, WE GOT THE LOCK
	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,D>,<JOBNO,D>,<FLKOWN,D>>)
	SETZM FLKCNT		;ZERO THE NEST COUNT
	SETOM FLKOWN		;CLEAR THE OWNER
	SETOM FKLOCK		;TIMEOUT, CLEAR LOCK AND PROCEED
FLOCK2:	JRST FLOCK1
;**;[2607] Add one line at FLOCK2: +0L	JGZ	3-APR-82
	ENDAV.			;[2607] 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 NUMBER
	MOVEM T1,FKTIMW		;SET IT NEVER TO TIMEOUT
	SETO 1,
	EXCH 1,FKLOCK		;CLEAR LOCK, GET PREVIOUS VALUE
	ECSKED			;NO LONGER CRITICAL
;**;[2928]CHANGE 1 LINE AT FUNLK:+11	TAM	23-MAR-82
	JUMPL 1,FUNLK3		;[2928] OVER DECREMENTED
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.

;**;[2928] REMOVE 4 LINES AT FUNLK1:+0L	TAM	23-MAR-83
REPEAT 0,<			;[2928]
FUNLK1:	JUMPL 1,FUNLK3		;BUG IF LOCK NOT SET AT ALL
	MOVEI 1,^D200		;WAIT FOR 200 MS
	DISMS
	JRST FUNLK2
>				;[2928]

FUNLK3:	BUG(FLKNS)
	JRST FUNLK2
;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

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

;	CALL FKHPTN
;		OR
;	CALL FKHPTX

;RETURNS +1: ERROR
;		T1/ ERROR CODE
;	 +2: SUCCESS
;		T1/ PTN,,PN

;PRESERVES T2

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

FKHPTN::STKVAR <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
	SKIPA			;ANOTHER FORK OR SECTION NO. WAS SPECIFIED
	JRST [	LOAD T3,VSECNO,UPDL ;GET USER'S PC SECTION
		DPB T3,[POINT 9,T1,26] ;PUT IT INTO THE PAGE NUMBER
		JRST .+1]	;CONTINUE
	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
	MOVE T2,FORKN		;Get current JRFN
	JN SFGXO,(T2),FKHP2	;If current process doing execute-only GET
				; then skip execute-only check
	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
		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 T3,T1		;COMPUTE INDEX INTO OTHER PSB
	SKIPN T3,USECTB(T3)	;GET SECTION POINTER
	JRST [	CALL CLRLFK	;UNMAP PSB
		JRST FKHPE1]	;GIVE PROPER ERROR
	LOAD T3,SPTX,T3		;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
	MOVE T1,SAV1		;GET BACK ARG
FKHP3:	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
	HRLI T1,-MXSECN-1
PTNF8:	LOAD T3,STGADR,USECTB(T1) ;GET SPT INDEX
	CAMN T3,PTNFPT		;IS THIS THE ONE WE WANTED?
	JRST [	HRRZ T2,T1	;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 T1,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
;**;[1752] CHANGE 1 LINE AT ATX2E: +5L	ARS	26-JUN-80
	CAIL 3,^D23		;[1752] ALLOW CH23 AND ABOVE
	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)
	MOVEI T3,(T4)
	IDIVI T3,2		;COMPUTE POINTER TO THE FORK'S CTTY
	ADD T3,FKCTYP(T4)
	LDB T1,T3
	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
	IDIVI T2,2		;COMPUTE SOURCE OF FORK'S PSI'S
	ADD T2,FKCTYP(T3)
	LDB T1,T2		;GET THE DESIGNATOR
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
	MOVEI Q2,0(T3)		;FORKN
	PUSH P,Q2+1		;PRESERVE AC OVER DIVIDE
	IDIVI Q2,2		;FIND THE FORK'S CTTY
	ADD Q2,FKCTYP(Q2+1)
	POP P,Q2+1		;RESTORE
	LDB Q2,Q2
	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
	MOVSI Q2,JTFRZB		;IS IT A JSYS TRAP FREEZE?
	TDNN Q2,FKINT(FX)	; ..
	JRST UPDT6		;NO, ORDINARY FREEZE
	MOVSI 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)
	IDIVI T1,2		;COMPUTE POINTER TO FORK'S CTTY
	ADD T1,FKCTYP(T2)
	LDB T1,T1		;GET THE DESIGNATOR
	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:	IDIVI T1,2		;COMPUTE POINTER TO FORK'S CTTY
	ADD T1,FKCTYP(T2)
	LDB T1,T1		;GET DEVICE DESIGNATOR
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
;**;[2943]	Change one line at .EPCAP+4	YKT	04-APR-83
	GTOKM (.GOCAP,<T3>,MRETN)	;[2943] NO ERROR ROUTINE NEEDED
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:	MOVE 2,CAPENB(1)	;GET THE ALLOWED BITS
	TXNN 2,SC%WHL		;THIS PROCESS HAVE WHEEL?
	AND 3,CAPMSK(1)		;NO, ONLY ALLOW MODES IN MASK
	MOVEM 3,CAPENB(1)
	JRST CLFRET
;SWTRP JSYS. SET AND READ USER-MODE TRAPS. CALLING SEQUENCE IS:
;	T1/ FORK HANDLE
;	T2/ FUNCTION
;	T3/ FUNCTION DEPENDENT ARG
;ITRAP ON ANY ILLEGAL ACT

.SWTRP::MCENT			;ESATBLISH 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)
	TLNN 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
	TLNN 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:	MOVSI T1,PSIJTR		;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
	MOVSI T2,JTFRZB
	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
	MOVSI T2,JTFRZB
	ANDCAB T2,FKINT(FX)	; Clear JSYS trap freeze
	TLNE T2,FRZBB		; Is fork still frozen?
;**;[2617] REPLACE 1 LINE WITH 2 AT UTFRK2:+7L	TAM	6-MAY-82
	 JRST [SETOM INTDF(T1)	;[2617] YES, MAKE IT OKINT
	       JRST UTFRK0]	;[2617] AND FINISH UP
	SKIPN T2,PIOLDS(T1)	; No, resume it
	JRST [	CALL UNBLK1	; Unblock fork
		JRST UTFRK3]
	MOVEM T2,FKSTAT(FX)
;**;[1950] Add one line at UTFRK2: +12L		RAS	30-SEP-81
	SETOM INTDF(T1)		;[1950] 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:	HRRZ T1,P1		; Job fork number
	IDIVI T1,2
	ADD T1,FKCTYP(T2)	; Make ptr into tbl
	LDB T2,T1		; Get the proper entry
	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:	CALL CHKSCT		; Quit if not allowed to do this
	MOVE T2,P2		; Get designator
	TRZN T2,1B18		; DES = 4XXXXX?
	 ITERR(DESX1,<CALL FUNLK>) ; No
	CAIGE T2,NLINES		; Check as a legal line #
	CAIGE T2,0
	 ITERR(DESX1,<CALL FUNLK>) ; Isn't
	LOCK DEVLCK,<CALL LCKTST>
	CALL GTCJOB		; WHO OWNS THIS TTY?
	 CAIA			; NOBODY
	CAME T3,JOBNO		; US?
	 ITERR(DEVX2,<UNLOCK DEVLCK
			CALL FUNLK>)
	CAMN T2,CTRLTT		; Job CTTY?
	 ITERR(SCTX3,<UNLOCK DEVLCK
			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,<UNLOCK DEVLCK
			CALL FUNLK>)
	MOVEI T1,-2		; This is just a "different" value
	CALL STTOPF		; SET TOP FORK TO "ASSIGNING"
	UNLOCK DEVLCK
	MOVE T3,P2		; Retrieve original designator
	JRST SCTT21		; Enter mainline
; Function to remove special controlling terminal from a fork and
; its inferiors. It reverts to the job's CTTY.

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

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

SCTT21:	MOVE P3,T3		; New designator
	HRRZ T2,FORKN		; Fork number of self
	HRRZ T1,P1		; Job fork number we are setting
	CAIN T2,0(P1)		; Setting own CTTY?
	CALL MAPINF		; Yes, freeze inferiors only
;**;[1783] Change one line at SCTT21: +5L	JGZ	15-SEP-80
	 CALL FFORK3		;[1783] 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.
	IDIVI Q1,2		; Get the CTTY of the superior
	ADD Q1,FKCTYP(Q2)
	CAIE T4,0(T1)		; Fork being changed=top job fork?
	 LDB T2,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
;**;[1783] Change one line at SCTT22: +3L	JGZ	15-SEP-80
	 CALL RFORK3		;[1783] 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:	MOVEI Q1,0(T1)		; Fork index
	IDIVI Q1,2
	ADD Q1,FKCTYP(Q2)	; Make ptr to correct entry
	LDB T4,Q1		; Get old CTTY
	DPB T3,Q1		; 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

	TNXEND
	END