;<FOONEX>FORKS.MAC;20 18-Mar-81 21:01:28, Edit by MMCM
; ERJMP/ERCAL
;<134-TENEX>FORKS.MAC;19    18-Jun-80 15:49:26    EDIT BY LYNCH
; MERGED IN SRI JSYS TRAP FIXES.
;DSK:<134-TENEX>FORKS.MAC;17  7-May-80 11:14:32, Edit by FRENCH
;DON'T ALLOW DISABLING OF TTJTIW BIT 30,31,32
;DON'T ALLOW DEFERRING OF TIW BITS 30,31,32
;<134-TENEX>FORKS.MAC;16    22-Sep-78 20:03:39    EDIT BY PETERS
;<134-TENEX>FORKS.MAC;15    22-Sep-78 19:58:25    EDIT BY PETERS
;<134-TENEX>FORKS.MAC;14    22-Sep-78 19:36:07    EDIT BY PETERS
;<TENEX-SOURCES>FORKS.MAC;13420     1-DEC-77 17:01:53    EDIT BY CHASE
;[ISI] Made TRMTST external for SCHED
;<TENEX-SOURCES>FORKS.MAC;5513  11-MAY-77 15:35:20  EDIT BY B-SMITH
;[ISI] Fixed ^P code check in STIW
;<XTENEX>FORKS.MAC;5512    15-MAR-77 21:03:37    EDIT BY ALFVIN
;[ISI] Fix to conditional code to run right without TCP set
;<XTENEX>FORKS.MAC;5511     1-DEC-76 19:09:12    EDIT BY ALFVIN
;[ISI] Conditional code for TCP
;<XTENEX>FORKS.MAC;5510     1-DEC-76 06:59:50    EDIT BY BOYNTON
;<XTENEX>FORKS.MAC;5509    26-NOV-76 20:20:21    EDIT BY BOYNTON
;[ISI] TRY TO HELP THE KI'S AC BLOCK PROBLEM.
;<XTENEX>FORKS.MAC;5508   1-OCT-76 05:36:22  EDIT BY B-SMITH
;[ISI] New GFRKS
;[ISI] added DAFKSH and Call at KFORK0, Bug fix: KSELF+8; UPDT5+1
;<XTENEX>FORKS.MAC;5503  17-MAY-76 13:22:59  EDIT BY DALE
;[BBN] HFORK1+5/ MOVSI 3,FRZBAL
;<XTENEX>FORKS.MAC;5502  23-FEB-76 18:29:15  EDIT BY DALE
;[ISI] TAFT questional code fix @ .SPLFK+3
;<XTENEX>FORKS.MAC;5501  22-JAN-76 20:47:29  EDIT BY DALE
;[ISI] added JSYS: GFRKS, IIT
;[ISI] .SFRKV+22/ IFN KIFLG,< HRLI 2,(1B6) >
;<134-TENEX>FORKS.MAC;55     9-OCT-75 16:55:49    EDIT BY BTHOMAS
; RELAX RESTRICTION ON USE OF SPLFK WHEN FORKS IN QUESTION ARE
; SUBJECT TO JSYS TRAPS - ALLOW SPLFK TO OCCUR IF FORK 1 (THE NEW
; SUPERIOR) IS THE IMMEDIATE TRAPPER OF FORK 2 (THE NEW INFERIOR).
;<134-TENEX>FORKS.MAC;54    26-SEP-75 13:22:08    EDIT BY BTHOMAS
; FIX SETRP1 TO PROPERLY HANDLE BIT TABLE WITH ALL ZEROS
;<134-TENEX>FORKS.MAC;52     4-JUL-75 11:57:10    EDIT BY CALVIN
; Made reference to MINUS1 extern'd (##)
;<134-TENEX>FORKS.MAC;51    30-JUN-75 12:59:16    EDIT BY PLUMMER
; GFRKH CAN NOW GET HANDLES ON SUPERIORS OF OTHER FORKS
;<134-TENEX>FORKS.MAC;50    29-APR-75 14:14:20    EDIT BY BTHOMAS
; FIX UPDTI TO INCLUDE TERM PSI'S OF FORKS WHICH ARE FROZEN ONLY BY
; JSYS TRAPS.
;<134-TENEX>FORKS.MAC;49    25-APR-75 12:32:33    EDIT BY TOMLINSON
;<134-TENEX>FORKS.MAC;48    24-APR-75 10:17:00    EDIT BY TOMLINSON
;<134-TENEX>FORKS.MAC;47    23-APR-75 16:39:38    EDIT BY CLEMENTS
; FIX MISSING EXTERNS IN NEW ERROR RETURN PATH OF SPLFK
;<134-TENEX>FORKS.MAC;46    23-APR-75 13:56:57    EDIT BY TOMLINSON
; REPAGINATED
; CORRECT BUG IN RFORK IN TEST OF TCITST FOR NVTS
; FIX BUG IN MAPINF TO RESTORE 16 AFTER EACH OPERATION
; SPLFK & KFORK FREEZE ALL INFERIORS FIRST TO INTERLOCK FORK STRUCTURE
;  MANIPULATIONS
; REVERSE ORDER OF FORK SUSPENSION AND FREEZING OF INFERIORS IN FFORK0
;<134-TENEX>FORKS.MAC;45    12-MAR-75 13:10:56    EDIT BY PLUMMER
; CALL TO SIGNAL.MAC IN KSEF0
;<134-TENEX>FORKS.MAC;44    11-FEB-75 17:36:32    EDIT BY ALLEN
; FIX BUG IN WTFKT
;<134-TENEX>FORKS.MAC;43    31-JAN-75 16:35:19    EDIT BY ALLEN
; ADD MISSING NOSKED-OKSKED IN RFSTS
;<134-TENEX>FORKS.MAC;42    30-JAN-75 00:05:08    EDIT BY ALLEN
; CORRECT ERRORS IN TESTING FOR WAITING FORK
;<133-TENEX>FORKS.MAC;41    23-DEC-74 00:42:11    EDIT BY ALLEN
;<133-TENEX>FORKS.MAC;39    22-DEC-74 23:06:25    EDIT BY ALLEN
; CHANGE STORAGE DEFINITIONFOR FORK GROUP TABLES
;<133-TENEX>FORKS.MAC;38    21-DEC-74 11:59:40    EDIT BY ALLEN
;<133-TENEX>FORKS.MAC;37    21-DEC-74 11:42:18    EDIT BY ALLEN
; MOVED CHKWT ROUTINE TO SCHED WHERE IT BELONGS
;<133-TENEX>FORKS.MAC;35    19-DEC-74 21:31:49    EDIT BY CALVIN
; FIX-UP EXTERN PROBLEM WITH WTFK, BLST, RNLS & FKPGST
;<133-TENEX>FORKS.MAC;34    19-DEC-74 17:50:25    EDIT BY ALLEN
; ADDED CHKWT ROUTINE FOR CHECKING FOR WAITING FORK BEING HELD
; IN BALANCE SET
;<133-TENEX>FORKS.MAC;33    13-DEC-74 10:32:17    EDIT BY TOMLINSON
; FIX NVT CHECK IN RFORK1 FOR CONTROLLING TERMINAL CASE
;<133-TENEX>FORKS.MAC;32     8-DEC-74 18:30:23    EDIT BY CLEMENTS
; INTERNED JTRPON SO OPRFN CAN SET IT
;<133-TENEX>FORKS.MAC;31    12-OCT-74 20:00:47    EDIT BY ALLEN
;<133-TENEX>FORKS.MAC;30    11-OCT-74 16:21:40    EDIT BY ALLEN
;<133-TENEX>FORKS.MAC;29    30-SEP-74 13:33:06    EDIT BY ALLEN
; CORRECT LOGIC FOR CREATING AND DELETING FORK IN PIE-SLICE SYSTEM
;<133-TENEX>FORKS.MAC;28    25-SEP-74 13:31:08    EDIT BY TOMLINSON
; MSFRK: TEST RIGHT HALF NOT LEFT FOR WHEEL+OPER
;<133-TENEX>FORKS.MAC;27    25-SEP-74 13:24:56    EDIT BY ALLEN
; PREVENT PIE-SLICE GROUP CHANGE IF FORK IS NOT RECORDED IN SYSFK
; SUCH AS WHEN BEING BORN OR WHEN DYING
;<133-TENEX>FORKS.MAC;26     6-SEP-74 13:27:25    EDIT BY ALLEN
; CALL LCKTST ON FAILURE TO LOCK DEVLCK
;<133-TENEX>FORKS.MAC;25    28-AUG-74 11:33:41    EDIT BY BTHOMAS
; SET SWITCH TO HAVE JSYS TRAP DEFAULT BE ON
;<133-TENEX>FORKS.MAC;24    15-AUG-74 15:38:38    EDIT BY CLEMENTS
; ADDED MISSING SWAPC AT BEGINNING OF ASSEMBLY
;<TENEX-132>FORKS.MAC;23    16-MAY-74 13:14:36    EDIT BY ALLEN
; CLEAN UP RELEASE OF PSB MAP ENTRIES IN KSELF. DO NOT RELEASE
; UPT ENTRY IN CASE PAGER TRAP OCCURS (MAY REF UPT).

SEARCH PROLOG

TITLE FORKS

INTERN .CFORK,.KFORK,.FFORK,.RFORK,.RFSTS,.SFORK,.SPLFK
INTERN .RFACS,.SFACS,.HFORK,.WFORK,.SFRKV,.SEVEC,.GEVEC
INTERN .RPCAP,.EPCAP,.GCVEC,.SCVEC,.MSFRK
INTERN .AIC,.ATI,.BPT,.CIS,.DIC,.DIR,.DTI,.EIR,.GFRKH,.GPJFN
INTERN .GTRPW,.IIC,.RCM,.RFRKH,.RIR,.RIRCM,.RTIW,.RWM,.SIR
INTERN .SIRCM,.SJPRI,.SKPIR,.SPJFN,.SPRIW,.STIW,.WAIT
INTERN .SCTTY,.CFGRP,.TFORK,.RTFRK,.UTFRK
INTERN .GFRKS,.IIT

INTERN SETLFK,SETJFK,SETLF1,CLRLFK,CLFRET,DTIALL
INTERN FKHPTN,FRZWT,KSELF,MAPFKH,PTNFKH,SKIIF,SKIIFA,TTFRKT,MAPINF
INTERN FFORK1,RFORK1,RLJBFK,GFKH

EXTERN FKQ,PSIWTF,NEWFKF,FRZBAL,TRPSI5,PSIJTR
EXTERN ASGPAG,JTULCK,MKSHRP,RELPAG,SETDVP,JTDVC1,JTMCN,JTFRZB
EXTERN BUGCHK,BUGHLT,MENTR,MRETN,FORKX,FKJOB,SYSFK,SUPERP,INFERP,PARALP
EXTERN MRETNE,RSKP,R,SKMRTN,SETPT,WTLST,EDISMS,FREJFK,FKPTRS
EXTERN BHC,BITS,HLTFK1,SPTC,SPC1,FREFK,ASSFK,PRIMRY,CAPMSK,CAPENB
EXTERN JSKP,FKSTAT,WTFPGS,FKINTT,FKINTW
EXTERN FKPGS,FRZB1,FRZB2,FRZBB,FKINT,FKPT,ITRAP1,WHEELX,JOBRT
EXTERN JOBPT,FKPGS,SETMPG,ISKED,PSKED,CLRM0,CAPX,FORCTM,GETCHA
EXTERN HALTF1,HALTT,ITRAP,JRET,PSICH,PSICHL,PSICHO,PSICHU
EXTERN PSIR4,PSIRQB,SETOVF,SUSFKR,SUSWT,TCITST,TTDPSI,TTFORK,TTPSI
EXTERN TTFRKP,DEVLCK,BLOCK1

IFDEF IMPCHN,<EXTERN NETKFK>
IFDEF DSPCHN,<EXTERN DSPKFK>

;NON RESIDENT FORK TABLES FOR FORK GROUP MECHANISM
NGS FKDIR,NFKS		;FORK DIRECTORIES:
			; FOR TOP FORK=CONN DIR,,LOGIN DIR
			; FOR OTHERS IN GROUP=-1,,SYS FORK INDEX TOP
NGS FKGRPS,NFKS		;FOR GROUP BITS, PARALLEL TABLE TO FKDIR
			; VALID ENTRIES FOR TOP FORK IN GROUP ONLY

	SWAPCD		;MOST OF THIS MODULE IS NON-RESIDENT

;FORK CREATION AND CONTROL JSYS'S

.CFORK:	JSYS MENTR
	NOINT			; Note this also prevents superiors
				;  from manipulating fork structure here

	MOVEI 1,-1
	CALL GFKH		;GET LOCAL HANDLE
	RETERR FRKHX6		;NONE
	PUSH P,1		;SAVE IT
	NOSKED
	MOVE 2,SPTC		;CURRENT SPT COUNT
	CAML 2,SPC1		;ROOM LEFT?
	JRST CFBAD		;NO
	SKIPE FREFK		;ROOM IN SYSTEM?
	SKIPN FREJFK		;ROOM IN JOB?
	JRST CFBAD		;NO
	CALL ASSFK		;ASSIGN FORK IN SYSTEM
	MOVE 1,FORKX
	MOVE 1,FKJOB(1)		;GET JOB NO AND JSB
	MOVEM 1,FKJOB(7)	;SET FOR NEW FORK
	CALL ASSJFK		;ASSIGN JOB FORK SLOT
	PUSH P,1		;SAVE RESULT
	OKSKED
	MOVSI 1,0(7)
	CALL WAITFK		;WAIT FOR IT TO INITIALIZE
	POP P,1			;GET SAVED JOB FORK SLOT
	SETZM FKPTRS(1)
	SETZM FKPSIE(1)
	SETZM FKDPSI(1)
	HRRO 2,FORKX
	SKIPGE 3,FKDIR(2)
	HRROI 2,0(3)		;2=-1,,SYS INDEX TOP FORK IN GROUP
	MOVEM 2,FKDIR(7)
	HRRZ 2,FORKN
	HLL 7,SYSFK(2)		;7=DES CTTY THIS FORK,,SYS INDEX NEW FRK
	MOVEM 7,SYSFK(1)

IFN PIESLC,<
	MOVSI 6,NOCNT##		;INDICATE NOW OK TO MAINTAIN NAPROC
	ANDCAM 6,FKFLGS##(7)
> ;END PIE-SLICE SCHEDULER CONDITIONAL

	MOVEI 6,FKPTRS(2)	;PUT NEW FORK INTO STRUCTURE LISTS
	HLL 6,INFERP
	LDB 3,6			;GET INFERIORS OF THIS FORK
	DPB 1,6			;PUT NEW FORK AT HEAD OF IT
	MOVEI 6,FKPTRS(1)
	HLL 6,SUPERP
	DPB 2,6			;THIS FORK IS SUPERIOR OF NEW FORK
	HLL 6,PARALP
	DPB 3,6			;OTHER INFERIORS ARE PARALLEL TO NEW FORK
; falls thru

; fallen into
	PUSH P,1
	CALL SETLF1		;MAP PSB OF NEW FORK
	MOVE 2,0(P)		;NEW FORK'S JOB HANDLE
	MOVEM 2,FORKN(1)
	HRLM 2,FKTAB(1)		;JOB HANDLE TO FKTAB SLOT FOR 400000
	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)
	HRRZ 2,JTMNW		;GET MONITOR OF EXECUTING FORK
	CAIN 2,7777		;NULL MONITOR?
	JRST CFORK1		;YES.
	HRRM 2,JTMNW(1)		;NO, SET NEW FORK'S MONITOR
	MOVSI 2,JTBTB		;AND SET ITS JSYS TRAP BIT TABLE
	HRRI 2,JTBTB(1)
	BLT 2,JTBTB+JTBSIZ-1(1)
	EXCH 1,0(P)		;EXCH PSB PTR AND FORK INDEX
	LDB 2,[POINT 13,PSB+JDVPG,26]
	CALL SETFJD		;SET FORK'S JSYS DISP VECTOR FOR TRAPS
	EXCH 1,0(P)		;RESTORE PSB PTR

CFORK1:	UMOVE 2,1		;GET ARG
	TLNE 2,(1B0)		;SAME MAP?
	CALL CFK4		;YES
	TLNE 2,(1B1)		;GIVE SPEC CAP?
	CALL CFK3
	TLNE 2,(1B3)		;INIT AC'S?
	CALL CFK1		;YES
	TLNE 2,(1B4)		;START FORK
	CALL CFK2
	CALL CLRLFK		;UNMAP PSB
	POP P,1
	MOVE 2,0(P)		;LOCAL HANDLE
	ANDI 2,377777
	IDIVI 2,2
	ADD 2,FKPTAB(3)
	DPB 1,2			;PUT JOB INDEX IN LOCAL TABLE
	POP P,1			;RETURN LOCAL HANDLE
	UMOVEM 1,1
	AOS 0(P)
	JRST MRETN

