Trailing-Edge
-
PDP-10 Archives
-
BB-4170G-SM
-
sources/fork.mac
There are 53 other files named fork.mac in the archive. Click here to see a list.
;<1BOSACK>FORK.MAC.1000, 5-Jun-78 18:42:33, EDIT BY BOSACK
;<3A.MONITOR>FORK.MAC.7, 24-Apr-78 16:14:44, Edit by BORCHEK
;MORE NSW FIXES
;<3A.MONITOR>FORK.MAC.6, 22-Apr-78 18:23:24, Edit by BORCHEK
;NSW FIXES FOR GFRKH FROM BBN
;<3A.MONITOR>FORK.MAC.5, 22-Apr-78 15:48:42, Edit by BORCHEK
;DELETE EXTRA OKINT IN SCTT0:
;<3A.MONITOR>FORK.MAC.4, 16-Apr-78 04:41:59, Edit by BORCHEK
;FIX TTY ASSIGNED TO OTHER JOB BUG IN SCTTY
;<3.SM10-RELEASE-3>FORK.MAC.2, 6-Jan-78 18:53:05, EDIT BY MILLER
;FIX RFORK1 TO FIX UP STACK EVEN IF JSYS TRAPPING IN USE
;<ENGEL>FORK.MAC.1, 13-Dec-77 16:44:03, EDIT BY ENGEL
;TCO #1888 PASS PSIBIP WHEN CALLING JSBSTF (FIX STACK CLOBBER PROBLEM)
;<3-MONITOR>FORK.MAC.123, 7-Nov-77 13:02:00, EDIT BY KIRSCHEN
;MORE COPYRIGHT UPDATING...
;<3-MONITOR>FORK.MAC.122, 20-Oct-77 16:43:34, EDIT BY CROSSLAND
;FIX JSYS TRAPS FOR NESTED TRAPS
;<3-MONITOR>FORK.MAC.121, 12-Oct-77 13:47:00, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-MONITOR>FORK.MAC.120, 5-Oct-77 17:26:42, EDIT BY MURPHY
;<3-MONITOR>FORK.MAC.119, 20-Sep-77 18:13:14, EDIT BY MURPHY
;<3-MONITOR>FORK.MAC.118, 12-Aug-77 16:35:38, EDIT BY KIRSCHEN
;FIX TYPE IN MAPJSB
;<3-MONITOR>FORK.MAC.117, 11-Aug-77 13:17:52, EDIT BY MILLER
;PRESERVE T3 IN SETLFK
;<3-MONITOR>FORK.MAC.116, 10-Aug-77 16:00:55, EDIT BY MILLER
;MAKE SETLFK (AND ITS VARIANTS) MAP BOTH PAGES OF THE PSB
;<3-MONITOR>FORK.MAC.115, 4-Aug-77 12:49:59, EDIT BY HALL
;IN KSELF, SET PRIMARY I/O TO CONTROLLING TTY BEFORE CLZFF
;<3-MONITOR>FORK.MAC.114, 3-Aug-77 23:53:38, EDIT BY CROSSLAND
;<3-MONITOR>FORK.MAC.113, 3-Aug-77 12:11:33, Edit by LCAMPBELL
;MORE TCO 1838 - ADDR BREAK
;<3-MONITOR>FORK.MAC.112, 3-Aug-77 12:01:20, EDIT BY KIRSCHEN
;ADD MAPJSB ROUTINE
;<3-MONITOR>FORK.MAC.111, 30-Jul-77 01:44:45, EDIT BY CROSSLAND
;ADD GFRKH JSYS
;<3-MONITOR>FORK.MAC.110, 29-Jul-77 08:58:16, EDIT BY MILLER
;MORE EDITS FOR STACK RELEASING
;<3-MONITOR>FORK.MAC.109, 28-Jul-77 21:16:39, EDIT BY CLEMENTS
; Fix to SCTTY in KSELF
;<3-MONITOR>FORK.MAC.108, 28-Jul-77 02:35:27, EDIT BY CLEMENTS
; Add SCTTY logic
;<3-MONITOR>FORK.MAC.107, 26-Jul-77 15:56:07, EDIT BY MILLER
;DEFER DELETING PSB STACK PAGE UNTIL PROCESS IS IN SCHED CONTEXT
;<3-NSW-MONITOR>FORK.MAC.2, 24-Jul-77 16:22:42, EDIT BY CLEMENTS
; Add JSYS trap logic
;<3-NSW-MONITOR>FORK.MAC.1, 23-Jul-77 14:39:08, EDIT BY CLEMENTS
; Adjust TIMER logic in KSELF
;<3-MONITOR>FORK.MAC.104, 23-Jun-77 15:02:04, Edit by MCLEAN
;ADD PSBMSZ
;<3-MONITOR>FORK.MAC.103, 5-May-77 16:06:26, EDIT BY MILLER
;TCO 1272. SAVE ALL PERM REGS IN TTFRKT
;<3-MONITOR>FORK.MAC.102, 12-Apr-77 17:12:10, EDIT BY MILLER
;TCO 1769. INCREASE SIZE OF PISPGA
;<3-MONITOR>FORK.MAC.101, 25-Mar-77 16:59:54, EDIT BY CROSSLAND
;MORE TCO 1744 - FIX SPLFK
;<3-MONITOR>FORK.MAC.100, 8-Mar-77 14:39:58, Edit by MCLEAN
;FIX CFK1 TO USE BLTUM CORRECTLY
;<3-MONITOR>FORK.MAC.99, 7-Mar-77 17:13:42, Edit by MCLEAN
;REPLACE XMOVEI WITH XHLLI
;<3-MONITOR>FORK.MAC.98, 28-Feb-77 04:35:35, EDIT BY CROSSLAND
;TCO 1744 - FIX SPLFK SO THAT IT FREZZES INFERIORS CORRECTLY
;TCO 1742 - ADD CALL TO NETKFK IN KSELF FOR ARPA SUPPORT
;<3-MONITOR>FORK.MAC.97, 23-Feb-77 20:26:30, EDIT BY HALL
;TCO 1740 - CHANGED REFERENCES TO TTY DATA TO CALLS TO TTYSRV
;<3-MONITOR>FORK.MAC.96, 15-Feb-77 19:07:19, EDIT BY MURPHY
;<3-MONITOR>FORK.MAC.95, 9-Feb-77 13:26:34, EDIT BY MURPHY
;<3-MONITOR>FORK.MAC.94, 7-Feb-77 08:10:31, EDIT BY HURLEY
;<3-MONITOR>FORK.MAC.93, 5-Feb-77 14:59:40, Edit by MCLEAN
;<3-MONITOR>FORK.MAC.92, 2-Feb-77 15:02:42, EDIT BY MURPHY
;TCO #1727 - PREVENT INTERRUPTS DURING SFRKV
;<3-MONITOR>FORK.MAC.89, 1-Feb-77 00:09:18, Edit by MCLEAN
;<3-MONITOR>FORK.MAC.88, 31-Jan-77 01:02:12, Edit by MCLEAN
;<3-MONITOR>FORK.MAC.87, 31-Jan-77 00:38:01, Edit by MCLEAN
;<3-MONITOR>FORK.MAC.86, 31-Jan-77 00:30:34, Edit by MCLEAN
;<3-MONITOR>FORK.MAC.85, 31-Jan-77 00:29:59, Edit by MCLEAN
;<3-MONITOR>FORK.MAC.84, 13-Jan-77 15:00:45, Edit by MCLEAN
;<3-MONITOR>FORK.MAC.83, 29-Dec-76 22:47:25, Edit by MCLEAN
;<3-MONITOR>FORK.MAC.82, 27-Dec-76 17:32:24, EDIT BY HURLEY
;<3-MONITOR>FORK.MAC.81, 18-Dec-76 04:01:00, Edit by MCLEAN
;<3-MONITOR>FORK.MAC.79, 10-Dec-76 16:36:17, Edit by MCLEAN
;<3-MONITOR>FORK.MAC.78, 10-Dec-76 16:25:16, Edit by MCLEAN
;<3-MONITOR>FORK.MAC.77, 30-Nov-76 17:23:17, EDIT BY MILLER
;TCO 1673. CHECK FOR DELETED HANDLES IN PTNFKH
;<3-MONITOR>FORK.MAC.76, 30-Nov-76 14:17:20, Edit by MCLEAN
;<3-MONITOR>FORK.MAC.75, 28-Nov-76 13:10:50, Edit by MCLEAN
;<3-MONITOR>FORK.MAC.74, 28-Nov-76 12:50:58, Edit by MCLEAN
;<3-MONITOR>FORK.MAC.73, 26-Nov-76 14:26:05, Edit by MCLEAN
;<3-MONITOR>FORK.MAC.72, 26-Nov-76 14:22:07, Edit by MCLEAN
;TCO 1669 EXTENDED ADDRESSING
;<2-MONITOR>FORK.MAC.70, 24-Nov-76 15:06:17, EDIT BY HURLEY
;MAKE ERRJMP MACRO SAVE ERROR CODE CORRECTLY
;<2-MONITOR>FORK.MAC.69, 18-Nov-76 20:23:54, EDIT BY BOSACK
;CORRECT BUG IN CFORK WHICH COPIED TOO MUCH
;<2-MONITOR>FORK.MAC.68, 18-Nov-76 17:48:04, EDIT BY HURLEY
;<2-MONITOR>FORK.MAC.67, 16-Nov-76 17:36:27, EDIT BY BOSACK
;<2-MONITOR>FORK.MAC.66, 29-Oct-76 10:52:24, EDIT BY MILLER
;TCO 1636. ADD INDIRECT FREEZE/RESUME ROUTINES
;<2-MONITOR>FORK.MAC.65, 12-Oct-76 11:25:42, Edit by MACK
;TCO 1589 - RFSTS CHECKS FOR THE FORK STATUS "JRET"
;<2-MONITOR>FORK.MAC.64, 4-Oct-76 14:26:00, EDIT BY HURLEY
;TCO 1564 - MAKE STIW LOOK AT ST%DIM BIT
;TCO 1560 - MAKE EPCAP SET ANYTHING IF PROCESS IS A WHEEL
;<2-MONITOR>FORK.MAC.63, 16-Sep-76 19:07:31, EDIT BY MURPHY
;TCO #1529 - FIX MAPINF
;<1B-MONITOR>FORK.MAC.62, 10-JUN-76 19:44:38, EDIT BY BOSACK
;<1B-MONITOR>FORK.MAC.60, 10-JUN-76 13:59:14, EDIT BY JMCCARTHY
;TCO 1383 - ERSTR RETURNS "UNDEFINED ERROR #" FOR A FORK WHICH
;HASN'T HAD AN ERROR YET
;<1B-MONITOR>FORK.MAC.8, 3-MAY-76 11:25:57, EDIT BY MILLER
;<1B-MONITOR>FORK.MAC.7, 3-MAY-76 10:27:29, EDIT BY MILLER
;<1B-MONITOR>FORK.MAC.6, 30-APR-76 11:30:13, EDIT BY MILLER
;TCO 1272 AGAIN. FIX WFORK TO SCAN INFERIORS BEFORE WAITING
;<1B-MONITOR>FORK.MAC.5, 30-APR-76 10:08:31, EDIT BY MILLER
;TCO 1272. PREVENT SPJFN TO GIVE ZERO VALUE
;<1B-MONITOR>FORK.MAC.4, 22-APR-76 14:50:55, EDIT BY MILLER
;<1B-MONITOR>FORK.MAC.3, 22-APR-76 13:27:25, EDIT BY MILLER
;TCO 1255. .CFORK SHOULD CHECK FOR DRUM SPACE LOW
;<1B-MONITOR>FORK.MAC.2, 11-APR-76 13:06:03, EDIT BY MILLER
;TCO 1246. MAKE .CIS RUN NOINT
;<1B-MONITOR>FORK.MAC.1, 9-APR-76 12:10:31, EDIT BY MILLER
;TCO 1245. FIX .SFORK TO CAL JSBSTF
;<1MONITOR>FORK.MAC.58, 22-MAR-76 11:04:43, EDIT BY MILLER
;TCO 1198. ADD MISSING INDEX REFERENCE TO ACBAS IN SFORK JSYS
;<2MONITOR>FORK.MAC.57, 9-FEB-76 17:29:12, EDIT BY HURLEY
;TCO 1068 - MOVE ENQ UNLOCKING BEFORE CLZFF IN THE KSELF ROUTINE
;<2MONITOR>FORK.MAC.56, 30-JAN-76 12:44:30, EDIT BY HURLEY
;MCO 44 - UNMAP DIRECTORIES BEFORE KILLING A FORK
;<2MONITOR>FORK.MAC.55, 16-JAN-76 17:47:41, EDIT BY MURPHY
;<2MONITOR>FORK.MAC.54, 9-JAN-76 10:59:45, EDIT BY HURLEY
;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 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>
;AC DEFINITIONS USED HEREIN
DEFAC (FX,Q3) ;FORK INDEX
;DATA STRUCTURES REFERENCED ONLY IN SWPMON
DEFSTR(FKHCNT,SYSFK,17,9) ;COUNT OF HANDLES ON A GIVEN FORK
SWAPCD
;GET/SET ENTRY VECTOR
.SEVEC::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
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: 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 SETLFK
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 SETLFK ;MAP IN PSB OF FORK
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)
JRST CLFRET
;SET PRIORITY WORD FOR ANOTHER JOB
; 1/ JOB NUMBER
; 2/ PRIORITY WORD
; SJPRI
.SJPRI::MCENT
MOVE 2,CAPENB
TRNN 2,SC%WHL+SC%OPR
ITERR(WHELX1)
CALL FLOCK
CAIL 1,0 ;LEGAL JOB NUMBER?
CAIL 1,NJOBS
JRST SJPRI1 ;NO
SKIPGE JOBRT(1) ;JOB EXISTS?
JRST SJPRI1 ;NO
CALL SETPSB ;SETUP PSB FOR TOP FORK OF JOB
JRST SPRI1
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
CALL MAPFKH
CALL SPJFN1
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
CALL FLOCK ;LOCK THE FORK STRUCTURE
MOVEI 1,-1
CALL GFKH ;GET LOCAL HANDLE
ERRJMP(FRKHX6,EFRKR) ;NONE
PUSH P,1 ;SAVE IT
NOSKED
MOVE 2,DRMFRE ;GET FREE SWAPPING SPACE
CAMG 2,DRMLV0 ;SPACE LEFT?
JRST CFBAD ;NO. DON'T CREATE THE FORK
MOVE 2,SPTC ;CURRENT SPT COUNT
CAML 2,SPC2 ;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 WTCONC ;PUT FORK ON WAIT LIST
OKSKED
BP$019: ;(MOVSI..): BREAKPOINT FOR CREATE SUBFORK
;ASSUMES FORK INDEX OF CREATED FORK IS IN 7
MOVSI 1,0(7)
CALL WAITFK ;WAIT FOR IT TO INITIALIZE
CALL ASSJFK ;ASSIGN JOB FORK SLOT
HRRZM 7,SYSFK(1)
MOVEI 2,1 ;INDICATE 1 HANDLE ON THIS FORK
STOR 2,FKHCNT,(1) ; ...
SETZM FKPTRS(1)
SETZM FKPSIE(1)
SETZM FKDPSI(1)
HRRZ 2,FORKN ;PUT NEW FORK INTO STRUCTURE LISTS
MOVEI 6,FKPTRS(2)
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
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,1
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 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 ;RETURN LOCAL HANDLE
UMOVEM 1,1
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
SMRETN
CFBAD: OKSKED
ERRJMP(CFRKX3,EFRKR) ;NO ROOM
;FORK CONTROL SUBRS
CFK1: SAVET
XCTU [MOVE 2,2] ;GET LOC OF INITIAL AC'S
XMOVEI 3,UAC(1) ;FIND ADDRESS OF SAVE AREA
MOVEI T1,20 ;ALL ACS
CALLRET BLTUM ;TRANSFER AC'S TO MONITOR AND RETURN
CFK2: MOVEI 3,0(2) ;START ADDRESS
MOVEM 3,PPC(1)
HRLI 3,(UMODF) ;IN USER MODE
MOVEM 3,PFL(1)
PUSH P,1
NOSKED
CALL UNBLK1 ;UNBLOCK IT
OKSKED
POP P,1
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
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
POP P,2
POP P,1
RET
WAITFK: HRRI 1,WTFKT
MDISMS
RET
RESCD ;SCHEDULER TEST, MUST BE RESIDENT
WTFKT: HLRZ 2,FKPT(1) ;SCHEDULER TEST - GET STATE OF FORK
CAIE 2,WTLST ;WAITING?
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
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
POP P,2 ;RESTORE 2
SETOM INTDF
MOVEM 4,P1 ;SAVE FORKX OF SUPERIOR
SETZM PSIBW
CALL DTIALL ;DEASSIGN TERM INTERRUPTS
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
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,400000
MOVE T3,[1B0+1000] ;REQUEST PMAP OF 1000 PAGES
PMAP ;CLEAR ALL PAGES FROM USER MAP
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
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
KSEF2: 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
;FREEZE FORK
.FFORK::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
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
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 ; ..
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
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
FFORK3: SKIPA 2,[XWD FRZB2,0] ;INDIRECT FREEZE BIT
FFORK1: MOVSI 2,FRZB1 ;DIRECT FREEZE BIT
HRRZ 7,SYSFK(1)
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
MOVEI T2,0(T1)
IDIVI T2,2 ;COMPUTE UP ITS CTTY POINTER
ADD T2,FKCTYP(T3)
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 MY OWN?
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)
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
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
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
MOVEI 1,JRET
MDISMS
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
CALL FLOCK ;LOCK THE FORK STRUCTURE
HRRZ 1,1 ;USE ONLY 18 BITS
TRNE 1,200000 ;LOCAL DESIGNATOR?
JRST RFST9 ;NO
CAIN T1,400000 ;SELF?
JRST RFST9 ;YES - DONT TRANSLATE HANDLE
CALL RFHJFK ;CONVERT SINGLE FORK RFH TO JRFN
JRST ITFRKR ;ERROR - ERR CODE IN T1
CAIGE 1,NUFKS ;ASSIGNED?
SKIPG SYSFK(1)
CAIA
JRST RFST8 ;YES
SETO 1, ;NOT ASSIGNED, RETURN -1
JRST RFSTSR
RFST9: CALL SETJFK ;NOT MULTIPLE FORKS
RFST8: HRRZ FX,SYSFK(T1) ;GET SYSTEM FORK INDEX
CALL SETLF1 ;MAP PSB
HLLZ 2,PFL(1) ;GET FLAGS
IOR 2,PPC(1) ;GET PC
TLNN 2,(UMODF) ;USER MODE?
JRST [ HLLZ 2,UPDL+1(1) ;NO, USER PC IS FIRST ON STACK
IOR 2,UPDL(1)
TLZ 2,(UMODF) ;BUT TURN OFF USER BIT FOR INFO
JRST .+1]
UMOVEM 2,2
CALL CLRLFK
CALL MRFSTS ;RETURN STATUS OF FORK IN T1
RFSTSR: UMOVEM T1,1
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
JRST MRETN
;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
HLRZ T2,FKPT(FX) ;GET QUEUE
CAIE T2,WTLST ;WAITING?
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,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
HRRZ 2,FORKN ;GET JOB HANDLE FOR THIS FORK
CAMN 1,2 ;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 1,ENTVEC
MOVE 2,FORCTC ;RELATIVE ADDRESS
HLRZ 3,ENTVEC ;SIZE OR JRST
CAIN 3,<JRST>B53 ;OLD STYLE?
JRST [ CAIN T2,0 ;YES, 0 MEANS .JBSA
UMOVE T1,.JBSA
CAIN T2,1 ;1 MEANS .JBREN
UMOVE T1,.JBREN
JRST SFRKV4]
ADD T1,T2
SFRKV4: HRRZ T2,T1
MOVX T1,UMODF ;MAKE IT A USER PC
RET
;START FORK
.SFORK::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETJFK
CALL STPFK ;STOP FORK
UMOVE 2,2
TLZ 2,(UIOF+2037B17) ;USER I/O, CALFRMMON, IDX AND IND OFF
TLO 2,(UMODF) ;AND USER ON
SFORK1: SETOM SLOWF(1) ;NORMALIZE FLAG
PUSH P,PFL(1)
HLLZM 2,PFL(1) ;FIND FLAGS
HRRZM 2,PPC(1) ;AND PC
PUSH P,1 ;SAVE PSB POINTER
HLLZ 2,PSIBIP(1) ;PASS FORK'S CURRENT INTERRUPT STATE
MOVE 1,FORKN(1) ;GET THIS FORKS JOB ID
MOVE 1,SYSFK(1) ;GET SYSTEM ID
CALL JSBSTF ;GO DO ANY DEALLOCATIONS
POP P,1 ;RECOVER PSB POINTER
POP P,2 ;RESTORE
TXNE 2,UMODF ;FORK WAS IN USER MODE?
JRST SFORK2 ;YES, ACS ALREADY IN RIGHT PLACE
HRRZ 2,ACBAS(1)
CAIGE 2,<UACB>B39 ;IN NESTED MONITOR CALL?
JRST SFORK2 ;NO, ACS ALREADY IN RIGHT PLACE
MOVSI 2,UACB(1) ;MUST MOVE ACS FROM AC STACK
HRRI 2,UAC(1) ; TO SAVED BLOCK 1
BLT 2,UAC+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
PUSH P,1
CALL UNBLK1 ;UNBLOCK IT
POP P,1
CALL CLRSFK ;NOW CLEAR SUSPENSION
SFORK3: SETZM PIOLDS(1) ;SET PRE-FREEZE STATE TO RUNNING
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
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
TLNE 4,SC%WHL+SC%OPR
JRST .+2
ITERR(CAPX1) ;USER LACKS CAPABILITY
CALL FLOCK ;LOCK THE FORK STRUCTURE
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?
JRST FRKE1 ;YES, ILLEGAL
CALL SETLF1 ;MAP PSB
CALLRET SUSFK ;SUSPEND FORK
;READ/SET FORK AC'S
.RFACS::MCENT
CALL FACS
MOVEI T1,20 ;ALL ACS
EXCH T2,T3 ;GET ARGS IN RIGHT ORDER
CALL BLTMU ;DO BLT TO USER
JRST FACSR ;RETURN
.SFACS::MCENT
CALL FACS
MOVEI T1,20 ;MOVE ACS
CALL BLTUM ;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
MOVE 6,1
HRRZ 7,SYSFK(6)
CALL SETLF1 ;MAP PSB
NOSKED
HLRZ 2,FKPT(7)
CAIE 2,WTLST ;WAITING?
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 [ CALL MAPFKH ;YES, DO THEM
CALL HFORK1
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
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
MDISMS ;AND DISMISS
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
MDISMS
JRST MRETN
RESCD
TRMTST::HLRZ 2,FKPT(1) ;SCHEDULER TEST, GET LOC OF FORK NOW
CAIE 2,WTLST ;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
;RETURNS WITH NOSKED SET
SUSFK: PUSH P,1
PUSH P,2
CAMN 7,FORKX
BUG(HLT,FRKSLF,<SUSFK - GIVEN SELF AS ARG>)
SUSF6: NOSKED
HLRZ 2,FKPT(7)
CAIE 2,WTLST ;WAITING NOW?
JRST SUSF4 ;NO
HRRZ 2,FKSTAT(7) ;GET WAITING STATUS
CAIE 2,SUSWT ;ALREADY SUSPENDED OR FROZEN?
CAIN 2,FRZWT
JRST PA2 ;YES, RETURN
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
MDISMS
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: HLRZ 2,FKPT(1) ;GET LOC OF SPECIFIED FORK
CAIE 2,WTLST ;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(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(CHK,ILJRFN,<JFKRFH - BAD JRFN, IGNORED>)
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)
; CALL MAPFKH
; INSTRUCTION ;INSTRUCTION TO BE EXECUTED FOR EACH
; ;FORK. JOB HANDLE PLACED IN 1 AND
; ;THIS INSTRUCTION EXECUTED.
; RETURN +2 ALWAYS
MAPFKH::HRRZ 1,1 ;USE ONLY RH FOR FORK HANDLE
CAIL 1,-5 ;IS IT A MULTIPLE FORK DESIGNATOR?
CAILE 1,-3
JRST [ CALLRET SETJFK] ;NO, GET JOB HANDLE AND RETURN +1
JRST MAPFT+5(1) ;DISPATCH TO APPROPRIATE FUNCTION
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 P6,@0(P) ;GET INSTRUCTION, WILL STAY IN P6
MAPF41: ADD 1,INFERP ;DO INFERIORS
MAPF42: LDB 1,1 ;GET NEXT IN LIST
JUMPE 1,MAPF43 ;END OF LIST, RETURN AND SKIP INSTR
HRLM 1,0(P) ;SAVE THIS FORK NUMBER
CALL MAPF41 ;DO INFERIORS OF IT
BUG(HLT,MAP41F,<MAPF41 FAILED TO SKIP>)
HLRZ 1,0(P) ;GET FORK NUMBER BACK
XCT P6 ;DO THIS FORK
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 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 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
;JSYS'S FOR CONTROLLING PSI SYSTEM
;MAP PSB OF FORK, GIVEN USER HANDLE IN 1
;RETURN WITH OFFSET TO MAPPED PSB IN 1
;DOES NOT CLOBBER T2 OR T3
SETLFK::TRNE 1,200000 ;SPECIAL DESIGNATOR?
JRST FRKES ;NOT ALLOWED
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
PUSH P,CAPENB(A) ;SAVE CAPABILITIES
CALL CLRPSB ;UNDO PSB MAPPING
POP P,A
RET
;GET JOB FORK HANDLE GIVEN USER HANDLE IN 1
;FOR SINGLE (NOT MULTIPLE) FORK HANDLES ONLY
SETJFK::CALL STJFKR ;DO ACTUAL TRANSLATION
JRST ITFRKR ;ERROR - ITRAP
RET ;SUCCESS
STJFKR::HRRZ T1,T1 ;USE ONLY 18 BITS FOR FORK HANDLE
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
FLOCK::
REPEAT 0,< ;NOT CHECKED NOW BECAUSE MLKBLK PROBLEM
SKIPN FORKN ;TOP FORK?
JRST FLOCK1 ;YES, INTERRUPTIBILITY NOT SIGNIFICANT
SKIPL INTDF ;INTERRUPTABLE NOW?
BUG(CHK,FLKINT,<FLOCK-CALLED WHILE NOINT>)
>
FLOCK1: NOINT ;BE NOINT IF LOCK WORKS
AOSN FKLOCK ;LOCK SUCCESSFUL?
RET ;YES, INTERRUPTS OFF UNTIL UNLOCKED
OKINT ;LOCK NOT SUCCESSFUL, ALLOW INTERRUPTS
PUSH P,1 ;PRESERVE ALL AC'S
MOVEI 1,^D100 ;WAIT 100 MS. BEFORE CHECKING LOCK AGAIN
DISMS
MOVE 1,FKLOCK
CAIGE 1,^D600 ;BEEN WAITING A LONG TIME?
JRST FLOCK2 ;NO, KEEP WAITING
BUG(CHK,FLKTIM,<FLOCK-TIMEOUT>)
SETOM FKLOCK ;TIMEOUT, CLEAR LOCK AND PROCEED
FLOCK2: POP P,1
JRST FLOCK1
;COMMON ROUTINE TO UNLOCK FORK STRUCTURE
; CALL FUNLK
; RETURN +1: ALWAYS, CLOBBERS NO AC'S
FUNLK:: PUSH P,1 ;BE TRANSPARENT TO ALL AC'S
SETO 1,
EXCH 1,FKLOCK ;CLEAR LOCK, GET PREVIOUS VALUE
JUMPN 1,FUNLK1 ;IF LOCK WAS 0, THEN NO ATTEMPT
FUNLK2: POP P,1 ; WAS MADE TO LOCK IT WHILE THIS FORK
OKINT ; HAD IT LOCKED.
RET
;IF LOCK WAS .G. 0, SOME OTHER FORK IS/WAS TRYING TO LOCK IT. THIS
;FORK WILL DO A BRIEF WAIT SO AS TO PREVENT HOGGING THE LOCK.
FUNLK1: JUMPL 1,FUNLK3 ;BUG IF LOCK NOT SET AT ALL
MOVEI 1,^D200 ;WAIT FOR 200 MS
DISMS
JRST FUNLK2
FUNLK3: BUG(CHK,FLKNS,<FUNLK-LOCK NOT SET>)
JRST FUNLK2
;COMMON EXIT FROM FORK JSYS. CLEAR LOCAL PSB MAPPING, DO UNLOCK AND MRETN
CLFRET::CALL CLRLFK
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
FKHPTN::CALL FLOCK ;LOCK THE FORK STRUCTURE
PUSH P,2
PUSH P,1
TRNE 1,777000 ;LEGAL PAGE NUMBER?
JRST FKHPE1 ;NO
HLRZ 1,1
CALL STJFKR ;GET JOB FORK INDEX
JRST FKHPER ;ILLEGAL - ERROR CODE IN 1
CALL SKIIF
JRST [ MOVSI 2,(1B9) ;NOT INFERIOR
TDNN 2,CAPENB ;ALLOWED TO MAP SUPERIOR?
JRST FKHPE2 ;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 FKHPE2 ;NO
JRST .+1]
HRRZ 2,SYSFK(1) ;GET SYSTEM FORK INDEX
POP P,1
HLL 1,FKPGS(2) ;GET PAGE TABLE PTN
TLNE 1,-1 ;IS ONE?
JRST FKHP3 ;YES
BUG(HLT,FRKNPT,<FKHPTN - FORK HAS NO PAGE TABLE>)
FKHP3: CALL FUNLK ;UNLOCK THE FORK STRUCTURE
POP P,2 ;RESTORE AC
RETSKP ;SUCCESS RETURN
FKHPE1: SKIPA T1,[FRKHX2] ;ILLEGAL PAGE NUMBER
FKHPE2: MOVEI T1,FRKHX2 ;ILLEGAL SUPERIOR MANIPULATION
FKHPER: POP P,(P) ;SCRAP STACK
POP P,T2 ;RESTORE
CALL FUNLK ;UNLOCK FORK LOCK
RETBAD () ;ERROR RETURN
;TRANSLATE PTN TO FKH
PTNFKH::CALL FLOCK ;LOCK THE FORK STRUCTURE
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: SKIPGE T1,SYSFK(3) ;HAVE A USABLE HANDLE?
JRST PTNF2 ;NO. SKIP IT THEN
HRRZS T1 ;YES. GET THE FORK INDEX
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,<CALL FUNLK>)
HRLM 1,0(P) ;CONSTRUCT FHK,,PN
PTNF4: POP P,1
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
JRST PB3
;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(CHK,NOXRFH,<DASFKH - ATTEMPT TO DEASSIGN NONEXISTANT RFH, IGNORED>)
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
.SIR:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
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
ERRJMP(SIRX1,ITFRKR) ;NO
SIR1: MOVEM 2,LEVCHN(1)
JRST CLFRET
.EIR:: MCENT
TRNE 1,200000 ;SPECIAL?
ITERR(FRKHX1) ;ILLEGAL
CALL FLOCK ;LOCK THE FORK STRUCTURE
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
CALL PSIRQB
OKSKED
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 SETLFK
SETOM PSISYS(1)
JRST CLFRET
.AIC:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
IORM 2,PSICHM(1)
ICR: CAIN 1,0 ;SELF?
CALL SETOVF ;YES, POSSIBLE CHANGE TO APR FLAGS
JRST CLFRET
.DIC:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
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
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 SETLFK
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:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
MOVE 2,LEVCHN(1) ;RETURN LEVEL AND CHANNEL DISPATCHES
JRST RETA2
;ACTIVATE TERMINAL INTERRUPT
; 1/ TERMINAL CODE ,, CHANNEL NUMBER
; ATI
; RETURN +1: ALWAYS.
.ATI:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
HLRZ 1,1
CAIL 1,^D36 ;REASONABLE TERM CODE?
ATIE1: ERRJMP(TERMX1,ITFRKR) ;NO
CAIE 1,3 ;CONTROL-C?
JRST .+4 ;NO
MOVE 3,CAPENB ;YES, SEE IF LEGAL
TLNN 3,(1B0)
ATX2E: ERRJMP(ATIX2,ITFRKR) ;USER LACKS ^C CAPABILITY
CALL GETCHA
XCTU [HRRZ 3,1] ;GET CHANNEL NUMBER
CAIG 3,^D5 ;LEGAL CHANNEL NUMBER?
JRST ATI3 ;YES
CAIL 3,^D24
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
PUSH P,2 ;SAVE 2
SETZ 2, ;CLEAR ALL FORK'S ENTRIES ON STACK
CALL JSBSTF ;GO MAKE SURE IT IS CLEAN
POP P,2 ;RESTORE 2
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
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
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
; 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
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 (CHK,NWJTBE,<NO FREE JTB BLOCKS>)
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
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?
JRST UTFRK0 ; Yes, no further action then
SKIPN T2,PIOLDS(T1) ; No, resume it
JRST [ CALL UNBLK1 ; Unblock fork
JRST UTFRK3]
MOVEM T2,FKSTAT(FX)
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
CALL FFORK1 ; 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
CALL RFORK1 ; 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 ; ..
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