CFBAD:	OKSKED
	RETERR CFRKX3		;NO ROOM

;FORK CONTROL SUBRS

CFK1:	XCTUU [HRLZ 3,2]	;GET LOC OF INITIAL AC'S
	HRRI 3,PAC(1)		;MOVE TO NEW FORK'S PSB
	XCTUM [BLT 3,PAC+17(1)]
	RET

CFK2:	MOVEI 3,0(2)		;START ADDRESS
	HRLI 3,UMODF		;IN USER MODE
	MOVEM 3,PPC(1)
	MOVEI 3,JSKP
	MOVEM 3,FKSTAT(7)	;MAKE FORK RUNNABLE
	RET

CFK3:	MOVE 3,CAPMSK		;GIVE NEW FORK SAME SPEC CAP
	MOVEM 3,CAPMSK(1)
	MOVE 3,CAPENB
	MOVEM 3,CAPENB(1)
	RET

;'SAME MAP' BIT - CAUSES MAP OF INFERIOR TO BE FILLED WITH
;IND PTRS TO SUPERIOR

CFK4:	PUSH P,1
	PUSH P,2
	MOVSI 4,-1000		;SIZE OF MAP
	MOVE 1,FORKX
	HLLZ 1,FKPGS(1)		;SOURCE IS THIS FORK
	HLLZ 2,FKPGS(7)		;DEST IS NEW FORK
	MOVSI 3,RWX
CFK41:	HRRI 1,0(4)
	HRRI 2,0(4)		;EQUIV EACH PAGE
	CALL SETPT
	AOBJN 4,CFK41
	POP P,2
	POP P,1
	RET

; SPLICE FORK STRUCTURE
; 1/  FORK HANDLE OF NEW SUPERIOR
; 2/  FORK HANDLE OF FORK TO BECOME INFERIOR
; FORK SPECIFIED BY 2 IS MADE AN IMMEDIATE INFERIOR OF THAT SPECIFIED
; BY 1
; RETURNS FORK HANDLE OF 2 RELATIVE TO 1

DEFINE	SPLERR(ERN)<
	JRST [	MOVEI 1,ERN##
		JRST SPLER]
>

.SPLFK:	JSYS MENTR
	NOINT
	CALL FALLI		; PREVENT INFERIORS FROM MANIPULATING
	XCTUU [HRRZ 1,1]	;[ISI]
	CALL RLJBFK		; FIND JOB FORK HANDLE
	 SPLERR(FRKHX1)
	PUSH P,1		; SAVE IT
	CALL SKIIF		; MUST SELF OR INFERIOR
	 SPLERR(SPLFX1)		; NOT, FAIL
	XCTUU [HRRZ 1,2]
	CALL RLJBFK		; FIND JOB HANDLE FOR F2
	 SPLERR(FRKHX1)
	PUSH P,1		; SAVE IT
	CAME 1,FORKN		; MUST BE STRICTLY INFERIOR
	CALL SKIIF
	 SPLERR(SPLFX2)
	MOVE 1,-1(P)		; ADDITIONALLY
	MOVE 2,0(P)		; F1 MUST NOT EQUAL OR INFERIOR TO
	CALL SKIIFA		; F2
	 SKIPA
	 SPLERR(SPLFX3)
	MOVE 1,0(P)
	CALL SETLF1		; MAP F2'S PSB
	HRRZ 2,JTMNW(1)		; GET F2'S MONITOR
	MOVE 1,-1(P)
	CALL SETLF1		; MAP F1'S PSB
	HRRZ 3,JTMNW(1)		; GET ITS MONITOR
	CAIE 2,0(3)		; F1 AND F2 HAVE SAME MONITOR?
	CAMN 2,-1(P)		; OR IS F1 THE IMMEDIATE MONITOR OF F2?
	 CAIA			; YES.
	jrst	splfk4		; Maybe traps will prevent splice
splfk0:	MOVE 1,0(P)		; POINTERS
	ADD 1,SUPERP		; POINTER TO SUPERIOR OF F2
	LDB 1,1
	ADD 1,INFERP
SPLFK1:	LDB 2,1			; SEARCH FOR F2
	CAMN 2,0(P)
	 JRST SPLFK2		; FOUND F2
	MOVE 1,2
	ADD 1,PARALP
	JRST SPLFK1

SPLFK2:	ADD 2,PARALP
	LDB 3,2			; GET SUCCESSOR
	DPB 3,1			; AND PATCH AROUND F2
	MOVE 1,0(P)		; GET F2 AGAIN
	MOVE 2,-1(P)		; AND F1
	ADD 2,INFERP
	LDB 3,2			; GET FIRST INFERIOR OF F1
	DPB 1,2			; MAKE F2 NEW FIRST INFERIOR OF F1
	ADD 1,PARALP
	DPB 3,1			; APPEND OLD INFERIORS OF F1 TO F2
	MOVE 1,0(P)		; F1
	ADD 1,SUPERP
	MOVE 2,-1(P)		; F2
	DPB 2,1			; MAKE F1 SUPERIOR OF F1
	MOVE 1,-1(P)		; GET FORK HANDLE OF F1
	CALL SETLF1		; MAP PSB
	HRL 1,0(P)
	MOVSS 1			; SET UP ARG FOR GRFKH
	CALL GRFKH		; GET FORK HANDLE F2 RELATIVE TO F1
	 SETZ 1,		; RETURN 0 IF FAILED
	UMOVEM 1,1
	CALL CLRLFK

SPLFK3:	HRRZ 1,0(P)		;NEW INFERIOR
	HRRZ 7,SYSFK(1)
	MOVSI 2,FRZB1
	IORM 2,FKINT(7)		; NEW INFERIOR ALWAYS BECOMES FROZEN
	CALL RALLI		; RESUME ALL INFERIORS
	SUB P,BHC+2		; STACK BACK TO RIGHT LEVEL
	JRST SKMRTN

; Check whether splicing will work with traped forks
; If the new superior isnt superior at all and is being traped,
; Then we cant be sure F2's inferiors will get F1's superiors'
; Traps so no dice -- Otherwise we reset F2's trap environment
; To same as F1's immediate inferior (its superior) and everything
; Fine.

splfk4:	move	1, (p)		; Maybe traps will prevent splice
	move	2, -1(p)	; Is F1 superior to F2 presently?
	call	skiifa			; Check it
	 jrst	[move	1, -1(p)	; No, see if F1 is being monitored
		call	setlf1
		hrrz	2, jtmnw(1)
		caie	2, 7777
		 splerr	splfx4		; Yes, cant do it right then
		jrst	splfk6]		; Looks ok

	move	2, (p)			; Get superior of F2 that is
splfk5:	movei	3, (2)			; Immediate inferior of F1
	add	2, superp
	ldb	2, 2
	came	2, -1(p)		; Is this guy inferior of F1?
	 jrst	splfk5			; Nope, try again
	movei	1, (3)			; Yep, get it psb
	call	setlf1
	movei	11, (1)		
	hrrz	2, jtmnw(11)		; Get its trap environment
	came	2, -1(p)		; Is it F1?
splfk6:	setz	11,			; No, make F2's the same as F1
	move	4, [point 13, jdvpg+psb(11),26]
	ldb	3, 4			; F2's new dispatch vector
	hrri	4, 1(p)			; BLT new jtbtb for F2 onto stack
	hrli	4, jtbtb(11)
	blt	4, jtbsiz(p)		; Map F2's psb
	move	1, 0(p)
	add	p, [jtbsiz,,jtbsiz]
	jumpge	p, mstkov##		; No room on stack?
	call	setlf1			; Ok, do it
	sub	p, [jtbsiz,,jtbsiz]	; Back to normal
	hrrm	2, jtmnw(1)		; F2's new trapper
	hrli	4, 1(p)
	hrri	4, jtbtb(1)
	blt	4, jtbtb+jtbsiz-1(1)	; F2's new jtbtb
	move	1, (p)
	move	2, 3
	call	setfjd			; F2's new jsys disp vector
	jrst	splfk0			; F2 aok now go splice it

SPLER:	MOVEM 1,LSTERR##
	CALL RALLI		; RESUME ALL INFERIORS
	MOVE 1,LSTERR
	JRST MRETNE

WAITFK:	HRRI 1,WTFKT
	JSYS EDISMS
	RET

	RESCD			;SCHEDULER TEST, MUST BE RESIDENT

WTFKT:	MOVSI 2,WTLS##		;SEE IF FORK ON WAITLIST
	TDNN 2,FKFLGS(1)
	JRST 0(4)		;NO
	MOVE 2,FKINT(1)		;YES, CHECK THAT HAS DONE INIT'ING
	TLNE 2,NEWFKF		;BY TESTING IF NEW FORK INT PROCESSED.
	JRST 0(4)		;NO
	JRST 1(4)		;YES

;TEST FOR WAITING FORK. FORKX IN 1. CALLS SCHEDULER CHKWT ROUTINE.
TSTWT:	PUSH P,7
	MOVEI 7,(1)
	CALL CHKWT
	 CAIA			;NOT WAITING
	AOS -1(P)		;WAITING
	POP P,7			;RESTORE 7
	RET

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

	SWAPCD

.SEVEC:	JSYS MENTR
	CALL SETLFK
	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:	ITERR SEVEX1		;NOT LEGAL
SEV1:	MOVEM 2,ENTVEC(1)
	JRST CLFRET

.GEVEC:	JSYS MENTR
	CALL SETLFK
	MOVE 2,ENTVEC(1)
GCV1:	UMOVEM 2,2
	JRST CLFRET

;GET/SET COMPATIBILITY ENTRY VECTOR AND PARAMETERS

.GCVEC:	JSYS MENTR
	CALL SETLFK
	MOVE 2,PATADR(1)
	MOVE 3,PATUPC(1)
	HRL 3,PATU40(1)
	UMOVEM 3,3
	JRST GCV1

.SCVEC:	JSYS MENTR
	CALL SETLFK
	MOVEM 2,PATADR(1)
	HRRM 3,PATUPC(1)
	HLRM 3,PATU40(1)
	JRST MRETN

;GET TRAP WORDS FROM FORK

.GTRPW:	JSYS MENTR
	CALL SETLFK		;MAP PSB
	MOVE 2,UTRSW(1)		;TRAP STATUS WORD
	UMOVEM 2,1		;RETURNED IN 1
	MOVE 2,UTRWD(1)		;WRITE DATA
	UMOVEM 2,2		;RETURNED IN 2
	JRST CLFRET

;SET SCHEDULER PRIORITY WORD

.SPRIW:	JSYS MENTR
	MOVE 2,CAPENB
	TRNN 2,WHEEL+OPER
	JRST WHEELX		;MUST BE PRIVILEGED
	CALL SETLFK
SPRI1:	UMOVE 2,2
	MOVEM 2,JOBBIT(1)
	JRST CLFRET

;SET PRIORITY WORD FOR ANOTHER JOB

.SJPRI:	JSYS MENTR
	MOVE 2,CAPENB
	TRNN 2,WHEEL+OPER
	JRST WHEELX
	NOINT
	CAIL 1,0		;LEGAL JOB NUMBER?
	CAIL 1,NJOBS
	JRST MRTNE1##		;NO
	SKIPGE JOBRT(1)		;JOB EXISTS?
	JRST MRTNE1		;NO
	HRRZ 1,JOBPT(1)		;TOP FORK
	HRRZ 1,FKPGS(1)		;ITS PSB
	MOVE 2,[XWD RWX,FPBPGA]
	CALL SETMPG		;MAP IT
	MOVEI 1,FPBPGA-PSB
	AOS 0(P)		;DO SKIP RETURN FOR OK
	JRST SPRI1

;GET AND SET PRIMARY IO JFN'S

.GPJFN:	JSYS MENTR
	CALL SETLFK
	MOVE 2,PRIMRY(1)
	UMOVEM 2,2
	JRST CLFRET

.SPJFN:	JSYS MENTR
	CALL MAPFKH
	 CALL SPJFN1
	JRST MRETN

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

.KFORK:	JSYS MENTR
	NOINT			; Note this also prevents manipulation of fork
				; structure by superiors.
	CALL FALLI		; And this for inferiors
	XCTUM [HRRZ 1,1]
	CAIN 1,-4		;ALL INFERIORS?
	JRST KFORK2		;YES
	CALL SETJFK		;NO, ANY ONE FORK
	CAMN 1,FORKN		;SELF?
	 JRST [	CALL RALLI	; YES, NOT PERMITTED
		MOVEI 1,KFRKX2##
		JRST ITRAP1]
	CALL SKIIF		;INFERIOR?
	 JRST [	CALL RALLI
		JRST FRKE2]
	CALL KFORK1		;KILL IT
	CALL RALLI
	JRST MRETN

KFORK2:	CALL KALLI		;KILL ALL INFERIORS
	JRST MRETN		; NO NEED TO RESUME THEM; THEY'RE GONE

KFORK1:
KFORK0:	CALL DAFKSH		;[ISI] REL FK HANDLE (THIS AND BELOW)
	MOVE 6,1
	HRRZ 7,SYSFK(6)
	CAMN 7,FORKX		;THIS FORK?
	 JRST [	CALL RALLI
		MOVEI 1,KFRKX2
		JRST ITRAP1]
	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,PPC(1)		;TOUCH PAGE BEFORE GOING NOSKED
	NOSKED
	MOVEI 2,KSELF
	MOVEM 2,PPC(1)		;START IT SO AS TO KILL ITSELF
	MOVEI 2,JSKP
	HRRM 2,FKSTAT(7)
	OKSKED
	RESKED
	CALL CLRLFK
	MOVSI 1,0(7)
	HRRI 1,KFK0T
	JSYS EDISMS		;WAIT TILL FORK IS KILLED
	MOVEI 1,JSKP
	HRRM 1,FKSTAT(7)	;LET IT FINISH UP
	MOVEI 1,FKPTRS(6)
	EXCH 1,FREJFK		;PUT JOB SLOT BACK ON LIST
	MOVEM 1,@FREJFK
	RET

;FORK KILL SELF

KSELF:	MOVE 7,FORKX
	MOVSI 1,200000
	MOVEM 1,FKINT(7)	;DISABLE ANY FURTHER INTERRUPTS
	MOVSI 1,UMODF
	MOVEM 1,FPC
	JSYS MENTR		;GET INTO REASONABLE MONITOR STATE
	SETZM PSIBW
	CALL DTIALL		;DEASSIGN TERM INTERRUPTS
	SETOM PRIMRY		;[ISI] Make TTY primary I/O JFNs
	HRRZ 1,FORKN
	HLRZ 2,SYSFK(1)		;2=DES FORK CTTY
	CAIN 2,-1		;=JOB CTTY?
	JRST KSEF0		;YES.
	TRZN 2,1B18		;MAYBE, CONVERT TO LINE # (ASSUMES TTY
	JRST KSEF0		;DES). NOT, TREAT AS ERROR.
	CAIGE 2,NLINES		;LEGAL LINE #?
	CAIGE 2,0
	JRST KSEF0		;NO.
	IDIVI 2,2
	ADD 2,TTFRKP(3)		;2=PTR TO TTFRK1 ENTRY
	LDB 1,2			;1=TOP FORK FOR TTY PSI'S THIS LINE
	SETO 3,
	CAMN 1,FORKX		;THIS FORK TOP FORK FOR TTY PSI'S?
	DPB 3,2			;YES, CLEAR TTFRK1 ENTRY

KSEF0:	MOVE 1,[1B4+400000]	;REASSIGN STILL-MAPPED FILES
	CLZFF			;CLOSE FILES HERE AND BELOW
IFDEF IMPCHN,<
	CALL NETKFK>		;FLUSH FORK FROM NET TABLES
IFDEF DSPCHN,<
	CALL DSPKFK>		; RELEASE DISPLAY PROCESSES OF THIS FORK
IFDEF SIGIPC,<
	CALL SIGKIL##>		;REMOVE FROM SIGNAL QUEUE
	CALL KALLI
	MOVE 7,FORKX
	HLRZ 1,FKPGS(7)
	LDB 2,[POINT 14,SPT(1),13] ;GET SHARE COUNT OF UPT
	PUSH P,2		;SAVE IT FOR LATER CHECK
	SETO 1,
	MOVSI 2,400000
; FALLS THRU

; FALLEN INTO
KSEF1:	SKIPE UPTA(2)		;IF THIS PAGE EXISTS IN MAP,
	PMAP			;CLEAR IT OUT.
	MOVEI 6,0(2)
	CAIGE 6,777
	AOJA 2,KSEF1

IFN PIESLC,<
	MOVE 7,FORKX		;GET FORK INDEX
	MOVSI 1,NOCNT
	LOCK GRPLOK##		;GET PIEGRP TO HOLD STILL
	IORM 1,FKFLGS(7)	;INDICATE THIS FORK NO LONGER TO
				;BE INCLUDED IN NAPROC
	MOVE 1,JOBNO
	MOVE 1,PIEGRP##(1)
	MOVSI 2,(-1.0)
	FADRM 2,NAPROC##(1)	;ADJUST NAPROC
	UNLOCK GRPLOK
> ;END PIE-SLICE SCHEDULER CONDITIONAL

	HRRZ 1,FORKN
	SETOM SYSFK(1)		;INDICATE FORK NOW KILLED
	MOVEI 1,KRET
	JSYS EDISMS		;AND WAIT TILL NOTIFICATION SEEN
KSEF2:	POP P,2			;SHARE COUNT OF UPT
	CAIE 2,1		;UNSHARED?
	JRST KSEF3
	MOVE 7,FORKX
IFN KIFLG,<			;[ISI] AC BLOCKS
	SKIPN PSB+UACPG		;WHEN DIEING WE DO NOT EXPECT THIS PAGE MAPPED
	JRST KSEF7		;CARRY ON
	BUG(CHK,<DIEING FORK HAS PAGE 775 DEFINED.>)
	SETZ 1,
	MOVEI 2,UACPGA
	CALL SETMPG		;GET RID OF IT ANYWAY
	MOVEI 1,<EUACB>B39-1	;SEE WHERE ACBAS IS
	CAMGE 1,ACBAS
	MOVEM 1,ACBAS		;SO IT WON'T TRY TO GO TO PAGE 775
KSEF7:>				;[ISI] AC BLOCKS
	MOVE 1,ACBAS
	CAIGE 1,<EUACB>B39	;AC BLOCKS IN PSB?
	SETZM PSB+UACPG		;YES, CLEAR MAP ENTRY FOR UACPG

KSEF5:	SETZM PSB+JSBPG		;CLEAR SPECIAL MAP WORDS
	MOVE 6,[XWD CPTPG+1-UPTPG,CPTPG+1]
	HRLZ 2,FKPGS(7)
	CALL CLRM0		;CLEAR PP AREA OF MON MAP
	SETZ 1,
	HRRI 2,JDVPG		;CLEAR JDV FROM MAP
	CALL SETDVP
	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
	LDB 2,[POINT 14,SPT(1),13]
	PUSH P,2
	SETZ 1,
	HLLZ 2,FKPGS(7)
KSEF4:	SKIPE UPTA(2)		;IF THIS PAGE EXISTS, CLEAR IT TOO.
	CALL SETPT		;BUT NOT USING PMAP
	MOVEI 6,0(2)
	CAIGE 6,777
	AOJA 2,KSEF4
	JRST KSEF2

	RESCD

KFK0T:	HRRZ 2,FKSTAT(1)
	CAIE 2,KRET		;WAIT TILL FORK ALMOST KILLED STATE
KRET:	JRST 0(4)
	JRST 1(4)

FRZWT:	JRST 0(4)

	SWAPCD

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

.FFORK:	JSYS MENTR
	NOINT
	MOVEI 1,0(1)
	CAIN 1,-4		;ALL INFERIORS?
	JRST FFORK5		;YES
	CALL SETJFK		;OTHERWISE, ANY SINGLE INFERIOR
	CAME 1,FORKN
	CALL SKIIF
	JRST FRKE1		;NOT INFERIOR
	CALL FFORK1
FFORK4:	HLRZ 2,SYSFK(1)		;2=SOURCE TERM PSI'S FROZEN FORK
	HRRZ 1,FORKN
	HLRZ 1,SYSFK(1)		;1=SOURCE THIS FORK.
	CAIN 1,0(2)		;SOURCES SAME?
	JRST UPDTIR		;YES, UPDATE TERM PSI WORDS
	JRST MRETN		;NO, WORDS ALREADY UPDATED.

FFORK5:	HRRZ 1,FORKN		;SELF
	CALL MAPINF		;MAP FFORK1 OVER ALL IMMED INFERIORS
	 CALL FFORK1		;THROUGH FFORK1
FFORK6:	HRRZ 1,FORKN
	HLRZ 1,SYSFK(1)		;1=SOURCE PSI'S THIS FORK
	JRST UPDTIR		;UPDATE TERM PSI WORDS

; (INDIRECTLY) FREEZE ALL INFERIORS

FALLI:	MOVE 1,FORKN
	CALL MAPINF
	 CALL FFORK3		; XCTED BY MAPINF
	RET

FFORK3:	SKIPA 2,[XWD FRZB2,0]	;INDIRECT FREEZE BIT
FFORK1:	MOVSI 2,FRZB1		;DIRECT FREEZE BIT
FFORK0:	HRRZ 7,SYSFK(1)
	TDNE 2,FKINT(7)		;ALREADY DONE?
	RET			;YES
	CALL SUSFK		;SUSPEND FORK
	NOSKED
	IORM 2,FKINT(7)
	MOVEI 2,FRZWT
	HRRM 2,FKSTAT(7)	;SET FROZEN STATE
	OKSKED
	HRLM 1,0(P)		;SAVE CURRENT FORK
	CALL MAPINF		;DO INDIRECT FREEZE OF INFERIORS
	 CALL FFORK3
	HLRZ 1,0(P)
FFORK7:	HLRZ 2,SYSFK(1)		;2=FORK'S SOURCE TERM PSI'S
	MOVEI 7,(1)
	ADD 7,SUPERP
	LDB 7,7			;7=ITS SUPERIOR
	HLRZ 7,SYSFK(7)		;7=SUPERIOR'S SOURCE TERM PSI'S
	CAIN 2,0(7)		;SAME SOURCE?
	RET			;YES.
	HRLM 1,0(P)
	MOVEI 1,0(2)
	CALL UPDTI		;NO, MUST UPDATE TERM PSI WORDS
	HLRZ 1,0(P)
	RET

;RESUME FORK

.RFORK:	JSYS MENTR
	NOINT
	MOVEI 1,0(1)
	CAIN 1,-4		;ALL INFERIORS?
	JRST RFORK5		;YES
	CALL SETJFK
	CAME 1,FORKN		;CHECK RELITIVITY
	CALL SKIIF
	JRST FRKE1		;NOT INFERIOR
	CALL RFORK1
	JRST FFORK4		;UPDATE TERM PSI WORDS AS NEC.

RFORK5:	HRRZ 1,FORKN
	CALL MAPINF		;DO ALL IMMED INFERIORS
	 CALL RFORK1
	JRST FFORK6		;UPDATE TERM PSI WORDS AS NEC.

; (INDIRECTLY) RESUME ALL INFERIORS

RALLI:	MOVE 1,FORKN
	CALL MAPINF
	 CALL RFORK3		; XCTED BY MAPINF
	RET

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 7,SYSFK(1)
	MOVSI 2,JTFRZB
	TDNE 2,FKINT(7)		;FROZEN BY JSYS TRAP?
	JRST FFORK7		;YES, DON'T RESUME IT

	CALL STPFK1		;SET TO UNFREEZE THIS FORK
	SKIPN 2,PIOLDS(1)	;WAS ON WTLST BEFORE FREEZE?
	MOVEI 2,JSKP		;NO, SET TO RUNNING
	MOVEM 2,FKSTAT(7)
IFG NNVTLN,<
	HRRZ 1,2
	HLRZS 2
	CAIN 2,-1		; CONTROLLING TERMINAL?
	 MOVE 2,CTRLTT		; YES, GET IT
	CAIE 1,TCITST		; WAS THIS FORK IN TCI WAIT?
	 JRST RFRK1V		; NOT TCITST
	CAIG 2,NVTHI		; NOT AN VT?
	CAIGE 2,NVTLO
RFRK1V:	 SETO 2,		; REMEMBER NOT TO DO IT
	PUSH P,2
>
	CALL CLRSFK		;UNSUSPEND FORK
	OKSKED
IFG NNVTLN,<
	POP P,2
	SKIPL 2
	 CALL NVTCAP##
>
	CALL CLRLFK
	HLRZ 1,0(P)		;1=FORK INDEX (CLOBBERED BY CLRLFK)
	JRST FFORK7		;UPDATE TERM PSI WORDS AS NEC

;BREAKPOINT JSYS FOR IDDT

.BPT:	JSYS MENTR
	JRST HALTF1		;MAKE LIKE HALTF

;PERPETUAL WAIT - INTERRUPTABLE

.WAIT:	JSYS MENTR
	MOVEI 1,JRET
	JSYS EDISMS
	JRST MRETN

;[ISI] Get FoRK Structure

.GFRKS:	JSYS MENTR		;[ISI]
	RESKD1			;[ISI] Make sure our status is up-to-date
	CALL RLJBFK		;[ISI] Get job fork no for top node into 1
	RETERR FRKHX1		;[ISI] Bad fork handle
	MOVE 11,1		;[ISI] Copy of starting fork
	UMOVE 10,2		;[ISI] Flgs,,Buffer
	TLZ 10,177777		;[ISI] Keep only declared flags
	PUSH P,ZERO##		;[ISI] Dummy pointer to superior block
	CALL GFRKS1		;[ISI] Do it
	SUB P,BHC+1		;[ISI] Remove dummy
	XCTUU [HRRM 10,2]	;[ISI] Update pointer (last block used)
	TLZE 10,(1B16)		;[ISI] Run out of Handles?
	JRST MRETN		;Yes, fail
	JRST SKMRTN		;[ISI] No problems, Skip return

;[ISI] Recursive subroutine to return structure to user
;[ISI] GFRKS1 is entry from top, GFRKS0 is parallels entry
;[ISI] 1/ Job fork number
;[ISI] 10/ Flgs,,User location for current block
;[ISI] 11/ Job fork number for top fork in structure
;[ISI] -1(P)/ Pointer to superior in user space

GFRKS0:	ADDI 10,3		;[ISI] Bump to next block
	XCTUU [HRLM 10,0(2)]	;[ISI] Return link to here (same level)
GFRKS1:	HRLM 1,0(P)		;[ISI] Remember job fork number
	XCTUU [SETZM 0(10)]	;[ISI] No parallel or inferior yet
	CALL GEFKH		;[ISI] Get existing handle (or 0)
	HRL 1,-1(P)		;[ISI] Superior pointer
	UMOVEM 1,1(10)		;[ISI] Return it
	TLNN 10,(1B0)		;[ISI] Assign Handles?
	JRST GFRKS2		;[ISI] No
	HLRZ 1,0(P)		;[ISI] Restore JFK Number
	CALL GFKH		;[ISI] Get a relative handle
	 TLOA 10,(1B16)		;[ISI] No more handles available
	XCTUU [HRRM 1,1(10)]	;[ISI] Return the Handle
GFRKS2:	SETO 1,			;[ISI] Default status value
	HLRZ 6,0(P)		;[ISI] Get job fork number for RFSTS0
	TLNE 10,(1B1)		;[ISI] Status desired?
	CALL RFSTS0		;[ISI] Yes. Go get it
	UMOVEM 1,2(10)		;[ISI] Return the status
GFRKS3:	HLRZ 1,0(P)		;[ISI] JFK No
	ADD 1,INFERP		;[ISI] Point to inferior
	LDB 1,1			;[ISI] Next JFK
	PUSH P,10		;[ISI] Pointer to this block
	JUMPE 1,GFRKS4		;[ISI] Skip it if no inferiors
	ADDI 10,3		;[ISI] Bump to next block
	XCTUU [HRRM 10,-3(10)]	;[ISI] Point of to inferior block
	CALL GFRKS1		;[ISI] Now go do inferiors
GFRKS4:	POP P,2			;[ISI] Location of current block
	HLRZ 1,0(P)		;[ISI] Current JFK
	CAIN 1,(11)		;[ISI] Is this top fork of group?
	RET			;[ISI] Yes, were done
	ADD 1,PARALP		;[ISI] No.  Now do parallels
	LDB 1,1			;[ISI] Parallel JFK
	JUMPN 1,GFRKS0		;[ISI] Go do it
	RET			;[ISI] Done with this level

;[ISI] Search for an existing relative fork handle, return 0 if none

GEFKH:	PUSH P,2		;[ISI]
	PUSH P,3		;[ISI]
	PUSH P,4		;[ISI]
	MOVE 3,FKPTAB		;[ISI] Pointer into FKTAB (18-bit)
	MOVE 4,[XWD -NLFKS+1,1]	;[ISI] AOBJN Pointer
	HRRZ 2,FORKN		;[ISI] Special check for this fork
	CAIN 1,(2)		;[ISI] Is it?
	SOJA 4,GEFKH2		;[ISI] Yes.
GEFKH1:	ILDB 2,3		;[ISI] Load JFK
	CAIN 2,(1)		;[ISI] Do we have it?
	JRST GEFKH2		;[ISI] Yes.
	AOBJN 4,GEFKH1		;[ISI] No, go around
	TDZA 1,1		;[ISI] Not found, return 0
GEFKH2:	MOVEI 1,400000(4)	;[ISI] Return handle
	JRST POP4		;[ISI]

;READ FORK STATUS

.RFSTS:	JSYS MENTR
	TRNE 1,200000		;LOCAL DESIGNATOR?
	JRST RFST9		;NO
	ANDI 1,377777
	JUMPE 1,RFST7		;THIS FORK
	CAIL 1,NLFKS		;LEGAL?
	ITERR FRKHX1		;NO
	IDIVI 1,2
	ADD 1,FKPTAB(2)
	LDB 1,1
	CAIL 1,NUFKS		;FORK ASSIGNED?
	JRST .+4		;OUT OF RANGE, CAN'T BE
	HRRZ 6,SYSFK(1)
	CAIE 6,-1		;FORK EXISTS?
	JRST RFST8		;YES.
	SETO 1,			;NOT ASSIGNED, RETURN -1
	JRST RFSTSX

RFST7:	RESKD1			;TO BE SURE OWN STATUS IS UP TO DATE
RFST9:	CALL SETJFK		;NOT MULTIPLE FORKS
RFST8:	MOVE 6,1
	CALL SETLF1		;MAP PSB
	NOSKED
	MOVE 2,PPC(1)		;GET PC
	TLNN 2,UMODF		;USER MODE?
	JRST [	MOVE 2,UPDL(1)	;NO, USER PC IS FIRST ON STACK
		TLZ 2,UMODF	;BUT TURN OFF USER BIT FOR INFO
		JRST .+1]
	UMOVEM 2,2
	CALL CLRLFK
	CALL RFSTS0		;DETERMINE STATUS AND INT CHANNEL
	OKSKED
RFSTSX:	UMOVEM 1,1		;RETURN IT TO USER
	JRST MRETN


;SUBROUTINE TO DETERMINE FORK STATUS. USED BY RFSTS AND GFRKS.
;CALL WITH JOB FORK INDEX IN 6, RETURNS STATUS IN 1

RFSTS0:	HRRZ 7,SYSFK(6)
	CALL CHKWT		;FORK DISMISSED?
	 JRST [SETZ 1,		;NO, RETURN 0
		RET]

RFST1:	HRRZ 2,FKSTAT(7)	;IS WAITING, GET STATE
	SETZ 1,
	CAIN 2,FRZWT		;FROZEN?
	JRST RFST4		;YES
RFST5:	CAIN 2,FORCTM		;FORCED TERMINATION?
	JRST RFST3		;YES
	CAIN 2,HALTT		;REGULAR TERMINATION?
	JRST RFST2		;YES
	CAIE 2,TRMTST		;WAITING FOR FORK TERMINATION
	CAIN 2,TRMTS1		;EITHER FLAVOR?
	JRST RFST6		;YES
	TLO 1,1			;N.O.T.A., MUST BE I/O
	RET

RFST2:	TLO 1,2			;REGULAR TERMINATION GIVES 2
	RET

RFST6:	TLO 1,4
	RET

RFST3:	PUSH P,1
	MOVE 1,6
	CALL SETLF1		;MAP PSB
	MOVE 2,FORCTC(1)	;GET CHANNEL CAUSING FORCED TERM
	HRRM 2,0(P)		;PUT IN RH OF STATUS WORD
	CALL CLRLFK
	POP P,1
	TLO 1,3			;WITH 3 INDICATING FORCED TERM
	RET

RFST4:	TLO 1,400000		;FROZEN, INDICATE IN BIT 0
	HLRZ 2,FKSTAT(7)	;AND GET OLD STATUS
	JUMPE 2,R##
	JRST RFST5

;GET FORK HANDLE. CALL WITH 1/ HANDLE ON KNOWING FORK, 2/ HANDLE IN
; KNOWING FORK ON DESIRED FORK
;
;RETURNS A (POSSIBLY NEW) HANDLE IN 1 USABLE BY CALLER.

.GFRKH:	JSYS MENTR		;ESTABLISH CONTEXT
	HRROI 2,0(2)		;MAKE SURE H IS 400001-4000NN
	CAME 2,MINUS1##		;ASKING FOR HANDLE ON SUPERIOR?
	 JRST GFRKH1		;NO

GFRKH0:	CALL RLJBFK		;GET JOB FORK INDEX FOR AC1
	 RETERR GFRKX1
	ADD 1,SUPERP		;FORK POINTER TO FKPTRS
	LDB 1,1			;GET JOB HANDLE OF TARGET FORK
	CALL GFKH		;MAKE A LOCAL HANDLE FOR IT
	 RETERR FRKHX6		;NONE LEFT.
	UMOVEM 1,1		;GIVE TO CALLER
	JRST SKMRTN

GFRKH1:	TRNN 2,200000
	ANDI 2,377777
	CAIL 2,0		;NEGATIVE IS ILLEGAL
	CAIL 2,NLFKS		;A LEGIT FORK HANDLE?
	RETERR GFRKX1		;NO. FAIL RETURN NONSKIP
	CALL SETLF0		;OK, SET UP THE PSB OF KNOWER
	IDIVI 2,2		;BUILD A POINTER TO JOB F INDEX
	ADD 2,FKPTAB(3)	; IN THE MAPPED PSB
	TLO 2,1			;OFFSET TO MAPPED PSB BY INDEXING PNTR
	LDB 2,2			;GET THE DESIRED FORK'S JOB FORK INDEX
	CAIL 2,NUFKS		;MAKE SURE IT'S ASSIGNED
	JRST .+3		;CAN'T BE
	HRRZ 1,SYSFK(2)
	CAIN 1,-1		;DOES FORK EXIST?
	RETERR GFRKX1		;IT DOESN'T. ERROR.
	MOVEI 1,(2)		;OK, HERE'S THE DESIRED JOB FORK INDEX
	CALL GFKH		;GET A FORK HANDLE IN THIS FORK FOR IT.
	  RETERR FRKHX6		;COULDN'T. NO SPACE LEFT.
	UMOVEM 1,1		;OK. RETURN H-PRIME TO USER.
	CALL CLRLFK
	JRST SKMRTN		;AND SKIP RETURN TO HIM.

;RELEASE A FORK HANDLE (TO MAKE ROOM FOR MORE)

.RFRKH:	JSYS MENTR
	HRROI 1,0(1)		;CHECK FOR SINGLE-FORK DESIGNATOR
	TRNN 1,200000		;OF POSITIVE GROUP
	ANDI 1,377777		; ..
	CAILE 1,0
	CAIL 1,NLFKS		;RANGE CHECK
	JRST FRKE1		;NO GOOD. ITRAP HIM
	IDIVI 1,2
	ADD 1,FKPTAB(2)		;POINTER TO SLOT REPRESENTING FORK
	MOVEI 2,-1		;THE NULL POINTER
	DPB 2,1			;SMASH ANY POINTER ALREADY THERE
	JRST MRETN		; AND RETURN.

;START FORK VIA ENTRY VECTOR

.SFRKV:	JSYS MENTR
	CALL SETJFK
	PUSH P,1
	CALL SETLF1
	UMOVE 2,2		;GET RELATIVE POSITION
	HLRZ 3,ENTVEC(1)	;SIZE OF VEC IN DEST FORK
	CAIN 3,<JRST>B53	;OLD TYPE?
	MOVEI 3,2		;YES, IMPLIES 2
	CAIL 3,1		;REASONABLE VECTOR LENGTH?
	CAIL 3,1000
	JRST SFRKV2		;NO
	CAIL 2,0(3)		;LEGAL ARG?
	JRST SFRKV2		;NO
	MOVEM 2,FORCTC(1)	;LEAVE FOR FOR TO START SELF
	CALL CLRLFK
	POP P,1			;RECOVER JOB HANDLE
	CALL STPFK
	MOVEI 2,SFRKV1		;START FORK IN MONITOR
IFN KIFLG,<			;[ISI]
	HRLI 2,(1B6) >		;[ISI] set user in/out
	JRST SFORK1

SFRKV2:	CALL CLRLFK
	ITERR SFRVX1		;ILLEGAL RELATIVE NUMBER

SFRKV1:	MOVEM 1,FPC		;ENTER HERE FORK STARTS SELF
	MOVSI 1,UMODF		;AT ENTVEC + C(FORTCT)
	EXCH 1,FPC
	JSYS MENTR
	HRRZ 1,ENTVEC
	MOVE 2,FORCTC		;RELATIVE ADDRESS
	HLRZ 3,ENTVEC		;SIZE OR JRST
	CAIN 3,<JRST>B53	;OLD STYLE?
	JRST SFRKV3		;YES
	ADDI 1,0(2)
SFRKV4:	HRRM 1,0(P)
	JRST MRETN		;START IN USER MODE

SFRKV3:	CAIN 2,0		;0 MEANS JOBSA
	UMOVE 1,120
	CAIN 2,1		;1 MEANS JOBREN
	UMOVE 1,124
	JRST SFRKV4

;START FORK

.SFORK:	JSYS MENTR
	CALL SETJFK
	CALL STPFK		;STOP FORK
	UMOVE 2,2
	TLZ 2,UIOF+2037		;USER I/O, CALFRMMON, IDX AND IND OFF
	TLO 2,UMODF		;AND USER ON
SFORK1:	SETOM SLOWF(1)		;NORMALIZE FLAG
	EXCH 2,PPC(1)		;SET PC
	TLNE 2,UMODF		;WAS IN USER MODE?
	JRST SFORK2		;YES
	MOVSI 2,UACB(1)		;NO, MOVE AC'S
	HRRI 2,PAC(1)
	BLT 2,PAC+17(1)
SFORK2:	HRRZS FKSTAT(7)		;CLEAR LH IN CASE FROZEN
	MOVSI 2,FRZBAL
	TDNE 2,FKINT(7)		;FORK FROZEN?
	JRST SFORK3		;YES, DON'T START IT NOW
	MOVEI 2,JSKP
	MOVEM 2,FKSTAT(7)	;MAKE FORK RUNNABLE
	CALL CLRSFK		;AND CLEAR SUSPENSION
SFORK3:	SETZM PIOLDS(1)		;SET PRE-FREEZE STATE TO RUNNING
	MOVE 1,FORKN(1)
	HLRZ 1,SYSFK(1)		;1=FORK'S SOURCE OF TERM PSI'S
	CALL UPDTI
	OKSKED
	RESKED
	JRST CLFRET

;MONITOR SFORK, CAN START IN MONITOR SPACE

.MSFRK:	JSYS MENTR
	MOVE 3,0(P)		;THIS IS LEGAL IF CALLED FROM
	MOVE 4,CAPENB		;MONITOR MODE, OR IF WHEEL OR
	TLNE 3,UMODF		;OPERATOR CAPABILITIES ARE PRESENT
	TRNE 4,WHEEL+OPER
	JRST .+2
	JRST CAPX		;LACKS CAPABILITY
	CALL SETJFK
	CALL STPFK		;SAME STUFF AS SFORK
	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?
	ITERR			;YES
	CALL SETLF1		;MAP PSB
	SKIP PPC(1)		;GET PSB INTO CORE BEFORE GOING NOSKED
	CALL SUSFK		;NO, SUSPEND FORK
	NOSKED
	RET

;READ/SET FORK AC'S

.RFACS:	JSYS MENTR
	CALL FACS
	MOVS 3,3
	MOVEI 2,17(3)
	XCTMU [BLT 3,0(2)]	;FROM FORK'S PSB TO USER
	OKSKED
	JRST MRETN

.SFACS:	JSYS MENTR
	CALL FACS
	MOVEI 2,17(3)
	XCTUM [BLT 3,0(2)]	;FROM USER TO FORK'S PSB
	OKSKED
	JRST MRETN

;COMMON AC ROUTINE

FACS:	CALL SETJFK		;ONE FORK ONLY
	CALL SKIIF		;AND IT MUST BE INFERIOR
FRKE2:	ITERR FRKHX2
	MOVE 6,1
	HRRZ 7,SYSFK(6)
	CALL SETLF1		;MAP PSB
	NOSKED
	CALL CHKWT##		;FORK WAITING?
	ITERR FRKHX4		;YES
	MOVE 2,PPC(1)		;GET PC
	MOVEI 3,PAC(1)		;LOC OF AC'S
	TLNN 2,UMODF		;IF IN USER MODE, OTHERWISE
	MOVEI 3,UACB(1)		;AC'S ARE IN FIRST AC BLOCK
	XCTUU [HRL 3,2]		;GET ADDRESS OF USER'S BLOCK
	RET

;HALT FORK

.HFORK:	JSYS MENTR
	CALL MAPFKH
	 CALL HFORK1
	JRST MRETN

HFORK1:	JUMPE 1,R		;NOT TOP SORK
	CAMN 1,FORKN		;THIS FORK?
	JRST HALTF1		;YES, MAKE LIKE HALTF
	CALL STPFK		;STOP THE FORK
	MOVEI 2,HALTT
	MOVSI 3,FRZBAL		;[BBN]
	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:	OKSKED
	MOVE 3,FORKN(1)
	CALL CLRLFK
	HLRZ 1,SYSFK(3)		;1=FORK'S SOURCE OF TERM PSI'S
	JRST 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
	HRRZ 2,SYSFK(3)
	CAIE 2,-1		;THIS SLOT IN USE?
	CAIE 1,0(2)		;AND HAS CORRECT FORKX?
	AOBJN 3,.-3		;NO
	JUMPGE 3,R		;RETURN IF NOT FOUND IN THIS JOB
	MOVEI 1,0(3)		;FORKN OF OTHER FORK
	CALL SKIIF		;IS IT INFERIOR
	JRST HALTF1		;NO, HALT OURSELF
	JRST HFORK1		;HALT THE OTHER GUY

;WAIT FOR FORK TO TERMINATE

.WFORK:	JSYS MENTR
	CAIN 1,-4		;ALL INFERIORS?
	JRST WFORK2		;YES
	CALL SETJFK		;ONE FORK, GET ITS JOB HANDLE
	HRLZ 1,SYSFK(1)		;SETUP TEST ON FORK INDEX
	HRRI 1,TRMTST
	JSYS EDISMS		;AND DISMISS
	JRST MRETN

WFORK2:	MOVEI 1,TRMTS1		;SETUP TEST TO WAIT UNTIL CHANGED
	JSYS EDISMS
	JRST MRETN

	RESCD

TRMTST:: CALL TSTWT		;SCHEDULER TEST, FORK WAITING?
	JRST 0(4)		;NO
	HRRZ 2,FKSTAT(1)
	CAIE 2,HALTT		;WAITING BECAUSE TERMINATION?
	CAIN 2,FORCTM		;OR FORCED TERM?
	JRST 1(4)		;YES
	JRST 0(4)		;NO, KEEP WAITING

TRMTS1:	JRST 0(4)

	SWAPCD

;SUSPEND FORK SO IT CAN BE DIDDLED

SUSFK:	PUSH P,1
	PUSH P,2
	CAMN 7,FORKX
	BUG(HLT,<SUSFK - GIVEN SELF AS ARG>)
SUSF6:	NOSKED
	CALL CHKWT		;WAITING NOW?
	JRST SUSF4		;NO
	HRRZ 2,FKSTAT(7)	;GET WAITING STATUS
	CAIE 2,SUSWT		;ALREADY SUSPENDED OR FROZEN?
	CAIN 2,FRZWT
	JRST SUSF2		;YES
	CAIN 2,TCITST		;WAS IN TTYIN WAIT?
	JRST [	HLRZ 2,FKSTAT(7) ;YES, MUST RESET LINE STATE
		HLLOS TTFORK(2)
		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
	JSYS EDISMS
SUSF3:	POP P,2
	POP P,1
	RET

SUSF2:	OKSKED
	JRST SUSF3

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,^D500
	DISMS
	JRST SUSF6		;AND CHECK AGAIN

;SCHEDULER TEST FOR SUSPENSION

	RESCD

SUSFKT:	CALL TSTWT		;FORK WAITING?
	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(7)	;CLEAR PSI STARTING STATE
	RET

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

MAPINF:	ADD 1,INFERP		; START WITH FIRST INFERIOR
MAPIF1:	MOVE 16,@0(P)		;INSTRUCTION TO EXECUTE
	LDB 1,1			; FORKN OF INFERIOR TO OPERATE ON
	JUMPE 1,RSKP		; TERMINATES WITH 0
	HRLM 1,0(P)		; PRESERVE THIS JOB FORK HANDLE
	XCT 16			; OPERATE ON IT
	HLRZ 1,0(P)		; RESTORE JOB FORK HANDLE
	HRRZS 0(P)		; FLUSH INDIRECT/INDEX BITS
	ADD 1,PARALP		; DO OTHER INFERIORS NEXT
	JRST MAPIF1		; LOOP THROUGH ALL INFERIORS AT THIS LEVEL

;PERFORM MAPPING FOR FORK CONTROL FUNCTION WHICH OPERATE ON SEVERAL
;FORKS

MAPFKH:	HRROI 1,0(1)		;GET FORK HANDLE
	TRNN 1,200000		;SPECIAL?
	ANDI 1,377777		;NO
	JUMPLE 1,MAPFK1
	CAIL 1,NLFKS
	ITERR FRKHX1
	IDIVI 1,2		;REGULAR HANDLE, GET JOB HANDLE
	ADD 1,FKPTAB(2)
	LDB 1,1
	CAIL 1,NUFKS		;ASSIGNED?
	JRST .+3		;CAN'T BE
	HRRZ 2,SYSFK(1)
	CAIN 2,-1		;DOES IT EXIST?
	ITERR FRKHX1		;NO
	RET			;RETURN AND DO FUNCTION ONCE

MAPFK1:	ADDI 1,2
	JUMPL 1,MAPFK2		;MULTIPLE INDICATION
	XCT SETJFT(1)		;SINGLE, GET JOB HANDLE
	RET

MAPFK2:	ADDI 1,3
	JUMPGE 1,MAPFT(1)	;GO TO ROUTINE
	ITERR FRKHX1		;HANDLE ILLEGAL

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(P)		;DO THIS FORK
	POP P,1
MAPFI:	MOVE 16,@0(P)		;GET INSTRUCTION, WILL STAY IN 16
MAPF41:	ADD 1,INFERP		;DO INFERIORS
MAPF42:	LDB 1,1			;GET NEXT IN LIST
	JUMPE 1,RSKP		;END OF LIST, RETURN AND SKIP INSTR
	HRLM 1,0(P)		;SAVE THIS FORK NUMBER
	CALL MAPF41		;DO INFERIORS OF IT
	BUG(HLT,<MAPF41 FAILED TO SKIP>)
	HLRZ 1,0(P)		;GET FORK NUMBER BACK
	XCT 16			;DO THIS FORK
	HLRZ 1,0(P)
	ADD 1,PARALP		;POINT TO NEXT IN LIST
	JRST MAPF42

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

MAPF5:	HLRZ 1,FORKN		;GET TOP
	JRST MAPF51		;DO THAT AND INFERIORS

;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 POP2		;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
	JRST RSKP

SKIIF6:	HLRZ 2,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,POP2		;END OF LIST, RETURN BAD
	ADD 2,SUPERP		;GET SUPERIOR POINTER
	LDB 2,2
	JRST SKISF1

;SKIPS IF FORK IN 1 IS IMMED INF OF EXECUTING FORK

SKIMIF:	PUSH P,1
	ADD 1,SUPERP
	LDB 1,1
	CAMN 1,FORKN
	AOS -1(P)
	POP P,1
	RET

;JSYS'S FOR CONTROLLING PSI SYSTEM

;MAP PSB OF FORK, GIVEN USER HANDLE IN 1
;RETURN WITH OFFSET TO MAPPED PSB IN 1

SETLFK:	TRNE 1,200000		;SPECIAL DESIGNATOR?
	JRST FRKE1		;NOT ALLOWED
SETLF0:	CALL SETJFK		;GET JOB FORK INDEX
SETLF1:	NOINT
	HRRZ 1,SYSFK(1)		;GET SYSTEM FORK INDEX
	CAMN 1,FORKX		;CURRENT FORK?
	JRST SETLF2		;YES
	HRRZ 1,FKPGS(1)		;GET PSB OF DESIGNATED FORK
	PUSH P,2
	MOVE 2,[XWD RWX,FPBPGA]
	CALL SETMPG		;MAP IT
	MOVEI 1,FPBPGA-PSB	;RETURN OFFSET USUAL PSB TO MAP PSB
	JRST POP2

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

CLRLFK:	SKIPN PSB+FPBPG		;NOW MAPPED?
	JRST CLRLFX		;NO
	SETZ 1,
	MOVEI 2,FPBPGA
	CALL SETMPG
CLRLFX:	OKINT
	RET

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

SETJFK:	CALL RLJBFK		;CONVERT TO A JOB FORK INDEX
FRKE1:	ITERR FRKHX1		;ILLEGAL USER HANDLE
	RET

;CONVERT USER HANDLE TO JOB FORK INDEX
;1/ USER HANDLE
;RET + 1 - FAIL
;    + 2 - OK WITH 1/ JOB FORK INDEX

RLJBFK:	HRROI 1,0(1)
	TRNN 1,200000
	ANDI 1,377777
	JUMPLE 1,RLJBF1
	CAIL 1,NLFKS
	RET
	PUSH P,2
	IDIVI 1,2
	ADD 1,FKPTAB(2)
	LDB 1,1			;GET JOB FORK INDEX (HALF WORD)
	CAIL 1,NUFKS		;FORK HANDLE ASSIGNED?
	JRST POP2		;OUT OF RANGE, FAIL
	HRRZ 2,SYSFK(1)
	CAIE 2,-1		;FORK EXISTS?
	AOS -1(P)		;YES.
	JRST POP2

RLJBF1:	CAMN 1,[-6]		;SPECIAL CASE -6, TOP FORK IN GROUP
	JRST RLJBF2
	ADDI 1,2
	JUMPL 1,.+3
	XCT SETJFT(1)
	AOS 0(P)
	RET

RLJBF2:	PUSH P,2
	PUSH P,3
	MOVE 2,FORKX
	SKIPGE 1,FKDIR(2)	;SKIPS IF 2=TOP FORK IN GROUP
	MOVEI 2,0(1)		;NOW 2=FORKX TOP FORK
	MOVSI 1,-NUFKS		;NOW CONVERT FROM FORKX TO JOB INDEX
	HRRZ 3,SYSFK(1)
	CAIN 3,0(2)
	JRST .+3		;RH(1)=JOB INDEX
	AOBJN 1,.-3
	CAIA			;CAN'T FAIL, BUT IF IT DOES ...
	AOS -2(P)
	TLZ 1,-1		;CLEAR LH(1)
	POP P,3
	JRST POP2

SETJFT:	HLRZ 1,FORKN		;-2, TOP FORK
	CALL GETSPF		;-1, SUPERIOR
	HRRZ 1,FORKN		;0, CURRENT

GETSPF:	HRRZ 1,FORKN		;GET SUPERIOR FORK
	MOVE 1,FKPTRS(1)
	LSH 1,-^D24
	RET

;MAP A FORK'S JSYS DISPATCH VECTOR
;1/ JOB FORK INDEX
;2/ REQUESTED ACCESS,,0
;RET WITH 2/ ADDRESS OF MAPPED DISPATCH VECTOR

SETJDV:	PUSH P,1
	HRR 2,JTJDA
	MOVE 1,SYSFK(1)		;1=SYSTEM FORK INDEX
	HRL 1,FKPGS(1)		;LH(1)=SPT INDEX OF FORK'S PSB
	HRRI 1,JDVPG
	CALL SETMPG		;MAP THE PAGE
	TLZ 2,-1		;CLEAR ACCESS FITS
	POP P,1
	RET

;UNMAP FORK'S DISP VECTOR
;1/ ADDRESS OF THE MAPPED DISP VECTOR

CLRJDV:	PUSH P,1
	PUSH P,2
	MOVE 2,JTJDA
	SETZ 1,
	CALL SETMPG		;UNMAP THE PAGE
	POP P,2
	POP P,1
	RET

;SET ANOTHER FORK'S JSYS DISPATCH VECTOR
;1/ JOB FORK INDEX
;2/ SPT INDEX FOR THE PAGE TO BE FORKS DISPATCH VECTOR

SETFJD:	PUSH P,1
	PUSH P,3
	EXCH 1,2
	MOVE 2,SYSFK(2)
	HRL 2,FKPGS(2)		;LH(2)=SPT INDEX OF FORK'S PSB
	HRRI 2,JDVPG
	MOVSI 3,RWX
	CALL SETDVP		;MAP THE PAGE
	MOVEI 2,0(1)
	POP P,3
	POP P,1
	RET


.SIR:	JSYS MENTR
	CALL SETLFK
	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
	ITERR SIRX1		;NO
SIR1:	MOVEM 2,LEVCHN(1)
CLFRET:	CALL CLRLFK
	JRST MRETN

.EIR:	JSYS MENTR
	TRNE 1,200000		;SPECIAL?
	ITERR FRKHX1		;ILLEGAL
	CALL SETJFK
	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
	MOVEI 2,0(2)		;CLEAR LH(2)
	CALL PSIRQB
	OKSKED
	JRST CLFRET

.SKPIR:	JSYS MENTR
	CALL SETLFK
	SKIPN PSISYS(1)
	AOS 0(P)
	JRST CLFRET

.DIR:	JSYS MENTR
	CALL SETLFK
	SETOM PSISYS(1)
	JRST CLFRET

.AIC:	JSYS MENTR
	CALL SETLFK
	IORM 2,PSICHM(1)
ICR:	CAIN 1,0		;SELF?
	CALL SETOVF		;YES, POSSIBLE CHANGE TO APR FLAGS
	JRST CLFRET

.DIC:	JSYS MENTR
	CALL SETLFK
	ANDCM 2,MONCHN(1)		;NOR MONITOR RESERVED CHANNELS
	ANDCAM 2,PSICHM(1)
	JRST ICR

IFNDEF TCP,<			; Conditionalize standard code
.IIC:	JSYS MENTR
	CALL SETJFK
	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
	HRRZ 1,SYSFK(1)
	EXCH 1,2
	NOSKED
	CALL PSIRQB
	OKSKED
	RESKD1			;INITIATE RESCHEDULE TO GET INTERRUPT
	JRST MRETN
>				; [ISI] End of IFNDEF TCP
IFDEF TCP,<			; [ISI] Conditional code for TCP
.IIC:	JSYS MENTR
	JUMPL 1,IIC0		;MULTI-FORK HANDLE.  NORMAL IIC.
	CAIL 1,NFKS		;POSSIBLE FORKX?
	 JRST IIC0		;NO.  NORMAL IIC.
	MOVSI 3,(1B17)		;CROSS-JOB IIC PERMIT BIT
	TDNE 3,FKFLGS##(1)	;RECEPTIVE?
	 JRST IIC1		;YES. GENERATE THE INTERRUPT
IIC0:	CALL SETJFK
	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
	HRRZ 1,SYSFK(1)
IIC1:	EXCH 1,2
	NOSKED
	CALL PSIRQB
	OKSKED
	RESKD1			;INITIATE RESCHEDULE TO GET INTERRUPT
	JRST MRETN

.FORKX::JSYS MENTR
	CALL RLJBFK		;GET JOB FORK HANDLE
	 JRST MRETN		;CANNOT
	HRRZ 1,SYSFK(1)		;GET FORKX
	MOVSI 2,(1B17)
	IORM 2,FKFLGS##(1)	;SET THE PERMIT BIT
	UMOVEM 1,1		;RETURN THE FORKX
	JRST SKMRTN
>				; [ISI] End of IFDEF TCP

.IIT:	JSYS MENTR		;[ISI] Initiate Interrupt in Time..
	CALL SETJFK		;[ISI]
	PUSH P,1		;[ISI]
	CALL SETLF1		;[ISI]
	UMOVE 2,2		;[ISI] get interrupt bits
	ANDCM 2,MONCHN(1)	;[ISI]
	PUSH P,2		;[ISI]
	CALL CLRLFK		;[ISI]
	POP P,2			;[ISI]
	POP P,1			;[ISI]
	MOVE 1,SYSFK(1)		;[ISI]
	XCTUM [SKIPE 3,3]	;[ISI] get time, reset if zero
	 ADD 3,TODCLK##		;[ISI]
       NOSKED			;[ISI]
	MOVEM 2,FKINTW(1)	;[ISI]
	MOVEM 3,FKINTT(1)	;[ISI]
       OKSKED			;[ISI]
	JRST MRETN		;[ISI]

.RCM:	JSYS MENTR
	CALL SETLFK
	MOVE 1,PSICHM(1)
	JRST RETA1

.RWM:	JSYS MENTR
	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:	JSYS MENTR
	CALL SETLFK
	CAIN 1,0		;SELF?
	JRST FRKE1		;ILLEGAL
	MOVEM 2,SUPCHN(1)
	JRST CLFRET

.RIRCM:	JSYS MENTR
	CALL SETLFK
	MOVE 2,SUPCHN(1)
RETA2:	UMOVEM 2,2
	JRST CLFRET

.RIR:	JSYS MENTR
	CALL SETLFK
	MOVE 2,LEVCHN(1)	;RETURN LEVEL AND CHANNEL DISPATCHES
	JRST RETA2

.ATI:	JSYS MENTR
	NOINT
	PUSH P,1
	HLRZ 1,1
	CAIL 1,^D36		;REASONABLE TERM CODE?
	JRST ATIE1		;NO
	CAIE 1,3		;CONTROL-C?
	JRST .+4		;NO
	MOVE 3,CAPENB		;YES, SEE IF LEGAL
	TLNN 3,(1B0)
ATX2E:	ITERR ATIX2		;ISN'T
	HRRZ 4,FORKN
	MOVE 3,BITS(1)
	IORM 3,FKPSIE(4)
	CALL GETCHA
	HRRZ 3,0(P)		;GET REQUESTED CHANNEL NUMBER
	DPB 3,2			;ASSIGN IT TO THIS CODE
	HLRZ 1,SYSFK(4)		;1=FORK'S SOURCE OF TERM PSI'S
	CALL UPDTI		;UPDATE JOB WORD
ATI2:	OKINT
	POP P,1
	JRST MRETN

GETTCD:	CAIGE 1,PSICHL		;IN LOW GROUP?
	JRST GTCD1		;YES
	CAIGE 1,PSICHU		;IN HIGH GROUP?
ATIE1:	ITERR TERMX1		;NO, ERROR
	SUBI 1,PSICHO		;OFFSET HIGH GROUP
GTCD1:	MOVE 1,PSICH(1)
	RET

.DTI:	JSYS MENTR
	NOINT
	CAIL 1,^D36		;REASONABLE CODE?
	JRST ATIE1		;NO
	HRRZ 2,FORKN
	MOVE 6,BITS(1)
	ANDCAM 6,FKPSIE(2)	;CLEAR FROM THIS FORK
	HLRZ 1,SYSFK(2)		;1=DESIGNATOR OF FORK CTTY.
UPDTIR:	CALL UPDTI		;UPDATE JOB WORDS
	JRST MRETN

;UPDATE TERMINAL PSI WORDS BY SCANNING FORK WORDS
;1/ SOURCE DESIGNATOR OF PSI SOURCE - CURRENTLY MUST BY TTY DESIGNATOR

UPDTI:	TRNN 1,1B18		;TEST FOR -1 OR 4XXXXX
	RET			;REQUIRED AT PRESENT.
	MOVSI 3,-NUFKS		;SETUP TO SCAN ALL FORKS OF JOB
	SETZB 4,5		;IOR PSI AND DPSI WORDS
UPDT0:	HRRZ 2,SYSFK(3)
	CAIN 2,-1		;FORK EXISTS?
	JRST UPDT2		;NO
	HLRZ 6,SYSFK(3)		;6=DESIGNATOR OF FORK CTTY
	CAIN 6,0(1)		;DESIGNATOR OF INTEREST?
	JRST UPDT1		;YES, ACCOUNT FOR CHARS ASSIGNED
UPDT2:	AOBJN 3,UPDT0
	CAIN 1,-1		;CTTY?
	JRST UPDT4		;YES
	TRZ 1,1B18		;MAYBE NOT, CONVERT TO LINE #
	CAMN 1,CTRLTT		;CTTY OF JOB?
	JRST UPDT4		;YES
	CAIGE 1,NLINES		;NO, CHECK LEGAL LINE #
	CAIGE 1,0
	RET			;NOT LEGAL, RETURN
	JRST UPDT5
UPDT4:	AND 4,TTJTIW		;FOR JOB CTTY: ALLOW ONLY ENABLED BITS
	MOVEM 4,TTSPSI
	AND 5,TTJTIW
	MOVEM 5,TTSDPS		;DEFERRED CODES
	SKIPGE 1,CTRLTT		;IF ATTACHED
	RET
UPDT5:	IFG NNVTLN,<
	MOVE 2,1		;[ISI] Put TTY# in 2 for NUTXPI
	CAME 4,TTPSI(1)
	 CALL NVTXPI##>
	MOVEM 4,TTPSI(1)	;SET FOR TTY LINE
	MOVEM 5,TTDPSI(1)
	RET

UPDT1:	PUSH P,7
	MOVEI 7,(2)
	CALL CHKWT		;DISMISSED?
	 JRST [POP P,7		;NO
		JRST UPDT3]
	POP P,7			;YES
	HRRZ 6,FKSTAT(2)
	CAIE 6,FRZWT		;FROZEN?
	JRST UPDT8		;NO
	PUSH P,6		;YES, CHECK IF JSYS TRAP FREEZE ONLY
	MOVSI 6,JTFRZB
	TDNN 6,FKINT(2)		;JSYS TRAP FREEZE?
	 JRST UPDT6		;NO.
	MOVSI 6,FRZBB
	TDNN 6,FKINT(2)		;YES, OTHER FREEZE ALSO?
	 JRST UPDT7		;NO, DON'T EXCLUDE THIS FORK'S TI'S YET
UPDT6:	POP P,6			;YES, EXCLUDE THIS FORK
	JRST UPDT2
UPDT7:	POP P,6
UPDT8:	CAIE 6,HALTT		;HALTF OR FORCED TERM?
	CAIN 6,FORCTM
	JRST UPDT2		;YES
UPDT3:	IOR 4,FKPSIE(3)		;INCLUDE FORK'S TI'S
	IOR 5,FKDPSI(3)
	JRST UPDT2


;DEASSIGN ALL TERMINAL INTERRUPTS FOR THIS FORK

DTIALL:	HRRZ 1,FORKN
	SETZM FKPSIE(1)
	HLRZ 1,SYSFK(1)		;1=DES FORK CTTY
	JRST UPDTI		;UPDATE AND RETURN

.CIS:	SETZM PSIBIP
	SETZM PSIBW
	MOVEM 1,PSIPT
	MOVE 1,[IOWD 1000,PSIPGA]
	EXCH 1,PSIPT		;RESET PSI STORAGE
	XCT MJRSTF

;READ/SET TERMINAL INTERRUPT WORD

.RTIW:	JSYS MENTR
	MOVEI 1,0(1)
	CAIN 1,-5		;WHOLE JOB?
	JRST [	MOVE 2,TTJTIW	;YES
		JRST RTIW1]
	CALL SETJFK		;GET JOB INDEX
	MOVE 2,FKDPSI(1)	;DEFERRED CODES
	UMOVE 4,1		;SEE IF USER WANTS THEM
	TLNE 4,(1B0)		;HE DOES IF SIGN OF 1 IS ON.
	UMOVEM 2,3		;RETURNED IN 3
	MOVE 2,FKPSIE(1)
RTIW1:	UMOVEM 2,2
	JRST MRETN

.STIW:	JSYS MENTR
	MOVEI 1,0(1)
	CAIN 1,-5
	JRST [	MOVE 3,CAPENB
		TLNN 3,(1B0)	;^C CAPABILITY?
		JRST ATX2E	;NO, DON'T PERMIT CHANGE TO JOB TI
		MOVEI 1,-1	;INDICATE JOB CTTY
		TRO 2,1B30!1B31!1B32 ;DON'T LET THESE GET TURNED OFF
		MOVEM 2,TTJTIW	;SET JOB MASK WORD
		JRST STIW2]	;GO UPDATE AND RET
	CALL SETJFK
	UMOVE 4,1		;SEE IF USER SUPPLIED THE DEFERRED CODES
	TRZ 3,1B30!1B31!1B32	;DON'T EVER LET THESE BE DERFERRED
	TLNE 4,(1B0)		;AND IF SO, UPDATE THEM.
	MOVEM 3,FKDPSI(1)	;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)		;[ISI] AND ^P BEING CHANGED?
	JRST STIW1		;NO
	MOVE 3,BITS+20		;YES, PUT ^P BACK LIKE IT WAS
	XORM 3,FKPSIE(1)
STIW1:	HLRZ 1,SYSFK(1)		;1=SOURCE OF FORK'S TERM PSI'S
STIW2:	CALL UPDTI		;UPDATE JOB TIW
	JRST MRETN

;FORK HANDLE - PTN CONVERSION ROUTINES

;TRANSLATE FKH.PN TO PTN.PN

FKHPTN:	PUSH P,2
	PUSH P,1
	TRNE 1,777000		;LEGAL PAGE NUMBER?
	JRST FRKE1		;NO
	HLRZ 1,1
	CALL SETJFK		;GET JOB FORK INDEX
	CALL SKIIF
	JRST [	MOVSI 2,(1B9)	;NOT INFERIOR
		TDNN 2,CAPENB	;ALLOWED TO MAP SUPERIOR?
		JRST FRKE2	;NO
		MOVE 2,1	;YES, SAVE OBJECT FORK
		CALL GETSPF	;GET HANDLE OF SUPERIOR
		EXCH 1,2
		CAME 1,2	;IS OBJECT FORK IMMED SUPERIOR?
		JRST FRKE2	;NO
		JRST .+1]
	HRRZ 2,SYSFK(1)		;GET SYSTEM FORK INDEX
	POP P,1
FKHP2:	HLL 1,FKPGS(2)		;GET PAGE TABLE PTN
	TLNE 1,-1		;IS ONE?
	JRST FKHP3		;YES
	BUG(HLT,<FKHPTN - FORK HAS NO PAGE TABLE>)

FKHP3:	POP P,2
	RET

;TRANSLATE PTN TO FKH

PTNFKH:	PUSH P,2
	PUSH P,3
	PUSH P,1
	HLRZ 2,1		;GIVEN PTN
	MOVSI 3,-NUFKS		;SETUP FOR SCAN OF JOB FORK TABLE
PTNF3:	HRRE 1,SYSFK(3)
	JUMPL 1,PTNF2		;UNUSED
	HLRZ 1,FKPGS(1)
	CAIN 2,0(1)		;IS PT?
	JRST PTNF1		;YES
PTNF2:	AOBJN 3,PTNF3
	SETOM 0(P)		;NOT FOUND, RETURN -1
	JRST PTNF4

PTNF1:	MOVEI 1,0(3)		;JOB INDEX
	CALL GFKH		;CONVERT TO LOCAL HANDLE
	ITERR FRKHX6
	HRLM 1,0(P)		;CONSTRUCT FHK,,PN
PTNF4:	POP P,1
POP32:	POP P,3
POP2:	POP P,2
	RET

;FIND OR INSERT LOCAL FORK HANDLE
; RH(1)/  JOB FORK INDEX
; LH(1)/  PSB OFFSET (GRFKH ONLY)

GFKH:	TLZ 1,777777		; ENTER HERE FOR RELATIVE TO SELF
GRFKH:	PUSH P,2		; ENTER HERE WITH LH OFFSET TO PSB
	PUSH P,3
	PUSH P,4
	HLRE 3,1		; INDEX TO CORRECT PSB (FULL WD NUMBER)
	HRRZ 2,FORKN(3)		; GET CORRECT FORKN
	PUSH P,3		; SAVE FOR LATER
	ADD 3,FKPTAB		; OFFSET POINTER
	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
	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)
	DPB 1,3			;STORE JOB INDEX IN ENTRY
	HLRZ 4,1
GFKH4:	MOVEI 1,400000(4)	;RETURN LOCAL HANDLE WITH BIT
	AOS -4(P)
POP41:	SUB P,BHC+1
POP4:	POP P,4
	JRST POP32

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

DAFKSH:	HRLM 1,0(P)		;[ISI] SAVE HANDLE
	ADD 1,INFERP		;[ISI] DO INFERIOR FORKS FIRST
DAFKS2:	LDB 1,1			;[ISI] INFERIORS
	JUMPE 1,DAFKS1		;[ISI] END IF ZERO
	CALL DAFKSH		;[ISI] DEASSIGN THIS AND ITS INFERIORS
	ADD 1,PARALP		;[ISI] NOW DO THE PARALLELS
	JRST DAFKS2		;[ISI]
DAFKS1:	HLRZ 1,0(P)		;[ISI] RESTORE HANDLE
	CALL DASFKH		;[ISI] RELEASE HANDLE FOR TOP OF GROUP
	RET			;[ISI] RETURN


;DEASSIGN LOCAL FORK HANDLE GIVEN JOB HANDLE IN 1

DASFKH:	PUSH P,2
	PUSH P,3
	PUSH P,4
	MOVE 3,FKPTAB
	MOVE 4,[XWD -NLFKS+1,1]
DASFK1:	ILDB 2,3		;GET THIS ENTRY
	CAIN 2,0(1)		;THE ONE WE WANT?
	JRST DASFK2		;YES
	AOBJN 4,DASFK1		;NO, KEEP LOOKING
	JRST POP4		;NOT FOUND, SO IGNORE IT

DASFK2:	MOVEI 2,-1		;PUT A -1 WHERE ENTRY WAS
	DPB 2,3
	JRST POP4

;TABLE OF BYTE POINTERS, HALF WORD

	POINT 18,FKTAB,-1
FKPTAB:	POINT 18,FKTAB,17
	POINT 18,FKTAB,35

;SPECIAL CAPABILITIES CONTROL

.RPCAP:	JSYS MENTR
	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:	JSYS MENTR
	CALL SETJFK
	CALL SKIIF
	ITERR FRKHX2		;INFERIORS ONLY
	CALL SETLF1
	JUMPE 1,[XOR 3,CAPMSK(1) ;IF SELF, DON'T MODIFY 14-17
		TLZ 3,(17B17)
		XOR 3,CAPMSK(1)
		JRST EPC1]
	MOVE 4,CAPMSK
	TLO 4,(777B17)		;9-17 DETERMINED BY SUPERIOR
	AND 2,4
	MOVEM 2,CAPMSK(1)
EPC1:	AND 3,CAPMSK(1)
	MOVEM 3,CAPENB(1)
	JRST CLFRET

;SET FORK CONTROLLING (TERMINAL PSI) TTY JSYS
;1/ FUNCTION BITS,,FORK HANDLE
;2/ SOURCE DESIGNATOR (ONLY TTY DESIGNATOR CURRENTLY IMPLEMENTED)
;FUNCTION BITS: B0: RETURN DESIGNATOR FOR FORK CTTY IN 2
;		B1: SET FORK CONTROLLING TTY
;		B2: CLEAR FORK CONTROLLING TTY (RESTORES JOB CTTY)

.SCTTY:	JSYS MENTR		;BECOME SLOW
	NOINT			;PREVENT SUPERIORS FROM INTERFERING
	CALL RLJBFK		;CONVERT REL FORK HANDLE TO JOB HANDLE
	 RETERR FRKHX1		;ILLEGAL HANDLE
	UMOVE 2,1
	TLNE 2,(1B0)		;RETURN FORK CTTY?
	JRST SCTT0
	MOVE 3,CAPENB
	TLNN 3,(1B6)		;CTTY CAPABILITY ENABLED?
	 RETERR CAPX2		;NO.
	CALL SKIIF		;IS FORK AN INFERIOR?
	 RETERR FRKHX2		;NO, ILLEGAL.
	TLNE 2,(1B1)		;SET CTTY?
	JRST SCTT1
	TLNE 2,(1B2)		;CLEAR CTTY?
	JRST SCTT2
	RETERR SCTX1		;UNDEFINED FUNCTION BITS, ERROR.

SCTT0:	HLRZ 2,SYSFK(1)		;GET CTTY DES FOR FORK
	UMOVEM 2,2		;RETURN IT
	JRST SKMRTN

SCTT1:	UMOVE 2,2
	TRZN 2,1B18		;DES = 4XXXXX?
	JRST .+3		;NO, ERROR.
	CAIGE 2,NLINES		;LEGAL LINE #?
	CAIGE 2,0
	RETERR DESX1		;NO.
       LOCK DEVLCK,<PUSHJ P,LCKTST##>
	HLRZ 3,TTFORK(2)	;3=JOB TTY ASSIGNED TO
	CAME 3,JOBNO		;ASSIGNED TO THIS JOB?
	JRST SCTT6		;NO, ERROR.
	CAMN 2,CTRLTT		;JOB CTTY?
	JRST SCTT7		;ILLEGAL, USE 1B1 TO RESET
	IDIVI 2,2
	ADD 2,TTFRKP(3)
	LDB 3,2			;3=TOP FORK FOR WHICH THIS TTY IS CTTY
	CAIE 3,-1		;NULL FORK?
	JRST SCTT8		;NO, ERROR.
	MOVEI 3,-2
	DPB 3,2			;INDICATE CTTY ASSIGNMENT IN PROGRESS
       UNLOCK DEVLCK
	MOVE 10,2		;SAVE PTR TO TTFRK1 TABLE
	UMOVE 3,2
	CAIA
; SKIPS THRU

; SKIPPED INTO
SCTT2:	MOVEI 3,-1		;RESTORE FORK CTTY TO JOB CTTY
	PUSH P,1		;SAVE FORK
	PUSH P,3		;AND TTY DES
	HRRZ 2,FORKN
	CAIN 1,0(2)		;SETTING OWN CTTY?
	CALL MAPINF		;YES, FREEZE INFERIORS ONLY
	 CALL FFORK1		;FREEZE FORKS (UPDATES TTPSI WORDS)
	POP P,3
	POP P,1
	HLRZ 4,FORKN		;4=TOP JOB FORK
	MOVE 5,FKPTRS(1)
	LSH 5,-^D24		;5=SUPERIOR OF FORK IN 1
	MOVEI 2,377777		;2=NULL DES
	CAIE 4,(1)		;FORK BEING CHANGED=TOP JOB FORK?
	HLRZ 2,SYSFK(5)		;NO, 2=DES OF ITS SUPERIOR'S CTTY
	CALL SCTT3		;SET NEW CTTY FOR FORK AND ITS INFS.
	HRRZ 2,SYSFK(1)		;2=SYS FORK INDEX OF TOP FORK
	CAIE 3,-1		;NEW CTTY=JOB CTTY?
	DPB 2,10		;NO, PUT FORK INDEX IN TTFRK1(LINE).
	HRRZ 2,FORKN
	CAIN 1,(2)
	CALL MAPINF
	 CALL RFORK1		;RESUME FORKS (UPDATES TTPSI WORDS)
	JRST SKMRTN		;RETURN.

SCTT6:	UNLOCK DEVLCK
	RETERR DEVX2
SCTT7:	UNLOCK DEVLCK
	RETERR SCTX3
SCTT8:	UNLOCK DEVLCK
	RETERR SCTX2

;CHANGE THE CTTY
;1/ JOB FORK INDEX
;2/ SUPERIOR FORK'S PREV CTTY
;3/ NEW CTTY DESIGNATOR.

SCTT3:	HLRZ 4,SYSFK(1)		;4=OLD CTTY
	HRLM 3,SYSFK(1)		;SET NEW CTTY
	CAIE 4,0(3)		;NEW CTTY=OLD CTTY?
	CAIN 4,0(2)		;PREV CTTY SAME AS SUP'S PREV CTTY?
	JRST SCTT5		;YES.
	TRO 1,1B18		;NO, MUST UPDATE OLD CTTY TTFRK1 ENTRY.
	CAIN 4,-1		;WAS PREV CTTY JOB CTTY?
	JRST SCTT4		;YES, NO NEED TO FIX TTFRK1
	MOVEI 5,0(4)		;NO, 5=PREV DES (ASSUMED TO BE TTY DES)
	TRZN 5,1B18		;CONVERT TO LINE #
	JRST SCTT4		;NOT A TTY DESIGNATOR.
	CAIGE 5,NLINES		;IS IT A VALID LINE?
	CAIGE 5,0
	JRST SCTT4		;NO, DON'T TOUCH TTFRK1
	SETZM TTPSI(5)		;CLEAR TERMINAL PSI WORD
	IDIVI 5,2
	ADD 5,TTFRKP(6)
	SETO 6,
	DPB 6,5			;CLEAR TTFRK1 ENTRY FOR LINE

SCTT4:	PUSH P,2		;SAVE SUP'S PREV CTTY
	MOVEI 2,0(4)		;SET PREV CTTY FOR INFS.
SCTT5:	HRLM 1,0(P)		;SAVE CURRENT FORK
	TRZ 1,1B18
	CALL MAPINF
	 CALL SCTT3		;DO ABOVE FOR INFERIORS
	HLRZ 1,0(P)
	TRZN 1,1B18		;SAVED SUP'S PREV CTTY?
	RET			;NO
	POP P,2			;YES, RESTORE IT
	TLZ 2,-1
	RET			;DONE

;CREATE FORK GROUP (FOR CNDIR'S) JSYS
;1/ HANDLE OF FORK TO BE TOP FORK IN NEW GROUP
;	(B0 - RETURN AS IF GJINF CALL
;		1/ "LOGIN" DIR  2/ CONNECTED DIR
;		3/ JOBNO        4/ FORK CTTY
;	 B1 - RETURN IN 2 REL HANDLE OF TOP FORK FOR FORK IN 1

.CFGRP:	JSYS MENTR		;BECOME SLOW
	CALL RLJBFK		;GET JOB FORK INDEX
	 RETERR FRKHX1		;ILLEGAL HANDLE
	UMOVE 2,1
	TLNE 2,(1B0)		;RETURN DIRECTORIES?
	JRST CFGRP0
	TLNE 2,(1B1)		;RETURN TOP FORK IN GROUP?
	JRST CFGRP3
	CALL SKIIF		;INFERIOR FORK?
	 RETERR FRKHX2		;NO, ILLEGAL
	NOINT			;PREVENT INTERFERENCE FROM SUPERIORS
	PUSH P,1		;SAVE FORK
	HRRZ 2,FORKN
	CAIN 1,0(2)		;TOP FORK OF NEW GROUP THIS FORK?
	CALL MAPINF		;YES, FREEZE ONLY INFERIORS
	 CALL FFORK1
	MOVE 1,0(P)		;RESTORE FORK
	HRRZ 2,SYSFK(1)		;2=SYS FORK INDEX FOR TOP FORK
	SKIPL 3,FKDIR(2)	;SKIPS IF NOT NOW A TOP FORK
	JRST CFGRP1		;CURRENTLY A TOP FORK
	MOVE 4,FKDIR(3)		;SET UP CONN DIR,,USER DIR FOR NEW TOP
	MOVEM 4,FKDIR(2)
	MOVE 4,FKGRPS(3)	;AND GROUP BITS FOR NEW TOP FORK
	MOVEM 4,FKGRPS(2)

CFGRP1:	HRROI 3,0(2)		;3=-1,,SYS FORK INDEX TOP FORK IN GROUP
	CALL MAPINF
	 CALL CFGRP2		;SET UP INFERIORS TO POINT TO TOP FORK
	POP P,1			;RESTORE FORK
	HRRZ 2,FORKN
	CAIN 1,0(2)
	CALL MAPINF
	 CALL RFORK1		;RESUME RELEVANT FORKS
	JRST SKMRTN

CFGRP2:	HRRZ 2,SYSFK(1)		;2=SYS FORK INDEX OF FORK
	MOVEM 3,FKDIR(2)	;SET PTR TO TOP FORK OF NEW GROUP
	HRLM 1,0(P)
	CALL MAPINF
	 CALL CFGRP2		;HANDLE ITS INFS.
	HLRZ 1,0(P)
	RET			;DONE.

CFGRP0:	MOVE 1,SYSFK(1)		;1=FORK'S FORKX
	HLRZ 4,1		;4=DES OF FORK CTTY
	CAIN 4,-1		;JOB CTTY?
	MOVE 4,CTRLTT		;YES.
	JUMPL 4,.+2		;DETACHED?
	TLZ 4,1B18		;NO, CONVERT TO LINE NUMBER
	UMOVEM 4,4		;RETURN LINE NUMBER OF FORK CTTY
	SKIPGE 1,FKDIR(1)
	MOVE 1,FKDIR(1)		;1=CONN DIR,,LOGIN DIR
	HLRZ 2,1
	HRRZS 1
	UMOVEM 1,1		;RETURN LOGIN DIR
	UMOVEM 2,2		;RETURN CONN DIR
	MOVE 3,JOBNO
	UMOVEM 3,3		;RETURN JOBNO.
	JRST SKMRTN

CFGRP3:	HRRZ 2,SYSFK(1)		;2=SYSTEM FORK INDEX
	SKIPL 2,FKDIR(2)	;2=TOP FORK I GROUP?
	JRST CFGRP4		;YES.
	TLZ 2,-1		;NO, BUT NOW IT DOES.
	MOVSI 1,-NUFKS		;CONVERT FROM SYSTEM TO JOB INDEX
	HRRZ 3,SYSFK(1)
	CAIN 3,0(2)
	JRST .+3
	AOBJN 1,.-3
	RETERR FRKHX1		;CAN ONLY HAPPEN IF TOP FORK GETS KILLED
	TLZ 1,-1		;1=JOB FORK INDEX OF TOP FORK
CFGRP4:	CALL GFKH		;GET RELATIVE FORK HANDLE
	RETERR FRKHX6
	UMOVEM 1,2		;RETURN IT.
	JRST SKMRTN

;JSYS TRAP JSYS'  (TFORK, RTFRK AND UTFRK)

;TFORK JSYS - FOR SETTING AND REMOVING TRAPS
;1/ FUNCTION BITS,,FORK HANDLE
;2/ PSI CHANNEL,,PTR TO BIT TABLE
;FUNCTION BITS:
; B0:	SET TRAPS AS SPECIFIED BY BIT TABLE
; B1:	REMOVE ALL TRAPS SET BY THIS FORK
; B2:	REMOVE TRAPS SET BY THIS FORK AS SPECIFIED BY BIT TABLE
; B3:	SET JSYS TRAP PSI CHANNEL FROM LH(2) / -1=>DON'T PSI ON TRAP
; B4:	READ JSYS TRAP PSI CHANNEL INTO LH(2)
; B5:	TEST IF SELF IS MONITORED: RET WITH 2=-1/0 FOR YES/NO
; B6:	TRAP RESET-REMOVE TRAPS FROM ALL INFERIORS, CLEAR PSI CHANNEL
;NOTE FOR B0 AND B1 FUNCTIONS WHEN RH(4)=-1, ALL OF THE INFERIOR
;FORKS MUST BE FROZEN.
;RET + 1 IF ERROR IN CALL
;    + 2 IF SUCCESSFUL

JTMONF==400000  ;FORK IS A MONITOR FLAG

RESCD
JTRPON:: -1	;JSYS TRAP "ON SWITCH" - SET TO NON-ZERO TO ENABLE
		;TRAPS - TO BE REMOVED (ALONG WITH TEST IN TFORK)
		;WHEN TRAPS ARE OFFICIALLY RELEASED
SWAPCD

.TFORK:	JSYS MENTR		;BECOME SLOW
	SKIPN JTRPON		;TRAPS ENABLED?
	JRST MRETN		;NO, NON-SKIP NOOP
	UMOVE 1,1
	TLNN 1,3777		;CHECK FUNCTION BITS
	TLNN 1,774000
	 RETERR TFRKX1		;BAD BITS
	JFFO 1,.+1
	MOVE 2,BITS(2)		;1 IS BETWEEN 0 AND 5
	TRO 2,-1		;USE ONLY MOST SIGNIFICANT
	AND 1,2			;FUNCTION BIT
	TLNE 1,(1B0+1B1+1B2)	;SETTING OR REMOVING TRAPS?
	JRST TFORK3
	TLNE 1,(1B3+1B4)	;SETTING OR READING CHANNEL?
	JRST TFORK2
	TLNE 1,(1B5)		;TESTING IF MONITORED
	JRST TFORK1
	TLNE 1,(1B6)		;TRAP RESET? - CAN'T SKIP ...
	JRST TFORK6
	RETERR TFRKX1		;BUT IF IT DOES ...

TFSKP:	AOS 0(P)		;TFORK SKIP RETURN
TFRET:	JRST MRETN

TFORK1:	SETZ 2,			;CHECK IF MONITORED
	HRRZ 3,JTMNW		;GET MONITORING FORK
	CAIE 3,7777		;IS IT NULL FORK?
	SETO 2,			;NO, FORK IS MONITORED
	UMOVEM 2,2
	JRST TFSKP

TFORK2:	TLNN 1,(1B3)		;SETTING CHANNEL?
	JRST TFRK21		;NO, READING IT
	UMOVE 2,2		;YES.
	MOVSS 2
	DPB 2,JTMCN		;SET THE CHANNEL
	JRST TFSKP
TFRK21:	HLLZ 2,JTMNW		;GET THE CHANNEL
	TLZ 2,777700		;CLEAR MONITOR BIT
	UMOVEM 2,2		;RETURN IT
	JRST TFSKP

TFORK3:	NOINT 			;PREVENT SELF FROM BEING FROEN
	MOVE 5,1		;5=USER'S AC1
	MOVEI 1,0(1)		;1=FORK HANDLE
	CAIN 1,-4		;ALL INFERIORS?
	JRST TFRK31		;YES
	CALL RLJBFK		;CONVERT REL HANDLE TO JOB FORK INDEX
	 RETERR TFRKX2
	CALL SKIMIF		;IS IT IMMEDIATE INFERIOR?
	 RETERR TFRKX2		;NO, ERROR
	MOVEI 2,0(1)		;YES, 2=JOB FORK INDEX

TFRK30:	PUSH P,2
	CALL ASGPAG		;GET A PAGE FOR TEMP STORAGE
	BUG(CHK,<TFORK:	ASGPAG FAILURE>)
	MOVEI 3,0(1)		;JSYS BIT TABLES, 3=PAGE ADDR
	PUSH P,3
	CALL ASGPAG		;GET PAGE FOR MAPPING DISP VECS
	BUG(CHK,<TFORK:	ASGPAG FAILURE>)
	MOVEM 1,JTJDA		;SAVE ADDR OF PAGE
	POP P,3			;RESTORE 3 SMASHED BY ASGPAG
	POP P,2			;RESTORE 2 SMASHED BY ASGPAG
	MOVEI 1,0(5)
	FFORK 			;FREEZE THE FORK
	CAIN 1,-4		;ALL INFERIORS?
	 JRST TFORK4		;YES, DON'T DO FREEZE.
	HRRZ 1,SYSFK(2)		;NO, CHECK IF FORK IS FROZEN.
	MOVE 1,FKINT(1)
	TLNE 1,FRZBB		;IS IT?
	 TLO 5,(1B17)		;YES, REMEMBER THAT IN 5.
	MOVEI 1,(5)
	TLNN 5,(1B17)		;IS FORK FROZEN?
	FFORK			;NO, FREEZE IT.
	MOVEI 1,0(2)		;1=JOB FORK INDEX
	JRST TFRK40

TFRK31:	MOVE 1,FORKN		;DOING ALL INFERIORS, CHECK IF
	CALL MAPINF		;THEY ARE ALL FROZEN.
	 CALL TFRK32
	JRST TFRK30		;IF RETURN, THEN ALL ARE FROZEN.

TFRK32:	HRRZ 1,SYSFK(1)
	MOVE 1,FKINT(1)
	TLNN 1,FRZBB		;IS FORK FROZEN?
	 RETERR TFRKX3		;NO, GIVE JSYS ERROR RETURN.
	RET			;YES.

TFORK4:	MOVE 1,FORKN
	CALL MAPINF		;HANDLE TRAPS FOR ALL INFERIORS
TFRK40:	 CALL TFORK5
	MOVEI 1,0(5)
	CAIN 1,-4		;ALL INFERIORS?
	 JRST TFRK41		;YES, DON'T RESUME THEM.
	TLNN 5,(1B17)		;NO, WAS FORK FROZEN ON CALL?
	RFORK			;NO, RESUME IT.
TFRK41:	MOVEI 1,0(3)
	CALL RELPAG		;RELEASE THE BIT TABLE PAGE
	MOVE 1,JTJDA
	CALL RELPAG		;RELEASE MAPPED DISP VEC PAGE
       OKINT
	JRST TFSKP

TFORK5:	PUSH P,5
	PUSH P,16		;SAVE 16 SET BY MAPINF
	MOVSI 2,JTIMF+JTDMF	;INIT FLAGS FOR CALL TO TPJSYS

	TLNE 5,(1B1)		;REMOVE ALL TRAPS?
	JRST TFRK54		;YES.

	UMOVE 4,2
	HRLI 4,0(4)		;SET UP 4 FOR BLT OF
	HRRI 4,0(3)		;USER BIT TABLE TO TABLE PAGE
	XCTUM [ BLT 4,JTBSIZ-1(3) ]

TFRK50:	MOVSI 4,776000
	ANDM 4,JTBSIZ-1(3)	;ONLY 1ST 8 BITS OF LAST WORD

	TLNE 5,(1B0)		;SETTING TRAPS?
	JRST TFRK53		;YES

	HRLI 7,0(3)
	ADDI 3,JTBSIZ		;COPY USER BITS AGAIN TO
	HRRI 7,0(3)		;DETERMINE WHICH JSYS' CAN
	BLT 7,JTBSIZ-1(3)	;CHANGE DISP VEC FOR.

	PUSH P,3		;SAVE PTR TO TABLE
	HRLI 3,-JTBSIZ
	MOVSI 11,-1000		;COMPUTE JSYS'S THIS FORK CAN
TFRK51:	MOVSI 10,-^D35		;REMOVE TRAPS FOR = USER
	SETZ 7,			;TABLE - JSYS'S TRAPPED
TFRK52:	HRRZ 6,JDV(11)		;BY SUPERIORS
	CAIN 6,JTDVC1(11)	;IS THIS JSYS TRAPPED BY SUP?
	IOR 7,BITS(10)		;YES, WILL CLEAR BIT IN TABLE
	AOBJN 11,.+2
	CAIA
	AOBJN 10,TFRK52
	ANDCAM 7,0(3)		;CLEAR BITS FOR JSYS'S CAN'T
	AOBJN 3,TFRK51		;UNTRAP.

	POP P,3			;RESTORE TABLE PTR-AT THIS POINT
	JRST TFRK55		;3 PTS TO TABLE OF JSYS' CAN
	 			;CHANGE DISPATCH VEC FOR.

TFRK53:	TLO 2,JTSTF		;INDICATE SETTING TRAPS
	MOVSI 4,JTMONF
	IORM 4,JTMNW		;INDICATE FORK IS A MONITOR
TFRK55:	CALL TPJSYS		;SET UP OR REMOVE THE TRAPS
	POP P,16
	POP P,5
	RET

TFRK54:	SETOM 0(3)		;REMOVING ALL TRAPS, START
	MOVSI 4,0(3)		;TABLE WITH ALL JSYS'S
	HRRI 4,1(3)
	BLT 4,JTBSIZ-1(3)
	TLO 2,JTRMAL		;INDICATE REMOVING ALL
	JRST TFRK50

TFORK6:	NOINT 			;TFORK RESET
	MOVSI 1,77		;CLEAR PSI CHANNEL FOR TRAPS
	HLLM 1,JTMNW		;AND CLEAR JTMONF BIT
	MOVE 1,FORKN		;FOR ALL FORKS, REMOVE ALL TRAPS.
	CALL MAPINF
	 CALL TFRK60
	RTFRK
	SETZ 1,
	JUMPE 1,.+3		;WAS A TRAP PENDING?
	HLRZS 1			;YES, ALLOW FORK TO CONTINUE
	UTFRK
	SETOM JTLCK		;CLEAR THE LOCK
	MOVSI 1,PSIJTR		;CLEAR PENDING TRAP PSI (IF ANY)
	MOVE 2,FORKX		;WHICH MAY HAVE OCCURED AFTER
	ANDCAM 1,FKINT(2)	;NOINT AND BEFORE TFORK
	OKINT
	JRST TFSKP

TFRK60:	MOVE 3,FKPTAB
	MOVE 4,[XWD -NLFKS+1,1]
	SETZ 5,			;REMEMBER IN 5 IF WE HAD TO GET
	ILDB 2,3		;NEW REL HANDLE FOR FORK.
	CAIN 2,(1)		;DO WE HAVE HANDLE FOR FORK?
	 JRST TFRK61		;YES.
	AOBJN 4,.-3		;NOT THIS ONE, TRY NEXT.
	TLO 5,(1B17)		;NO HANDLE, GFKH WILL GET NEW ONE.
TFRK61:	CALL GFKH		;GET RELATIVE HANDLE FOR FORK.
	 RETERR FRKHX6		;THERE ARE NONE LEFT.
	HRLI 1,(1B2)
	TFORK			;REMOVE ALL TRAPS SET FOR FORK.
	BUG(CHK,<IMPOSSIBLE TFORK FAILURE WITHIN TFORK>)
	TLZ 1,-1
	TLNE 5,(1B17)		;DID WE GET A NEW REL HANDLE?
	 CALL DASFKH		;YES, GET RID OF IT.
	RET


;ROUTINE TO SET OR REMOVE JSYS TRAPS
;1/ JOB FORK INDEX
;2/ FLAGS
;3/ PTR TO TABLE OF JSYS'S TO TRAP/UNTRAP
;USES (BUT DOESN'T SAVE) ACS 4,5,6,7,11
;FLAGS:

JTIMF==400000	;FORK IS IMMED MONITORED BY EXECUTING FORK
JTDMF==200000	;FORK IS IMMED INF OF A MONITOR FORK
JTNIMF==100000	;EXECUTING FORK IS A NEW MONITOR FOR THIS FORK
JTTBF==40000	;TABLE OF JSYS'S RECOMPUTED ON THIS CALL
JTRTBF==20000	;TAB OF JSYS'S WRITTEN ON OLD ONE BECAUSE NO STACK ROOM
JTSTF==10000	;SETTING TRAPS
JTRMAL==4000	;REMOVING ALL TRAPS

TPJSYS:	MOVEI 11,0(1)
	CALL SETLF1		;MAP FORK'S PSB
	EXCH 1,11		;1=FORK INDEX,11=PSB PTR
	TLNE 2,JTIMF		;FORK IMMED MONITORED BY ME?
	JRST TPJS1		;YES.
	TLNE 2,JTDMF		;FORK IMMED INFERIOR OF A MON?
	JRST TPJS2		;YES, MODIFY DISPATCH AS NEC.

TPJS0:	HRLS 1			;LH(1)=JOB FORK INDEX
	IOR 1,2			;AND FLAGS
	HLLM 1,0(P)		;SAVE FLAGS AND JOB FORK INDEX
	TLZ 2,JTTBF		;CLEAR TABLE COMPUTED BIT
	MOVEI 1,0(1)

	MOVE 4,JTMNW(11)
	TLNN 4,JTMONF		;FORK ITSELF A MONITOR?
	JRST .+4		;NO
	TLZ 2,JTIMF		;YES, CLEAR MON BY EXECUTING
	TLO 2,JTDMF		;FORK BIT AND SET IMMED INF. TO
	CAIA 			;A MONITOR BIT.
	TLZ 2,JTDMF		;NOT A MONITOR, CLEAR INF. BIT
	CALL MAPINF		;HANDLE TRAPS IN FORKS INFERIORS
	 CALL TPJSYS
	HLLZ 2,0(P)
	HLRZ 1,2
	TLZ 2,777		;RESTORE FLAGS
	TRZ 1,777000		;AND JOB FORK INDEX
	TLNE 2,JTTBF		;TABLE RECOMPUTED IN THIS CALL?
TPJS01:	POP P,3			;YES, RESTORE OLD TABLE PTR
	RET 			;RETURN

TPJS1:	TLNE 2,JTSTF		;SETTING TRAPS?
	JRST SETRP1		;YES.
	HRRZ 4,JTMNW(11)	;NO, REMOVING THEM
	CAIN 4,7777		;IS FORK REALLY MONITORED?
	RET 			;NO, RETURN
	JRST RMTRP1		;YES, GO REMOVE THEM.

TPJS2:	HRRZ 4,JTMNW(11)	;4=JOB INDEX OF ITS IMMED MON
	MOVEI 5,0(1)
	ADD 5,SUPERP
	LDB 5,5			;GET JOB INDEX OF IMMED SUP.
	CAME 4,5		;IMMED SUPERIOR=IMMED MON?
	JRST TPJS23		;NO

	TLNE 2,JTRTBF		;FORK IMMED INF OF A MONITOR.
	JRST TPJS4		;RECOMPUTE JSYS'S OF INTEREST.
	 			;ROOM ON STACK? TO TPJS4 IF NOT.

	PUSH P,3		;SAVE PTR TO OLD TABLE
	MOVEI 4,JTBSIZ(3)	;4=PTR TO START OF NEW TABLE
	MOVEI 5,JTBTB(11)	;5=PTR TO FORK'S TABLE
	HRLI 5,-JTBSIZ		;5=AOBJN PTR
	SETZ 6,			;USE 6 TO FLAG IF JSYS'S LEFT
TPJS21:	MOVE 7,0(3)		;JSYS'S OF INTEREST = ONES
	ANDCM 7,0(5)		;IN OLD TABLE - ONES HANDLED BY
	MOVEM 7,0(4)		;FORK'S IMMED MONITOR.
	CAIE 7,0		;ANY JSYS'S LEFT?
	AOJ 6,			;YES, INCREMENT FLAG
	AOJ 3,
	AOJ 4,
	AOBJN 5,TPJS21

	JUMPE 6,TPJS01		;IF NO JSYS'S LEFT, RETURN
	MOVEI 6,0(3)		;CHECK IF ENOUGH ROOM IN PAGE
	TRZ 6,777		;FOR NEXT BIT TABLE
	ADDI 6,1000		;6=TABLE BASE+1000
	SUB 6,3			;6=WORDS LEFT IN PAGE
	CAIGE 6,JTBSIZ		;ENOUGH FOR ANOTHER TABLE?
	TLO 2,JTRTBF		;NO, SIGNAL THAT FACT
	TLO 2,JTTBF		;INDICATE TABLE RECOMPUTED.

TPJS22:	TLNN 2,JTSTF		;SETTING TRAPS?
	JRST RMTRP2		;NO
	JRST SETRP2		;YES

TPJS23:	TLNN 2,JTSTF		;IMMED SUP A MON BUT NOT FOR
	JRST RMTRP3		;THIS FORK. JSYS DISP OK (ITS
	JRST SETRP3		;SHARED WITH SUP) BUT BIT TABLE
	 			;MAY NEED UPDATE.

TPJS4:	SETZM 0(3)		;MUST WRITE NEW TABLE OVER OLD
	MOVEI 4,1(3)		;FIRST CLEAR OLD ONE
	HRLI 4,0(3)
	BLT 4,JTBSIZ-1(3)
	PUSH P,1		;SAVE JOB FORK INDEX
	PUSH P,3		;AND TABLE PTR

TPJS41:	HRL 11,1		;11=FORK,,PSB PTR

TPJS42:	MOVEI 4,0(11)
	HRLI 4,-JTBSIZ
TPJS46:	MOVE 5,JTBTB(4)		;JSYS'S OF INTEREST=THE ONES
	IORM 5,0(3)		;SPEC BY USER MINUS ALL
	AOJ 3,			;TRAPED BETWEEN EXECUTING
	AOBJN 4,TPJS46		;FORK AND FORK OF INTEREST

	HRRZ 1,JTMNW(11)	;1=FORK'S IMMED MON.
	MOVEI 11,0(1)		;MAP IMMED MON'S PSB
	CALL SETLF1
	EXCH 1,11
	HRRZ 4,JTMNW(11)	;4=ITS MONITOR
	CAMN 4,FORKN		;IS IT EXECUTING FORK?
	JRST TPJS43		;YES, NOW ADD USER'S BITS
	HRRZ 3,0(P)		;NO,ACCOUNT FOR JSYS'S MONITORED
	JRST TPJS41

TPJS43:	HRR 4,0(P)		;4=PTR TO TABLE
	TRZ 4,777		;MAKE IT PT ORIGINAL TABLE
	TLNN 2,JTSTF
	ADDI 4,JTBSIZ
	HRLI 4,-JTBSIZ
	SETZ 6,
TPJS44:	MOVE 5,0(4)		;"AND" THE COMPLEMENT OF
	ANDCMM 5,0(3)		;PARTIALLY COMPUTED TABLE WITH
	SKIPE 0(3)		;USER TABLE, ANY JSYS'S LEFT?
	AOJ 6,			;YES, FLAG THAT FACT
	AOJ 3,
	AOBJN 4,TPJS44

	POP P,3			;RESTORE TABLE PTR
	POP P,1			;AND FORK HANDLE

	HLRZS 11
	CAMN 1,11		;IS MAPPED PSB ONE OF FORK OF
	JRST TPJS45		;INTEREST?   YES
	MOVEI 11,0(1)		;NO
	CALL SETLF1		;MAP PSB
	EXCH 1,11
TPJS45:	JUMPE 6,[ RET ]		;IF NO JSYS'S LEFT, RETURN.
	JRST TPJS22		;GO MODIFY DISPATCH VECTOR.

;REMOVE TRAPS FOR FORK - RMTRP1/RMTRP2 JRST'D TO FROM TPJS1/TPJS22
; 		 RMTRP3 JRST'D TO FROM TPJS23
;1/ FORK INDEX
;2/ FLAGS
;3/ PTR TO BIT TABLE OF JSYS'S TO UNTRAP
;11/ PTR TO FORK'S MAPPED PSB
;USES (BUT DOESN'T SAVE) ACS 4,5,6,7,10,12,13,14

RMTRP1:	 			;EX FORK IS IMMED MON OF FORK
	TLNN 2,JTRMAL		;REMOVING ALL TRAPS?
	JRST RMTRP2		;NO
	HRLI 4,JTBTB		;YES, SET FORK'S JSYS TRAP DATA
	HRRI 4,JTBTB(11)	;TO SAME AS EXECUTING FORK'S
	BLT 4,JTBTB+JTBSIZ-1(11);SET BIT TABLES TO BE THE SAME
	HRRZ 5,JTMNW		;GET MONITOR OF EXECUTING FORK
	HRRM 5,JTMNW(11)	;SET MONITOR FO INF TO IT

	MOVE 6,2		;SAVE FLAGS
	LDB 2,[POINT 13,PSB+JDVPG,26];2=SPT PTR - EX FORK'S DISP VEC
	CALL SETFJD		;SET FORK'S DISP VEC TO SHARE
	 			;WITH EX FORK'S DISP VEC.
	MOVE 2,6		;RESTORE FLAGS
	JRST TPJS0

RMTRP2:
	MOVE 13,2		;SAVE FLAGS
	MOVSI 2,RWX
	CALL SETJDV		;MAP FORK'S DISP VEC
	EXCH 13,2		;13=PTR TO MAPPED DISP VEC.

	MOVEI 7,0(3)
	HRLI 7,-JTBSIZ
	SETZ 10,
	TLNN 2,JTIMF
	JRST RMTR13
	MOVEI 12,0(11)		;IF IMMED INF OF EX FORK, SET
	MOVEI 14,0(3)		;12 TO PSB OFFSET, 14 TO USER
	TRZ 14,777		;BIT TABLE
RMTR13:	MOVE 4,0(7)		;4=BITS FOR TRAPS TO REM
RMTR14:	JFFO 4,RMTR15
	TLNN 2,JTIMF		;FORK IMMED MON'TD BY EX FORK?
	JRST RMTR16		;NO
	MOVE 4,0(14)		;YES, GET USER BITS AND
	ANDCAM 4,JTBTB(12)	;AND CLEAR BITS FOR JSYS'S
	AOJ 12,
	AOJ 14,
RMTR16:	ADDI 10,^D36
	AOBJN 7,RMTR13

	CALL CLRJDV		;UNMAP DISP VECTOR
	JRST TPJS0

RMTR15:	MOVE 6,BITS(5)
	ANDCM 4,6		;CLEAR "JFFO" BIT FOR THIS JSYS
	ADDI 5,0(10)		;5=JSYS #
	MOVE 6,NJDV(5)		;6=NORMAL DISPATCH FOR THIS JSYS
	ADDI 5,0(13)		;5=OFFSET INTO FORK'S DISP VEC
	MOVEM 6,(5)		;SET NORMAL DISPATCH
	JRST RMTR14

RMTRP3:	 			;FORK'S IMMED SUP A MON BUT NOT
	 			;FOR IT.
	CAME 4,FORKN		;IMMED MON. OF FORK EX FORK?
	JRST TPJS0		;NO, BIT TABLE OK AS IS.
	MOVEI 7,0(3)		;YES, CLEAR BITS FOR UNTRAPPED
	TRZ 7,777
	HRLI 7,-JTBSIZ		;JSYS'S
	MOVEI 12,0(11)
	MOVE 4,0(7)
	ANDCAM 4,JTBTB(12)
	AOJ 12,
	AOBJN 7,.-3
	JRST TPJS0

;SET TRAPS FOR FORK - SETRP1/SETRP2 JRST'D TO FROM TPJS1/TPJS22
; 	      SETRP3 JRST'D TO FROM TPJS23
;1/ FORK INDEX
;2/ FLAGS
;3/ PTR TO TABLE OF JSYS'S TO TRAP
;11/ PTR TO FORK'S MAPPED PSB
;USES (BUT DOES NOT SAVE) ACS 4,5,6,7,10,12,13

SETRP1:	HRRZ 4,JTMNW(11)	;EX FORK IMMED MON OF FORK
	CAME 4,FORKN		;MONITOR OF FORK EX FORK?
	TLO 2,JTNIMF		;NO, EX FORK NEW MONITOR

	TLNN 2,JTDMF		;IMMED INF OF EX FORK?
	JRST STRP17		;NO
	MOVE 13,2		;SAVE FLAGS
	MOVSI 2,RCW		;READ,COPY WRITE ACCESS
	TLNN 13,JTNIMF		;EX FORK NEW MONITOR?
	MOVSI 2,RWX		;NO, READ-WRITE ACCESS ON MAP
	JRST STRP10

SETRP2:
	MOVE 13,2
	MOVSI 2,RWX
STRP10:	CALL SETJDV		;MAP FORK'S DISP VEC.
	EXCH 13,2		;13=PTR TO MAPPED VEC.

	MOVEI 7,0(3)
	HRLI 7,-JTBSIZ
	SETZ 10,
STRP11:	MOVE 4,0(7)		;4=BITS FOR JSYS'S TO BE TRAPPED
STRP12:	JFFO 4,STRP13
	ADDI 10,^D36
	AOBJN 7,STRP11
	TLNN 2,JTIMF		;FORK IMMED MON'TRD BY EX FORK?
	JRST STRP18		;NO.
	JRST STRP14		;YES, MODIFY ITS BIT TABLE, ETC.

STRP13:	MOVE 6,BITS(5)
	ANDCM 4,6		;CLEAR "JFFO" BIT FOR THIS JSYS
	MOVE 6,[XWD FPC,JTDVC1]	;SET TRAP FOR THIS JSYS
	ADDI 5,0(10)		;5=JSYS #
	ADDI 6,0(5)		;6=DISP THROUGH INTERMEDIATE VEC
	ADDI 5,0(13)		;5=OFFSET IN FORK'S DISP VEC
	MOVEM 6,(5)		;SET TRAP
	JRST STRP12

STRP14:	TLNN 2,JTNIMF		;EX FORK NEW MONITOR FOR FORK?
	JRST STRP16		;NO, SET NEW BITS ON
	MOVES	0(13)		;YES, TOUCH FORK'S DISPATCH VECTOR
	 			;TO INSURE THAT IT IS PRIVATE PAGE.
	MOVEM 1,JTTMP1		;SAVE FORK INDEX
	MOVEI 1,0(13)
	CALL MKSHRP		;MAKE MODIFIED DISP VEC A SHARED
	EXCH 1,JTTMP1		;PAGE, JTTMP1=SPT INDEX FOR IT

STRP15:	HRLI 4,0(3)		;SET BIT TABLE
	HRRI 4,JTBTB(11)
	BLT 4,JTBTB+JTBSIZ-1(11)
	HRR 4,FORKN
	HRRM 4,JTMNW(11)	;SET FORK'S MONITOR TO EX FORK
	EXCH 2,JTTMP1
	CALL SETFJD		;SET FORK'S DISPATCH VECTOR TO
	EXCH 2,JTTMP1		;MODIFIED PAGE
	JRST STRP18

STRP16:	MOVEI 7,0(3)
	HRLI 7,-JTBSIZ		;OR IN NEW TRAPPED JSYS BITS
	MOVEI 6,JTBTB(11)
	MOVE 4,0(7)
	IORM 4,0(6)
	AOJ 6,
	AOBJN 7,.-3

STRP18:	TLNE 2,JTDMF		;FORK'S IMMED SUP A MON?
	CALL CLRJDV		;YES, UNMAP FORK'S DISP VEC
	JRST TPJS0		;NO

STRP17:	TLNN 2,JTNIMF		;IS EX FORK A NEW MONITOR FOR
	JRST STRP16		;FORK? NO JUST SET NEW BITS
	 			;YES, SET FORKS PAGE TABLE
	 			;ENTRY FOR NEW DISPATCH VECTOR
	JRST STRP15		;AND SETUP BIT TABLE, ETC.

SETRP3:	 			;FORK'S IMMED SUP A MON BUT
	 			;NOT FOR FORK
	CAMN 4,FORKN		;IS MON OF FORK EX FORK?
	JRST STRP16		;YES, OR IN NEW BITS
	CAIE 4,7777		;IS MON OF FORK NULL FORK?
	JRST TPJS0		;NO, BITS OK
	JRST STRP15		;YES, EX FORK IS NEW MON.

;RTRFK JSYS
;READ TRAPPED FORK
;RET + 1 IF NO MORE ROOM FOR REL HANDLES
;RET + 2 WITH
; 1/ RELATIVE FORK HANDLE,,JSYS #   ;IF A FORK IS TRAPPED
; 1/ 0   ;OTHERWISE

.RTFRK:	JSYS MENTR		;BECOME SLOW
	MOVE 1,JTTRW		;GET JOB FORK INDEX,,JSYS
	JUMPE 1,RTFRK1		;1=0 IF NO FORK TRAPPED
	PUSH P,1		;SAVE IT
	HLRZS 1
	CALL GFKH		;GET FORK REL HANDLE
	 RETERR FRKHX6		;NO MORE ROOM
	HRLM 1,0(P)		;SAVE REL HANDLE
       NOSKED			;PREVENT SCHED WHILE CLEAR LOCK
	SETZM JTTRW		;CLEAR TRAPPED FORK,,JSYS
	CALL JTULCK
       OKSKED
	POP P,1			;1=REL HANDLE,,JSYS#
RTFRK1:	UMOVEM 1,1		;SET USER AC1
	JRST SKMRTN		;AND SKIP RETURN

;UNTRAP FORK JSYS
;USED TO RESUME TRAPPED FORK AFTER A JSYS TRAP
;1/ USER HANDLE FOR FORK TO UNTRAP
;RET + 1 ALWAYS
;NOOP IF FORK IS NOT TRAPPED OR IT EXECUTING FORK IS NOT PERMITTED
;TO UNTRAP THE FORK (I.E. IS NOT FORKED TRAPPED TO OR ITS SUPERIOR).

.UTFRK:	JSYS MENTR		;BECOME SLOW
	NOINT
	MOVEI 1,0(1)		;CHECK FORK HANDLE
	TRNE 1,200000		;MULTIPLE HANDLE?
	ITERR FRKHX3		;NOT ALLOWED
	CALL SETJFK		;GET JOB FORK INDEX
	CALL SKIIF		;IS IT AN INFERIOR FORK?
	ITERR FRKHX2		;NO, ERROR
	HRRZ 7,SYSFK(1)		;7=SYS FORK INDEX OF FORK 
	CALL SETLF1		;MAP ITS PSB
	MOVEI 11,0(1)		;11=OFFSET TO PSB

	MOVES PSB(11)		;TOUCH PSB TO AVOID PAGE FAULT
	 			;WHILE NOSKED
       NOSKED 			;PREVENT OTNER FORKS FROM RUNNIN
	CALL CHKWT		;FORK WAITING?
	JRST UTFRK0		;NO, NOOP
	HRRZ 2,FKSTAT(7)

	CAIE 2,FRZWT		;IS IT FROZEN?
	JRST UTFRK0		;NO, NOOP
	MOVSI 2,JTFRZB
	TDNN 2,FKINT(7)		;IS IT TRAPPED?
	JRST UTFRK0		;NO, NOOP

	HRRZ 3,JTTMP(11)	;3=JOB INDEX OF FORK TRAPPED TO
	CAMN 3,FORKN		;IS IT EXECUTING FORK
	JRST UTFRK2		;YES.

	HRRZ 3,SYSFK(3)		;NO, 3=SYS INDEX OF FORK TRAPPED
	MOVSI 1,-NUFKS		;TO, MUST CHECK IF IT IS INF TO
	HRRZ 2,SYSFK(1)		;EX. FORK AFTER GETTING JOB
	CAIN 3,0(2)		;FOR IT.
	JRST UTFRK1
	AOBJN 1,.-3

UTFRK0:	OKSKED 			;NOOP EXIT
	CALL CLRLFK
	JRST MRETN

UTFRK1:	HRRZS 1			;1=JOB INDEX OF FORK TRAPPED TO
	MOVE 2,FORKN
	CALL SKIIFA		;IS THAT FORK INF TO EX. FORK?
	JRST UTFRK0		;NO, NOOP

UTFRK2:	MOVEI 1,0(11) 		;1=OFFSET TO FORK'S PSB
	MOVSI 2,JTFRZB
	ANDCAB 2,FKINT(7)	;CLEAR JSYS TRAP FREEZE
	TLNE 2,FRZBB		;IS FORK STILL FROZEN
	JRST UTFRK0		;YES, NO FURTHER ACTION
	SKIPN 2,PIOLDS(1)	;NO, RESUME IT
	MOVEI 2,JSKP
	MOVEM 2,FKSTAT(7)
	MOVE 2,PPC(1)		;CHECK IF FORK'S PC HAS BEEN
	CAME 2,[ CAI TRPSI5 ]	;FROM JSYS TRAP FREEZE PC
	CALL CLRSFK		;IT HAS, CLEAR FKINT BIT 1
	JRST UTFRK0

	END			;END OF FORKS.MAC

