Trailing-Edge
-
PDP-10 Archives
-
tops20v41_monitor_sources
-
monitor-sources/fork.mac
There are 53 other files named fork.mac in the archive. Click here to see a list.
; Edit 7111 to FORK.MAC by WAGNER on 31-Jul-85 (TCO 4-1-1164)
; Edit 7109 had a typo, PISYS instead of the correct PSISYS.
; Edit 7109 to FORK.MAC by WAGNER on 26-Jul-85, for SPR #17842 (TCO 6-1-1498)
; Fix GFRKH% to not take .FHSUP in AC2, but will take in AC 1
;Edit 6719 to FORK.MAC by TBOYLE on Fri 12-Apr-85
; Fix handling of handle counts by SPLFK with suicide option.
;Edit 3157 to FORK.MAC by MOSER on Thu 20-Sep-84 - SYNCRONOUS KFORK
;EDIT 3157 - SYNCORNOUS KFORK
;Edit 3125 to FORK.MAC by TBOYLE on Mon 18-Jun-84, for SPR #20195 - Fix 3006
;EDIT 3120 - UNMAP INDEX FILE AT FORK TERMINATION
;Edit 3115 to FORK.MAC by MOSER on Fri 8-Jun-84, for SPR #19578
; FIX CRJOB AND EXEC XCT ONLY
;EDIT 3115 - EDITS FOR XCT ONLY EXEC AND CRJOB LOGIN
;Edit 3109 to FORK.MAC by TBOYLE on Thu 17-May-84 - MERGE IN NEW SPLFK CHANGES
;Edit 3087 to FORK.MAC by TBOYLE on Thu 5-Apr-84 - New SPLFK code for 4.1
;Edit 3072 to FORK.MAC by MOSER on Mon 20-Feb-84 - FIX 3023
;EDIT 3072 - FIX 3023
;Edit 3047 to FORK.MAC by MOSER on Thu 1-Dec-83, for SPR #19473
; FIX FLKTIM/FLKNS/GLFNF WHEN USINF TFORK .TFRES
;Edit 3023 to FORK.MAC by MOSER on Thu 6-Oct-83, for SPR #19351
; CHECK ARGS IN SJPRI AND SPRIW
;EDIT 3023 - CHECK ARGS FOR SJPRI AND SPRIW
;Edit 3006 to FORK.MAC by TBOYLE on Mon 29-Aug-83, for SPR #18805
; Fix fencepost in GFRKS% on counting buffer space.
;Edit 2943 by TSANG on Mon 4-Apr-83
; Fix .EPCAP, no error message needed
;Edit 2928 by MOSER on Wed 30-Mar-83, for SPR #16525 - FIK FLKTIM, FLKNS, GLFNF
;EDIT 2928 - FIX FLKTIM, FLKNS, GLFNF
; UPD ID= 148, FARK:<4-1-WORKING-SOURCES.MONITOR>FORK.MAC.6, 8-Sep-82 15:18:03 by MOSER
;EDIT 2804 - CORRECT TYPO IN 2645.
; UPD ID= 128, FARK:<4-1-WORKING-SOURCES.MONITOR>FORK.MAC.5, 12-Aug-82 11:05:09 by MOSER
;EDIT 2645 - CHECK MINOR FORK STATE IN TRMTST
; UPD ID= 93, FARK:<4-1-WORKING-SOURCES.MONITOR>FORK.MAC.4, 11-Jun-82 13:04:00 by DONAHUE
;Edit 2627 - Prevent GJCAPS from returning privileges job shouldn't have
; UPD ID= 80, FARK:<4-1-WORKING-SOURCES.MONITOR>FORK.MAC.3, 6-May-82 15:45:00 by MOSER
;EDIT 2617 - OKINT FROZEN FORK WHEN UNTRAPPING.
; UPD ID= 51, FARK:<4-1-WORKING-SOURCES.MONITOR>FORK.MAC.2, 3-Apr-82 19:59:05 by ZIMA
;Edit 2607 - add ENDAV.s to ACVARs to use v5 MACSYM, change some to SAVEAC.
;<4-1-FIELD-IMAGE.MONITOR>FORK.MAC.2, 25-Feb-82 20:21:45, EDIT BY DONAHUE
;UPDATE COPYRIGHT DATE
; UPD ID= 951, FARK:<4-WORKING-SOURCES.MONITOR>FORK.MAC.6, 22-Jan-82 16:26:49 by MOSER
;EDIT 1974 - FIX FLKTIM BUGCHKs when nesting lock after failing.
; UPD ID= 836, FARK:<4-WORKING-SOURCES.MONITOR>FORK.MAC.5, 30-Sep-81 09:13:02 by SCHMITT
;Edit 1950 - OKINT Jsys trapped process if not resumed in UTFRK JSYS
; UPD ID= 521, FARK:<4-WORKING-SOURCES.MONITOR>FORK.MAC.4, 8-May-81 09:59:28 by DONAHUE
;Edit 1869 - Disregard nestable lock check at FLOCK1
;Edit 1868 - check fork handle at FFORK1 before freezing fork
; UPD ID= 478, FARK:<4-WORKING-SOURCES.MONITOR>FORK.MAC.3, 23-Apr-81 16:06:21 by SCHMITT
;Edit 1856 - Make process non-virgin if loading ACs with CFORK
; UPD ID= 471, FARK:<4-WORKING-SOURCES.MONITOR>FORK.MAC.2, 23-Apr-81 11:50:22 by ZIMA
;Edit 1852 - Have FLOCK account for self if nesting so no DISMS in FUNLK.
; UPD ID= 206, FARK:<4-WORKING-SOURCES.MONITOR>FORK.MAC.5, 15-Sep-80 17:24:07 by ZIMA
;Edit 1783 - fix SCTTY resuming directly frozen forks.
; UPD ID= 181, FARK:<4-WORKING-SOURCES.MONITOR>FORK.MAC.4, 2-Sep-80 17:46:15 by ZIMA
;Edit 1776 - make the KSELF PMAP have PM%ABT to avoid writing out to
; files with OF%DUD set.
; UPD ID= 105, FARK:<4-WORKING-SOURCES.MONITOR>FORK.MAC.3, 26-Jun-80 15:45:31 by SANICHARA
;EDIT 1752 - ALLOW CH 23 TO BE USER ASSIGNABLE.
; UPD ID= 18, FARK:<4-WORKING-SOURCES.MONITOR>FORK.MAC.2, 2-Jun-80 10:03:25 by ZIMA
;EDIT 1721 - FIX MSFRK SECURITY CHECK
; UPD ID= 218, SNARK:<4.MONITOR>FORK.MAC.242, 24-Jan-80 09:40:24 by GRANT
;TCO 4.2598 - ADD CHECK FOR PRARG JSB SPACE TO KSELF
;<4.MONITOR>FORK.MAC.241, 3-Jan-80 08:08:45, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
; UPD ID= 39, SNARK:<4.MONITOR>FORK.MAC.240, 28-Nov-79 11:08:50 by MILLER
;TCO 4.2582 AGAIN. FIX FUNLK TO SET FKTIMW VERY LARGE
; UPD ID= 32, SNARK:<4.MONITOR>FORK.MAC.239, 28-Nov-79 10:50:56 by MILLER
;TCO 4.2582. ADD CHECK AND SET FOR FKTIMW
;<4.MONITOR>FORK.MAC.238, 16-Nov-79 14:48:58, EDIT BY ENGEL
;PUT INTERNAL LINE NUMBER IN T2 BEFORE CALLING CLRINT AT SCTT3
;<4.MONITOR>FORK.MAC.237, 9-Nov-79 16:24:20, EDIT BY HALL
;CIS JSYS - DON'T CLEAR PSXSIR BECAUSE LEVTAB AND CHNTAB AREN'T CLEARED
;<4.MONITOR>FORK.MAC.236, 3-Nov-79 07:54:32, EDIT BY R.ACE
;FIX NON-ZERO SECTION DELETION IN KSELF
;<4.MONITOR>FORK.MAC.235, 29-Oct-79 10:44:21, EDIT BY MILLER
;FIX CODE AT MAPBLW
;<4.MONITOR>FORK.MAC.234, 20-Oct-79 14:03:28, EDIT BY MILLER
;TWO CHANGES. EDIT BY HALL: APPLY PCS IN FKHPTN IF
; FORK HANDLE IS SELF AND SECTION NUMBER IS 0. EDIT BY MILLER:
; FIX MAPFKH TO ALLOW COROUTINE TO SPECIFY BLOCKING
;<4.MONITOR>FORK.MAC.232, 12-Oct-79 13:28:27, EDIT BY MURPHY
;FURTHER REVISION OF SFORK TO PREVENT RACES
;<4.MONITOR>FORK.MAC.231, 9-Oct-79 15:36:26, EDIT BY MILLER
;BRACKET CODE IN SFORK THAT PROCESSES GETOK AND JSB STACK
; WITH OKSKED AND NOSKED
;<4.MONITOR>FORK.MAC.230, 1-Oct-79 15:43:34, EDIT BY HALL
;REMOVE ENTRY FKHPTA FROM ROUTINE FKHPTN -- NEED TO PROHIBIT PMAP
;AT A HIGHER LEVEL THAN THIS IF AT ALL
;<4.MONITOR>FORK.MAC.229, 1-Oct-79 15:34:03, EDIT BY HALL
;XSIR - FIX BUG IN XOR FOR LEVTAB
;CIS - CLEAR FLAG FOR EXTENDED SIR
;<4.MONITOR>FORK.MAC.228, 1-Oct-79 08:18:56, EDIT BY R.ACE
;FIX COMPUTATION OF END OF CHANNEL TABLE AND LEVEL TABLE
;<4.MONITOR>FORK.MAC.227, 29-Sep-79 14:51:06, EDIT BY HALL
;FKHPTN - REMOVE TEMPORARY COMMENT AND ALREADY-COMMENTED-OUT LITERAL
;RESTORE RIR, MAKE XRIR
;RESTORE SIR, MAKE XSIR
;<4.MONITOR>FORK.MAC.226, 28-Sep-79 18:50:17, EDIT BY HELLIWELL
;<4.MONITOR>FORK.MAC.225, 28-Sep-79 18:09:42, EDIT BY HELLIWELL
;TEST FOR PSUTPS IN KSELF AND CALLS TTDTPS IF SET
;THIS REMOVES THE FORK # FROM ANY TTY DATABASES WHICH MAY HAVE IT
;SET FOR NON-CONTROLLING TERMINAL INTERRUPTS
;<4.MONITOR>FORK.MAC.224, 26-Sep-79 15:47:14, EDIT BY HALL
;RFACS - CALL BLTMU1 INSTEAD OF BLTMU FOR EXTENDED ADDRESSING
;CFK1 AND .SFACS - CALL BLTUM1 INSTEAD OF BLTUM FOR EXTENDED ADDRESSING
;<4.MONITOR>FORK.MAC.223, 21-Sep-79 13:44:43, EDIT BY MURPHY
;MAKE SUSFK RETURN NOSKED LIKE IT USTA - PREVENTS RACES
;<4.MONITOR>FORK.MAC.222, 13-Sep-79 11:10:29, EDIT BY HALL
;FUNLK - IMPROVE EDIT 220 BY DETECTING OVERLY DECREMENTED FLKCNT
;<OSMAN.MON>FORK.MAC.1, 10-Sep-79 15:30:33, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>FORK.MAC.220, 7-Sep-79 17:24:31, EDIT BY HALL
;FUNLK - DON'T LET FLKCNT GO BELOW ZERO
;<4.MONITOR>FORK.MAC.219, 30-Aug-79 08:48:14, EDIT BY R.ACE
;FIX BAD FORK INDEX IN FFORK1
;<4.MONITOR>FORK.MAC.218, 17-Aug-79 10:55:49, EDIT BY HALL
;PTNFKH - CONVERT PAGE NUMBER IN NON-ZERO SECTION TO ABSOLUTE
;PAGE NUMBER, RETURN +1 AND +2
;<4.MONITOR>FORK.MAC.217, 11-Aug-79 07:55:29, EDIT BY HALL
;ADD NEW ENTRY POINT TO FLOCK TO ALLOW NESTED LOCKING.
;<4.MONITOR>FORK.MAC.216, 28-Jul-79 11:53:52, EDIT BY R.ACE
;RIR - INDEX BY T1 WHEN LOADING FROM CHNTAB AND LEVTAB
;<4.MONITOR>FORK.MAC.215, 26-Jul-79 15:22:19, EDIT BY HALL
;RIR - FIX LOADING OF LEVTAB INTO T2 FOR OLD STYLE RIR
;<4.MONITOR>FORK.MAC.214, 15-Jul-79 11:40:14, EDIT BY HALL
;FKHPTN - DON'T GIVE PMAPX4 ERROR WHEN NON-ZERO SECTION IS
;MAPPED TO AN OFN
;<4.MONITOR>FORK.MAC.213, 13-Jul-79 16:19:39, EDIT BY HALL
;PROVIDE EXTENDED VERSIONS OF SIR AND RIR
;<4.MONITOR>FORK.MAC.212, 21-Jun-79 14:44:05, EDIT BY DBELL
;MORE TCO 4.2283 - MAKE CFORK SET SFSRT IF CR%ST WAS SET
;<4.MONITOR>FORK.MAC.211, 14-Jun-79 12:13:54, EDIT BY DBELL
;FIX TCO 4.2283 BY CORRECTLY OBTAINING JOB FORK NUMBER
;<4.MONITOR>FORK.MAC.210, 11-Jun-79 19:53:24, EDIT BY DBELL
;TCO 4.2283 - DON'T ALLOW SFORK TO DO CONTINUES UNTIL FORK HAS BEEN STARTED
;<4.MONITOR>FORK.MAC.209, 8-Jun-79 14:07:18, EDIT BY DBELL
;TCO 4.2280 - FIX RACE IN CFORK CONCERNING ASSIGNMENT OF JOB FORK SLOTS
;<4.MONITOR>FORK.MAC.208, 10-May-79 15:35:45, EDIT BY HALL
;TCO 4.2243 - FIX TWO BUGS IN .FFORK - PRESERVE T1 OVER CALL
;TO FFORK1, AND FIX UP T2 BEFORE GETTING THE CONTROLLING TERMINAL
;FOR CALLING FORK
;<4.MONITOR>FORK.MAC.207, 30-Apr-79 17:51:56, EDIT BY MILLER
;MAKE FLOCK WAIT TIME 200 MS
;<4.MONITOR>FORK.MAC.206, 23-Apr-79 13:58:36, Edit by MCLEAN
;RETURN EPCAP TO WHAT IT WAS EARLIER.....
;<4.MONITOR>FORK.MAC.205, 21-Apr-79 19:56:40, Edit by MCLEAN
;DUMB IDEA BUT MAKE .EPCAP QUIETLY RETURN ON GETOK FAILURE
;<4.MONITOR>FORK.MAC.204, 14-Apr-79 22:36:12, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.203, 14-Apr-79 22:16:42, Edit by MCLEAN
;ADD KILL FOR ACJ FORK
;<4.MONITOR>FORK.MAC.202, 11-Apr-79 12:53:33, Edit by MCLEAN
;FIX FORK COUNT IN CFORK TO BE EARLIER
;<4.MONITOR>FORK.MAC.201, 5-Apr-79 11:51:18, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.200, 5-Apr-79 11:47:19, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.199, 5-Apr-79 11:23:02, Edit by MCLEAN
;REMOVE 1ST ARG FROM GTOKM
;<4.MONITOR>FORK.MAC.198, 4-Apr-79 13:17:58, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.197, 4-Apr-79 13:16:58, Edit by MCLEAN
;FIX .CFORK SO GETOK IS EARLIER
;<4.MONITOR>FORK.MAC.196, 4-Apr-79 13:08:15, Edit by MCLEAN
;MAKE .GOCFK RETURN CURRENT NUMBER NOT NEXT NUMBER IF SUCCESS
;<4.MONITOR>FORK.MAC.195, 23-Mar-79 11:13:14, EDIT BY HALL
;FLOCK - PRINT FORK NUMBER AND JOB NUMBER IN FLKTIM BUGCHK
;<4.MONITOR>FORK.MAC.194, 22-Mar-79 13:10:42, Edit by MCLEAN
;FIX CALLS TO GOKFRE TO HAVE CORRECT ARGUMENTS AND MAKE NTCOFF NOT SKIP OVER MOVEI
;<4.MONITOR>FORK.MAC.193, 13-Mar-79 18:08:16, Edit by HURLEY
;REMOVE GETOK FROM FORK
;<4.MONITOR>FORK.MAC.192, 11-Mar-79 21:00:35, Edit by MCLEAN
;FIX GETOK IN EPCAP AND FORK
;<4.MONITOR>FORK.MAC.191, 4-Mar-79 17:18:08, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>FORK.MAC.190, 18-Feb-79 13:45:23, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.189, 18-Feb-79 13:33:29, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.188, 18-Feb-79 13:30:58, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.187, 18-Feb-79 13:27:05, Edit by MCLEAN
;MORE GETOK FIXES FOR FORK COUNT AND EPCAP
;<4.MONITOR>FORK.MAC.186, 17-Feb-79 13:41:25, EDIT BY DBELL
;IN KSELF, RELEASE PAGE USED BY MDDT
;<4.MONITOR>FORK.MAC.185, 8-Feb-79 13:47:31, EDIT BY MILLER
;FIX SFORK CONTINUE NOT TO LOSE BLOCKED STATE
;<4.MONITOR>FORK.MAC.184, 16-Jan-79 11:03:59, EDIT BY MILLER
;CHECK FOR SECTION ZERO PAGE IN FKHPTN AND DO FAST COMPUTATION OF PTN.PN
;<4.MONITOR>FORK.MAC.183, 15-Jan-79 14:06:18, Edit by KONEN
;ADD CHECK FOR ALLOWING USE OF STR, EVEN IF NOT INCREMENTED
;<4.MONITOR>FORK.MAC.182, 2-Jan-79 16:05:24, Edit by MCLEAN
;FIX EPCAP SO GETOK IS ONLY FOR A CHANGE
;<4.MONITOR>FORK.MAC.181, 21-Dec-78 11:23:45, EDIT BY ENGEL
;CLEAN UP NETWORK TOPOLOGY CHANGE INTERRUPT TABLES AT KSELF
;<4.MONITOR>FORK.MAC.180, 19-Dec-78 15:30:56, EDIT BY MURPHY
;ADD BLOCK PRIORITY TO VARIOUS SCHED CALLS
;<4.MONITOR>FORK.MAC.179, 17-Dec-78 01:26:31, Edit by MCLEAN
;FIX SUSFK SO IT RETURNS OKSKED
;<4.MONITOR>FORK.MAC.178, 11-Dec-78 18:45:38, Edit by MCLEAN
;FIX EPCAP TO GIVE CORRECT WORD TO GETOK
;<4.MONITOR>FORK.MAC.177, 7-Dec-78 14:29:05, EDIT BY MURPHY
;NEW SWAP LOGIC
;<4.MONITOR>FORK.MAC.176, 9-Nov-78 13:26:19, EDIT BY OSMAN
;ADD WAIT1::
;<KONEN>FORK.MAC.3, 10-Aug-78 11:15:17, Edit by KONEN
;ADD CODE TO KSELF TO CLEAR FORK STRUCTURE MOUNTS
;<4.MONITOR>FORK.MAC.174, 23-Oct-78 15:10:14, EDIT BY MILLER
;BE CKSED WITH FORK LOCK LOCKED
;<4.MONITOR>FORK.MAC.173, 13-Oct-78 13:36:35, EDIT BY R.ACE
;CHANGE SMAP TO SMAP%
;<4.MONITOR>FORK.MAC.172, 19-Sep-78 06:48:56, EDIT BY R.ACE
;TCO 4.2013 - ADDED CHKINT TO EIR JSYS
;<4.MONITOR>FORK.MAC.171, 16-Sep-78 13:46:58, EDIT BY MILLER
;MORE FIXES TO MSFRK
;<4.MONITOR>FORK.MAC.170, 16-Sep-78 13:37:18, EDIT BY MILLER
;MAKE ANY FORK STARTED WITH MSFRK HAVE PRIROITY
;<4.MONITOR>FORK.MAC.169, 15-Sep-78 11:02:42, EDIT BY MILLER
;ALLOW SJPRI IF CALL IS FROM MONITOR
;<4.MONITOR>FORK.MAC.168, 28-Aug-78 08:14:09, EDIT BY MILLER
;ADD FKHPTA TO ALLOW "MAPPING" OF ANY SECTION
;<4.MONITOR>FORK.MAC.167, 18-Aug-78 12:46:50, EDIT BY MILLER
;DISALLOW FKHPTN IF SECTION IS A "FILE SECTION"
;<4.MONITOR>FORK.MAC.166, 17-Aug-78 08:58:22, EDIT BY MILLER
;MAKE FKHPTN ACCEPT ANY VALID SECTION
;<4.MONITOR>FORK.MAC.165, 15-Aug-78 14:17:01, Edit by PORCHER
;MAKE SFORK-SF%CON LEAVE PRE-FREEZE STATE ALONE
; IF PROCESS NOT HALTED OR FORCED TERMINATION
;<4.MONITOR>FORK.MAC.164, 15-Aug-78 08:04:50, EDIT BY MILLER
;MAKE NOOP WITH SF%CON A NOOP IF FORK NOT HALTED
;<4.MONITOR>FORK.MAC.163, 31-Jul-78 13:26:35, EDIT BY MILLER
;<4.MONITOR>FORK.MAC.162, 28-Jul-78 13:42:23, EDIT BY MILLER
;MORE FIXES TO SMAP CODE
;<4.MONITOR>FORK.MAC.161, 28-Jul-78 09:25:45, EDIT BY MILLER
;FIX SMAP REFERECNE
;<4.MONITOR>FORK.MAC.160, 28-Jul-78 01:18:47, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.159, 25-Jul-78 15:02:48, Edit by PORCHER
;MORE...
;<4.MONITOR>FORK.MAC.158, 25-Jul-78 12:00:36, Edit by PORCHER
;TCO 1952 - ADD SF%CON FUNCTION TO SFORK - CONTINUE PROCESS
;ALLOW WHEELS TO DIDDLE EXECUTE-ONLY PROCESSES
;<4.MONITOR>FORK.MAC.157, 25-Jul-78 08:10:20, EDIT BY MILLER
;DO AN SMAP IN KSELF
;<4.MONITOR>FORK.MAC.156, 19-Jul-78 01:58:29, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.155, 18-Jul-78 00:12:27, Edit by MCLEAN
;TCO 1939 KILL MAGTAPE ONLINE/OFFLINE PSI'S ON KILLING FORKS
;<4.MONITOR>FORK.MAC.154, 6-Jul-78 16:52:11, EDIT BY MILLER
;TCO 1929 AGAIN. FIX SJPRI TO SCAN MAPPED JSB AND FIND ALL FORKS IN JOB
;<4.MONITOR>FORK.MAC.153, 6-Jul-78 07:26:34, EDIT BY MILLER
;MORE FIXES FOR LOW AND HIGH Q (TCO 1929)
;<4.MONITOR>FORK.MAC.152, 5-Jul-78 16:09:16, EDIT BY MILLER
;TCO 1929. INT PROCESS WHENVER PRIORITY MIGHT EFFECT FKMXQ
;<4.MONITOR>FORK.MAC.151, 19-Jun-78 21:54:32, EDIT BY BOSACK
;<1BOSACK>FORK.MAC.1000, 5-Jun-78 18:42:33, EDIT BY BOSACK
;<4.MONITOR>FORK.MAC.149, 19-Jun-78 14:48:45, Edit by MCLEAN
;TCO 1908 GETOK JSYS ADD OF GOKFRE
;<4.MONITOR>FORK.MAC.148, 18-Jun-78 17:32:29, Edit by MCLEAN
;REMOVE EXTRANEOUS CODE IN .CIS
;<4.MONITOR>FORK.MAC.147, 26-May-78 09:02:43, EDIT BY MILLER
;FIX ERROR IN RFSTS. NEED TO PRESERVE TO OVER CALL TO MRFSTS
;<4.MONITOR>FORK.MAC.146, 23-May-78 11:33:27, Edit by PORCHER
;MORE ON TCO # 1912 - LONG FORM OF RFSTS CALL
;<4.MONITOR>FORK.MAC.145, 24-Apr-78 16:15:26, Edit by BORCHEK
;MORE NSW FIXES
;<4.MONITOR>FORK.MAC.144, 22-Apr-78 18:27:20, Edit by BORCHEK
;NSW FIXES TO GFRKH FROM BBN
;<4.MONITOR>FORK.MAC.143, 22-Apr-78 15:50:30, Edit by BORCHEK
;DELETE EXTRA OKINT IN SCTT0:
;<4.MONITOR>FORK.MAC.141, 16-Apr-78 04:45:51, Edit by BORCHEK
;FIX TTY ASSIGNED TO OTHER JOB BUG IN SCTTY
;<4.MONITOR>FORK.MAC.140, 7-Apr-78 15:27:45, Edit by PORCHER
;TCO # 1912 - ADD LONG FORM OF RFSTS CALL
;<4.MONITOR>FORK.MAC.139, 10-Mar-78 10:17:27, EDIT BY MILLER
;TCO 1189. FIX SJPRI TO STORE WORD IN JOBSKD
;<4.MONITOR>FORK.MAC.138, 9-Mar-78 14:19:10, EDIT BY MILLER
;SURROUND MOST OF SJPRI WITH NOSKED AND OKSKED
;<4.MONITOR>FORK.MAC.137, 9-Mar-78 08:17:55, EDIT BY MILLER
;MAKE SURE UNSED PC BITS NOT RETURNED IN RFSTS
;<4.MONITOR>FORK.MAC.136, 17-Feb-78 13:40:13, Edit by PORCHER
;Allow CCL start offsets in SFRKV
;Fix NOSKED BLT to/from user space in RFACS/SFACS
;<4.MONITOR>FORK.MAC.135, 15-Feb-78 12:57:38, EDIT BY MILLER
;MODIFY RFSTS TO RETURN 30-BIT PC IF NOT SECTION 0
;<4.MONITOR>FORK.MAC.134, 30-Jan-78 15:00:25, EDIT BY MILLER
;ALLOW ANY FORK IN SWTRP
;<4.MONITOR>FORK.MAC.133, 30-Jan-78 14:38:30, EDIT BY MILLER
;MORE FIXES TO SWTRP
;<4.MONITOR>FORK.MAC.132, 30-Jan-78 13:32:25, EDIT BY MILLER
;MORE TCO 1880 FIXES
;<4.MONITOR>FORK.MAC.131, 30-Jan-78 13:23:42, EDIT BY MILLER
;TCO 1880 AGAIN. CHANGE ERROR CODES
;<4.MONITOR>FORK.MAC.130, 30-Jan-78 13:18:05, EDIT BY MILLER
;TCO 1880. ADD SWTRP JSYS
;<4.MONITOR>FORK.MAC.129, 28-Jan-78 23:14:44, Edit by PORCHER
;<4.MONITOR>FORK.MAC.128, 28-Jan-78 15:17:58, EDIT BY PORCHER
;<4.MONITOR>FORK.MAC.125, 27-Jan-78 11:17:34, EDIT BY PORCHER
;Add Execute-Only checks to JSYSes
;<4.MONITOR>FORK.MAC.124, 19-Jan-78 14:50:18, EDIT BY PORCHER
;Add bits and routines for Execute-Only
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH PROLOG
TTITLE FORK
;FORK CONTROLLING JSYSES AND FUNCTIONS - D. MURPHY
;LOCAL ITEMS DECLARED IN STG.MAC
EXTN <DEVKFK>
;ITEMS DEFINED IN APRSRV FOR SWTRP
EXTN <SETART,SETLUU,GTLUUB>
;AC DEFINITIONS USED HEREIN
DEFAC (FX,Q3) ;FORK INDEX
;DATA STRUCTURES REFERENCED ONLY IN SWPMON
;Definitions for SYSFK in JSB (index by JRFN)
;Bit 0 set indicates JRFN not in use
DEFSTR(SFEXO,SYSFK,1,1) ;Fork is Execute-Only if set
DEFSTR(SFNVG,SYSFK,2,1) ;Fork is not "virgin" if set
DEFSTR(SFGXO,SYSFK,3,1) ;Fork can PMAP into execute-only forks
; because it is doing an execute-only GET
DEFSTR(SFSRT,SYSFK,4,1) ;FORK HAS BEEN STARTED
;Bits 5 to 8 are unused
DEFSTR(FKHCNT,SYSFK,17,9) ;COUNT OF HANDLES ON A GIVEN FORK
;Bits 18 to 35 is the system fork number
SWAPCD
;GET/SET ENTRY VECTOR
.SEVEC::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;Map PSB and check for execute-only
JUMPE 2,SEV1 ;ALL-0 IS LEGAL
HLRZ 3,2 ;GET SIZE
CAIN 3,<JRST>B53 ;10/50 STYLE?
JRST SEV1 ;YES
CAIL 3,1000
ESVX1: ERRJMP(SEVEX1,ITFRKR) ;NOT LEGAL
SEV1: MOVEM 2,ENTVEC(1)
JRST CLFRET
.GEVEC::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
MOVE 2,ENTVEC(1)
GCV1: UMOVEM 2,2
JRST CLFRET
;GET/SET COMPATIBILITY ENTRY VECTOR AND PARAMETERS
.GCVEC::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
MOVE 2,PATADR(1)
MOVE 3,PATUPC(1)
HRL 3,PATU40(1)
UMOVEM 3,3
JRST GCV1
.SCVEC::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;Map PSB and check for execute-only
MOVEM 2,PATADR(1)
HRRM 3,PATUPC(1)
HLRM 3,PATU40(1)
JRST CLFRET
;GET/SET DMS ENTRY VECTOR
;GET DMS ENTRY VECTOR
;ACCEPTS IN 1/ FORK HANDLE
; GDVEC
;RETURNS +1: ALWAYS
; 2/ -LENGTH ,, ENTRY VECTOR ADDRESS
.GDVEC::MCENT
CALL FLOCK ;LOCK FORK STRUCTURE
CALL SETLFK ;MAP IN PSB OF FORK
MOVE 2,DMSADR(1) ;GET ENTRY VECTOR
JRST GCV1 ;GIVE THESE TO USER
;SET DMS ENTRY VECTOR
;ACCEPTS IN 1/ FORK HANDLE
; 2/ LENGTH ,, ENTRY VECTOR ADDRESS
.SDVEC::MCENT
CALL FLOCK ;LOCK FORK STRUCTURE
CALL SETLFX ;Map PSB and check for execute-only
MOVEM T2,DMSADR(T1) ;SAVE DMS ENTRY VECTOR
HRRZS T2
UMOVE 3,4(2) ;GET POINTER TO PC WORD
HRRM 3,DMSUPC(1) ;SAVE ADR OF WHERE TO PUT PC
UMOVE 3,3(2) ;GET POINTER TO JSYS LOCATION
HRRM 3,DMSU40(1) ;SAVE ADR OF WHERE TO PUT JSYS
JRST CLFRET ;EXIT UNLOCKING PSB
;SET SCHEDULER PRIORITY WORD
; 1/ FORK HANDLE
; 2/ PRIORITY WORD
; SPRIW
.SPRIW::MCENT
MOVE 2,CAPENB
TRNN 2,SC%WHL+SC%OPR
ITERR(WHELX1) ;MUST BE PRIVILEGED
;**;[3023] ADD 1 LINE AT .SPRIW::+4L TAM 6-OCT-83
CALL CKPRWV ;[3023] CHECK PRIORITY WORD
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
SPRI1: UMOVE 2,2
MOVEM 2,JOBBIT(1)
MOVE T2,FORKN(T1) ;GET JOB-WIDE INDEX
HRRZ T2,SYSFK(T2) ;GET SYSTEM INDEX
CALL SETPRF ;INTERRUPT PROCESS
JRST CLFRET
;SET PRIORITY WORD FOR ANOTHER JOB
; 1/ JOB NUMBER
; 2/ PRIORITY WORD
; SJPRI
.SJPRI::MCENT
MOVE 2,CAPENB
CALL CKMMOD ;SEE IF MONITOR OR USER
TRNE 2,SC%WHL+SC%OPR ;USER. SEE IF PRIVILEGED
SKIPA ;MONITOR OR PRIVILEGED
ITERR(WHELX1)
;**;[3023] ADD 1 LINE AT .SJPRI::+6L TAM 6-OCT-83
CALL CKPRWV ;[3023] CHECK PRIORITY WORD
CALL FLOCK ;GET FORK LOCK IN CASE THIS JOB
CAIL 1,0 ;LEGAL JOB NUMBER?
CAIL 1,NJOBS
JRST SJPRI1 ;NO
CALL MAPJSB ;GET THE JSB MAPPED
JRST SJPRI1 ;NON-EX JOB
UMOVE T2,2 ;GET PRIORITY WORD
MOVEM T2,JOBSKD(T1) ;STORE IT
MOVE P1,T1 ;GET JSB OFFSET
HRLI P1,-NUFKS ;FORM AOBJN POINTER
SJPRI2: SKIPGE T2,SYSFK(P1) ;THIS FORK ACTIVE?
JRST SJPRI3 ;NO. GO ON
HRRZS T2 ;YES. GET FORK HANDLE
CALL SETPRF ;UPDATE ITS PRIORITY
SJPRI3: AOBJN P1,SJPRI2 ;DO ALL PROCESSES
JRST CLFRET ;AND DONE
SJPRI1: CALL FUNLK
ITERR (SJPRX1) ;NON-EXISTANT JOB
;**;[3023] ADD SUBROUTINE CKPRWV: AT .SJPRI1:+2L
;[3023] CHECK PRIORITY WORD IN USERS AC2 FOR .SJPRI AND .SPRIW JSYSES
;[3023]
;[3023] RETURN +1: SUCCESS
;[3023] ITERR IF QUEUE NUMBERS OUT OF RANGE
CKPRWV: SAVEAC <T1> ;[3023] PRESERVE T1 FOR CALLERS
UMOVE T2,2 ;[3023] GET PRIORITY WORD
LDB T1,[POINT 6,T2,35] ;[3023] GET MAX Q
LDB T2,[POINT 6,T2,29] ;[3023] AND MIN Q
;**;[3072] CHANGE 2 [3023] LINES AT CKPRWV:+4L TAM 2-1-84
CAIG T2,LOWQ ;[3072][3023] MIN > MAX?
CAILE T1,LOWQ+1 ;[3072][3023] MAX > MAX+1?
ITERR (ARGX22) ;[3023] YES, ERROR
RET ;[3023] ALL IS OK
;GET AND SET PRIMARY IO JFN'S
.GPJFN::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
MOVE 2,PRIMRY(1)
UMOVEM 2,2
JRST CLFRET
.SPJFN::MCENT
XCTU [SKIPN 2] ;PROVIDING A VALID VALUE?
ITERR (DESX3) ;NO. DISALLOW IT THEN
CALL FLOCK ;LOCK THE FORK STRUCTURE
MOVX T2,<CALL SPJFN1> ;ROUTINE TO EXECUTE
CALL MAPFKH
NOP ;WON'T BLOCK
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
JRST MRETN
SPJFN1: CALL SKIIF
JRST FRKE2
CALL SETLF1
UMOVE 2,2
MOVEM 2,PRIMRY(1)
JRST CLRLFK
;GET TRAP WORDS FROM FORK
.GTRPW::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK ;MAP PSB
MOVE 2,UTRSW(1) ;TRAP STATUS WORD
TXNN T2,TWUSR ;SETUP BITS IN OLD FORMAT
TXO T2,TSW%MN ;MONITOR MODE REFERENCE
TXNE T2,TWWRT
TXO T2,TSW%WT ;WRITE REF
TXO T2,TSW%RD ;READ ALWAYS
UMOVEM 2,1 ;RETURNED IN 1
HRL 2,UMUUOW(1) ;MUUO WORD
HRR 2,UMUUOW+1(1)
UMOVEM 2,2 ;RETURNED IN 2
JRST CLFRET
;FORK CREATION AND CONTROL JSYS'S
.CFORK::MCENT
MOVE T1,FKCNT ;COUNT OF FORKS
ADDI T1,2 ;CORRECT COUNT FOR THIS CREATION AND INITIAL JOB'S FORK
HRRZ T2,GTOKPR+.GOCFK ;GET COUNT OF FORKS
CAMG T1,T2 ;AND DO GETOK IF REQUIRED
JRST CFGOK ;NO PROCEED WITHOUT GETOK
SOS T1 ;MAKE CURRENT NUMBER
GTOKM (.GOCFK,<T1>,[RETERR ()])
CFGOK: CALL FLOCK ;LOCK THE FORK STRUCTURE
MOVEI T1,-1
CALL GFKH ;GET LOCAL HANDLE
ERRJMP(FRKHX6,EFRKR) ;NONE
PUSH P,T1 ;SAVE IT
NOSKED
MOVE T2,DRMFRE ;GET FREE SWAPPING SPACE
CAMG T2,DRMLV0 ;SPACE LEFT?
JRST CFBAD ;NO. DON'T CREATE THE FORK
MOVE T2,SPTC ;CURRENT SPT COUNT
CAML T2,SPC2 ;ROOM LEFT?
JRST CFBAD ;NO
SKIPE FREFK ;ROOM IN SYSTEM?
SKIPN FREJFK ;ROOM IN JOB?
JRST CFBAD ;NO
CALL ASSFK ;YES, ASSIGN FORK IN SYSTEM
CALL ASSJFK ;AND ASSIGN FORK IN JOB
PUSH P,T1 ;SAVE JOB FORK HANDLE
AOS FKCNT ;UPDATE THIS JOBS FORK COUNT
MOVE T1,FORKX
MOVE T1,FKJOB(T1) ;GET JOB NO AND JSB
MOVEM T1,FKJOB(FX) ;SET FOR NEW FORK
CALL WTCONC ;PUT FORK ON WAIT LIST
OKSKED
; ..
;CFORK ...
BP$019: ;BREAKPOINT FOR CREATE SUBFORK
HRLZ T1,FX
CALL WAITFK ;WAIT FOR IT TO INITIALIZE
POP P,T1 ;RESTORE JOB FORK HANDLE
HRRZM FX,SYSFK(T1)
;Note that this clears all the
; flag bits in LH of SYSFK
MOVEI T2,1 ;INDICATE 1 HANDLE ON THIS FORK
STOR T2,FKHCNT,(T1) ; ...
SETZM FKPTRS(T1)
SETZM FKPSIE(T1)
SETZM FKDPSI(T1)
HRRZ T2,FORKN ;PUT NEW FORK INTO STRUCTURE LISTS
MOVEI Q2,FKPTRS(T2)
HLL Q2,INFERP
LDB T3,Q2 ;GET INFERIORS OF THIS FORK
DPB T1,Q2 ;PUT NEW FORK AT HEAD OF IT
MOVEI Q2,FKPTRS(T1)
HLL Q2,SUPERP
DPB T2,Q2 ;THIS FORK IS SUPERIOR OF NEW FORK
HLL Q2,PARALP
DPB T3,Q2 ;OTHER INFERIORS ARE PARALLEL TO NEW FORK
IDIVI T2,2 ;FIND OUT WHERE THIS IS IN THE CTTY TABLE
ADD T2,FKCTYP(T3)
LDB T4,T2 ;GET CTTY FOR CREATING FORK
MOVEI T2,0(T1) ;NEW FORK'S FORKN
IDIVI T2,2 ;POINT TO ITS CTY FIELD
ADD T2,FKCTYP(T3)
DPB T4,T2 ;PUT SUPERIOR'S CTTY IN INFERIOR
PUSH P,T1
CALL SETLF1 ;MAP PSB OF NEW FORK
; ..
;CFORK ...
MOVE 2,0(P) ;NEW FORK'S JOB HANDLE
MOVEM 2,FORKN(1)
ADDM T2,JTBLK(T1) ;MAKE INFERIOR POINT TO CORRECT FKJTB
MOVE T3,@JTBLK ;GET EXECUTING FORK'S MONITOR, IF ANY
MOVEM T3,FKJTB(T2) ;SAME ENVIRONMENT TO INFERIOR
MOVE 2,JOBNO
MOVEM 2,JOBNO(1)
MOVE 2,PRIMRY
MOVEM 2,PRIMRY(1)
MOVE 2,JOBBIT
MOVEM 2,JOBBIT(1) ;PASS PRIORITY
SETZM CAPMSK(1)
SETZM CAPENB(1)
MOVEI 2,LSTRX1 ;INITIALIZE LAST ERROR CODE TO NONE
MOVEM 2,LSTERR(1)
POP P,4 ;GET JOB WIDE INDEX
MOVE 2,0(P) ;LOCAL HANDLE
ANDI 2,377777 ;MASK OFF FORK BIT
IDIVI 2,2 ;GET FKTAB INDEX
ADD 2,FKPTAB(3) ;GET PROPER BYTE POINTER
DPB 4,2 ;STORE LOCAL POINTER
MOVX 2,PSIIF ;CHECK IF FORK WAS PROPERLY INITED
TDNN 2,FKINT(7) ;WAS IT?
JRST CFK5 ;YES
MOVE 2,BITS+.ICMSE ;GOT INT. SEE IF FATAL
TDNN 2,FKINTB(7) ;WAS IT?
JRST CFK5 ;NO. LET IT GO ON
NOINT ;PREVENT UNWANTED INTS
CALL CLRLFK ;YES. CLEAR MAPPING
CALL FUNLK ;RELEASE FORK LOCK
POP P,1 ;GET LOCAL INDEX
KFORK ;ZAP THE FORK
OKINT ;FORK PROPERLY KILLED. ALLOW INTS AGAIN
RETERR (CFRKX3) ;GIVE NO RESOURCES ERROR
; ..
;CFORK...
CFK5: UMOVE T2,1 ;GET ARG
TXNE T2,CR%MAP ;Same map?
CALL CFK4 ;YES
TXNE T2,CR%CAP ;Give special capabilities?
CALL CFK3
TXNE T2,CR%ACS ;Load ACs?
CALL CFK1 ;YES
TXNE T2,CR%ST ;Start process?
CALL CFK2
CALL CLRLFK ;UNMAP PSB
POP P,1 ;RETURN LOCAL HANDLE
UMOVEM 1,1
MOVEI T2,0(7) ;GET SYSTEM FORK INDEX
MOVE 7,FORKX ;GET INDEX OF THIS FORK
LOAD T1,FKMXQ ;GET LOCAL MAX Q
MOVE 7,T2 ;RESTORE INDEX OF CREATED FORK
STOR T1,FKMXQ ;SET UP ITS MAX Q
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
SMRETN
CFBAD: OKSKED
ERRJMP(CFRKX3,EFRKR) ;NO ROOM
;FORK CONTROL SUBRS
;Load ACs
CFK1: SAVET
XCTU [MOVE T2,2] ;GET LOC OF INITIAL AC'S
XMOVEI T3,UAC(T1) ;FIND ADDRESS OF SAVE AREA
MOVEI T1,20 ;ALL ACS
;**;[1856] Replace one line with 3 Lines at CFK1: +4L RAS 23-APR-81
CALL BLTUM1 ;[1856] TRANSFER AC'S TO MONITOR
MOVE T1,T4 ;[1856] GET JRFN
CALLRET CLRVGN ;[1856] CLEAR VIRGIN FLAG AND RETURN
;Start process
CFK2: MOVEI T3,0(T2) ;START ADDRESS
MOVEM T3,PPC(T1)
HRLI T3,(UMODF) ;IN USER MODE
MOVEM T3,PFL(T1)
PUSH P,T1
NOSKED
CALL UNBLK1 ;UNBLOCK IT
OKSKED
MOVE T1,0(P) ;Get PSB address
MOVE T1,FORKN(T1) ;Get JRFN for process
SETONE SFSRT,(T1) ;FLAG THAT FORK HAS BEEN STARTED
CALL CLRVGN ;No longer a Virgin Process
POP P,T1
RET
;Give special capabilities
CFK3: MOVE T3,CAPMSK ;GIVE NEW FORK SAME SPEC CAP
MOVEM T3,CAPMSK(T1)
MOVE T3,CAPENB
MOVEM T3,CAPENB(T1)
RET
;'SAME MAP' BIT - CAUSES MAP OF INFERIOR TO BE FILLED WITH
;IND PTRS TO SUPERIOR
CFK4: PUSH P,1
PUSH P,2
MOVE 1,FORKX
HLLZ 1,FKPGS(1) ;SOURCE IS THIS FORK
HLLZ 2,FKPGS(7) ;DEST IS NEW FORK
MOVSI 3,(PTRW)
MOVEI 4,PGSIZ
CALL MSETPT ;DO FOR ALL PAGES
MOVE T1,FORKN ;Get current JRFN
CALL CKNXOR ;Is current process Execute-only?
JRST [ MOVE T1,-1(P) ;Yes-- get PSB of new process
MOVE T1,FORKN(T1) ;Get JRFN of new process
CALL SETEXO ;Make new process execute-only also
JFCL ;Can't (should never happen)
JRST .+1]
POP P,2
POP P,1
RET
WAITFK: HRRI 1,WTFKT
MDISMS
RET
RESCD ;SCHEDULER TEST, MUST BE RESIDENT
WTFKT: MOVE T2,FKSWP(T1)
TXNN T2,FKBLK ;FORK BLOCKED?
JRST 0(4) ;NO
JRST 1(4) ;YES
ASSJFK: MOVE 1,@FREJFK
EXCH 1,FREJFK
SUBI 1,FKPTRS
RET
SWAPCD
;SPLICE FORK STRUCTURE
; 1/ FORK HANDLE OF NEW SUPERIOR
; 2/ FORK HANDLE OF FORK TO BECOME INFERIOR
; RETURNS +2: SUCCESS, WITH 1/ FORK HANDLE OF 2 RELATIVE TO 1
DEFINE SPLERR (ERN,JMP)<
JRST [CALL RALLI ;RESUME ALL INFERIORS
ERRJMP (ERN,JMP)]>
.SPLFK:: MCENT
TRVAR <F1,F2,F3>
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL FALLI ;FREEZE ALL OF CALLER'S INFERIORS
UMOVE Q1,T1
TXNE Q1,SF%EXT ;IS THIS AN EXTENDED CALL?
JRST SPLFK4 ;YES, DO SPECIALLY..
XCTU [HRRZ T1,T1] ;GET RFH OF NEW SUPERIOR
CALL SETJFK ;GET JOB FORK HANDLE OF 1
MOVEM T1,F1
CALL SKIIF ;IS 1 INFERIOR OR EQ TO SELF?
SPLERR(SPLFX1,EFRKR) ;NO
XCTU [HRRZ T1,T2] ;GET 2
CALL SETJFK ;GET JOB HANDLE OF 2
MOVEM T1,F2
CAME T1,FORKN ;IS 2 STRICTLY INFERIOR TO SELF?
CALL SKIIF
SPLERR(SPLFX2,EFRKR) ;NO
MOVE T1,F1 ;GET 1
MOVE T2,F2 ;GET 2
CALL SKIIFA ;IS 1 ALREADY EQ OR INFERIOR TO 2?
JRST .+2 ;NO, OK
SPLERR(SPLFX3,EFRKR) ;YES, ERROR
MOVE T1,F1 ;GET F1
SKIPN T1,FKJTB(T1) ;DOES F1 HAVE A JTB?
TROA T1,7777 ;NO, THERE IS NO MONITOR
LOAD T1,JTIMP,(T1) ;YES, GET F1'S MONITOR
MOVE T2,F2 ;GET F2
SKIPN T2,FKJTB(T2) ;DOES F2 HAVE A JTB?
TROA T2,7777 ;NO, THERE IS NO MONITOR
LOAD T2,JTIMP,(T2) ;YES, GET F2'S MONITOR
CAIE T1,(T2) ;F1 AND F2 HAVE THE SAME MONITOR?
CAMN T2,F1 ;OR IS F1 THE IMMEDIATE MONITOR OF F2?
CAIA ;YES, OK.
CALL SPLFK3 ;NO. UPDATE TRAP ENVIRONMENTS
CALL SPLFK9 ;DO THE SPLICE
MOVE T1,F1 ;GET 1
CALL SETLF1 ;MAP PSB OF 1
MOVSI T1,0(T1) ;SETUP ARG FOR GRFKH
HRR T1,F2 ;PSB OFFSET ,, JOB HANDLE
CALL GRFKH ;GET RELATIVE HANDLE FOR 2 RELATIVE TO 1
SETZ T1,
UMOVEM T1,T1
CALL CLRLFK
HRRZ T1,F2 ;NEW INFERIOR
HRRZ FX,SYSFK(T1)
SETONE FKFR1,(FX) ;NEW INFERIORS ALWAYS BECOME FROZEN
CALL RALLI ;RESUME ALL INFERIORS
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
SMRETN
; UPDATE JSYS TRAP ENVIRONMENTS DUE TO SPLICING
; F2 HAS ITS OLD JSYS TRAP ENVIRONMENT REMOVED AND A NEW ONE ADDED.
; THE NEW ENVIRONMENT IS EITHER THE SAME AS F1'S OR IS THE ENVIRONMENT
; F1 INDIRECTLY SET FOR F2 (BY MONITORING ONE OF F2'S SUPERIORS)
SPLFK3: MOVE P1,F2 ;F2
MOVE P2,F1 ;F1
PUSH P,FKJTB(P2) ;SAVE F1'S JTB, IF ANY.
MOVE P4,T2 ;SAVE F2'S MONITOR
SKIPA P3,P1 ;START WITH IMD. MON. OF F2 AND
SPFK3A: MOVE P3,T1 ;FIND OUT IF F1 IS A MON. OF F2
SKIPN T1,FKJTB(P3) ;GET THE NEXT MONITOR UP THE CHAIN
JRST SPFK3B ;NO MORE IN CHAIN
LOAD T1,JTIMP,(T1) ;WHO IS THE MONITOR?
CAIE T1,(P2) ;IS IT F1?
JRST SPFK3A ;NO, KEEP LOOKING.
PUSH P,FKJTB(P1) ;SAVE F2'S CURRENT JTB
CALL NEWJTB ;GET A NEW BLOCK
POP P,FKJTB(P1) ;RESTORE OLD BLOCK, ADDR OF NEW IN T2
MOVEM T2,0(P) ;USE IT AS NEW ENVIRONMENT FOR F2
HRL T1,FKJTB(P3) ;COPY F1'S INFERIOR'S BLOCK
HRR T1,T2 ;TO NEW BLOCK FOR F2
BLT T1,JTBSIZ(T2) ;RETAINING ENV OF F2 SET BY F1
SPFK3B: HRRZ T1,P1 ;FIND SUPERIOR OF F2
ADD T1,SUPERP ;BUILD NEEDED POINTER
LDB T1,T1 ;GET FORK
CAIN P4,(T1) ;IS F2'S MONITOR SAME AS F2'S SUPERIOR?
CALL RELJTB ;YES. RELEASE JTB POINTER TO BY FK IN P1
POP P,FKJTB(P1) ;F2'S NEW JSYS TRAP ENVIRONMENT
CALLRET TFINF ;UPDATE F2'S INFERIORS (FORK IN P1)
;CONTINUE WITH SPLICE NOW THAT THE
;JSYS TRAP ENVIRONMENTS ARE THE SAME
; DO THE SPLICE.
; F1 IS THE NEW SUPERIOR AND F2 IS THE NEW INFERIOR
SPLFK9:
NOSKED ;NOSKED WHILE CHANGING POINTERS
MOVE T1,F2
ADD T1,SUPERP ;MAKE PTR TO SUPERIOR OF 2
LDB T1,T1 ;GET IT
ADD T1,INFERP ;MAKE PTR TO FIRST INFERIOR
SPLFK1: LDB T2,T1 ;SEARCH FOR 2
CAMN T2,F2
JRST SPLFK2 ;FOUND IT
MOVE T1,T2
ADD T1,PARALP
JRST SPLFK1 ;CONTINUE SEARCH
;REMOVE 2 FROM THE INFERIOR LIST OF ITS SUPERIOR
SPLFK2: ADD T2,PARALP
LDB T3,T2 ;GET SUCCESSOR
DPB T3,T1 ;PATCH AROUND 2
;NOW MAKE 2 BE THE FIRST INFERIOR OF 1
MOVE T1,F2
MOVE T2,F1
ADD T2,INFERP ;MAKE PTR TO INFERIOR LIST OF 1
LDB T3,T2 ;GET CURRENT FIRST INFERIOR OF 1
DPB T1,T2 ;MAKE 2 NEW FIRST INFERIOR OF 1
ADD T1,PARALP
DPB T3,T1 ;CONC REST OF INFERIOR LIST TO 2
;NOW UPDATE TO SHOW 1 IS SUPERIOR OF 2
MOVE T1,F2
ADD T1,SUPERP ;MAKE PTR TO SUPERIOR OF 2
MOVE T2,F1
DPB T2,T1 ;PUT 1 AS SUPERIOR OF 2
OKSKED
RET
SPLFK4: TXZ Q1,SF%EXT ;REMOVE FLAG FROM ARG BLOCK ADDRESS
XCTU [HRRZ P1,.SFLEN(Q1)] ;GET WORD COUNT FROM USER
CAIGE P1,2 ;LONG ENOUGH FOR FUNCTION CODE?
SPLERR(SPLBTS,EFRKR) ;NO, ERROR, BLOCK TOO SHORT
UMOVE T1,.SFCOD(Q1) ;GET FUNCTION CODE
CAIE T1,.SFUNS ;IS IT .SFUNS (ONLY ONE SO FAR)
SPLERR(SPLBFC,EFRKR) ;NO, ERROR, BAD FUNCTION CODE.
CAIGE P1,4 ;DOES WORD COUNT INCLUDE FLAGS?
SPLERR(SPLBTS,EFRKR) ;NO, ERROR, BLOCK TOO SHORT
UMOVE T1,.SFUFL(Q1) ;GET FLAGS
TXNN T1,SF%GO
IFSKP. ;IF SF%GO..
CAIGE P1,5 ;IS THERE ROOM FOR ENTRY VECTOR.
SPLERR(SPLBTS,EFRKR) ;NO, ERROR
ENDIF.
TXNN T1,SF%ADR ;IF SF%ADR
IFSKP. ;IS THERE ROOM FOR PC FLAGS AND ADDRESS
CAIGE P1,6 ;NO, ERROR
SPLERR(SPLBTS,EFRKR)
ENDIF.
; SET UP F1, F2, F3 AND CHECK FOR ERRORS
MOVE T1,FORKN
ADD T1,SUPERP
LDB T1,T1
MOVEM T1,F1 ;F1 IS OUR SUPERIOR
XCTU [HRRZ T1,.SFUIN(Q1)]
CALL SETJFK
MOVEM T1,F2 ;F2 IS THE NEW INFERIOR
CAME T1,FORKN
CALL SKIIF ;BE SURE F2 IS STRICTLY INFERIOR TO SELF
SPLERR(SPLFX2,EFRKR)
MOVEI T1,.FHSLF
CALL SETJFK
MOVEM T1,F3 ;F3 IS US
; DO THE XSFRK% OR SFRKV NOW WHILE WE HAVE A VALID HANDLE. NOTHING
; WILL HAPPEN YET ANYWAY BECAUSE F2 IS FROZEN. WE ALSO CATCH ANY
; ERRORS HERE.
CALL SPLFK5 ;SETUP AND CALL APPROPRIATE JSYS.
JRST [CALL RALLI ;RESUME INFERIORS
MOVE T1,LSTERR
JRST EFRKR] ;ERROR RETURN
MOVE T1,F1 ;KILL ANY JSYS TRAPS TO F1
MOVEI Q1,.TFRAL
CALL TFSR
NOSKED ;EXCHANGE FORKN NUMBERS BETWEEN F3 AND F2
MOVE T2,FORKN ;GET OUR FORKN NUMBER
MOVE T1,F2
CALL SETLF1 ;MAP NEW INFERIOR
EXCH T2,FORKN(T1) ;SWAP FORK NUMBERS
PUSH P,T2 ;DON'T LOSE T2
CALL CLRLFK ;UNMAP NEW INFERIOR
POP P,T2
MOVEM T2,FORKN ;COMPLETE SWAP OF FORKN NUMBERS
CALL SPSWAP ;SWAP INFO BETWEEN F3 AND F2
CALL SPLFK9 ;CHANGE FORK STRUCTURE BASED ON F1,F2
HRRZ T1,FORKN ;VIA OUR FORKN
ADD T1,SUPERP ;GET SUPERIOR FORKN
LDB T1,T1
HRRZ FX,SYSFK(T1) ;GET SYSTEM ID OF SUPERIOR.
SETONE FKSPL,(FX) ;SET INFERIOR HAS SPLICED EVENT.
MOVE T1,FORKN ;GET NEW VALUE OF FORKN FOR US.
MOVEM T1,FLKOWN ;FIX THE OWNER OF FLOCK WHILE WE STILL HAVE IT
DO. ;WAKE SUPERIOR IF IT IS IN TRMTST FOR US.
JE FKBL%,(FX),ENDLP. ;IF NOT BLOCKED, THERE IS NO SCHEDULER TEST
LOAD T1,FKWTL ;BLOCKED, SEE WHERE IT IS?
CAIE T1,TRMLST ;WAITING FOR TERMINATION?
IFSKP.
LOAD T1,FKSTD,(FX) ;YES, FOR WHICH FORK?
CAMN T1,FORKX ;WAITING FOR US?
CALL UNBLK1 ;YES, THEN UNBLOCK.
ENDIF.
ENDDO.
OKSKED
CALL RALLI ;RESUME INFERIORS
MOVE T1,F3 ;THIS IS OUR BROTHER WHO WAS INFERIOR
CALL RFORK3 ;ALSO RESUME OUR BROTHER WHO WAS INFERIOR
CALL RFORK1 ;THIS NEEDS TO BE DONE ALSO, FOR SOME REASON.
MOVE T1,FORKN ;GET JOB FORK NUMBER
CALL DASFKH ;DEASSIGN FORK HANDLES
CALL KFORK3 ;REMOVE FROM FORK STRUCTURE
CALL FUNLK ;UNLOCK, WE ARE NOW OUT OF FORK STRUCTURE.
; THE FOLLOWING IS WHAT IS NECESSARY TO DO THE EQUIVALENT OF KSELF FOR ONES
; OWN JOB. THE CODE JUST ABOVE DOES WHAT .KFORK WHAT HAVE DONE.
MOVE 7,FORKX
MOVX T1,FKPSI1 ;DEFERRED INTERRUPT STATE
STOR T1,FKINX,(FX) ;THIS MAKES US NON-INTERRUPTIBLE
JRST KSELF1 ;ENTER KSELF CODE IN THE RIGHT PLACE.
SMRETN
; setup and call appropriate JSYS based on flags.
SPLFK5: UMOVE T1,.SFUFL(Q1)
TXNN T1,SF%CON ;continue fork specified?
IFSKP. ;yes, do it.
MOVX T1,SF%CON ;LH T1/ continue flag for XSFRK%
XCTU [HRR T1,.SFUIN(Q1)] ;RH T1/ obtain inferior to continue
SFORK%
ERJMP [RET] ;error return
RETSKP ;good return
ENDIF.
TXNN T1,SF%ADR ;start fork at address?
IFSKP. ;yes, do it.
UMOVE T1,.SFUIN(Q1) ;T1/ inferior handle
XCTU [HLL T2,.SFUA1(Q1)] ; RH of T2/ PC flags
XCTU [HRR T2,.SFUA2(Q1)] ; LH of T2/ PC address
SFORK%
ERJMP [RET] ;error return
RETSKP ;good return
ENDIF.
TXNN T1,SF%GO ;start fork at entry vector?
IFSKP. ;yes, do it.
UMOVE T1,.SFUIN(Q1) ;T1/ inferior handle
UMOVE T2,.SFUA1(Q1) ;T2/ entry vector address
SFRKV
ERJMP [RET] ;error return
RETSKP ;good return
ENDIF.
RETSKP ;if no flags, then leave as is, good return.
; swap information between forks.
SPSWAP:
CALL CTEXCH ;CONTROLLING TERMINAL
MOVEI T4,SYSFK ;MAKE F3 BECOME F2 AND VICE VERSA
CALL SPEXCH
;[6719]Add 1 line at SPSWAP+2L 12-APR-85 TAB
CALL FHEXCH ;[6719]EXCHANGE BACK FORK HANDLE COUNTS
MOVEI T4,FKJTB ;JSYS traps
CALL SPEXCH
MOVEI T4,FKPSIE ;PSI related
CALL SPEXCH
MOVEI T4,FKDPSI ;PSI related
CALL SPEXCH
RET
;
; EXCHANGES INFORMATION IN JOB TABLES.
; T4/ JOB TABLE NAME
; F3 AND F2 INDICATE TGHE ONES TO EXCHANGE
;
SPEXCH:
MOVE T1,T4
ADD T1,F3 ;PTR TO TABLE(F3)
MOVE T3,0(T1)
MOVE T2,T4
ADD T2,F2 ;PTR TO TABLE(F2)
EXCH T3,0(T2)
MOVEM T3,0(T1)
RET
;[6719]Add 10 lines at SPEXCH+9L 12-APR-85 TAB
;[6719]
;[6719] EXCHANGE FORK HANDLE COUNTS BETWEEN FORK F3 AND F2.
;[6719]
FHEXCH: MOVE T1,F2 ;[6719]JFH OF FORK F2
MOVE T2,F3 ;[6719]JFH OF FORK F3
LOAD T3,FKHCNT,(T1) ;[6719]
LOAD T4,FKHCNT,(T2) ;[6719]
STOR T3,FKHCNT,(T2) ;[6719]
STOR T4,FKHCNT,(T1) ;[6719]SWAP COMPLETE
RET ;[6719]
; EXCHANGE INFORMATION IN FKCTYP HALF WORDS
CTEXCH: HRRZ T1,F2
IDIVI T1,2
ADD T1,FKCTYP(T2)
LDB T2,T1 ;F2'S CTTY
HRRZ T3,F3
IDIVI T3,2
ADD T3,FKCTYP(T4)
LDB T4,T3 ;F3'S CTTY
DPB T2,T3
DPB T4,T1 ;EXHCNAGED
RET
ENDTV.
;KILL FORKS
.KFORK::MCENT
;**;[3157] MAKE CHANGES AT .KFORK:: TAM 20-SEP-84
;[3157] CALL FLOCK ;LOCK THE FORK STRUCTURE
MOVEI 1,0(1)
CAIN 1,-4 ;ALL INFERIORS?
JRST KFORK2 ;YES
CALL FLOCK ;[3157]LOCK THE FORK STRUCTURE
CALL SETJFK ;NO, ANY ONE FORK
CAMN 1,FORKN ;SELF?
ERRJMP(KFRKX2,ITFRKR) ;YES, NOT PERMITTED
CALL SKIIF ;INFERIOR?
JRST FRKE2 ;NO, NOT PERMITTED
SETZ P1, ;[3157]INIT COUNT OF KILLED FORKS
MOVE P2,P ;[3157]GET STORAGE POINTER
ADJSP P,1 ;[3157] 1 FORK
CALL KFORK1 ;KILL IT
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
CALL KFKWAT ;[3157] WAIT FOR IT TO DIE
ADJSP P,-1 ;[3157] REMOVE STORAGE
JRST MRETN
KFORK2: CALL FLOCK
HRRZ 1,FORKN
CALL MAPINF ;FREEZE ALL TO INSURE INTERRUPTIBILITY
CALL FFORK1
CALL KALLI ;KILL ALL INFERIORS
;[3157] 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
CALL KFORK3 ;remove fork from structure
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
AOS P1 ;[3157] COUNT FORKS KILLED
AOS P2 ;[3157] ADVANCE POINTER
MOVEM FX,0(P2) ;[3157] SAVE FORK INDEX
SETONE FKKIL ;[3157] SAY FORK BEING KILLED
CALL UNBLK1
OKSKED ;MATCH NOSKED IN SUSFK
CALL CLRLFK
SETZ 1,
MOVEI 2,FPG0A
MOVEI 3,FPG3+1-FPG0 ;CLEAR FORK TEMP PAGES
CALL MSETMP
RET
;KILL ALL INFERIORS OF THIS FORK
;**;[3157] REWRITE KALLI: TAM 20-SEP-84
KALLI: SETZ P1, ;[3157] INIT COUNT OF FORKS KILLED
MOVE P2,P ;[3157] GET STORAGE POINTER
ADJSP P,NUFKS ;[3157] GET STORAGE
KALI1: HRRZ 1,FORKN ;[3157]
ADD 1,INFERP
LDB 1,1 ;GET NEXT INFERIOR
JUMPE 1,[CALL FUNLK ;[3157] NO MORE
CALL KFKWAT ;[3157] WAIT FOR DEATH
ADJSP P,-NUFKS ;[3157] RETURN SPACE
RET] ;[3157]
CALL KFORK0 ;KILL ALL INFERIORS TOO
JRST KALI1 ;[3157]
; remove fork from structure, called by KSELF and KSELFJ.
; T1/ job fork number, destroys T3,T4
KFORK3: MOVE T3,T1
ADD T3,SUPERP
LDB T3,T3 ;GET SUPERIOR
ADD T3,INFERP
KFK01: LDB T4,T3 ;GET NEXT PARALLEL
CAIN T4,0(T1) ;DESIRED FORK?
JRST KFK02 ;YES
MOVE T3,T4
ADD T3,PARALP
JRST KFK01
KFK02: ADD T4,PARALP ;FOUND FORK TO BE KILLED IN LIST
LDB T4,T4
DPB T4,T3 ;PUT NEXT IN LAST, REMOVING FORK FROM LIST
RET
;**;[3157] ADD 2 ROUTINES AT KFK02:+4L TAM 20-SEP-84
KFKWAT: SOJL P1,R ;[3157] IF DONE RETURN
HRL T1,0(P2) ;[3157] DATA IS FORK INDEX
HRRI T1,KFKTST ;[3157] SCHEDULER TEST
MDISMS ;[3157] WAIT
SOJA P2,KFKWAT ;[3157] DECREMENTS STG AND LOOP
RESCD ;[3157]
;[3157] SCHEDULER TEST FOR ABOVE
KFKTST: JE FKKL%,(T1),1(T4) ;[3157] NOT WAITING TO DIE IS SUCCESS
JRST 0(4) ;[3157] FAILURE OTHERWISE
SWAPCD ;[3157]
;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
KSELF1: MOVEI 1,0(7) ;GET FORK HANDLE
PUSH P,2 ;SAVE
SETZ 2, ;CLEAR ALL FORK'S ENTRIES ON STACK
CALL JSBSTF ;GO PROCESS DEALLOCATION LIST
SKIPE T1,SYMPAG ;ANY PAGE USED BY MDDT?
CALL RELPAG ;YES, RELEASE IT
SKIPE T2,PRARGP ;ANY JSB SPACE USED BY PRARG?
JRST [NOINT ;YES, MUST BE NOINT TO CALL PRARGF
SETZM PRARGP ;ZERO OLD POINTER
CALL PRARGF ;RELEASE THE SPACE
OKINT
JRST .+1]
CALL NTCOFF ;CLEAR THE NETWORK CHANGE INTERRUPT TABLE
JFCL ;IGNORE
MOVEI 1,0(7) ;GET FORK HANDLE
SETZ 2,0 ;CLEAR ALL FORK'S ENTRIE
CALL GOKFRE
POP P,2 ;RESTORE 2
CAMN 7,ACJFN ;CHECK FOR ACJ FORK
CALL ACJKIL ;KILL ACJ NOW
SETOM INTDF
MOVEM 4,P1 ;SAVE FORKX OF SUPERIOR
SETZM PSIBW
CALL DTIALL ;DEASSIGN TERM INTERRUPTS
OPSTR <SKIPE >,PSUTPS ;DID THIS FORK USE .MOTPS MTOPR FUNCTION?
CALL TTDTPS ;YES, SCAN TTYS FOR THIS FORK
MOVE 1,JOBNO ;GET JOB NUMBER OF THIS PROCESS
OPSTR <SKIPE >,DIAFL,(1) ;DOES THIS JOB HAVE DIAG RESOURCES?
CALL DGFKIL ;YES. GO RELEASE THIS PROCESSES SET
CALL NETKFK ;CLEAR FORK FROM NET TABLES
CALL MTAKFK ;KILL MTA ONLINE/OFFLINE PSI INTERRUPTS
HLRZ T1,DSPSFK ;GET DSK PSI FORK
CAIN 7,0(T1) ;SAME AS THIS ONE?
SETZM DSPSFK ;YES CANCEL IT
KSEFW: HRRZ T1,FORKN ;GET SELF
IDIVI T1,2 ;BUILD POINTER TO MY CTTY
ADD T1,FKCTYP(T2)
LDB T2,T1 ;GET MY CTTY
CAIN T1,-1 ;JUST THE JOB'S CTTY?
JRST KSEF0 ;YES, NOTHING TO DO.
TRZN T2,1B18 ;CONVERT FROM DESIGNATOR TO LINE NUMBER
JRST KSEF0 ;WASN'T A DESIGNATOR?
CAIGE T2,NLINES ;RANGE CHECK
CAIGE T2,0
JRST KSEF0 ;NOT A VALID LINE
CALL GTTOPF ;GET THE TOP FORK OF CTTY GRP FOR THIS TTY
JRST KSEF0 ;NOT AN ACTIVE LINE
CAME T3,FORKX ;IS IT ME?
JRST KSEF0 ;NO. NOTHING TO DO.
LOCK DEVLCK ;REQUIRED DURING DEASSIGN OF TTY
CALL TTYDAS ;YES, MAKE IT GO AWAY.
JUMPL T1,[HRL T1,T2
UNLOCK DEVLCK ;FREE THE TTY DATA
MDISMS
JRST KSEFW]
UNLOCK DEVLCK ;DONE WITH TTY DEVICE DATA
KSEF0: SETO T1,
RFRKH ;GO RELEASE ALL RELEASABLE HANDLES
JFCL
MOVSI T2,.FHSLF
;**;[1776] Change one line at KSEF0: +4L JGZ 2-SEP-80
MOVE T3,[PM%CNT+PM%ABT+1000] ;[1776] REQUEST PMAP OF 1000 PAGES
PMAP ;CLEAR ALL PAGES FROM SECTION-ZERO MAP
CALL CLNZSC ;UNMAP PAGES FROM NON-ZERO SECTIONS
JFCL ;DON'T CARE IF SECTIONS STILL EXIST
MOVE T1,FORKX ;GET FORK NUMBER
CALL PIDKFK ;KILL ALL PIDS BELONGING TO THIS FORK
MOVE T1,FORKX
CALL ENQFKR ;DEQ ALL REQUESTS FOR THIS FORK
MOVE T1,FORKX ;CHECK IF THIS FORK OWNS THE UTEST LOCK
CAMN T1,UTLOCK ;...
CALL UTREL ;YES, RELEASE IT
SETOM PRIMRY ;SET PRIMARY I/O TO CONTROLLING TERMINAL
MOVE T1,[CZ%UNR+CZ%ABT+400000] ;REASSIGN STILL-MAPPED+FLUSH NONX FILES
CLZFF ;CLOSE FILES HERE AND BELOW
SOS FKCNT ;COUNT OF FORKS
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL KALLI
;**;[3157]DELETE 1 LINE AT KSEF0:+23L TAM 20-SEP-84
;[3157] CALL FUNLK ;UNLOCK THE FORK STRUCTURE
;**;[3120] CHANGE 1 LINE AT KSEF0:+24L TAM 11-JUN-84
CALL UNMIDX ;[3120] UNMAP THE DIRECTORY AND INDEX
CALL CLKREL ; Release any clocks for this fork
MOVE T1,JOBNO ;GET JOB NUMBER OF THIS FORK
SKIPE SNPPGS ;THIS FORK SNOOPING?
CALL SNPREL ;YES, GO REMOVE ITS BREAK POINTS
MOVE FX,FORKX
HLRZ 1,FKPGS(7)
LOAD 2,SPTSHC,(1) ;GET SHARE COUNT OF UPT
PUSH P,2 ;SAVE IT FOR LATER CHECK
CALL FLOCK
SKIPN T2,@JTBLK ;DO WE HAVE A JSYS TRAB BLOCK?
JRST KSEF1 ;NO
HRRZ T3,FORKN ;YES, SEE WHETHER IT SHOULD BE RELEASED
ADD T3,SUPERP ;IDENTIFY MY SUPERIOR
LDB T3,T3 ; ..
HRRZ P1,FORKN ;NEED MY FORK NUMBER FOR RELJTB
LOAD T2,JTIMP,(T2) ;MY MONITOR
CAIN T3,(T2) ;IS MY SUPERIOR MY MONITOR?
CALL RELJTB ;YES. RELEASE THE JTB
KSEF1: HRRZ 4,FORKN ;GET JOB FORK HANDLE FOR SELF
LOAD 1,FKHCNT,(4) ;GET NUMBER HANDLES OF THIS FORK
JUMPN 1,[MOVSI 1,(1B0) ;NO. MARK IT DELETED THEN
IORM 1,SYSFK(4) ;""
JRST KSEF5] ;AND GO FINISH UP
MOVEI 1,FKPTRS(4) ;NO OTHERS, PUT JOB SLOT BACK ON FREE LIST
EXCH 1,FREJFK
MOVEM 1,@FREJFK
SETOM SYSFK(4) ;NOTE SLOT AVAILABLE
KSEF5: CALL FUNLK
LOAD T1,NOSTR
SKIPE T1 ;IF NO STRUCTURES MOUNTED, SKIP STR CODE
CALL RELSTR ;RELEASE ALL STRUCTURE MOUNTS FOR FORK
;**;[3156] ADD 1 LINE AT KSEF5:+4L TAM 20-SEP-84
SETZRO FKKIL ;[3157] FORK IS NOW EFFECTIVLY DEAD
;FINAL RUNDOWN - HAVE TO WAIT FOR THE SHARE COUNTS ON ALL SECTION MAPS
;TO GO TO ZERO. NON-ZERO SECTIONS ARE CHECKED WITH THE CLNZSC ROUTINE.
;SECTION ZERO IS CHECKED WITH BY EXPLICITLY TESTING ITS SHARE COUNT.
;IF ANY SECTIONS ARE STILL SHARED, DISMISS AND TRY AGAIN LATER.
KSEF2: CALL CLNZSC ;DELETE USER'S NON-ZERO SECTIONS
JRST [ POP P,2 ;STILL SOME LEFT, FIX STACK
JRST KSEF3] ;GO WAIT FOR A WHILE
POP P,2 ;SHARE COUNT OF UPT
CAIE 2,1 ;UNSHARED?
JRST KSEF3
MOVE 7,FORKX
HRLZ 2,FKPGS(7)
SETZ 1,
HRRI 2,PPLOW ;CLEAR PROCESS MAP FROM PPLOW
MOVEI 4,PPHI-PPLOW+1 ; TO PPHI
CALL MSETPT ;CLEAR PROCESS MAP
CALL WTFPGS ;WAIT FOR UPT AND PSB TO BE UNMAPPED
JRST HLTFK1 ;GO DELETE UPT AND PSB
KSEF3: MOVEI 1,^D5000
DISMS ;WAIT FOR 5 SECS
HLRZ 1,FKPGS(7) ;THEN CLEAR MAP AGAIN
LOAD 2,SPTSHC,(1) ;SHARE COUNT OF UPT
PUSH P,2
SETZ 1,
HLLZ 2,FKPGS(7)
KSEF4: HRRZ T3,T2 ;MAKE A GOOD ADDRESS.
SKIPE UPTPGA(T3) ;QUICK CHECK FOR ALREADY EMPTY
CALL SETPT ;BUT NOT USING PMAP
MOVEI 6,0(T3)
CAIGE 6,777
AOJA 2,KSEF4
JRST KSEF2
;CLNZSC - DELETE NON-ZERO SECTIONS OF USER'S ADDRESS SPACE
;RETURNS +1: ONE OR MORE SECTIONS CAN'T BE DELETED BECAUSE
; THEY ARE STILL SHARED
; +2: ALL NON-ZERO SECTIONS CLEARED
CLNZSC: CALL CKXADR ;EXTENDED-ADDRESSING MACHINE?
RETSKP ;NO, CAN'T HAVE NON-ZERO SECTIONS, DONE
;**;[2607] Change one line at CLNZSC: +2L JGZ 3-APR-82
SAVEAC <Q1,Q2> ;[2607] GET WORK AC'S
MOVEI Q1,(VSECNO) ;GET HIGHEST SECTION #
SETZ Q2, ;CLEAR COUNT OF SECTIONS I COULDN'T KILL
;LOOP TO SCAN ALL SECTIONS, ATTEMPTING TO DELETE ANY THAT EXIST
CLNZS1: MOVE T1,Q1 ;GET SECTION #
CALL CHKMPS ;DOES THIS SECTION EXIST?
JUMPE T1,CLNZS2 ;NO, SKIP IT
SETO T1, ;YES, GET -1 TO SPECIFY DELETION
MOVSI T2,.FHSLF
HRR T2,Q1 ;GET FORK HANDLE,,SECTION#
MOVEI T3,1 ;COUNT
SMAP% ;TRY TO DELETE THE SECTION
ERJMP [HRRZ T1,LSTERR ;FAILED, GET ERROR CODE
CAIN T1,SMAPX1 ;FAILED BECAUSE STILL SHARED?
AOS Q2 ;YES, COUNT IT
JRST .+1]
CLNZS2: SOJG Q1,CLNZS1 ;LOOP THRU ALL SECTIONS
JUMPE Q2,RSKP ;SKIP RETURN IF ALL DELETED
RET ;SOME SECTION(S) STILL SHARED
;FREEZE FORK
;ACCEPTS:
; T1/ RELATIVE FORK HANDLE
;RETURNS +1: ALWAYS
; ILLEGAL INSTRUCTION TRAP ON ERROR
.FFORK::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
MOVEI 1,0(1)
CAIN 1,-4 ;ALL INFERIORS?
JRST FFORK5 ;YES
;USER WANTS TO FREEZE JUST ONE FORK. GET THE JOB-WIDE FORK HANDLE
;RETURN ERROR IF REQUEST IS FOR SELF, SUPERIOR, OR PARALLEL
CALL SETJFK ;OTHERWISE, ANY SINGLE INFERIOR
CAME 1,FORKN ;REQUESTING FREEZE OF SELF?
CALL SKIIF ;REQUESTING SELF OR INFERIOR?
JRST FRKE1 ;NOT INFERIOR. RETURN ERROR
;DO THE FREEZE. UPDATE TTY PSI INFORMATION IF REQUESTED FORK AND
;REQUESTING FORK HAVE THE SAME CONTROLLING TERMINAL
PUSH P,T1 ;SAVE THE REQUESTED JOB-WIDE INDEX
CALL FFORK1 ;DO THE WORK
POP P,T1 ;RESTORE REQUESTED INDEX
IDIVI T1,2 ;DECIDE WHETHER TO UPDATE PSI WORDS
ADD T1,FKCTYP(T2) ; WHICH SHOULD BE DONE IF SAME CTTY
LDB T1,T1 ;HERE'S ONE FORK'S CTTY
HRRZ T2,FORKN ;NOW DO SAME FOR SELF
IDIVI T2,2 ;COMPUTE INDEX INTO FKCTTY
ADD T2,FKCTYP(T3) ;POINT TO THE PROPER HALFWORD
LDB T2,T2 ;HERE'S MY CTTY
CAIN T1,0(T2) ;ARE THEY THE SAME SOURCE?
CALLRET UPDTIR ;YES. SO GO UPDATE TTY PSI INFO
CALL FUNLK ;NO. SO JUST RELEASE FORK STRUCTURE
MRETNG ;AND RETURN
;HERE WHEN REQUESTED ALL INFERIORS OF THE CALLER. STEP THROUGH
;ALL IMMEDIATE INFERIORS AND, FOR EACH ONE, CALL FFORK1 TO
;FREEZE IT.
FFORK5: HRRZ 1,FORKN ;SELF
CALL MAPINF ;MAP ALL IMMED INFERIORS
CALL FFORK1 ;THROUGH FFORK1
HRRZ T1,FORKN ;GET MY SOURCE OF TERMINAL PSI'S
IDIVI T1,2
ADD T1,FKCTYP(T2) ;POINT TO THE TTY
LDB T1,T1 ;RETRIEVE IT
CALLRET UPDTIR
;FFORK1 AND FFORK3 - FREEZE A FORK AND ALL OF ITS INFERIORS
;ACCEPTS:
; T1/ JOB-WIDE FORK HANDLE
; CALL FFORK1 - DIRECT FREEZE
; CALL FFORK3 - INDIRECT FREEZE
;RETURNS +1: ALWAYS
FFORK3: SKIPA 2,[XWD FRZB2,0] ;INDIRECT FREEZE BIT
FFORK1: MOVSI 2,FRZB1 ;DIRECT FREEZE BIT
HRRZ 7,SYSFK(1) ;GET SYSTEM WIDE FORK INDEX
;**;[1868] Add 1 line at FFORK1:+1L PED 8-MAY-81
CAIE 7,-1 ;[1868] FORK EXIST?
TDNE 2,FKINT(7) ;ALREADY DONE?
RET ;YES
TLNE 2,FRZB1 ;REMEMBER WHICH BIT - B1?
TRO 1,1B18 ;YES
HRLM 1,0(P) ;SAVE CURRENT FORK
TRZ 1,1B18
CALL MAPINF ;DO INDIRECT FREEZE OF INFERIORS
CALL FFORK3
HLRZ T1,0(P) ;GET CURRENT FORKN
TRZ T1,1B18
MOVEI T2,0(T1)
IDIVI T2,2 ;COMPUTE UP ITS CTTY POINTER
ADD T2,FKCTYP(T3) ;POINT TO FKCTTY TABLE
LDB T2,T2 ;THIS FORK'S CURRENT SOURCE OF PSI'S
PUSH P,Q1 ;SAVE A COUPLE AC'S
PUSH P,Q2 ; ..
MOVEI Q1,0(T1) ;FIND SUPERIOR OF THIS FORK
ADD Q1,SUPERP ; ..
LDB Q1,Q1 ;GET FORK NUMBER
IDIVI Q1,2 ;CONVERT TO GET ITS CTTY
ADD Q1,FKCTYP(Q2)
LDB Q1,Q1 ;GET THE CTTY DESIGNATOR
CAIN T2,0(Q1) ;SAME AS FORK BEING FROZEN?
JRST FFORK4 ;YES, SKIP THE PSI UPDATE
MOVEI T1,0(T2) ;NO, DIFFERENT. SO UPDATE PSI INFO
CALL UPDTI ; FOR THAT TTY
FFORK4: POP P,Q2 ;RESTORE AC'S USED JUST ABOVE
POP P,Q1 ; ..
HLRZ 1,0(P) ;RESTORE FORK PLUS FLAG BIT
XHLLI T2,20 ;GET SECTION #
HLLM T2,0(P) ;SET IT IN RETURN
MOVSI 2,FRZB1 ;RESTORE BIT
TRZN 1,1B18 ;B1?
MOVSI 2,FRZB2 ;NO, B2
HRRZ 7,SYSFK(1)
CALL SUSFK ;SUSPEND FORK
IORM 2,FKINT(7)
MOVEI 2,FRZWT
HRRM 2,FKSTAT(7) ;SET FROZEN STATE
CALL RECONC ;UPDATE LIST
OKSKED ;MATCH NOSKED IN SUSFK
RET
;(INDIRECTLY) FREEZE ALL INFERIORS
FALLI: MOVE T1,FORKN
CALL MAPINF
CALL FFORK3 ;XCTED BY MAPINF
RET
RESCD
FRZWT:: JRST 0(4) ;FREEZE WAIT SCHED TEST
SWAPCD
;RESUME FORK
.RFORK::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
MOVEI 1,0(1)
CAIN 1,-4 ;ALL INFERIORS?
JRST RFORK5 ;YES
CALL SETJFK
MOVE P1,T1 ;SAVE A COPY OF THE FORK INDEX
CAME 1,FORKN ;CHECK RELATIVITY
CALL SKIIF
JRST FRKE1 ;NOT INFERIOR
CALL RFORK1
IDIVI P1,2 ;MAKE THE POINTER TO THE CTTY
ADD P1,FKCTYP(P2)
LDB T1,P1 ;TTY. ARG TO UPDTI
CALLRET UPDTIR
RFORK5: HRRZ 1,FORKN
CALL MAPINF ;DO ALL IMMED INFERIORS
CALL RFORK1
HRRZ T1,FORKN
IDIVI T1,2 ;FIND THE FORK'S CTTY
ADD T1,FKCTYP(T2)
LDB T1,T1 ;ARG TO UPDTI
CALLRET UPDTIR
RFORK3: SKIPA 2,[XWD FRZB2,0] ;INDIRECT FREEZE BIT
RFORK1: MOVSI 2,FRZB1 ;DIRECT FREEZE BIT
HRRZ 7,SYSFK(1)
TDNN 2,FKINT(7) ;FROZEN THIS WAY?
RET ;NO
ANDCAB 2,FKINT(7) ;CLEAR THIS TYPE OF FREEZE
TLNE 2,FRZBB ;ALL TYPES OF FREEZE NOW CLEARED?
RET ;NO, LEAVE FORK FROZEN
HRLM 1,0(P) ;SAVE CURRENT FORK
CALL MAPINF ;CLEAR INDIRECT FREEZE ON INFERIORS
CALL RFORK3
HLRZ 1,0(P)
HRRZ FX,SYSFK(T1) ;SYSTEM FORK INDEX
XHLLI T2,. ;FIND CURRENT SECTION
HLLM T2,0(P) ;SET IT IN RETURN PC
MOVSI T2,JTFRZB ;FROZEN BY JSYS TRAP?
TDNE T2,FKINT(FX) ; ?
RET ;YES. DON'T RESUME.
MOVSI T2,ABFRZB ;CLEAR ADDRESS BREAK FREEZE
ANDCAM T2,FKINT(FX) ; ..
CALL STPFK1 ;SET TO UNFREEZE THIS FORK
SKIPN 2,PIOLDS(1) ;WAS ON WTLST BEFORE FREEZE?
JRST [ CALL UNBLK1 ;UNBLOCK IT
JRST RFORK4]
MOVEM 2,FKSTAT(7)
CALL RECONC ;UPDATE WAIT LISTS
RFORK4: CALL CLRSFK ;UNSUSPEND FORK
OKSKED ;MATCH NOSKED IN STPFK1 (SUSFK)
JRST CLRLFK
;(INDIRECTLY) RESUME ALL INFERIORS
RALLI: MOVE T1,FORKN
CALL MAPINF
CALL RFORK3 ;XCTED BY MAPINF
RET
;BREAKPOINT JSYS FOR IDDT
.BPT:: MCENT
JRST HALTF1 ;MAKE LIKE HALTF
;PERPETUAL WAIT - INTERRUPTABLE
.WAIT:: MCENT
WAIT1:: MOVEI 1,JRET
MOVSI T2,FHV2 ;LOWER BLOCK PRIORITY
HDISMS
JRST MRETN
;SPECIAL ROUTINES CALLED FROM HANG-UP CODE TO INDIRECTLY FRREZE OR
;UNFREEZE ALL INFERIORS. THIS TECHNIQUE IS USED (RATHER THAN FFORK
;AND RFORK) IN ORDER TO PRESERVE THE FROZENNESS OF FORKS ACROSS
;A HANGUP ATTATCH SEQUENCE.
;FORK FREEZE INDIRECT:
FFORKI::CALL FLOCK ;LOCK UP THE JOB FORK STRUCTURE
HRRZ T1,FORKN ;GET RELATIVE HANDLE FOR THIS PROCESS
CALL MAPINF ;MAP ALL INFERIORS
CALL FFORK3 ;INDIRECTLY FREEZE THEM ALL
FORKI: CALL UPDTI ;UPDATE TTY PI WORDS
CALL FUNLK ;UNLOCK FORK STRUCTURE
RET ;AND DONE
;RESUME FREEZE INDIRECT
RFORKI::CALL FLOCK ;LOCK UP FORK STRUCTURE
HRRZ T1,FORKN ;GET JOB WIDE INDEX
CALL MAPINF ;MAP ALL INFERIORS
CALL RFORK3 ;INDIRECT RESUME OF ALL INFERIORS
JRST FORKI ;AND DONE
;READ FORK STATUS
.RFSTS::MCENT
TXNE T1,^-<RF%LNG!RF%PRH> ;ANY RESERVED BITS NON-0?
ITERR (DECRSV)
CALL FLOCK ;LOCK THE FORK STRUCTURE
MOVE P1,[-1] ;ASSUME FORK HANDLE IS UNASSIGNED, STATUS=-1
HRRZ T1,T1 ;USE ONLY 18 BITS
TRNE T1,200000 ;LOCAL DESIGNATOR?
JRST RFSTS5 ;NO
CAIN T1,400000 ;SELF?
JRST RFSTS5 ;YES - DONT TRANSLATE HANDLE
CALL RFHJFK ;CONVERT SINGLE FORK RFH TO JRFN
JRST ITFRKR ;ERROR - ERR CODE IN T1
CAIGE T1,NUFKS ;ASSIGNED?
SKIPG SYSFK(T1)
JRST RFSTS7 ;NO-- RETURN -1
JRST RFSTS6 ;YES
RFSTS5: CALL SETJFK ;NOT MULTIPLE FORKS
RFSTS6: HRRZ FX,SYSFK(T1) ;GET SYSTEM FORK INDEX
MOVE P1,T1 ;SAVE JOB INDEX
CALL MRFSTS ;GET FORK STATUS WORD
EXCH P1,T1 ;SAVE STATUS. GET BACK JOB INDEX
CALL SETLF1 ;MAP PSB
RFSTS7: UMOVE T2,1 ;GET USER AC1
TXNE T2,RF%LNG ;LONG FORM RFSTS?
JRST RFSLNG ;YES-- DO LONG FORM
CAMN P1,[EXP -1] ;UNASSIGNED FORK HANDLE?
JRST RFSTSR ;YES-- JUST RETURN STATUS
HLLZ T3,PFL(T1) ;GET FLAGS
MOVE T2,PPC(T1) ;GET PC
TXNN T3,UMODF ;USER MODE?
JRST [ HLLZ T3,UPDL+1(T1) ;NO, USER PC IS FIRST ON STACK
MOVE T2,UPDL+0(T1) ;AND GET THE PC
TXZ T3,UMODF ;BUT TURN OFF USER BIT FOR INFO
JRST .+1]
TXZ T2,PCX ;IGNORE UNUSED PC BITS
TLNN T2,-1 ;SECTION 0?
IOR T2,T3 ;YES. FORM SECTION 0 PC WORD THEN
UMOVEM T2,2
CALL CLRLFK
RFSTSR: UMOVEM P1,1
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
JRST MRETN
;HERE FOR LONG FORM OF RFSTS CALL
; T1/ PSB OFFSET FOR PROCESS TO READ STATUS
RFSLNG: UMOVE Q1,2 ;GET ADDRESS OF ARGUMENT BLOCK
XCTU [HRRZ T2,.RFCNT(Q1)] ;GET USER'S MAX COUNT
MOVEI T3,RFSMAX ;ASSUME MAX ENTRIES ARE LEGAL
CAMN P1,[EXP -1] ;UNASSIGNED FORK HANDLE?
MOVEI T3,.RFPSW+1 ;YES-- JUST RETURN STATUS WORD
CAMLE T2,T3 ;USER'S LENGTH TOO BIG?
MOVE T2,T3 ;YES-- ONLY GIVE WHAT WE HAVE
MOVN T2,T2 ;FORM
HRL Q1,T2 ; AOBJN POINTER TO USER TABLE
MOVEI Q2,.RFPSW ;FIRST WORD IS PROCESS STATUS WORD
AOBJP Q1,RFSLN2 ;SKIP COUNT WORD, DO NOTHING IF ONLY COUNT!
RFSLN1:
CALL @RFSLTB-.RFPSW(Q2) ;GET A WORD FOR TABLE INTO T2
UMOVEM T2,0(Q1) ;STORE THE WORD
ADDI Q2,1 ;BUMP TO NEXT ENTRY
AOBJN Q1,RFSLN1 ;LOOP FOR ALL ITEMS TO BE RETURNED
RFSLN2:
CALL CLRLFK ;RESET PSB MAPPING
CALL FUNLK ;UNLOCK FORK STRUCTURE
UMOVE T2,2 ;GET TABLE ADDRESS BACK
XCTU [HRLM Q2,.RFCNT(T2)] ;STORE COUNT OF WORDS RETURNED
JRST MRETN ;RETURN NOW
;DISPATCH TABLE FOR LONG RFSTS BLOCK ENTRIES
; CALL ROUTINE WITH T1/ PSB OFFSET
; RETURN WITH T2/ DATA WORD FOR THIS ITEM
RFSLTB: DTBDSP (RFSLSW) ;.RFPSW -- PROCESS STATUS WORD
DTBDSP (RFSLFL) ;.RFPFL -- PROCESS' PC FLAGS
DTBDSP (RFSLPC) ;.RFPPC -- PROCESS' PC
DTBDSP (RFSLSF) ;.RFSFL -- PROCESS STATUS FLAGS
RFSMAX==.-RFSLTB+.RFPSW
;PROCESS STATUS WORD
RFSLSW: MOVE T2,P1 ;GET STATUS WORD
RET ;RETURN FROM RFSLSW
;PROCESS' PC FLAGS
RFSLFL: HLLZ T2,PFL(T1) ;GET FLAGS
TXNN T2,UMODF ;IN USER MODE?
JRST [ MOVE T2,UPDL+1(T1) ;NO-- GET FLAGS FROM STACK
TXZ T2,UMODF ;BUT CLEAR USER AS FLAG
JRST .+1]
RET ;RETURN FROM RFSLFL
;PROCESS' PC
RFSLPC: MOVE T2,PPC(T1) ;GET PROCESS' PC
MOVE T3,PFL(T1) ;GET FLAGS
TXNN T3,UMODF ;USER MODE?
MOVE T2,UPDL+0(T1) ;NO-- GET PC FROM STACK
TXZ T2,PCX ;CLEAR UNUSED PC BITS
RET ;RETURN FROM RFSLPC
;PROCESS STATUS FLAGS
RFSLSF: MOVX T2,0 ;ASSUME NONE
MOVE T3,FORKN(T1) ;GET JRFN FOR THIS PROCESS
JE SFEXO,(T3),RFSLS1 ;NOT EXECUTE-ONLY-- GO ON
TXO T2,RF%EXO ;EXECUTE-ONLY-- SET FLAG
RFSLS1: RET ;RETURN FROM RSFLSF
;MONITOR READ FORK STATUS
;FX/ SYSTEM FORK INDEX
; CALL MRFSTS
;RETURNS+1(ALWAYS):
;T1/ FORK STATUS
;**WARNING** IF FX POINTS TO A FORK IN A JOB DIFFERENT FROM THAT OF THE
; CURRENT FORK, YOU MUST INSURE THE FORK CANNOT BE KILLED
; OUT FROM UNDER YOU.(NOSKED IS ONE SOLUTION)
MRFSTS: CAME FX,FORKX ;SAME AS CURRENT CONTEXT?
JRST MRFST1 ;NO - GO ON
CHKINT ;INSURE UP TO DATE STATUS
CONI PI,T1 ;INSURE INTERRUPT ACCEPTED
TLNE T1,1_<SCDCHN-7> ;REQUEST STILL PENDING?
JRST .-2 ;YES - WAIT
MRFST1: SETZ T1, ;INITIALIZE T1
MOVE T2,FKSWP(FX)
TXNN T2,FKBLK ;FORK BLOCKED?
JRST MRFSTX ;NOT WAITING, RETURN ZERO
HRRZ T2,FKSTAT(FX) ;IS WAITING, GET STATE
CAIN T2,FRZWT ;FROZEN?
JRST RFST4 ;YES
RFST5: CAIN T2,FORCTM ;FORCED TERMINATION?
JRST RFST3 ;YES
CAIN T2,HALTT ;REGULAR TERMINATION?
JRST RFST2 ;YES
CAIE T2,TRMTST ;WAITING FOR FORK TERMINATION
CAIN T2,TRMTS1 ;EITHER FLAVOR?
JRST RFST6 ;YES
CAIE T2,BLOCKM ;IN A DISMS?
CAIN T2,BLOCKW
JRST RFST7 ;YES
CAIE T2,BLOCKT ;LONG BLOCK?
CAIN T2,HIBERT ;OR HIBER JSYS?
JRST RFST7 ;YES
CAIN T2,JRET ;WAITING INDEFINITELY?
JRST RFST7 ;YES
TLO T1,.RFIO ;N.O.T.A., MUST BE I/O
JRST MRFSTX
RFST2: TLO T1,.RFHLT ;REGULAR TERMINATION GIVES 2
JRST MRFSTX
RFST6: TLO T1,.RFWAT
JRST MRFSTX
RFST3: PUSH P,T1
MOVE T1,FX ;COPY FORK INDEX
CALL SETLF3 ;MAP PSB
MOVE T2,FORCTC(T1) ;GET CHANNEL CAUSING FORCED TERM
HRRM T2,0(P) ;PUT IN RH OF STATUS WORD
CALL CLRLFK
POP P,T1
TLO T1,.RFFPT ;WITH 3 INDICATING FORCED TERM
JRST MRFSTX
RFST4: TLO T1,400000 ;FROZEN, INDICATE IN BIT 0
MOVE T2,FKINT(FX) ;ADDRESS BREAK?
TLNE T2,ABFRZB ; ?
JRST [ TLO T1,.RFABK ;YES, RETURN PROPER CODE
JRST MRFSTX] ; ..
TLNE T2,JTFRZB ;NO, MAYBE JSYS TRAPPED?
TLOA T1,.RFTRP ;IT IS, FLAG IT.
CAIA
JRST MRFSTX ;AND RETURN THAT
HLRZ T2,FKSTAT(FX) ;AND GET OLD STATUS
JUMPE T2,MRFSTX
JRST RFST5
RFST7: TLO T1,5 ;DISMS'ING
MRFSTX: RET ;COMMON EXIT
;START FORK VIA ENTRY VECTOR
.SFRKV::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETJFK
PUSH P,T1
UMOVE T2,2 ;Get user's start offset
CAIGE T2,0 ;Must be positive number
ERRJMP (SFRVX1,ITFRKR)
HRRZ T3,T2 ;Get position in vector
CAILE T3,1 ;Is offset 0 or 1?
CALL CHKNXS ;No-- make sure not execute-only
CALL SETLF1
HLRZ T3,ENTVEC(T1) ;SIZE OF VEC IN DEST FORK
CAIE T3,<JRST>B53 ;TOPS-10 style vector?
JRST SFKV01 ;No-- go on
MOVEI T3,2 ;Yes-- length is 2
CAMN T2,[XWD 1,0] ;This CCL start position?
JRST SFKV02 ;Yes-- all checking done
SFKV01: CAIL T3,1 ;REASONABLE VECTOR LENGTH?
CAIL T3,1000
JRST SFRKV2 ;NO
CAIL T2,0(T3) ;LEGAL ARG?
JRST SFRKV2 ;NO
SFKV02: MOVEM T2,FORCTC(T1) ;LEAVE FOR FOR TO START SELF
CALL CLRLFK
POP P,T1 ;RECOVER JOB HANDLE
HRRZ T2,FORKN ;GET JOB HANDLE FOR THIS FORK
CAMN T1,T2 ;SAME?
JRST [ CALL FUNLK ;YES, UNLOCK AND CONTINUE IN SAME FORK
CALL SFRKV5 ;CONSTRUCT NEW PC
MOVEM T1,0(P) ;STORE FLAGS
MOVEM T2,-1(P) ;STORE ADDRESS
JRST MRETN] ;RETURN TO IT
CALL STPFK
MOVE T2,[PCU+SFRKV1] ;START FORK IN MONITOR
JRST SFORK1
SFRKV2: CALL CLRLFK
ERRJMP(SFRVX1,ITFRKR) ;ILLEGAL RELATIVE NUMBER
SFRKV1: MOVE P,UPP ;SETUP STACK
CALL SFRKV5 ;CONSTRUCT NEW PC
DMOVEM T1,FFL ;SETUP FLAGS AND PC
JRST GOUSR ;RETURN TO IT
;CONSTRUCT ADDRESS FROM ENTRY VECTOR PARAMETERS
SFRKV5: HRRZ T1,ENTVEC
HRRZ T2,FORCTC ;RELATIVE ADDRESS
HLRZ T3,ENTVEC ;SIZE OR JRST
CAIN T3,<JRST>B53 ;OLD STYLE?
JRST [ CAIN T2,0 ;YES, 0 MEANS .JBSA
UMOVE T1,.JBSA
CAIN T2,1 ;1 MEANS .JBREN
UMOVE T1,.JBREN
HLRZ T2,FORCTC ;Get start offset
JRST .+1]
ADD T1,T2
HRRZ T2,T1
MOVX T1,UMODF ;MAKE IT A USER PC
RET
;START FORK
.SFORK::MCENT
TXNE T1,^-<SF%CON!SF%PRH> ;ANY UNKNOWN BITS SET?
ITERR (DECRSV) ;YES-- GIVE ERROR
CALL FLOCK ;LOCK THE FORK STRUCTURE
UMOVE T1,1 ;GET ARG AGAIN
CALL SETJFK
UMOVE T2,1 ;GET FLAGS/PROCESS HANDLE FROM USER
TXNE T2,SF%CON ;CONTINUE PROCESS ONLY?
JRST [ PUSH P,T1 ;SAVE JOB-WIDE HANDLE
OPSTR <SKIPN>,SFSRT,(T1) ;HAS FORK BEEN STARTED?
ITERR (FRKHX5,<CALL FUNLK>) ;NO, UNLOCK AND GIVE ERROR
HRRZ FX,SYSFK(T1) ;GET SYSTEM HANDLE
CALL MRFSTS ;GET STATUS OF FORK
LOAD T2,RF%STS,T1 ;GET STATUS
POP P,T1 ;RESTORE HANDLE
CAIE T2,.RFHLT ;HALTED?
CAIN T2,.RFFPT ;OR FORCED TERMINATION?
SKIPA ;YES
JRST CLFLK0 ;NO. RETURN NOW
CALL STPFK ;YES. STOP IT BEFORE STARTING IT
JRST SFORK2] ;AND PROCEED
;PROCESS TO BE STARTED-- MUST SETUP CONTEXT
CALL CHKNXS ;Check for execute-only
CALL STPFK ;STOP FORK
UMOVE T2,2
TLZ T2,(UIOF+2037B17) ;USER I/O, CALFRMMON, IDX AND IND OFF
TLO T2,(UMODF) ;AND USER ON
SFORK1: SETOM SLOWF(T1) ;NORMALIZE FLAG
PUSH P,PFL(T1)
HLLZM T2,PFL(T1) ;FIND FLAGS
HRRZM T2,PPC(T1) ;AND PC
HRRZ T2,FORKN(T1) ;GET JOB FORK NUMBER
SETONE SFSRT,(T2) ;FLAG THAT FORK HAS BEEN STARTED
POP P,T2 ;OLD PC
TXNE T2,UMODF ;FORK WAS IN USER MODE?
JRST SFORK2 ;YES, ACS ALREADY IN RIGHT PLACE
HRRZ T2,ACBAS(T1)
CAIGE T2,<UACB>B39 ;IN NESTED MONITOR CALL?
JRST SFORK2 ;NO, ACS ALREADY IN RIGHT PLACE
MOVSI T2,UACB(T1) ;MUST MOVE ACS FROM AC STACK
HRRI T2,UAC(T1) ; TO SAVED BLOCK 1
BLT T2,UAC+17(T1)
SFORK2: HRRZS FKSTAT(FX) ;CLEAR LH IN CASE FROZEN
SETZM PIOLDS(T1) ;SET PRE-FREEZE STATE TO RUNNING
PUSH P,T1 ;SAVE PSB POINTER
HLLZ T2,PSIBIP(T1) ;PASS FORK'S CURRENT INTERRUPT STATE
HRRZ T1,FORKN(T1) ;GET THIS FORKS JOB ID
HRRZ T1,SYSFK(T1) ;GET SYSTEM ID
PUSH P,T1 ;SAVE FORK
PUSH P,T2 ;SAVE PSB STATE
OKSKED ;MUST DO THIS IN CASE JSBSTF OR GOKFRE BLOCK
CALL JSBSTF ;GO DO ANY DEALLOCATIONS
POP P,T2 ;RESTORE T2
POP P,T1 ;GET FORK AGAIN
CALL GOKFRE ;FREE GETOK REQUESTS
CALL SUSFK ;MAKE SURE FORK STILL SUSPENDED
POP P,T1 ;RECOVER PSB POINTER
MOVSI T2,FRZBAL
TDNE T2,FKINT(FX) ;FORK FROZEN?
JRST SFORK3 ;YES, DON'T START IT NOW
PUSH P,T1
CALL UNBLK1 ;UNBLOCK IT
POP P,T1
CALL CLRSFK ;NOW CLEAR SUSPENSION
SFORK3: MOVE T1,FORKN(T1) ;FIND THAT FORK'S CTTY
IDIVI T1,2
ADD T1,FKCTYP(T2) ;POINTER TO CTTY
LDB T1,T1 ;GET THE CTTY
CALL UPDTI
OKSKED ;MATCH NOSKED IN STPFK (SUSFK)
CALLRET CLFRET
;MONITOR SFORK, CAN START IN MONITOR SPACE
.MSFRK::MCENT
MOVE 3,0(P) ;THIS IS LEGAL IF CALLED FROM
MOVE 4,CAPENB ;MONITOR MODE, OR IF SC%WHL OR
TLNE 3,(UMODF) ;OPERATOR CAPABILITIES ARE PRESENT
;**;[1721] Change 1 line at .MSFRK: +4L JGZ 2-JUN-80
TXNE T4,SC%WHL+SC%OPR ;[1721]MAKE THE CHECK
JRST .+2
ITERR(CAPX1) ;USER LACKS CAPABILITY
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETJFK
CALL STPFK ;SAME STUFF AS SFORK
MOVEI T2,MFRKWD ;GET PRIORITY WORD FOR MONITOR FORKS
SKIPN JOBSKD ;DOES JOB HAVE PRIORITY?
SKIPE JOBBIT(T1) ;NO. DOES THE PROCESS ALREADY HAVE SOME?
SKIPA ;YES. DON'T SET IT
MOVEM T2,JOBBIT(T1) ;DOESN'T
UMOVE 2,2 ;EXCEPT BELIEVE PC AND ALL FLAGS
JRST SFORK1
;STOP FORK, USED BY SEVERAL FORK JSYS'S
STPFK: CALL SKIIF ;JOB FORK NUMBER IN 1, IS INFERIOR?
JRST FRKE2 ;NO
STPFK1: MOVE 6,1
HRRZ 7,SYSFK(6)
CAMN 7,FORKX ;THIS SAME FORK?
JRST FRKE1 ;YES, ILLEGAL
CALL SETLF1 ;MAP PSB
CALLRET SUSFK ;SUSPEND FORK
;READ/SET FORK AC'S
.RFACS::MCENT
XCTU [MOVES 0(2)] ;Test existence/writeability before NOSKED
XCTU [MOVES 17(2)] ; of whole block
CALL FACS
MOVEI T1,20 ;ALL ACS
EXCH T2,T3 ;GET ARGS IN RIGHT ORDER
CALL BLTMU1 ;DO BLT TO USER
JRST FACSR ;RETURN
.SFACS::MCENT
XCTU [SKIP 0(2)] ;Test existnece before NOSKED
XCTU [SKIP 17(2)] ; of whole block
CALL FACS
MOVEI T1,20 ;MOVE ACS
CALL BLTUM1 ;MOVE ACS TO MONITOR
; JRST FACSR ;RETURN
FACSR: OKSKED
JRST CLFRET
;COMMON AC ROUTINE
FACS: CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETJFK ;ONE FORK ONLY
CALL SKIIF ;AND IT MUST BE INFERIOR
JRST FRKE2 ;NOT INFERIOR
CALL CHKNXS ;Check for execute-only process
MOVE 6,1
HRRZ 7,SYSFK(6)
CALL SETLF1 ;MAP PSB
NOSKED
MOVE T2,FKSWP(FX)
TXNN T2,FKBLK ;FORK BLOCKED?
ERRJMP(FRKHX4,FACSE) ;NO
MOVE T2,PFL(T1) ;GET CURRENT PC
HRRZ T3,ACBAS(T1) ;GET AC STACK PTR
TXNN 2,UMODF ;IN USER MODE?
CAIGE 3,<UACB>B39 ;OR TOP-LEVEL MON CALL?
SKIPA 3,[UAC] ;YES, ACS IN SAVED BLOCK 1
MOVEI 3,UACB ;NO, ACS IN TOP OF AC STACK
ADDI 3,0(1) ;ADJUST INTO OTHER PSB
XCTU [MOVE 2,2] ;GET ADDRESS FROM USER
RET
FACSE: OKSKED
PUSH P,1 ;SAVE THE ERROR CODE
CALL CLRLFK
POP P,1 ;RESTORE ERROR CODE
JRST ITFRKR
;HALT FORK
.HFORK::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
HRRZ 1,1
CAIN 1,-4 ;ALL INFERIORS?
JRST [ MOVX T2,<CALL HFORK1> ;ROUTINE TO EXECUTE
CALL MAPFKH ;MAP OVER ALL FORKS
NOP ;WON'T BLOCK
JRST HFORK4]
CALL SETJFK ;NO, SOME ONE FORK
CAMN 1,FORKN ;SELF?
ERRJMP(HFRKX1,EFRKR) ;YES, RETURN ERROR
CALL SKIIF ;IS DESIGNATED FORK AN INFERIOR?
JRST FRKE2 ;NO, ILLEGAL
CALL HFORK1 ;DO THE WORK
HFORK4: CALL FUNLK
JRST MRETN
HFORK1: PUSH P,1 ;SAVE FORK NUMBER
CALL STPFK ;STOP THE FORK
MOVEI 2,HALTT
MOVSI 3,FRZBAL
TDNE 3,FKINT(7) ;FROZEN?
JRST [ HRLM 2,FKSTAT(7) ;YET, UPDATE PRE-FREEZE STATE
MOVEM 2,PIOLDS(1)
JRST HFORK2]
MOVEM 2,FKSTAT(7) ;TERMINATED STATE
CALL CLRSFK ;BUT INTERRUPTABLE
HFORK2: MOVE 1,0(P)
ADD 1,SUPERP ;GET SUPERIOR
LDB 1,1
HRRZ 1,SYSFK(1) ;GET SYSTEM INDEX
CALL SUPUB0 ;WAKEUP SUPERIOR IF NECESSARY
HFORK3: MOVE T1,0(P)
OKSKED ;MATCH NOSKED IN STPFK (SUSFK)
CALL CLRLFK
POP P,T3 ;FORKN OF OTHER FORK
IDIVI T3,2 ;FIND THAT FORK'S CTTY
ADD T3,FKCTYP(T4) ;POINT TO THE CTTY
LDB T1,T3 ;GET THE DESIGNATOR
CALLRET UPDTI ;UPDATE TERM INT WORD
;CALL FROM TTY SERVICE TO RESOLVE FORK CONFLICT
TTFRKT::SKIPGE FKPT(1) ;FORK STILL EXISTS?
RET ;NO
HRRZ 2,FKSTAT(1) ;GET ITS STATUS
CAIE 2,TCITST ;STILL WAITING FOR TTY?
RET ;NO
MOVSI 3,-NUFKS ;SETUP TO SEARCH FOR FORK
SKIPL 2,SYSFK(3) ;THIS SLOT IN USE?
CAIE 1,0(2) ;AND HAS CORRECT FORKX?
AOBJN 3,.-2 ;NO
JUMPGE 3,R ;RETURN IF NOT FOUND IN THIS JOB
PUSH P,A ;SAVE FORK HANDLE IN CASE
MOVEI 1,0(3) ;FORKN OF OTHER FORK
CALL SKIIF ;IS IT INFERIOR
JRST [ MOVEI T1,^D1000 ;NO, WAIT AWHILE
DISMS
POP P,A ;GET BACK HANDLE OF THE FORK
JRST TTFRKT] ;TRY AGAIN
POP P,0(P) ;CLEAN UP STACK
SAVEPQ ;SAVE ALL PERMANENT REGS
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL HFORK1 ;HALT THE OTHER GUY
CALLRET FUNLK ;UNLOCK AND RETURN
;WAIT FOR FORK TO TERMINATE
.WFORK::MCENT
CAIN 1,-4 ;ALL INFERIORS?
JRST WFORKA ;YES
CALL FLOCK ;LOCK THE FORK STRUCTURE
MOVE T2,FORKX
SETZRO FKSPL,(T2) ;RESET INFERIOR SPLICED EVENT
CALL SETJFK ;ONE FORK, GET ITS JOB HANDLE
HRLZ 1,SYSFK(1) ;SETUP TEST ON FORK INDEX
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
HRRI 1,TRMTST
MOVSI T2,FHV1 ;LOW BLOCK PRIORITY
HDISMS
MOVE T1,FORKX
JE FKSPL,(T1),MRETN ;NOT DUE TO SPLICE, RETURN
UMOVE T1,T1
JRST .WFORK ;RE-EVALUATE FORK HANDLE AND DO AGAIN
WFORKA::MOVSI D,-NLFKS+1 ;NUMBER TO DO
MOVE C,FKPTAB ;GET POINTER TO HANDLES
WFORK3: ILDB A,C ;GET NEXT HANDLE
CAIN A,-1 ;ASSIGNED?
JRST WFORK4 ;NO. LOOP TO NEXT THEN
MOVEI A,.FHSLF+1(D) ;GET NEXT HANDLE
RFSTS ;GET STATUS
CAMN A,[-1] ;IS IT DELETED?
JRST WFORK4 ;YES. GO DO NEXT THEN
LOAD A,RF%STS,A ;GET STATUS
CAIE A,.RFHLT ;HALTED?
CAIN A,.RFFPT ;NO. ERROR ABORT?
JRST MRETN ;YES. RETURN GOOD
WFORK4: AOBJN D,WFORK3 ;NO. LOOK AT ALL LOCALS
MOVEI A,TRMTS1 ;SETUP TEST TO WAIT UNTIL CHANGED
MOVSI T2,FHV1 ;LOW BLOCK PRIORITY
HDISMS
JRST MRETN
RESCD
TRMTST::
JN FKSPL,(FX),1(T4) ;GET OUT IF INFERIOR SPLICED
MOVE T2,FKSWP(T1)
TXNN T2,FKBLK ;FORK BLOCKED?
JRST 0(4) ;NO
HRRZ 2,FKSTAT(1)
CAIE 2,HALTT ;WAITING BECAUSE TERMINATION?
CAIN 2,FORCTM ;OR FORCED TERM?
JRST 1(4) ;YES
;**;[2645]ADD 6 LINES AT TRMTST:+7L TAM 4-AUG-82
CAIE T2,FRZWT ;[2645]FROZEN?
JRST 0(4) ;[2645]NO WAIT
HLRZ 2,FKSTAT(1) ;[2645]GET PRE FREEZE STATE
CAIE 2,HALTT ;[2645]HALTED?
;**;[2804]CHANGE 1 [2645] LINE AT TRMTST:+12L TAM 8-SEP-82
CAIN 2,FORCTM ;[2645][2804]OR FORCED TERM?
JRST 1(4) ;[2645]YES
JRST 0(4) ;NO, KEEP WAITING
TRMTS1::JRST 0(4)
SWAPCD
;SUSPEND FORK SO IT CAN BE DIDDLED
; RETURNS NOSKED SO THAT CALLER CAN FINISH CHANGING STATE RACE-FREE
SUSFK: SAVEAC <T1,T2>
CAMN 7,FORKX
BUG(FRKSLF)
SUSF6: NOSKED
MOVE T2,FKSWP(FX)
TXNN T2,FKBLK ;FORK BLOCKED NOW?
JRST SUSF4 ;NO
HRRZ 2,FKSTAT(7) ;GET WAITING STATUS
CAIE 2,SUSWT ;ALREADY SUSPENDED OR FROZEN?
CAIN 2,FRZWT
RET
CAIN 2,TCITST ;WAS IN TTYIN WAIT?
JRST [ HLRZ 2,FKSTAT(7) ;YES, GET TERMINAL NUMBER
CALL TTCLFK ;INDICATE NO FORK WAITING
JRST .+1]
SUSF5: MOVSI 1,400000+SUSFKR ;SUSPEND FORK REQUEST BIT FOR PSI
IORM 1,FKINT(7) ;LEAVE IT FOR SPECIFIED FORK
MOVEI 2,0(7)
CALL PSIR4 ;INTERRUPT THE FORK
OKSKED
MOVSI 1,0(7) ;SETUP SCHEDULER TEST TO WAIT
HRRI 1,SUSFKT ;UNTIL FORK HAS SUSPENDED ITSELF
MOVSI T2,FHV5 ;HIGHER BLOCK PRIORITY
HDISMS
JRST SUSF6 ;NOW CHECK IT AGAIN
SUSF4: SKIPN FKINT(7) ;TRANSITIONAL STATE?
JRST SUSF5 ;NO
MOVSI 1,400000+SUSFKR ;YES, REQUEST INTERRUPT
IORM 1,FKINT(7)
MOVEI 2,0(7)
CALL PSIR4
OKSKED ;THEN WAIT TO BE SURE IT WAS RECEIVED
MOVEI 1,^D50
DISMS
JRST SUSF6 ;AND CHECK AGAIN
;SCHEDULER TEST FOR SUSPENSION
RESCD
SUSFKT::MOVE T2,FKSWP(T1)
TXNN T2,FKBLK ;FORK BLOCKED?
JRST 0(4)
HRRZ 2,FKSTAT(1)
CAIE 2,SUSWT ;SUSPENSION?
CAIN 2,FRZWT
JRST 1(4)
JRST 0(4)
SWAPCD
;CLEAR FORK WHICH HAD BEEN SUSPENDED
CLRSFK: MOVSI 2,200000
ANDCAM 2,FKINT(FX) ;CLEAR PSI STARTING STATE
PUSH P,1
SETZ 1,
MOVE 2,FX
CALL PSIRQB ;REQUEST TO RECHECK PENDING PSI'S
POP P,1
RET
;MAP ALL IMMEDIATE INFERIORS OF FORK IN 1
; EXECUTES +1 FOR EACH FORK
; RETURNS +2
MAPINF: ADD 1,INFERP
MAPIF1: LDB 1,1
JUMPE 1,MAPIF2
HRLM 1,0(P)
HRRZ T2,0(P) ;GET CALLER PC
XCT 0(T2) ;EXECUTE INSTRUCTION AT CALL+1
HLRZ 1,0(P)
ADD 1,PARALP
JRST MAPIF1
MAPIF2: XHLLI 2,20 ;FIND CURRENT SECTION
HLLM 2,0(P) ;RESTORE IT FOR RETSKP
JRST RSKP ;RETURN
;GET FORK STRUCTURE
;RETURNS A COPY OF THE JOB FORK STRUCTURE FROM A SPECIFIED
;STARTING POINT DOWNWARD.
;CALL
;1/ HANDLE ON INITIAL FORK
;2/ FLAGS - GF%GFH TO GET RELATIVE FORK HANDLES, GF%GFS TO DO RFSTS
;3/ -LENGTH,,START ADDR OF USER AREA TO RETURN FORK STRUCTURE IN
;EACH FORK IS REPRESENTED IN THE STRUCTURE BY A 3 WORD BLOCK:
;WD0: PARALLEL PTR,,INFERIOR PTR
;WD1: SUPERIOR PTR,,RELATIVE FORK HANDLE(IF REQUESTED)
;WD3: STATUS WORD (IF REQUESTED - ELSE -1)
;NOTE: EVEN IF GF%GFH IS OFF,PREVIOUSLY ACQUIRED FORK HANDLES WILL BE
; GIVEN FOR FORKS APPEARING IN THE RETURNED STRUCTURE.
;AC USAGE
;GLOBALS
;Q1/ REMAINING FREE AREA,,NEXT FREE CELL (USER ADDR)
;Q2/ GF%GFH!GF%GFS - COPIES OF UAC2; B17 - LOCAL FLAG
; FOR RFH SPACE EXHAUSTED. RH CONTAINS JRFN OF STARTING FORK
;RECURSIVE VARIABLES
;P1/ CURRENT JRFN,,USER ADDR OF CORRESPONDING BLOCK
.GFRKS::MCENT
HRRZ T1,T1 ;IGNORE LH T1
MOVE Q1,T3 ;INITIALIZE FREE POINTER
;**;[3125]Change 1 line at .GFRKS: + 3L TAB 18-JUN-84
;**;[3006]Add 1 line at .GFRKS: + 3L TAB 29-AUG-83
SUB Q1,BITS+^D17 ;[3125]SUBTRACT [1,,0] FOR COUNTING SPACE.
MOVSI Q2,(GF%GFH!GF%GFS) ;COPY OPTIONAL COMMAND BITS
AND Q2,T2 ; ...
MOVE T2,T1 ;COPY SPECIFIED HANDLE
CALL FLOCK ;FREEZE FORK DATABASE
CALL STJFKR ;CONVERT RFH IN T1 TO JRFN
JRST [CAIE T2,.FHTOP ;TOP FORK?
JRST EFRKR ;NO - ERROR CODE STILL IN T1
HLRZ T1,FORKN ;YES - UNPRIVLEDGED REF TO TOP FORK
TLZ Q2,(GF%GFH) ;PROHIBIT ACQUISITION OF HANDLES
JRST .+1]
HRR Q2,T1 ;SET STARTING FORK JRFN
HRLZ P1,T1 ;SET INITIAL CURRENT FORK
PUSH P,[0] ;DUMMY UP SUPERIOR
CALL GFRKS1 ;WALK THE TREE
POP P,(P) ;SCRAP DUMMY SUPERIOR
CALL FUNLK ;RELEASE FORK LOCK
TLNN Q2,(1B17) ;WERE THERE ENOUGH RFH?
SMRETN ;YES - SKIP RETURN
RETERR(FRKHX6) ;NO - RETURN ERROR CODE
;PREORDER TRANSITION OF A N-ARY TREE
GFRKS1: HLRZ T1,P1 ;GET CURRENT JRFN
HRRZ T2,Q1 ;SAVE NEW BASE ADDR
ADD Q1,BHC+2 ;ALLOCATE NEW BLOCK
AOBJP Q1,[MOVEI T1,GFKSX1 ;SPACE EXHAUSTED
JRST EFRKR] ;ERROR RETURN
XCTU [SETZM (T2)] ;CLEAR OUT NEW BLOCK
XCTU [SETZM 1(T2)] ; ...
XCTU [SETOM 2(T2)] ; ...
XCTU [HRLM P1,(T2)] ;STORE PARALLEL POINTER
HRR P1,T2 ;UPDATE CURRENT POINTER
MOVE T2,-1(P) ;GET SUPERIOR POINTER
HRRZ P2,P1 ;GET ADDRESS ONLY
XCTU [HRLM T2,1(P2)] ;STORE SUPERIOR POINTER
CALL JFKRFH ;SEE IF A HANDLE ALREADY EXISTS
XCTU [HRRM T2,1(P2)] ;RETURN HANDLE OR ZERO
TLNN Q2,(GF%GFH) ;ASSIGN RFH?
JRST GFRKS2 ;NO - GO ON
CALL SKIIF ;IS JRFN IN T1 INFERIOR?
JRST GFRKS2 ;NO - DONT GIVE OUT HANDLE
CALL GFKH ;JRFN STILL IN T1, RETURNS RFH IN T1
TLOA Q2,(1B17) ;ERROR RETURN - RFH EXHAUSTED
XCTU [HRRM T1,1(P2)] ;RETURN RELATIVE FORK HANDLE
GFRKS2: TLNN Q2,(GF%GFS) ;FORK STATUS REQUESTED?
JRST GFRKS3 ;NO - GO ON TO INFERIORS
HLRZ T1,P1 ;YES - GET JRFN
HRRZ FX,SYSFK(T1) ;GET SYSTEM FORK INDEX
CALL MRFSTS ;DO RFSTS
UMOVEM T1,2(P2) ;STORE STATUS.
GFRKS3: HLRZ T1,P1 ;GET JRFN AGAIN
ADD T1,INFERP ;CHECK FOR INFERIORS
LDB T1,T1 ; ...
JUMPE T1,GFRKS4 ;NONE - GO ON TO PARALLEL
PUSH P,P1 ;SAVE RECURSIVE VARIABLES
HRLZ P1,T1 ;GET INF JRFN & CLEAR PAR. PTR
CALL GFRKS1 ;DO ALL INFERIORS
HRRZ P2,(P) ;GET CURRENT BLOCK BACK
XCTU [HRRM P1,(P2)] ;STORE INFERIOR LIST
POP P,P1 ;RESTORE RECURSIVE VARS
GFRKS4: HLRZ T1,P1 ;GET CURRENT JRFN BACK
CAIN T1,(Q2) ;TOP SPECIFIED FORK?
RET ;YES - DONT DO PARALLEL
ADD T1,PARALP ;SEE IF ANY PARALLEL
LDB T1,T1 ; ...
JUMPE T1,R ;NONE - DONE WITH THIS LEVEL
HRL P1,T1 ;LOOP FOR THIS LEVEL
JRST GFRKS1 ; ...
;ROUTINE TO MAP A JRFN TO RFH FROM CURRENT FORK
;T1/ JRFN
; CALL JFKRFH
;RETURNS+1(ALWAYS):
;T1/ JRFN (UNCHANGED)
;T2/ RFH OR 0 IF NONE
;T3/ BYTE POINTER TO FKTAB ENTRY CORRESPONDING TO RFH
JFKRFH: CAIGE T1,NUFKS ;REASONABLE JRFN?
JRST JFKRH1 ;YES - MAP IT
BUG(ILJRFN)
JRST JFKRH3 ;ACT AS IF NOT FOUND
JFKRH1: MOVEI T2,.FHSLF ;CHECK IF SELF FIRST
HRRZ T3,FORKN ; ...
CAMN T1,T3 ;SELF?
RET ;YES - RETURN
MOVE T4,[-NLFKS+1,,1] ;SETUP COUNT
MOVE T3,FKPTAB ;SETUP INIITAL POINTER
JFKRH2: ILDB T2,T3 ;GET JRFN CORRESPONDING TO RFH IN T4
CAIN T2,(T1) ;MATCH?
JRST JFKRH4 ;YES - RETURN RFH
AOBJN T4,JFKRH2 ;NO - LOOP
JFKRH3: SETZ T2, ;NO MATCH - RETURN 0
RET
JFKRH4: MOVEI T2,400000(T4) ;BUILD CORRESPONDING RFH
RET
;ROUTINE TO MAP A SINGLE LOCAL RFH TO A JRFN
;NOTE THE DIFFERENCE BETWEEN RFHJFK AND SETJFK/STJFKR.
;RFHJFK ALLOWS ONLY LOCAL FORK HANDLES AND IGNORES THE ISSUE
;OF HAVING A HANDLE ON A PREVIOUSLY KILLED FORK. RFHJFK SHOULD
;ONLY BE USED WHEN THE CALLER IS PREPARED TO HANDLE THIS
;CASE (RFSTS, RFRKH FOR EXAMPLE). SETJFK/STJFKR ARE INTENDED FOR
;MOST USES. THEY ALLOW ALL NON MULTIPLE HANDLES AND SUCCEED ONLY
;IF THERE IS A LIVE FORK UNDER THE GIVEN HANDLE.
;T1/ RFH
; CALL RFHJFK
;RETURNS+1(ERROR):
;T1/ ERROR CODE
;RETURNS+2(SUCCESS):
;T1/ JRFN
;ALL OTHER ACS UNCHANGED
RFHJFK: CAIL T1,400001 ;REASONABLE LOCAL HANDLE?
CAIL T1,400000+NLFKS ; ...
JRST FRKESR ;NO - FIGURE OUT ERROR CODE
TRZ T1,400000 ;YES - GET LOCAL INDEX
PUSH P,T2 ;BE TRANSPARENT WRT ACS
IDIVI T1,2 ;BUILD BYTE POINTER
ADD T1,FKPTAB(T2) ; ...
POP P,T2 ;RESTORE T2
LDB T1,T1 ;GET JRFN
CAIN T1,-1 ;IN USE?
JRST FRKE1R ;NO, GIVE ERROR RETURN
RETSKP ;SUCCESS RETURN
;GET FORK HANDLE.
;CALL WITH T1/ HANDLE ON KNOWING FORK, T2/ HANDLE IN
; KNOWING FORK ON DESIRED FORK
;
;RETURNS A (POSSIBLY NEW) HANDLE IN T1 USABLE BY CALLER.
.GFRKH:: MCENT ;ESTABLISH CONTEXT
CALL FLOCK ;LOCK FORK STRUCTURE
;**;[7109] DELETE 12.LINES AT .GFRKH:+2L DSW 7/25/85
ANDI T2,377777
CAIL T2,0 ;NEGATIVE IS ILLEGAL
CAIL T2,NLFKS ;A LEGIT FORK HANDLE?
;**;[7109] REWRITE CODE (REMOVING LABELS) AT .GFRKH:+5L DSW 7/25/85
ERRJMP (GFRKX1,EFRKR) ;NO. FAIL RETURN NONSKIP
CALL SETLF0 ;OK, SET UP THE PSB OF KNOWER
CAIE T2,0 ;WANT "SELF" OF KNOWER?
IFSKP.
MOVE T2,FORKN(T1) ;OH YEAH, COVER THIS SPECIAL CASE
ELSE. ;NO, NORMAL CASE FIND SYSFK INDEX 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
ENDIF.
CAIGE T2,NUFKS ;MAKE SURE IT'S ASSIGNED
SKIPGE SYSFK(T2) ;FORK STILL EXIST?
ERRJMP (GFRKX1,EFRKRC) ;NO, RETURN ERROR
MOVEI T1,(T2) ;OK, HERE'S THE DESIRED JOB FORK INDEX
CALL GFKH ;GET A FORK HANDLE IN THIS FORK FOR IT.
ERRJMP (FRKHX6,EFRKRC) ;COULDN'T. NO SPACE LEFT.
UMOVEM T1,T1 ;OK. RETURN H-PRIME TO USER.
CALL CLRLFK
CALL FUNLK ;UNLOCK FORK STRUCTURE
SMRETN ;AND SKIP RETURN TO HIM.
;RELEASE FORK HANDLE JSYS
;CALL
;1/ FORK HANDLE TO BE RELEASED
; RFRKH
;RETURNS+1:
;1/ ERROR CODE
;RETURNS+2:
;SUCCESS - AC UNCHANGED
.RFRKH::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CAMN A,[-1] ;WANT TO DO ALL OF THEM?
JRST RFRKH2 ;YES. GO DO IT THEN
CALL RFRKH0 ;GO DO THE WORK
JRST EFRKR ;FOUND AN ERROR. GO REPORT IT
CALL FUNLK ;FREE THE STRUCTURE
SMRETN ;AND RETURN GOOD
;INTERNAL ROUTINE TO RELEASE A FORK HANDLE
;ACCEPTS: A/ PROCESS RELATIVE FORK HANDLE
;RETURNS: +1 / CAN'T RELEASE HANDLE. REASON IN A
; +2/ HANDLE RELEASED AND ALL RELEVANT JOB FORK
; TABLES CLEANED UP
;WARNING: MUST BE CALLED WITH JOB FORK LOCK LOCKED
RFRKH0: CALL RFHJFK ;MAP RFH IN T1 TO JRFN
RET ;ERROR. CODE IN A
SKIPGE SYSFK(A) ;NOW ASSIGNED?
JRST RFRKH1 ;NO,IS OKAY TO DO IT.
LOAD B,FKHCNT,(A) ;IS INFERIOR. SEE ABOUT COUNT
CAIG B,1 ;NOW BEING SHARED?
JRST [ MOVEI A,FRKHX1 ;CAN'T RELEASE IT
RET] ;SO RETURN AN ERROR
RFRKH1: CALL DASFKH ;DEASSIGN FORK HANDLE
RETSKP ;GOOD RETURN
;ROUTINE TO RELEASE ALL HANDLES
RFRKH2: MOVE D,[-NLFKS+1,,1]
MOVE C,FKPTAB ;BEGINNING POINTER
RFRKH3: ILDB A,C ;GET POINTER
CAIN A,-1 ;IN USE?
JRST RFRKH4 ;NO
MOVEI A,.FHSLF(D) ;YES. GET RELATIVE HANDLE
PUSH P,C ;SAVE POINTER
PUSH P,D ;SAVE COUNTER
CALL RFRKH0 ;GO RELEASE IT
JFCL ;DON'T CARE
POP P,D
POP P,C ;RESTORE REGISTERS
RFRKH4: AOBJN D,RFRKH3 ;DO ALL HANDLES
CALL FUNLK ;FREE THE STRUCTURE
SMRETN ;AND DONE
;PERFORM FORK CONTROL FUNCTION FOR EACH FORK OF MULTIPLE FORK
;HANDLE (I.E. MAP A FUNCTION ONTO ALL FORKS)
; 1/ USER FORK HANDLE (SINGLE OR MULTIPLE)
; 2/ INSTRUCTION TO DO FOR EACH FORK
; CALL MAPFKH
; ;EXECUTE INSTRUCTION WITH JOB-WIDE
; HANDE IN T1
;RETURNS: +1 COROUTINE NEEDS TO BLOCK
; +2 ALL DONE
MAPFKH::CAIL 1,-5 ;IS IT A MULTIPLE FORK DESIGNATOR?
CAILE 1,-3
JRST [ PUSH P,T2 ;SAVE INST
CALL SETJFK ;GET HANDLE
POP P,T2 ;GET INST
XCT T2 ;DO IT
RETSKP ;DONE
RET] ;BLOCK
PUSH P,P6 ;SAVE FRAME POINTER
MOVE P6,P ;ESTABLISH FRAME
PUSH P,T2 ;SAVE INSTRUCTION
CALL MAPFT+5(1) ;DISPATCH TO APPROPRIATE FUNCTION
NOP ;NEVER GETS HERE
MOVE P,P6 ;RESTORE STACK
POP P,P6 ;RESTORE REG
RETSKP ;AND DONE
MAPFT: JRST MAPF5 ;-5, ALL FORKS IN JOB
JRST MAPF4 ;-4, ALL INFERIORS
JRST MAPF3 ;-3, SELF AND ALL INFERIORS
MAPF3: HRRZ 1,FORKN ;SELF
MAPF51: PUSH P,1
XCT 1(P6) ;DO INSTRUCTION
SKIPA ;DONE
JRST MAPBLW ;NEEDS TO BLOCK
POP P,1
MAPF41: ADD 1,INFERP ;DO INFERIORS
MAPF42: LDB 1,1 ;GET NEXT IN LIST
JUMPE 1,MAPF43 ;END OF LIST, RETURN AND SKIP INSTR
HRLM 1,0(P) ;SAVE THIS FORK NUMBER
CALL MAPF41 ;DO INFERIORS OF IT
BUG(MAP41F)
HLRZ 1,0(P) ;GET FORK NUMBER BACK
XCT 1(P6) ;DO THIS FORK
SKIPA ;DONE
JRST MAPBLW ;NEEDS TO BLOCK
HLRZ 1,0(P)
ADD 1,PARALP ;POINT TO NEXT IN LIST
JRST MAPF42
MAPF43: XHLLI T2,20 ;GET CURRENT SECTION
HLLM T2,0(P)
RETSKP
MAPF4: HRRZ 1,FORKN ;GET SELF
JRST MAPF41 ;DO INFERIORS
MAPF5: HLRZ 1,FORKN ;GET TOP
JRST MAPF51 ;DO THAT AND INFERIORS
;COROUTINE INDICATED TO BLOCK
MAPBLW: MOVE P,P6 ;GET PROPER FRAME
POP P,P6 ;RESTORE P6
RET ;AND INDICATE BLOCK UP
;FORK RELATIVITY TESTS
;SKIP IF FORK IN 1 IS SELF OR INFERIOR TO SELF
SKIIF:: PUSH P,2
HRRZ 2,FORKN ;GET SELF
CALL SKIIFA ;DO TEST
JRST PB2 ;RETURN NO SKIP
SKISF2: POP P,2
JRST RSKP
;SKIP IF FORK IN 1 IS SAME AS OR INFERIOR TO FORK IN 2
SKIIFA::HRLM 2,0(P) ;SAVE FORK NUMBER
SKIIF4: CAIN 1,0(2) ;SAME?
JRST SKIIF1 ;YES
ADD 2,INFERP ;NO, GET POINTER TO INFERIOR LIST
SKIIF2: LDB 2,2 ;NEXT INFERIOR
JUMPE 2,SKIIF6 ;END OF LIST
CALL SKIIFA ;IS THIS FORK OR INFERIOR?
JRST SKIIF5 ;NO
SKIIF1: HLRZ 2,0(P) ;SUCCEEDS, RETURN +2
XHLLI T4,20 ;FIND CURRENT SECTION
HLLM T4,0(P) ;SET IN RETURN
RETSKP ;AND RETURN +2
SKIIF6: HLRZ 2,0(P)
XHLLI T4,20 ;RESTORE SECTION NUMBER
HLLM T4,0(P)
RET ;FAILS RETURN +1
SKIIF5: ADD 2,PARALP ;LOOK PARALLEL
JRST SKIIF2
;SKIP IF FORK IN 1 IS SUPERIOR OF THIS FORK
SKISF:: PUSH P,2
HRRZ 2,FORKN
SKISF1: CAIN 1,0(2)
JRST SKISF2 ;SAME, RETURN GOOD
JUMPE 2,PB2 ;END OF LIST, RETURN BAD
ADD 2,SUPERP ;GET SUPERIOR POINTER
LDB 2,2
JRST SKISF1
;SKIMIF - SKIP IF FORK IN T1 IS IMMED INF OF EXECUTING FORK
SKIMIF: PUSH P,T1 ;MAKE TRANSPARENT TO T1
ADD T1,SUPERP ;GET SUPERIOR OF FORK IN T1
LDB T1,T1
CAMN T1,FORKN ;IS IT ME?
AOS -1(P) ;YES, SKIP RETURN.
POP P,T1 ;RESTORE CALLER'S ARG
RET
;Execute-Only process tests
; CHKNXS - Check for SELF or not execute-only
;
; Call:
; Fork structure is locked
; T1/ Job-relative fork number (JRFN) to be tested
; CALL CHKNXS
;
; Returns:
; +1: Always
; Process is now non-virgin
;
; ITRAPs if fork cannot be manipulated because it is execute-only
;
CHKNXS::
CALL CKNXSR ;Skip if OK
JRST ITFRKR ;Invalid-- ITRAP
RET ;Return from CHKNXS
;
;
; CKNXSR - Skip if not execute-only or SELF
; CKNXOR - Skip if not execute-only
;
; Call:
; Fork structure is locked
; T1/ Job-relative fork number (JRFN) to be tested
; CALL CKNXSR/CKNXOR
;
; Returns:
; +1: Check failed,
; T1/ Error code (FRKHX8)
; +2: Not execute-only (or SELF)
; Process is now non-virgin
;
CKNXSR:
CAMN T1,FORKN ;This SELF?
JRST CHKNX2 ;Yes, it's OK
CKNXOR::
JE SFEXO,(T1),CHKNX2 ;Jump if not execute-only
PUSH P,T1 ;Save the JRFN
MOVE T1,CAPENB ;Get enabled capability mask
TXNE T1,SC%WHL ;Is calling process a WHEEL?
JRST CHKNX1 ;Yes-- let him play
POP P,T1 ;Clean JRFN from stack
MOVEI T1,FRKHX8 ;Can't manipulate execute-only process
RET ;Return +1 with error code in T1
;
CHKNX1:
POP P,T1 ;Restore JRFN
CHKNX2:
CALL CLRVGN ;No longer virgin process
RETSKP ;Return +2 from CHKNXS/CHKNXO
;
;
; SETEXO - Set execute-only process
;
; Call:
; Fork structure is locked
; T1/ Job-relative fork number (JRFN) to be made execute-only
; CALL SETEXO
;
; Returns:
; +1: Cannot set execute-only becuase process is not virgin
; +2: Process is now execute-only
;
SETEXO::
JN SFNVG,(T1),R ;If not virgin, then can't be execute-only
SETONE SFEXO,(T1) ;Now process is execute-only
CALL CLRVGN ;No longer virgin
RETSKP ;Return +2 from SETEXO
;
;
; CLRVGN - Make process non-virgin
;
; Call:
; T1/ Job-relative fork number (JRFN) to be made non-virgin
; CALL CLRVGN
;
; Returns:
; +1: Always, process is now not virgin
;
CLRVGN:
SETONE SFNVG,(T1) ;No longer a virgin fork!!
RET ;Return from CLRVGN
;**;[3115]ADD 2 LINES AT CLRVGN:+2L TAM 31-MAY-84
SETVGN::SETZRO SFNVG,(T1) ;[3115] RESTORE VIRGINITY TO FORK!!
RET ;[3115] RETURN FROM SETVGN
;
;
; SETGXO/CLRGXO - Enable/Disable for execute-only GET
;
; Call:
; CALL SETGXO/CLRGXO
;
; Returns:
; +1: Always
;
SETGXO::
PUSH P,T1 ;Save register
MOVE T1,FORKN ;Get current JRFN
SETONE SFGXO,(T1) ;Set execute-only GET flag
JRST CLRGX1 ;Restore T1 and return
;
CLRGXO::
PUSH P,T1 ;Save register
MOVE T1,FORKN ;Get current JRFN
SETZRO SFGXO,(T1) ;Reset execute-only GET bit
CLRGX1:
POP P,T1 ;Restore T1
RET ;Return from SETGXO/CLRGXO
;
;
; SETLFX - Map PSB and check for execute-only
;
; This routine is available for a common sequence of functions:
; - Convert RFH to JRFN
; - Check for execute-only
; - Map PSB of process
;
; Call:
; Fork structure is locked
; T1/ Process relative fork handle (RFH)
; CALL SETLFX
;
; Returns:
; +1: Always,
; T1/ Address of PSB
;
; ITRAPs under a variety of fork-handle conditions
;
SETLFX::
CALL SETJFK ;Convert RFH to JRFN
CALL CHKNXS ;Make sure not execute-only or SELF
CALLRET SETLF1 ;Map PSB of process, and return from SETLFX
SUBTTL MISCELLANEOUS ROUTINES
;MAP PSB OF FORK, GIVEN USER HANDLE IN 1
;RETURN WITH OFFSET TO MAPPED PSB IN 1
;DOES NOT CLOBBER T2 OR T3
SETLFK::
REPEAT 0,< ;This is antiquated by capability checking
TRNE 1,200000 ;SPECIAL DESIGNATOR?
JRST FRKES ;NOT ALLOWED
> ;End of REPEAT 0
SETLF0: CALL SETJFK ;GET JOB FORK INDEX
SETLF1::HRRZS T1
HRRZ 1,SYSFK(1) ;GET SYSTEM FORK INDEX
SETLF3: NOINT
SE1CAL
CAMN 1,FORKX ;CURRENT FORK?
JRST SETLF2 ;YES
HRL T1,FKPGS(T1) ;GET PSB OF DESIGNATED FORK
HRRI T1,PSBM0-PSBPGA+PSBPG ;GET MAP OFFSET FOR THE PSB
PUSH P,2
PUSH P,T3 ;SAVE T3 AS WELL
MOVE 2,[PTRW+FPG1A]
MOVEI T3,2 ;MAP PSB AND STACK PAGE
CALL MSETMP ;DO IT
MOVEI 1,FPG1A-PSBPGA ;RETURN OFFSET USUAL PSB TO MAP PSB
JRST PB3
SETLF2: SETZ 1, ;USE CURRENT PSB, NO OFFSET
RET
;CLEAR MAPPING OF FPG1. USED BY LFK, PSB, JSB.
CLRJSB::
CLRPSB::
CLRLFK::SKIPN PSBM0+FPG1 ;NOW MAPPED?
JRST CLRLFX ;NO
SETZ 1,
MOVEI 2,FPG1A
MOVEI T3,2 ;CLEAR FPG1 AND FPG2
CALL MSETMP ;DO IT
CLRLFX: OKINT
RET
;MAPJSB - ROUTINE TO MAP ANOTHER JOB'S JSB
;
;ACCEPTS IN T1/ JOB NUMBER
; CALL MAPJSB
;RETURNS: +1 FAILED, NO SUCH JOB
; +2 SUCCESS, WITH T1/ OFFSET SUCH THAT JSB(T1) REFERS TO
; 'JSB' IN OTHER JOB'S JSB.
MAPJSB:: NOSKED ;PREVENT JOB FROM LOGGING OUT
SKIPGE JOBRT(T1) ;THIS JOB EXIST ?
RETBAD (,<OKSKED>) ;NO, FAIL
CALL SETJSB ;YES, MAP THE JSB
OKSKED ;PERMIT SCHEDULING AGAIN
RETSKP ;DONE, RETURN SUCCESS
;SETUP JSB FOR ANOTHER JOB
; 1/ JOB NUMBER
; RETURN +1 WITH JSB MAPPED INTO FPG1A,
; 1/ OFFSET SUCH THAT JSB(1) REFERS TO 'JSB' IN OTHER JOB'S JSB
SETJSB:: NOINT
PUSH P,FX
HRRZ FX,JOBPT(A) ;GET TOP FORK OF OTHER JOB
LOAD A,FKJSB ;GET JSB OF OTHER JOB
MOVE B,[PTRW+FPG1A]
CALL SETMPG ;MAP JSB INTO FPG1
MOVEI A,FPG1A-JSBPGA
POP P,FX
RET
;SETUP TOP FORK PSB FOR ANOTHER JOB
; 1/ JOB NUMBER
; RETURN +1 WITH PSB MAPPED INTO FPG1,
; 1/ OFFSET SUCH THAT PSB(1) REFERS TO 'PSB' IN OTHER JOB'S PSB
SETPSB::HRRZ A,JOBPT(A) ;GET TOP FORK OF OTHER JOB
JRST SETLF3 ;GO DO THE REST
;GET CAPABILITIES OF ANOTHER JOB
; 1/ JOB NUMBER
; RETURN +1,
; 1/ CAPMSK OF DESIGNATED JOB FROM TOP FORK
GJCAPS:: CALL SETPSB ;GET OTHER JOB'S PSB
;**;[2627] Change 1 line, Add 2 at GJCAPS:+1L PED 11-JUN-82
MOVE B,CAPENB(A) ;[2627] GET ENABLED CAPABILITIES
AND B,CAPMSK(A) ;[2627] MASK OFF ANY WE SHOULDN'T HAVE
PUSH P,B ;[2627] SAVE THEM OVER CALL
CALL CLRPSB ;UNDO PSB MAPPING
POP P,A
RET
;GET JOB FORK HANDLE GIVEN USER HANDLE IN 1
;FOR SINGLE (NOT MULTIPLE) FORK HANDLES ONLY
SETJFK::CALL STJFKR ;DO ACTUAL TRANSLATION
JRST ITFRKR ;ERROR - ITRAP
RET ;SUCCESS
STJFKR::HRRZ T1,T1 ;USE ONLY 18 BITS FOR FORK HANDLE
CAIN T1,400000 ;SELF?
JRST [ HRRZ T1,FORKN ;YES
RETSKP]
CAIL T1,-2 ;-1 OR -2?
XCT SETJFT+2(T1) ;YES - TRANSFER TO CORRECT ROUTINE
CALL RFHJFK ;LOCAL HANDLE - CONVERT TO JRFN
RET ;ILL FORMED - ERR CODE IN T1
CAIGE T1,NUFKS ;FORK HANDLE ASSIGNED?
SKIPGE SYSFK(T1) ;FORK KILLED?
JRST FRKE1R ;NO TO EITHER QUESTION
RETSKP ;RETURN
SETJFT: JRST GETTPF ;-2, TOP FORK
JRST GETSPF ;-1, SUPERIOR
GETSPF: MOVE T1,[1B9+SC%WHL+SC%OPR] ;DOES USER HAVE CAPABILITY TO
TDNN T1,CAPENB ; REFERENCE SUPERIOR FORK?
JRST FRKE2R ;NO
HRRZ T1,FORKN ;GET SUPERIOR FORK
MOVE T1,FKPTRS(T1)
LSH T1,-^D24
RETSKP
GETTPF: MOVEI T1,SC%WHL+SC%OPR ;DOES USER HAVE CAPABILITY TO
TDNN T1,CAPENB ; REFERENCE TOP FORK?
JRST FRKE2R ;NO
HLRZ T1,FORKN ;YES, GET TOP FORK
RETSKP
;COMMON ROUTINE TO LOCK FORK STRUCTURE
; CALL FLOCK
; RETURN +1: ALWAYS, CLOBBERS NO AC'S
;ALTERNATE ENTRY POINT, FLOCKN, ALLOWS NESTING OF THE LOCK.
;CALLING FLOCKN IMPLIES THAT A CALLER TO EITHER ENTRY THAT FINDS
;THE LOCK ALREADY LOCKED CAN FURTHER LOCK IT IF THE CALLING PROCESS
;IS THE ONE THAT LOCKED IT. A COUNT IS KEPT IN FLKCNT, AND THE
;LOCK IS UNLOCKED ONLY WHEN THE COUNT GOES TO 0. THE LEFT HALF OF
;FLKOWN IS -1 IF NESTING IS ALLOWED, 0 OTHERWISE.
FLOCK::
REPEAT 0,< ;NOT CHECKED NOW BECAUSE MLKBLK PROBLEM
SKIPN FORKN ;TOP FORK?
JRST FLOCK1 ;YES, INTERRUPTIBILITY NOT SIGNIFICANT
SKIPL INTDF ;INTERRUPTABLE NOW?
BUG(FLKINT)
>
ACVAR <W1>
SETZM W1 ;INDICATE NESTING NOT ALLOWED
JRST FLOCK1
;**;[2607] Add one line at FLOCK: +10L JGZ 3-APR-82
ENDAV. ;[2607] END ACVAR
;HERE TO ALLOW NESTING OF THE LOCK
FLOCKN::ACVAR <W1>
;**;[1869] Change 1L at FLOCKN:+1L PED 8-MAY-81
SETZM W1 ;[1869] INDICATE NESTING ALLOWED
FLOCK1: CSKED ;BE CRITICAL IF LOCK WORKS
AOSN FKLOCK ;LOCK SUCCESSFUL?
;THE LOCK WAS PREVIOUSLY UNLOCKED. SAVE THIS FORK INDEX AND INCREMENT
;THE NEST COUNT
;**;[1974]CHANGE 1 LINE AT FLOCK1: + 6l TAM 22-JAN-82
JRST [ HRRZ W1,FORKN ;[1974] GET OUR JOB-WIDE FORK HANDLE ONLY
MOVEM W1,FLKOWN ;SAVE IT AS THE OWNER
SKIPE FLKCNT ;IF NOT ZERO, SOMETHING IS WRONG
CALL [ BUG (FKCTNZ,<<JOBNO,D>,<FORKN,D>>)
SETZM FLKCNT
RET]
AOS FLKCNT ;INCREMENT NEST COUNT
MOVE W1,TODCLK ;GET NOW
ADDI W1,^D120000 ;TIMEOUT IS 2 MINUTES
MOVEM W1,FKTIMW ;AND SET IT
RET] ;SUCCESS
;SOMEONE HAS IT INCREMENTED. SUCCEED IF IT IS OUR FORK, AND INCREMENT
;THE NEST COUNT
ECSKED ;LOCK NOT SUCCESSFUL, ALLOW INTERRUPTS
;**;[1869] Delete 1L, Change 2L at FLOCK1:+22L PED 8-MAY-81
HRRZ W1,FORKN ;[1869] GET OWNING FORK
CAME W1,FLKOWN ;[1869] IS IT THIS ONE?
JRST FLOCK3 ;NO. FAIL
AOS FLKCNT ;YES. INCREMENT NEST COUNT
;**;[1852] Add one line at FLOCK1: +27L JGZ 23-APR-81
SOS FKLOCK ;[1852] DON'T COUNT US HERE, WE GOT THE LOCK
RET ;SUCCESS
;SOMEONE ELSE HAS THE LOCK. WAIT A WHILE.
FLOCK3: MOVE W1,T1 ;PRESERVE T1
MOVEI T1,^D200 ;WAIT 200 MS BEFORE RECHECKING
DISMS
MOVE T1,W1 ;RESTORE T1
MOVE W1,TODCLK ;GET NOW
CAMG W1,FKTIMW ;HAS THE LOCK TIMED OUT YET?
JRST FLOCK2 ;NO, KEEP WAITING
;WE'VE BEEN WAITING A LONG TIME FOR THIS LOCK. BUGCHK AND THEN
;FORCE IT TO BE UNLOCKED
BUG(FLKTIM,<<FORKN,D>,<JOBNO,D>,<FLKOWN,D>>)
SETZM FLKCNT ;ZERO THE NEST COUNT
SETOM FLKOWN ;CLEAR THE OWNER
SETOM FKLOCK ;TIMEOUT, CLEAR LOCK AND PROCEED
FLOCK2: JRST FLOCK1
;**;[2607] Add one line at FLOCK2: +0L JGZ 3-APR-82
ENDAV. ;[2607] END ACVAR
;FUNLK - COMMON ROUTINE TO UNLOCK FORK STRUCTURE
; CALL FUNLK
; RETURN +1: ALWAYS, CLOBBERS NO AC'S
;NOTE: THIS CODE COULD CAUSE FLKCNT TO GO NEGATIVE IN THE FOLLOWING
;CASE: FORK 1 LOCKS FKLOCK AND INCREMENTS FLKCNT TO 1, FORK 2 TIMES
;OUT THE LOCK AND SETS FLKCNT TO 0, FORK 2 LOCKS THE LOCK AND LATER
;UNLOCKS IT. WHEN FORK 1 FINALLY UNLOCKS THE LOCK, THE COUNT IS ALREADY
;ZERO. THIS CODE FORCES THE COUNT TO BE NO LESS THAN ZERO.
FUNLK:: PUSH P,1 ;BE TRANSPARENT TO ALL AC'S
SOSLE FLKCNT ;DECREMENT THE NEST COUNT
JRST [ POP P,T1
RET] ;NOT THE LAST TIME. DONE
SETOM FLKOWN ;CLEAR OWNER OF LOCK
SETZM FLKCNT ;MAKE SURE THE COUNT IS ZERO
MOVX T1,1B1 ;GET VERY LARGE NUMBER
MOVEM T1,FKTIMW ;SET IT NEVER TO TIMEOUT
SETO 1,
EXCH 1,FKLOCK ;CLEAR LOCK, GET PREVIOUS VALUE
ECSKED ;NO LONGER CRITICAL
;**;[2928]CHANGE 1 LINE AT FUNLK:+11 TAM 23-MAR-82
JUMPL 1,FUNLK3 ;[2928] OVER DECREMENTED
FUNLK2: POP P,1 ; WAS MADE TO LOCK IT WHILE THIS FORK
RET
;IF LOCK WAS .G. 0, SOME OTHER FORK IS/WAS TRYING TO LOCK IT. THIS
;FORK WILL DO A BRIEF WAIT SO AS TO PREVENT HOGGING THE LOCK.
;**;[2928] REMOVE 4 LINES AT FUNLK1:+0L TAM 23-MAR-83
REPEAT 0,< ;[2928]
FUNLK1: JUMPL 1,FUNLK3 ;BUG IF LOCK NOT SET AT ALL
MOVEI 1,^D200 ;WAIT FOR 200 MS
DISMS
JRST FUNLK2
> ;[2928]
FUNLK3: BUG(FLKNS)
JRST FUNLK2
;COMMON EXIT FROM FORK JSYS. CLEAR LOCAL PSB MAPPING, DO UNLOCK AND MRETN
CLFRET::CALL CLRLFK
CLFLK0: CALL FUNLK ;UNLOCK THE FORK STRUCTURE
JRST MRETN
;COMMON ERROR EXITS FROM FORK JSYS'S
FRKE1: MOVEI 1,FRKHX1 ;'ILLEGAL FORK HANDLE'
JRST ITFRKR ;GO UNLOCK AND ITRAP
FRKE2: MOVEI 1,FRKHX2 ;'ILLEG REF TO SUPERIOR'
JRST ITFRKR ;GO UNLOCK AND TRAP
FRKE3: MOVEI 1,FRKHX3 ;'MULTIPLE FORK HANDLE NOT LEGAL'
JRST ITFRKR
FRKE4: MOVEI A,FRKHX7 ;RELATIVE PAGE NUMBER TOO LARGE
JRST ITFRKR ;GO UNLOCK AND TRAP
;ERROR RETURN FROM FORK JSYS
;**;[7109] INSERT 3 LINES AT EFRKR:-1.L DSW 7/25/85
EFRKRC: PUSH P,T1 ;SAVE ERROR
CALL CLRLFK ;CLEAR MAPPED PAGE
POP P,T1 ;SNAG BACK ERROR
EFRKR: CALL FUNLK ;UNLOCK THE FORK STRUCTURE
RETERR() ;RETURN ERROR CODE ALREADY IN 1
FRKES: CALL FRKESR ;DETERMINE ERROR CODE
;; JRST ITFRKR ;ITRAP
;ITRAP RETURN FROM FORK JSYS
ITFRKR: CALL FUNLK ;UNLOCK THE FORK STRUCTURE
ITERR() ;RETURN ERROR CODE ALREADY IN 1
;COMMON NON-SKIP ERROR RETURNS FROM FORK JSYS'S
FRKE1R: MOVEI T1,FRKHX1 ;ILLEGAL FORK HANDLE
RET
FRKE2R: MOVEI T1,FRKHX2 ;ILLEGAL REFERENCE TO SUPERIOR
RET
FRKE3R: MOVEI T1,FRKHX3 ;MULTIPLE FORK HANDLE ILLEGAL
RET
;HERE TO FIGURE OUT WHICH OF THE ABOVE TO RETURN
FRKESR: HRRZ T1,T1 ;USE ONLY RH
CAIE T1,-1 ;CHECK SUPERIOR OR TOP FORK
CAIN T1,-2 ; ...
JRST FRKE2R ;ILLEGAL SUPERIOR
CAIL T1,-5 ;MULTIPLE FORK HANDLE?
CAILE T1,-3 ; ...
JRST FRKE1R ;NO, RANDOMNESS
JRST FRKE3R ;SUPERIOR ILLEGAL
;TRANSLATE FKH.PN TO PTN.PN
; FKHPTX - return error if execute-only and not SELF
; FKHPTN - normal entry
;ACCEPTS:
; T1/ FORK HANDLE,,PAGE NUMBER
; CALL FKHPTN
; OR
; CALL FKHPTX
;RETURNS +1: ERROR
; T1/ ERROR CODE
; +2: SUCCESS
; T1/ PTN,,PN
;PRESERVES T2
FKHPTX::STKVAR <SAV2,SAV1>
MOVEM T2,SAV2 ;SAVE T2
SETO T2, ;Flag to check execute-only
JRST FKHP1 ;Continue . . .
FKHPTN::STKVAR <SAV2,SAV1>
MOVEM T2,SAV2 ;SAVE T2
SETZ T2, ;Flag no execute-only check
;FKHP1 - COMMON ENTRY
; T2/ -1 IF WANT TO RETURN ERROR FOR EXECUTE-ONLY
; 0 OTHERWISE
FKHP1: CALL FLOCK ;LOCK THE FORK STRUCTURE
TLNN T1,^-<.FHSLF> ;IS THIS MY FORK?
TRNE T1,777000 ;YES. IS THERE A SECTION NUMBER
SKIPA ;ANOTHER FORK OR SECTION NO. WAS SPECIFIED
JRST [ LOAD T3,VSECNO,UPDL ;GET USER'S PC SECTION
DPB T3,[POINT 9,T1,26] ;PUT IT INTO THE PAGE NUMBER
JRST .+1] ;CONTINUE
MOVEM T1,SAV1 ;SAVE PAGE NO. INCLUDING SECTION
LDB T3,[POINT 9,T1,26] ;GET SECTION NUMBER FROM ARG
CAILE T3,(VSECNO) ;A VALID SECTION?
JRST FKHPE1 ;NO
HLRZ T1,T1
CALL STJFKR ;GET JOB FORK INDEX
JRST FKHPER ;ILLEGAL - ERROR CODE IN 1
JUMPE T2,FKHP2 ;Skip check if call to FKHPTN
MOVE T2,FORKN ;Get current JRFN
JN SFGXO,(T2),FKHP2 ;If current process doing execute-only GET
; then skip execute-only check
CALL CKNXSR ;Execute-only process?
JRST FKHPER ;Yes, return error
;..
;..
FKHP2: CALL SKIIF ;SELF OR INFERIOR TO SELF?
JRST [ MOVSI T2,(1B9) ;NOT INFERIOR
TDNN T2,CAPENB ;ALLOWED TO MAP SUPERIOR?
JRST FKHPE2 ;NO
MOVE T2,T1 ;YES, SAVE OBJECT FORK
CALL GETSPF ;GET HANDLE OF SUPERIOR
EXCH T1,T2
CAME T1,T2 ;IS OBJECT FORK IMMED SUPERIOR?
JRST FKHPE2 ;NO
JRST .+1]
HRRZ T2,SAV1 ;GET PAGE NUMBER FROM ARG
CAIGE T2,1000 ;NON-ZERO SECTION WANTED?
JRST [ HRRZ T1,SYSFK(T1) ;NO. GET SYSTEM FORK HANDLE
HLL T1,FKPGS(T1) ;GET PT OF SECTION ZERO
HRR T1,T2 ;AND COPY PAGE NUMBER AS WELL
JRST FKHP3] ;AND DONE
CALL SETLF1 ;MAP FORK'S PSB
MOVE T2,SAV1 ;GET BACK ORIGINAL ARG
LDB T3,[POINT 9,T2,26] ;GET SECTION # FROM ARG
ADD T3,T1 ;COMPUTE INDEX INTO OTHER PSB
SKIPN T3,USECTB(T3) ;GET SECTION POINTER
JRST [ CALL CLRLFK ;UNMAP PSB
JRST FKHPE1] ;GIVE PROPER ERROR
LOAD T3,SPTX,T3 ;GET SPT INDEX OF PAGE TABLE
ANDI T2,777 ;GET PAGE OFFSET IN SECTION
HRL T2,T3 ;FORM PTN.PN
MOVEM T2,SAV1 ;SAVE RESULT
CALL CLRLFK ;UNMAP PSB
MOVE T1,SAV1 ;GET BACK ARG
FKHP3: CALL FUNLK ;UNLOCK THE FORK STRUCTURE
MOVE T2,SAV2 ;RESTORE AC
RETSKP ;SUCCESS RETURN
FKHPE1: SKIPA T1,[ARGX06] ;ILLEGAL PAGE NUMBER
FKHPE2: MOVEI T1,FRKHX2 ;ILLEGAL SUPERIOR MANIPULATION
FKHPER: MOVE T2,SAV2 ;RESTORE AC
CALL FUNLK ;UNLOCK FORK LOCK
RETBAD () ;ERROR RETURN
;PTNFKH - TRANSLATE PTN TO FKH
;ACCEPTS:
; T1/ PTN,,PN FOR A FORK'S PAGE
; CALL PTNFKH
;RETURNS +1: ERROR
; T1/ ERROR CODE
; +2: SUCCESS,
; T1/ LOCAL FORK HANDLE,,PAGE NUMBER IF PAGE CAN BE IDENTIFIED
; OR
; T1/ -1 IF PAGE CAN'T BE IDENTIFIED
;THIS ROUTINE IS CALLED BY THE RMAP JSYS WHEN IT HAS ALREADY
;DETERMINED THAT THE PAGE OF INTEREST IS OWNED BY A FORK.
;THE PAGE TABLE MAY BE A PAGE TABLE FOR ANY SECTION IN THE USER'S
;ADDRESS SPACE
PTNFKH::STKVAR <PTNFPT,PTNFPS,PTNFPN>
HRRZM T1,PTNFPN ;SAVE PAGE NUMBER
CALL FLOCK ;LOCK THE FORK STRUCTURE
HLRZ T2,T1 ;GET PTN
MOVEM T2,PTNFPT ;SAVE IT
HRRZ T1,SPTH(T2) ;GET THE OWNING FORK
HLRZ T3,FKPGS(T1) ;GET SECTION 0 PAGE TABLE
CAME T3,PTNFPT ;THE ONE WE WERE GIVEN?
JRST PTNF6 ;NO. GO TRY FOR NON-ZERO SECTION
;HERE WHEN IT IS THE FORK'S SECTION 0 PAGE TABLE. GET ITS
;JOB-WIDE INDEX
MOVSI 3,-NUFKS ;SETUP FOR SCAN OF JOB FORK TABLE
PTNF3: SKIPGE T2,SYSFK(3) ;HAVE A USABLE HANDLE?
JRST PTNF2 ;NO. SKIP IT THEN
CAIN T1,0(T2) ;IS IT THE FORK WE WANTED?
JRST [ HRRZ T1,T3 ;YES. GET HANDLE INTO AC
JRST PTNF1] ;GO CONVERT IT
PTNF2: AOBJN 3,PTNF3
SETOB T1,PTNFPN ;NOT FOUND, RETURN -1
JRST PTNF4
;..
;..
;HERE WHEN IT'S NOT THE FORK'S SECTION 0 PAGE TABLE
;SEE IF IT'S A NON-ZERO SECTION TABLE
PTNF6: CALL SETLF3 ;MAP THAT FORK'S PSB
MOVEM T1,PTNFPS ;SAVE INDEX TO PSB
HRLI T1,-MXSECN-1
PTNF8: LOAD T3,STGADR,USECTB(T1) ;GET SPT INDEX
CAMN T3,PTNFPT ;IS THIS THE ONE WE WANTED?
JRST [ HRRZ T2,T1 ;YES. CLEAR LEFT HALF
SUB T2,PTNFPS ;COMPUTE SECTION NUMBER
LSH T2,PGSFT ;MOVE IT TO PAGE NUMBER
ADDM T2,PTNFPN ;COMPUTE NEW PAGE NUMBER
MOVE T1,PTNFPS ;GET OFFSET INTO OTHER PSB
MOVE T1,FORKN(T1) ;GET JOB-WIDE FORK HANDLE
MOVEM T1,PTNFPS ;SAVE FORK HANDLE
CALL CLRLFK ;UNMAP THE PSB
MOVE T1,PTNFPS ;RESTORE FORK HANDLE
JRST PTNF1] ;GO CONVERT
AOBJN T1,PTNF8 ;TRY THE NEXT FORK
;DIDN'T FIND IT. PROBABLY THIS SPT SLOT WAS A SECTION TABLE
;FOR A FORK THAT HAS SINCE UNSMAP'D IT. THERE IS STILL A POINTER
;TO IT IN THE FORK OF INTEREST, AND THE OWNING FORK HAS BEEN
;CHANGED TO BE THE TOP FORK OF THE JOB.
CALL CLRLFK ;UNMAP THE PSB
SETOM T1 ;INDICATE UNKNOWN
JRST PTNF9 ;GO FINISH
;HERE WHEN FORK HAS BEEN FOUND. T1/ JOB-WIDE HANDLE. CONVERT
;TO LOCAL HANDLE AND FINISH
PTNF1: CALL GFKH ;CONVERT TO LOCAL HANDLE
RETBAD(FRKHX6,<CALL FUNLK>)
HRLS T1 ;GET PTN INTO LEFT HALF
PTNF4: HRR T1,PTNFPN ;PN INTO RIGHT HALF
PTNF9: CALL FUNLK ;UNLOCK THE FORK STRUCTURE
RETSKP
;FIND OR INSERT LOCAL FORK HANDLE
; 1/ PSB OFFSET (GRFKH ONLY) ,, JOB FORK INDEX
;GFKH GETS HANDLE RELATIVE TO SELF
;GRFKH GET HANDLE RELATIVE TO FORK WHOSE PSB IS IN LH 1
GFKH: MOVEI 1,0(1) ;LEAVE LH 0 FOR SELF
GRFKH: PUSH P,2
PUSH P,3
PUSH P,4
HLRE 3,1 ;GET PSB OFFSET
HRRZ 2,FORKN(3) ;GET JOB HANDLE FOR F1
PUSH P,3 ;SAVE PSB OFFSET
ADD 3,FKPTAB ;MAKE PTR TO FKTAB
MOVE 4,[XWD -NLFKS+1,1]
CAIN 2,0(1) ;IS IT SELF?
SOJA 4,GFKH4 ;YES, 0
HRLI 1,400000 ;USE LH TO REMEMBER ANY EMPTY ENTRIES
GFKH1: ILDB 2,3 ;LOOK AT NEXT HALF-WORD
CAIN 2,-1 ;ASSIGNED?
JRST GFKH2 ;NO
CAIN 2,0(1) ;IS GIVEN?
JRST GFKH4 ;YES
GFKH3: AOBJN 4,GFKH1
HRRZ 3,1
SKIPL SYSFK(3) ;FORK STILL EXTANT?
TLNE 1,400000 ;NOT FOUND, ROOM TO ADD ENTRY?
JRST POP41 ;NO, RETURN NOSKIP
HLRZ 3,1 ;GET INDEX OF FIRST FREE ENTRY
IDIVI 3,2 ;CONSTRUCT POINTER TO IT
ADD 3,FKPTAB(4)
ADD 3,0(P) ;OFFSET TO PROPER PSB
DPB 1,3 ;STORE JOB INDEX IN ENTRY
HRRZ 2,1 ;GET REQUESTED JRFN
CAIN 2,-1 ;FREE ENTRY REQUESTED?
JRST GFKH5 ;YES - DONT UP COUNT
HRRZ 4,1
LOAD 2,FKHCNT,(4) ;NO - INCR COUNT OF HANDLES ON THIS FORK
ADDI 2,1 ; ...
STOR 2,FKHCNT,(4) ;UPDATE COUNT
GFKH5: HLRZ 4,1
GFKH4: MOVEI 1,400000(4) ;RETURN LOCAL HANDLE WITH BIT
AOS -4(P)
POP41: SUB P,BHC+1 ;FLUSH OFFSET
JRST PB4
GFKH2: TLNE 1,400000 ;FIRST EMPTY SLOT?
HRLI 1,0(4) ;YES, SAVE INDEX
JRST GFKH3
;DEASSIGN LOCAL FORK HANDLE GIVEN JOB HANDLE IN 1
DASFKH: PUSH P,2
PUSH P,3
PUSH P,4
CALL JFKRFH ;SEE IF A HANDLE EXISTS
JUMPN T2,DASFK1 ; ...
; BUG(NOXRFH)
JRST PB4 ;IGNORE ATTEMPT
DASFK1: MOVEI 2,-1 ;PUT A -1 WHERE ENTRY WAS
DPB 2,3
LOAD T2,FKHCNT,(T1) ;GET COUNT OF HANDLES ON THIS FORK
SUBI T2,1 ;DECREMENT
STOR T2,FKHCNT,(T1) ; ...
SKIPGE SYSFK(T1) ;WAS THIS FORK KILLED?
SKIPE T2 ;AND NO REMAINING HANDLES?
JRST PB4 ;NO - RETURN
MOVEI T2,FKPTRS(T1) ;YES - RELEASE JRFN NOW
EXCH T2,FREJFK ; ...
MOVEM T2,@FREJFK ; ...
SETOM SYSFK(T1)
JRST PB4
;TABLE OF BYTE POINTERS, HALF WORD
POINT 18,FKTAB,-1
FKPTAB: POINT 18,FKTAB,17
POINT 18,FKTAB,35
SUBTTL JSYS'S FOR SOFTWARE INTERRUPT SYSTEM
;SIR JSYS
;ACCEPTS:
; T1/ FORK HANDLE
; T2/ (ADDRESS OF LEVEL TABLE,,ADDRESS OF CHANNEL TABLE)
; SIR
;RETURNS +1: ALWAYS
; ILLEGAL INSTRUCTION INTERRUPT ON FAILURE
.SIR:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;Map PSB and check execute-only
XSFM T4 ;GET FLAGS WORD, INCLUDING PCS
TXNE T4,EXPCS ;IS PCS NON-ZERO?
ERRJMP(SIRX2,ITFRKR) ;NO. DON'T ALLOW OLD STYLE SIR
JUMPE 2,SIR1 ;ALL 0 IS LEGAL
HLRZ 3,2 ;GET ADDRESSES GIVEN
MOVEI 4,0(2)
CAIL 3,20 ;BOTH .GE. 20?
CAIGE 4,20
ERRJMP(SIRX1,ITFRKR) ;NO
SIR1: HRRZM T2,PSCHNT(1) ;SAVE ADDRESS OF CHNTAB
HLRZM T2,PSLEVT(T1) ;SAVE ADDRESS OF LEVTAB
SETZRO PSXSIR,(T1) ;INDICATE NOT EXTENDED SIR
JRST CLFRET
;XSIR JSYS
;ACCEPTS:
; T1/ FORK HANDLE
; T2/ ADDRESS OF ARGUMENT BLOCK
;ARGUMENT BLOCK:
; LENGTH OF THIS BLOCK (3)
; ADDRESS OF LEVEL TABLE
; ADDRESS OF CHANNEL TABLE
; XSIR
;RETURNS +1: ALWAYS,
; ILLEGAL INSTRUCTION INTERRUPT ON FAILURE
;THIS IS AN EXTENDED SIR JSYS. IT IS USED BY PROGRAMS THAT WILL
;RUN IN NON-ZERO SECTIONS.
.XSIR:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;MAP PSB AND CHECK EXECUTE-ONLY
UMOVE T4,2 ;GET ADDRESS OF ARGUMENT BLOCK
UMOVE T3,0(T4) ;GET SIZE OF THIS TABLE
TLNE T3,-1 ;CAN'T BE THIS BIG
ERRJMP (ARGX05,ITFRKR) ;ARGUMENT BLOCK TOO BIG
CAIGE T3,.SICHT+1 ;CAN'T BE TOO SMALL EITHER
ERRJMP(ARGX04,ITFRKR) ;ARGUMENT BLOCK TOO SMALL
UMOVE T2,.SILVT(T4) ;GET ADDRESS OF LEVEL TABLE
UMOVE T3,.SICHT(T4) ;GET ADDRESS OF CHANNEL TABLE
SKIPN T2 ;OK FOR BOTH TO BE ZERO
SKIPE T3
SKIPA ;NOT BOTH ZERO. CONTINUE
JRST [ SETZRO PSXSIR,(T1) ;BOTH ZERO. CLEAR EXTENDED SIR FLAG
JRST XSIR4] ;GO FINISH
;DON'T ALLOW CHNTAB OR LEVTAB TO BE IN THE AC'S
HRRZ P2,T2 ;GET OFFSET IN THE SECTION FOR LEVTAB
CAIGE P2,20 ;IS IT LESS THAN 20?
TLNE T2,777776 ;YES. SECTION 0 OR 1?
SKIPA ;OK
ERRJMP(SIRX1,ITFRKR) ;YES. INDICATE ERROR
HRRZ P3,T3 ;GET OFFSET IN SECTION FOR CHNTAB
CAIGE P3,20 ;IT IS LESS THAN 20?
TLNE T3,777776 ;YES. SECTION 0 OR 1?
SKIPA
ERRJMP(SIRX1,ITFRKR) ;YES. INDICATE ERROR
;..
;DON'T LET THE CHANNEL TABLE OR THE LEVEL TABLE GO BEYOND THE
;END OF ITS SECTION.
;..
MOVE P2,T3
ADDI P2,^D35 ;GET ADDRESS OF LAST WORD IN CHAN TABLE
XOR P2,T3 ;SEE IF START AND END ARE IN SAME SECTION
TLNE P2,-1 ;ARE THEY?
ERRJMP(XSIRX1,ITFRKR) ;NO. ERROR
MOVE P2,T2
ADDI P2,2 ;GET ADDRESS OF LAST WORD IN LEVEL TABLE
XOR P2,T2 ;SEE IF START AND END ARE IN SAME SECTION
TLNE P2,-1 ;ARE THEY?
ERRJMP(XSIRX2,ITFRKR) ;NO. ERROR
SETONE PSXSIR,(T1) ;INDICATE EXTENDED SIR WAS DONE
XSIR4: MOVEM T2,PSLEVT(T1) ;SAVE ADDRESS OF LEVEL TABLE
MOVEM T3,PSCHNT(T1) ;SAVE ADDRESS OF CHANNEL TABLE
JRST CLFRET ;RETURN SUCCESS
.EIR:: MCENT
REPEAT 0,< ;This is antiquated by capability checking
TRNE 1,200000 ;SPECIAL?
ITERR(FRKHX1) ;ILLEGAL
> ;End of REPEAT 0
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETJFK
CALL CHKNXS ;Check if specified process is execute-only or not SELF
PUSH P,SYSFK(1) ;REMEMBER FORK INDEX
CALL SETLF1 ;MAP PSB
SETZM PSISYS(1) ;0 IS ON
POP P,2
SKIPN PSIBW(1) ;ANY BREAKS WAITING?
JRST CLFRET ;NO
SETZ 1, ;YES, INITIATE SERVICE
NOSKED
CALL PSIRQB
OKSKED
CHKINT ;GET ANY PENDING BREAKS TO BE SEEN
JRST CLFRET
;SKIP IF PSI SYSTEM ENABLED
.SKPIR::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
;**;[7109] REPLACE 3 LINES WITH 1 AT .SKPIR:+3L DSW 7/25/85
;**;[7111] CORRECT TYPO AT .SKPIR:+3L DSW 7/25/85
MOVE P1,PSISYS(1) ;GET STATE OF PI SYSTEM
CALL CLRLFK ;UNLOCK THE FORK STRUCTURE
CALL FUNLK
JUMPN P1,EMRET1 ;TAKE NO SKIP RETURN
SMRETN ;SKIP
.DIR:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;Map PSB and check execute-only
SETOM PSISYS(1)
JRST CLFRET
.AIC:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;Map PSB and check execute-only
IORM 2,PSICHM(1)
ICR: CALL SETOV0 ;RECOMPUTE TRAP LOCATION
JRST CLFRET
.DIC:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;Map PSB and check execute-only
ANDCM 2,MONCHN(1) ;DISALLOW MONITOR RESERVED CHANNELS
ANDCAM 2,PSICHM(1)
JRST ICR
;INITIATE INTERRUPT ON CHANNEL
; 1/ FORK HANDLE
; 2/ CHANNEL MASK
; IIC
; RETURN +1 ALWAYS
;FOR MONITOR USE, SEE IICSLF IN SCHED
.IIC:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETJFK
CALL CHKNXS ;Check if specified process is execute-only or not SELF
PUSH P,1
CALL SETLF1 ;MAP DEST PSB
UMOVE 2,2
ANDCM 2,MONCHN(1) ;DISALLOW MON RESERVED CHANS
PUSH P,2
CALL CLRLFK
POP P,2
POP P,1
MOVE 1,SYSFK(1)
EXCH 1,2
NOSKED
CALL PSIRQB
OKSKED
CHKINT ;GET IT SEEN
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
JRST MRETN
.RCM:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
MOVE 1,PSICHM(1)
JRST RETA1
;READ PSI IN PROGRESS AND WAITING MASKS
.RWM:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
MOVE 2,PSIBIP(1)
UMOVEM 2,2 ;REPORT BREAKS IN PROGRESS IN 2
MOVE 1,PSIBW(1)
RETA1: UMOVEM 1,1 ;RETURN VALUE IN 1
JRST CLFRET
.SIRCM::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;Map PSB and check execute-only
CAIN 1,0 ;SELF?
JRST FRKE1 ;ILLEGAL
MOVEM 2,SUPCHN(1)
JRST CLFRET
.RIRCM::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
MOVE 2,SUPCHN(1)
RETA2: UMOVEM 2,2
JRST CLFRET
;RIR JSYS
;ACCEPTS:
; T1/FORK HANDLE
; RIR
;RETURNS +1: ALWAYS
; T2/ (ADDRESS OF LEVEL TABLE,,ADDRESS OF CHANNEL TABLE)
; ILLEGAL INSTRUCTION INTERRUPT ON FAILURE
;IT IS ILLEGAL TO DO THIS JSYS IF THE INTERRUPT SYSTEM WAS SET
;UP VIA XSIR.
.RIR:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
JN PSXSIR,(T1),[ ERRJMP(RIRX1,ITFRKR)] ;XSIR WAS DONE PREVIOUSLY
HRL T2,PSLEVT(T1) ;GET LEVEL TABLE
HRR T2,PSCHNT(T1) ;GET CHANNEL TABLE
JRST RETA2
;XRIR JSYS
;ACCEPTS:
; T1/ FORK HANDLE
; T2/ ADDRESS OF ARGUMENT BLOCK
; XRIR
;RETURNS +1: ALWAYS
;ARGUMENT BLOCK:
; UNCHANGED
; ADDRESS OF LEVEL TABLE
; ADDRESS OF CHANNEL TABLE
;ILLEGAL INSTRUCTION INTERRUPT ON FAILURE
.XRIR::
MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;MAP PSB AND CHECK EXECUTE-ONLY
UMOVE T4,2 ;GET ADDRESS OF ARGUMENT BLOCK
UMOVE T3,0(T4) ;GET SIZE OF THIS TABLE
TLNE T3,-1 ;CAN'T BE THIS BIG
ERRJMP (ARGX05,ITFRKR) ;ARGUMENT BLOCK TOO BIG
CAIGE T3,.SICHT+1 ;CAN'T BE TOO SMALL EITHER
ERRJMP(ARGX04,ITFRKR) ;ARGUMENT BLOCK TOO SMALL
MOVE T2,PSLEVT(T1) ;GET LEVEL TABLE
UMOVEM T2,1(T4) ;RETURN TO USER
MOVE T2,PSCHNT(T1) ;GET CHANNEL TABLE
UMOVEM T2,2(T4) ;RETURN TO USER
JRST CLFRET ;RETURN
;ACTIVATE TERMINAL INTERRUPT
; 1/ TERMINAL CODE ,, CHANNEL NUMBER
; ATI
; RETURN +1: ALWAYS.
.ATI:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
HLRZ 1,1
CAIL 1,^D36 ;REASONABLE TERM CODE?
ATIE1: ERRJMP(TERMX1,ITFRKR) ;NO
CAIE 1,3 ;CONTROL-C?
JRST .+4 ;NO
MOVE 3,CAPENB ;YES, SEE IF LEGAL
TLNN 3,(1B0)
ATX2E: ERRJMP(ATIX2,ITFRKR) ;USER LACKS ^C CAPABILITY
CALL GETCHA
XCTU [HRRZ 3,1] ;GET CHANNEL NUMBER
CAIG 3,^D5 ;LEGAL CHANNEL NUMBER?
JRST ATI3 ;YES
;**;[1752] CHANGE 1 LINE AT ATX2E: +5L ARS 26-JUN-80
CAIL 3,^D23 ;[1752] ALLOW CH23 AND ABOVE
CAILE 3,^D35
ERRJMP(ATIX1,ITFRKR) ;NO
ATI3: DPB 3,2 ;ASSIGN IT TO THIS CODE
HRRZ 4,FORKN
MOVE 3,BITS(1)
IORM 3,FKPSIE(4)
MOVEI T3,(T4)
IDIVI T3,2 ;COMPUTE POINTER TO THE FORK'S CTTY
ADD T3,FKCTYP(T4)
LDB T1,T3
CALL UPDTI ;UPDATE JOB WORD
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
MRETNG
;DEACTIVATE TERMINAL INTERRUPT
; 1/ TERMINAL CODE
; DTI
; RETURN +1: ALWAYS, UNLESS ITRAP
.DTI:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CAIL 1,0
CAIL 1,^D36 ;REASONABLE CODE?
JRST ATIE1 ;NO
HRRZ 2,FORKN
MOVE 6,BITS(1)
ANDCAM 6,FKPSIE(2) ;CLEAR FROM THIS FORK
IDIVI T2,2 ;COMPUTE SOURCE OF FORK'S PSI'S
ADD T2,FKCTYP(T3)
LDB T1,T2 ;GET THE DESIGNATOR
UPDTIR: CALL UPDTI ;UPDATE JOB WORDS
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
JRST MRETN
;UPDATE JOB TPSI WORDS BY SCANNING FORK WORDS
;TTY DESIGNATOR IN T1 AT CALL
UPDTI: TRNN T1,1B18 ;IS IT A TTY DESIGNATOR?
RET ;NOPE, DO NOTHING.
SAVEQ ;GET SOME MORE WORK AC'S
MOVSI T3,-NUFKS ;SETUP TO SCAN ALL FORKS OF JOB
SETZB T4,Q1 ;IOR PSI AND DPSI WORDS
UPDT0: HRRZ Q2,SYSFK(T3) ;GET FORKX OF THE FORK
CAIN Q2,-1 ;DOES THE FORK EXIST?
JRST UPDT2 ;NO, SKIP OVER IT
MOVEI Q2,0(T3) ;FORKN
PUSH P,Q2+1 ;PRESERVE AC OVER DIVIDE
IDIVI Q2,2 ;FIND THE FORK'S CTTY
ADD Q2,FKCTYP(Q2+1)
POP P,Q2+1 ;RESTORE
LDB Q2,Q2
CAIN Q2,0(T1) ;IS IT THE ONE WE WERE CALLED WITH?
JRST UPDT1 ;YES! GO UPDATE THE PSI WORDS
UPDT2: AOBJN T3,UPDT0
MOVEI T2,(T1) ;MOVE TO AC FOR TTYSRV
CAIN T2,-1 ;IS THE CALLING ARG THE JOB CTTY?
JRST UPDT4 ;YES.
TRZ T2,1B18 ;MAYBE NOT
CAMN T2,CTRLTT ;CHECK IN LINE NUMBER FORM
JRST UPDT4 ;IT IS.
CAIGE T2,NLINES ;NOPE. THIS THING IS A LEGAL TTY, I HOPE?
CAIGE T2,0
RET ;NO, IT WASN'T. ALL FOR NOW.
JRST UPDT5 ;YES, GO STORE PSI WORDS
UPDT4: AND T4,TTJTIW ;ALLOW ONLY ENABLED BITS
MOVEM T4,TTSPSI
AND Q1,TTJTIW
MOVEM Q1,TTSDPS ;DEFERRED CODES
SKIPGE T2,CTRLTT ;IF ATTACHED
RET
UPDT5: MOVEM T4,T1 ;SET LINE'S PSI WORDS
MOVEM Q1,T3 ; ..
CALLRET TTSINT
UPDT1: HRRZ FX,SYSFK(T3) ;GET THE SYSTEM FORKX
MOVEI T2,(FX) ;KEEP A COPY
CALL CHKWT ;IS THE FORK DISMISSED?
JRST UPDT3 ;NO
HRRZ Q2,FKSTAT(FX) ;YES, SEE HOW.
CAIE Q2,FRZWT ;FROZEN?
JRST UPDT8 ;NO
PUSH P,Q2 ;YES, SAVE STATE
MOVSI Q2,JTFRZB ;IS IT A JSYS TRAP FREEZE?
TDNN Q2,FKINT(FX) ; ..
JRST UPDT6 ;NO, ORDINARY FREEZE
MOVSI Q2,FRZBB ;IS IT JSYS TRAP AND ALSO OTHER FREEZE?
TDNN Q2,FKINT(FX) ; ..
JRST UPDT7 ;NO, JUST JSYS TRAP FREEZE
UPDT6: POP P,Q2 ;SOME OTHER FREEZE. EXCLUDE THIS FORK.
JRST UPDT2 ; ..
UPDT7: POP P,Q2
UPDT8: CAIE Q2,HALTT ;WHAT OTHER KIND OF WAIT IS IT?
CAIN Q2,FORCTM ;HALT OR FORCED TERMINATION?
JRST UPDT2 ;YES. DON'T INCLUDE THIS FORK'S PSI BITS
UPDT3: IOR T4,FKPSIE(T3) ;INCLUDE THESE BITS. THIS FORK COUNTS FOR
IOR Q1,FKDPSI(T3) ; PSI COLLECTION PURPOSES
JRST UPDT2 ;ON TO MORE FORKS
;DEASSIGN ALL TERMINAL INTERRUPTS FOR THIS FORK
DTIALL::HRRZ T1,FORKN
SETZM FKPSIE(T1)
IDIVI T1,2 ;COMPUTE POINTER TO FORK'S CTTY
ADD T1,FKCTYP(T2)
LDB T1,T1 ;GET THE DESIGNATOR
CALLRET UPDTI ;UPDATE AND RETURN
;CLEAR PSI SYSTEM
.CIS:: MCENT
NOINT ;PREVENT INTERRUPTION
SETZM PSIBIP
SETZM PSIBW
MOVE T1,[IOWD NPSIPG*PGSIZ,PSIPGA] ;SET UP STACK POINTER
MOVEM 1,PSIPT ;RESET PSI STORAGE
MOVE T1,FORKX ;GET ID OF THIS PROCESS
SETZ 2, ;CLEAR ALL FORK'S ENTRIES ON STACK
CALL JSBSTF ;GO MAKE SURE IT IS CLEAN
MOVE T1,FORKX ;GET ID OF THIS PROCESS
SETZ T2,0
CALL GOKFRE ;FREE GETOKK REQUESTS
OKINT ;ALLOW INTS NOW
JRST MRETN
;READ/SET TERMINAL INTERRUPT WORD
.RTIW:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
HRRZS T1
CAIN 1,-5 ;WHOLE JOB?
JRST [ MOVE 2,TTJTIW ;YES
JRST RTIW1]
CALL SETJFK ;GET JOB INDEX
MOVE 2,FKDPSI(1) ;DEFERRED CODES
UMOVEM 2,3 ;RETURNED IN 3
MOVE 2,FKPSIE(1)
RTIW1: UMOVEM 2,2
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
JRST MRETN
.STIW:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
HRRZS T1
CAIN 1,-5
JRST [ MOVE 3,CAPENB
TLNN 3,(1B0) ;^C CAPABILITY?
JRST ATX2E ;NO, DON'T PERMIT CHANGE TO JOB TI
MOVEM 2,TTJTIW ;SET JOB MASK WORD
MOVEI T1,-1 ;JOB CONTROLLING TERMINAL
JRST STIW2] ;GO UPDATE AND RET
CALL SETJFK
CALL CHKNXS ;Check if specified process is execute-only or not SELF
UMOVE 3,3 ;GET DEFERRED CODES
UMOVE 4,1 ;GET THE FLAGS
TXNE 4,ST%DIM ;USER WANT TO SET DEFERRED MASK?
MOVEM 3,FKDPSI(1) ;YES, SET THE DEFERRED CODES
EXCH 2,FKPSIE(1) ;SET NEW, REMEMBER OLD
XOR 2,FKPSIE(1) ;DIFFERENCES
SKIPE MONCHN(1) ;RESERVED MON CHANS EXIST?
TLZN 2,(1B16) ;AND ^P BEING CHANGED?
JRST STIW1 ;NO
MOVE 3,BITS+20 ;YES, PUT ^P BACK LIKE IT WAS
XORM 3,FKPSIE(1)
STIW1: IDIVI T1,2 ;COMPUTE POINTER TO FORK'S CTTY
ADD T1,FKCTYP(T2)
LDB T1,T1 ;GET DEVICE DESIGNATOR
STIW2: CALL UPDTI ;UPDATE JOB TIW
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
JRST MRETN
;SPECIAL CAPABILITIES CONTROL
.RPCAP::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETJFK
CALL SETLF1
MOVE 2,CAPMSK(1)
UMOVEM 2,2 ;RETURN POSSIBLE IN 2
MOVE 3,CAPENB(1)
UMOVEM 3,3 ;ENABLED IN 3
JRST CLFRET
.EPCAP::MCENT
HRRZ Q1,CAPENB ;CHECK FOR CHANGE
HRRZ Q2,T3 ;REQUESTED
CAMN Q1,Q2
JRST EPCNGO ;NO
;**;[2943] Change one line at .EPCAP+4 YKT 04-APR-83
GTOKM (.GOCAP,<T3>,MRETN) ;[2943] NO ERROR ROUTINE NEEDED
EPCNGO: CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETJFK
CALL SKIIF
ERRJMP(FRKHX2,ITFRKR) ;INFERIORS ONLY
CALL SETLF1
JUMPE 1,[XOR 3,CAPMSK(1) ;IF SELF, DON'T MODIFY 14-17
TLZ 3,(17B17)
XOR 3,CAPMSK(1)
JRST EPC1]
MOVE 4,CAPMSK
TLO 4,(777B17) ;9-17 DETERMINED BY SUPERIOR
AND 2,4
MOVEM 2,CAPMSK(1)
EPC1: MOVE 2,CAPENB(1) ;GET THE ALLOWED BITS
TXNN 2,SC%WHL ;THIS PROCESS HAVE WHEEL?
AND 3,CAPMSK(1) ;NO, ONLY ALLOW MODES IN MASK
MOVEM 3,CAPENB(1)
JRST CLFRET
;SWTRP JSYS. SET AND READ USER-MODE TRAPS. CALLING SEQUENCE IS:
; T1/ FORK HANDLE
; T2/ FUNCTION
; T3/ FUNCTION DEPENDENT ARG
;ITRAP ON ANY ILLEGAL ACT
.SWTRP::MCENT ;ESATBLISH CONTEXT
UMOVE T1,1 ;GET FORK HANDLE
CALL FLOCK ;LOCK FORK STURCTURE
CALL SETLFK ;MAP FORK
UMOVE T2,2 ;GET ARG
SKIPL T2 ;VALID FUNCTION?
CAILE T2,.SWRLT ;VALID FUNCTION?
ITERR (ARGX02,<CALL CLRLFK
CALL FUNLK>)
CALL @SWTRPT(T2) ;YES. DO THE FUNCTION
ITERR (,<CALL CLRLFK
CALL FUNLK>)
JRST CLFRET ;AND DONE
;DISPATCH TABLE FOR SWTRP ARGS
SWTRPT: IFIW!ARTSET
IFIW!ARTGET
IFIW!LUUSET
IFIW!LUUGET
;SET ARITHMETIC TRAP
ARTSET: UMOVE T3,3 ;GET VALUE
CALL SETART ;CHECK VALUE
RETBAD (ARGX20) ;CAN'T USE IT
RETSKP ;AND DONE
;READ ARITHMETIC TRAP
ARTGET: MOVE T3,ARTHTR ;GET TRAP VALUE
UMOVEM T3,3 ;STASH IT
RETSKP ;DONE
;SET LUUO DISPATCH ADDRESS
LUUSET: UMOVE T3,3 ;GET IT
CALL SETLUU ;VERIFY IT
RETBAD (ARGX21) ;BAD. CAN'T USE IT
RETSKP ;AND DONE
;READ LUUO DISPATCH ADDRESS
LUUGET: CALL GTLUUB ;GET LUUO BLOCK ADDRESS
UMOVEM T3,3 ;RETURN VALUE
RETSKP ;AND DONE
; Jsys Traps jsyses (TFORK, RTFRK and UTFRK)
;TFORK JSYS - FOR SETTING AND REMOVING TRAPS
;1: XWD function code, fork handle
;2: XWD channel #, number of bits in bit table
;3: Address of bit table
;FUNCTION CODES:
; 0: (.TFSET) Set traps as specified by bit table
; 1: (.TFRAL) Remove all traps set by this fork
; 2: (.TFRTP) Remove traps set by this fork as specified by bit table
; 3: (.TFSPS) Set JSYS trap PSI chan from LH(2); 77=>Don't PSI on trap
; 4: (.TFRPS) Read JSYS trap PSI chan into LH(2)
; 5: (.TFTST) Test if self is monitored: Ret with 2=-1/0 for yes/no
; 6: (.TFRES) Trap reset-remove traps from all inferiors, clear PSI chan
; 7: (.TFUUO) Set UUO traps for fork
; 8: (.TFSJU) Set both UUO and JSYS traps (combine 1 & 7)
; 9: (.TFRUU) Remove UUO traps
; Returns +1 always
.TFORK::MCENT
MOVE Q2,T2 ; Get chan #, # bits set in bit tbl
MOVE P4,T3 ; Bit tbl addr
HRR Q2,T1 ; Make channel, fork handle
HLRZ Q1,T1 ; Function code
CAIL Q1,0 ; Range check the function code
CAILE Q1,.TFRUU
ITERR TFRKX1 ; Bad code, abort
CALL @TFFUN(Q1) ;DO USER'S FUNCTION
MRETNG ; Return a success
TFFUN: IFIW!TFRKSR ; 0 set traps
IFIW!TFRKSR ; 1 remove traps
IFIW!TFRKSR ; 2 remove all
IFIW!TFORK3 ; 3 set channel
IFIW!TFORK4 ; 4 read channel
IFIW!TFORK5 ; 5 test if trapped
IFIW!TFORK6 ; 6 Reset
IFIW!TFRKSR ; 7 UUO traps set
IFIW!TFRKSR ; 8 combine 1 & 7
IFIW!TFRKSR ; 9 Remove UUO traps
TFRKSR: CALL FLOCK ;LOCK FORK STRUCTURE
MOVEI T1,(Q2) ;FORK HANDLE
CAIN T1,-4 ;ALL INFERIORS?
JRST TFSRA ;YES
CALL STJFKR ;CONVERT REL. HANDLE TO JOB FORK INDEX
ITERR TFRKX2,<CALL FUNLK>
CALL SKIMIF ;IS IT AN IMMEDIATE INFERIOR?
ITERR TFRKX2,<CALL FUNLK> ;NO, ERROR
CALL CHKNXS ;Check if specified process is execute-only or not SELF
HRRZ T2,SYSFK(T1) ;SYSTEM FORK INDEX
MOVE T2,FKINT(T2)
TLNN T2,FRZBB ;IS THE FORK FROZEN?
ITERR TFRKX3,<CALL FUNLK> ;NO, TELL THE USER
CALL TFSR ;SET OR REMOVE THE TRAPS
CALLRET FUNLK ;UNLOCK FORK STRUCTURE AND RET
TFSRA: HRRZ T1,FORKN
CALL MAPINF
CALL TFFRZ ;CHECK ALL FORKS FOR FROZENNESS
HRRZ T1,FORKN
CALL MAPINF
CALL TFSR
CALLRET FUNLK
TFFRZ: HRRZ T1,SYSFK(T1) ;JOB FORK NO. TO SYSTEM FORK INDEX
MOVE T1,FKINT(T1) ;FORK'S STATE
TLNN T1,FRZBB ;IS THE FORK FORZEN?
ITERR TFRKX3,<CALL FUNLK> ;NO, LET USER KNOW IT
RET ;YES, FORK IS FROZEN; DIRECT OR INDIRECT
;SET OR REMOVE TRAPS FOR A FORK
;T1/ FORKN OF FORK TO TRAP OR UNTRAP
TFSR: MOVE P1,T1 ;copy forkn
MOVE P3,SUPERP
ADD P3,P1
LDB P3,P3 ;forkn of superior
SKIPN T2,FKJTB(P1) ;do we have a monitor at all?
JRST [ CALL TFIFST ; Some form of setting?
RET ; No, and no monitor so done
CALL NEWJTB ;yes, ret addr. in T2
JRST .+1]
LOAD P2,JTIMP,(T2) ;forkn of our immed. monitor
;P1/ FORKN OF IMMEDIATE INF. TO SET/REMOVE TRAPS FOR
;P2/ FORKN OF P1'S MONITOR
;P3/ FORKN OF P1'S SUPERIOR
CAME P2,P3 ;is my monitor my superior?
JRST [ CALL TFIFST ; A form of set?
RET ; No, & sup. not my mon. so done
CALL NEWJTB ;yes, assign new JTB, ret addr. in T2
LOAD P2,JTIMP,(T2) ;forkn of ITS immed. monitor
JRST .+1]
CAIN Q1,.TFRAL ; Removing all?
JRST [ CALL RELJTB ;yes, release block
CALLRET TFINF3] ;take superior's block and update inf's
CALL TFUBIM ;update JTBIM (im. mon.'s bit table)
CALL TFUALL ;update JTALL
TFINF: MOVE T1,P1 ;pass starting point to mapinf
CALL MAPINF ;do all of his immediate inferiors
CALL TFINF1 ;trap forks inferiors
RET
TFINF1: MOVE P1,T1 ;copy forkn (of inf. fork)
MOVE P3,SUPERP ;get superior pointer
ADD P3,P1
LDB P3,P3 ;get forkn of superior fork
SKIPN T2,FKJTB(P1) ;does this fork have a monitor?
JRST TFINF3 ;no, point to superior's JTB
LOAD P2,JTIMP,(T2) ;P2=forkn of immediate mon for this fork
CAME P2,P3 ;is my monitor my immed. superior?
JRST TFINF3 ;no, point to superior's JTB
CALL TFUALL ;yes, update JTBAL
CALLRET TFINF ;do this forks inferiors, etc.
TFINF3: MOVE T1,FKJTB(P3) ;superior's JTB
MOVEM T1,FKJTB(P1) ;equals inferiors JTB
CALLRET TFINF ;do this forks inferiors, etc.
;UPDATE JTBAL, CALLED WHEN IMMED. MONITOR OF FORK IN P1 IS IT'S SUPERIOR
;P1/ FORKN OF INFERIOR TO SET/REMOVE TRAPS FOR
;P2/ FORKN OF P1'S IMMEDIATE MONITOR (ALSO IT'S SUPERIOR)
TFUALL: MOVSI T4,-JTBTL
HRR T4,FKJTB(P1) ;addr. of inf's JTB
HRRZ T3,FKJTB(P2) ;addr. of monitor's JTB (possibly null)
JUMPE T3,[MOVSI T1,JTBIM(T4) ;this forks JTBIM
HRRI T1,JTBAL(T4) ;equals this forks JTBAL
BLT T1,JTBAL+JTBTL-1(T4)
RET]
TFUAL1: MOVE T1,JTBAL(T3) ;monitor's JTBAL
IOR T1,JTBIM(T4) ;this fork's JTBIM
MOVEM T1,JTBAL(T4) ;this fork's JTBAL
AOS T3
AOBJN T4,TFUAL1
RET
;UPDATE JTBIM, CALLED FOR IMMED. INF. OF EXECUTING FORK ONLY
;P1/ FORKN OF THE IMMED. INF. FORK TO UPDATE
TFUBIM: MOVSI T4,-JTBTL
HRR T4,FKJTB(P1) ;addr. of inf's JTB
MOVE T3,P4 ;addr. of user table
MOVSI T2,(1B0) ; JSYS 0, or UUO trap bit
UMOVE T1,(T3) ; Get word that would be in
CALL TFIFST ; Form of set?
JRST TFUBI2 ; No
CAIE Q1,.TFSJU
CAIN Q1,.TFUUO ; Either form that allows B0 W0?
JRST [ IOR T1,T2 ; Yes, do that
CAIN Q1,.TFUUO ; UUO's only?
MOVE T1,T2 ; Then ignore that from bit tbl
JRST TFUB10]
ANDCAM T2,T1 ; No, remove it
CAIA
TFUBI1: UMOVE T1,(T3) ;user's table
TFUB10: IORM T1,JTBIM(T4) ;ored with existing table (maybe zero)
AOS T3
CAIE Q1,.TFUUO ; If UUO's only, get out
AOBJN T4,TFUBI1
RET
TFUBI2: CAIN Q1,.TFRUU ; Removing UUO traps?
JRST [ MOVE T1,T2 ; Then UUO's only
JRST TFUB20]
ANDCAM T2,T1 ; Can't remove UUO traps this way
CAIA
TFUB21: UMOVE T1,(T3) ;user's table
TFUB20: ANDCAM T1,JTBIM(T4) ;remove from JTB
AOS T3
CAIE Q1,.TFRUU ; If UUO's only, get out
AOBJN T4,TFUBI2
RET
TFIFST: CAIE Q1,.TFSET ; Check if function code is form of set
CAIN Q1,.TFSJU
JRST RSKP
CAIN Q1,.TFUUO
JRST RSKP
RET ; No form of set
;ASSIGN A NEW Jsys Trap Block (JTB)
;P1/ FORKN OF FORK TO ASSIGN TABLE
;RETURNS: +1 ALWAYS
;T2/ ADDRESS OF JTB
NEWJTB: MOVE T1,JTBFRE ;FREE STORAGE BIT TABLE
JFFO T1,.+2
BUG (NWJTBE)
MOVE T3,BITS(T2) ;MARK BLOCK AS ASSIGNED
ANDCAM T3,JTBFRE
IMULI T2,JTBSIZ ; Adr=(blk #*size)+ JTB pg adr+1
ADDI T2,JTBOFF ;FIRST WORD IS FREE BIT TABLE
HRLZI T1,JTBAL(T2)
HRRI T1,JTBAL+1(T2)
SETZM JTBAL(T2)
BLT T1,JTBSIZ-1(T2) ;CLEAR BOTH BIT TABLES
HRRZ T1,FORKN
MOVEM T1,JTBMN(T2) ;SET JTIMP TO FORK EXECUTING TFORK
MOVEM T2,FKJTB(P1) ;MAKE INF. FORK POINT TO JTB
RET
;RELEASE Jsys Trap Block
;P1/ FORKN OF FORK THAT HAS BLOCK ASSIGNED (TO BE RELEASED)
RELJTB: SKIPN T1,FKJTB(P1) ;GET ADDRESS OF JTB
RET ;IF THERE ISN'T A BLOCK ASSIGNED, RETRUN
SETZM FKJTB(P1) ;SAY FORK IS NO LONGER TRAPPED
SUBI T1,JTBOFF
IDIVI T1,JTBSIZ
MOVE T1,BITS(T1)
IORM T1,JTBFRE ;RELEASE BLOCK
RET
TFORK3: HLRZ T2,Q2 ;GET CHANNEL FROM COPY OF USER'S AC2
CAILE T2,^D35 ;LEGAL CHANNEL?
MOVEI T2,77 ;NO, ASSUME NO PSI'S WANTED
STOR T2,JTMCN ;SET THE CHANNEL
RET
TFORK4: LOAD T2,JTMCN ;GET CHANNEL NUMBER
XCTU [HRLM T2,2] ;RETURN IT IN LEFT HALF OF USER'S AC2
RET
TFORK5: SETZ T2, ;ASSUME NOT MONITORED
SKIPE @JTBLK ;ARE WE MONITORED?
SETO T2, ;YES, THEN SAY SO
UMOVEM T2,2 ;RETURN IN USER'S AC2
RET
;**;[3047] MAKE CHANGES TO ROUTINE TFORK6: 1-DEC-83 TAM
TFORK6: CALL FLOCK ;[3047] TFORK RESET
MOVSI T1,77 ;CLEAR PSI CHANNEL FOR TRAPS
STOR T1,JTMCN ;CAUSE MONITORED FORKS TO BYPASS US
MOVE T1,[XWD .TFRAL,-4] ;REMOVE TRAPS FROM ALL INFERIORS
TFORK ; Forks must be frozen; this has side
; effect of forcing forks queued with
; traps to this fork to bypass it
ERJMP [CALL FUNLK ;[3047] 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 [CALL FUNLK ;[3047] 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
CALLRET FUNLK ;[3047]
;RTFRK JSYS - READ TRAPPED FORK
; Returns +1 always with:
; 1: Relative fork handle; 0=> no fork currently trapped
; 2: JSYS instruction or UUO that caused fork to be trapped
.RTFRK::MCENT
LOAD T1,JTFRK ; Get job fork index
MOVE T2,JTTRW ; Get trapped JSYS or UUO instruction
JUMPE T1,RTFRK1 ; T1=0 if no fork trapped
PUSH P,T1 ; Save it
PUSH P,T2
CALL GFKH ; Get relative fork handle
ITERR FRKHX6 ; No handles left
MOVEM T1,-1(P) ; Save relative handle
NOSKED ; Prevent sched while clearing lock
SETZRO JTFRK ; Clear trapped fork
SETZM JTTRW ; And JSYS or UUO that we trapped on
CALL JTULCK
OKSKED
POP P,T2 ; JSYS or UUO
POP P,T1 ; Relative fork handle
RTFRK1: UMOVEM T1,1 ; Return stuff to user
UMOVEM T2,2
MRETNG
; UTFRK JSYS - Untrap fork
; Used to resume a trapped fork after a JSYS trap
; 1: Flags,,User handle for fork to untrap
; Flags: B0 (UT%TRP) ITRAP JSYS (or do ERJMP/ERCAL if present)
; Returns: +1 always
; NOOP if fork is not trapped or if executing fork is not permitted
; to untrap the fork (i.e. not forked trapped to or its superior).
.UTFRK::MCENT
MOVE P2,1 ; Get flags & fork handle
MOVEI T1,(P2) ; Check fork handle
TRNE T1,200000 ; Multiple?
ITERR FRKHX3 ; Not allowed
CALL FLOCK ; Nail down structure
CALL SETJFK ; Get job fork index
CALL SKIIF ; Is it an inferior?
ITERR FRKHX2,<CALL FUNLK> ; No, tell user
CALL CHKNXS ;Check if specified process is execute-only or not SELF
HRRZ FX,SYSFK(T1) ; FORKX of fork
CALL SETLF1 ; Map PSB
MOVEI P1,0(T1) ; Save offset to the PSB
MOVES PSBPGA(P1) ; Touch to aviod NOSKED page fault
NOSKED ; Let no others run
CALL CHKWT ; Fork waiting?
JRST UTFRK0 ; No, NOOP
HRRZ T2,FKSTAT(FX)
CAIE T2,FRZWT ; Is it frozen
JRST UTFRK0 ; No, NOOP
MOVSI T2,JTFRZB
TDNN T2,FKINT(FX) ; Fork trapped?
JRST UTFRK0 ; No, NOOP
LOAD T3,JTMNI,(P1) ; Job index of fork trapped to
CAMN T3,FORKN ; Same as executing fork?
JRST UTFRK2 ; Yes.
HRRZ T1,T3 ; Job index of fork trapped to
MOVE T2,FORKN
CALL SKIIFA ; Is that fork inf to ex. fork?
JRST UTFRK0 ; No, NOOP
UTFRK2: MOVEI T1,0(P1) ; Offset to fork's PSB
MOVEI T2,ITRAP
TLNE P2,(UT%TRP) ; Caller want us to bomb JSYS?
HRRM T2,PPC(T1) ; Yes, do that
MOVSI T2,JTFRZB
ANDCAB T2,FKINT(FX) ; Clear JSYS trap freeze
TLNE T2,FRZBB ; Is fork still frozen?
;**;[2617] REPLACE 1 LINE WITH 2 AT UTFRK2:+7L TAM 6-MAY-82
JRST [SETOM INTDF(T1) ;[2617] YES, MAKE IT OKINT
JRST UTFRK0] ;[2617] AND FINISH UP
SKIPN T2,PIOLDS(T1) ; No, resume it
JRST [ CALL UNBLK1 ; Unblock fork
JRST UTFRK3]
MOVEM T2,FKSTAT(FX)
;**;[1950] Add one line at UTFRK2: +12L RAS 30-SEP-81
SETOM INTDF(T1) ;[1950] Since process not resumed, OKINT it
CALL RECONC ; Update wait lists
UTFRK3: CALL CLRSFK ; Clear FKINT bit 1
UTFRK0: OKSKED ; NOOP exit
CALL CLRLFK
CALL FUNLK
MRETNG
; SCTTY - Set fork controlling TTY (Terminal PSI)
; 1: Function code,,fork handle
; 2: Source designator (only tty designator implemented)
; Function codes:
; 0: (.SCRET) Return designator for fork in 2
; 1: (.SCSET) Set fork controlling TTY
; 2: (.SCRST) Clear fork controlling TTY (restores job CTTY)
.SCTTY::MCENT
CALL FLOCK ; Prevent meddling
HRRZ P1,1 ; Get fork
MOVE P2,2 ; Get designator
HLRZ P3,1 ; Function number
HRRZ T1,P1 ; Fork
CALL STJFKR ; Job fork number
ITERR(FRKHX1,<CALL FUNLK>)
CALL SKIIF ; Is fork an inferior?
ITERR(FRKHX2,<CALL FUNLK>) ; No, that's not legal
HRRZ P1,T1 ; Update to Job fork number
CAIL P3,0 ; Check range on functions
CAILE P3,.SCRST ; In range?
ITERR(SCTX1,<CALL FUNLK>) ; Undefined function code
XCT SCTFUN(P3) ; Do it
CALL FUNLK ; Returns here successful
MRETNG
SCTFUN: CALL SCTT0 ; Return CTTY for fork
CALL SCTSET ; Set CTTY
CALL SCTCLR ; Clear it (reset to JOB's)
SCTT0: HRRZ T1,P1 ; Job fork number
IDIVI T1,2
ADD T1,FKCTYP(T2) ; Make ptr into tbl
LDB T2,T1 ; Get the proper entry
UMOVEM T2,2 ; And hand to user
RET
CHKSCT: MOVX T1,SC%SCT ; Allowed to fiddle CTTY's?
TDNN T1,CAPENB ; ..
ITERR (SCTX4,<CALL FUNLK>)
RET ; OK
; Function to set a new controlling TTY for a fork and its inferiors
SCTSET: CALL CHKSCT ; Quit if not allowed to do this
MOVE T2,P2 ; Get designator
TRZN T2,1B18 ; DES = 4XXXXX?
ITERR(DESX1,<CALL FUNLK>) ; No
CAIGE T2,NLINES ; Check as a legal line #
CAIGE T2,0
ITERR(DESX1,<CALL FUNLK>) ; Isn't
LOCK DEVLCK,<CALL LCKTST>
CALL GTCJOB ; WHO OWNS THIS TTY?
CAIA ; NOBODY
CAME T3,JOBNO ; US?
ITERR(DEVX2,<UNLOCK DEVLCK
CALL FUNLK>)
CAMN T2,CTRLTT ; Job CTTY?
ITERR(SCTX3,<UNLOCK DEVLCK
CALL FUNLK>)
CALL GTTOPF ; 3 := TOP FK FOR WHICH THIS TTY IS CTTY
CAIA ; CAN'T FAIL. GIVE ERROR IF IT DOES
CAIE T3,-1 ; Null fork?
ITERR(SCTX2,<UNLOCK DEVLCK
CALL FUNLK>)
MOVEI T1,-2 ; This is just a "different" value
CALL STTOPF ; SET TOP FORK TO "ASSIGNING"
UNLOCK DEVLCK
MOVE T3,P2 ; Retrieve original designator
JRST SCTT21 ; Enter mainline
; Function to remove special controlling terminal from a fork and
; its inferiors. It reverts to the job's CTTY.
SCTCLR: CALL CHKSCT ; Is process privileged to do this?
MOVEI T3,-1 ; Restore fork CTTY to job CTTY
;Here to set the designator in T3 to be the controlling terminal
; for the fork in P1.
SCTT21: MOVE P3,T3 ; New designator
HRRZ T2,FORKN ; Fork number of self
HRRZ T1,P1 ; Job fork number we are setting
CAIN T2,0(P1) ; Setting own CTTY?
CALL MAPINF ; Yes, freeze inferiors only
;**;[1783] Change one line at SCTT21: +5L JGZ 15-SEP-80
CALL FFORK3 ;[1783] Freeze forks (updates TTPSI words)
HRRZ T1,P1 ; Job number we are setting
HLRZ T4,FORKN ; Top job fork
MOVEI Q1,(T1) ; Compute pointer to its superior
ADD Q1,SUPERP ; ..
LDB Q1,Q1 ; Job fork number of its superior
MOVEI T2,377777 ; NULL designator, just something that
; the previous CTTY won't be.
IDIVI Q1,2 ; Get the CTTY of the superior
ADD Q1,FKCTYP(Q2)
CAIE T4,0(T1) ; Fork being changed=top job fork?
LDB T2,Q1 ; Get designator of superior's old CTTY
HRRZ T3,P3 ; New designator for desired fork's ctty
CALL SCTT3 ; Set new CTTY for fork and inferiors
CAIN T3,-1 ; Was that all set to job CTTY?
JRST SCTT22 ; Yes, skip following stuff
MOVEI T2,-400000(T3) ; It's a real line. Must set it to know
PUSH P,T1 ; what FORKX to poke on an interrupt char
HRRZ T1,SYSFK(T1) ; Get system FORKX for that fork.
CALL STTOPF ; Set top fork in TTYSRV data base
POP P,T1 ; Restore job fork number
SCTT22: HRRZ T2,FORKN
CAIN T2,0(P1) ; Resume the forks that we froze
CALL MAPINF
;**;[1783] Change one line at SCTT22: +3L JGZ 15-SEP-80
CALL RFORK3 ;[1783] Resume forks (updates TTPSI words)
RET
; Change the CTTY for some fork and its inferiors
;1/ Job fork index
;2/ Superior fork's prev CTTY designator
;3/ New CTTY designator for fork in 1
SCTT3: MOVEI Q1,0(T1) ; Fork index
IDIVI Q1,2
ADD Q1,FKCTYP(Q2) ; Make ptr to correct entry
LDB T4,Q1 ; Get old CTTY
DPB T3,Q1 ; And store NEW
CAIE T4,0(T3) ; New CTTY=old CTTY?
CAIN T4,0(T2) ; Prev CTTY same as sup's prev CTTY?
JRST SCTT5 ; Yes
;Here if this fork is getting a new CTTY, and it also used to have
; a CTTY which wasn't the same as its superior's CTTY.
CAIN T4,-1 ; Was prev CTTY job CTTY?
JRST SCTT4 ; Yes, no need to fix TTFRK1
MOVEI Q2,0(T4) ; No, prev des (assumed to be TTY des)
TRZN Q2,1B18 ; Convert to line #
JRST SCTT4 ; Not a TTY designator
CAIGE Q2,NLINES ; Is it valid?
CAIGE Q2,0
JRST SCTT4 ; No, don't touch TTFRK1
PUSH P,T1 ; Shuffle some AC's for TTYSRV calls
PUSH P,T2 ; ..
MOVEI T2,(Q2) ; Line number
SETO T1,0 ; CLEAR ALL BITS IN TERMINAL PSI WORD
CALL CLRINT ; ..
MOVEI T2,(Q2) ; Line number
CALL STTOPF ; AND SET -1 AS TOP FORK FOR THIS TTY
POP P,T2 ; Restore ac's
POP P,T1 ; ..
SCTT4:
;Here if a different "superior's CTTY" must be told to inferiors
PUSH P,T2 ; Save this fork's SUPERIOR's previous CTTY
MOVEI T2,0(T4) ; Set prev CTTY for inferiors to be old
; CTTY of this fork.
JRST SCTT6 ; Go tell the inferiors
; Here if the "Superior's CTTY" to be told to inferiors is same as
; the one this fork was told
SCTT5: PUSH P,T2 ; Save this fork's superior's previous CTTY
SCTT6: HRLM T1,0(P) ; Save current fork
CALL MAPINF
CALL SCTT3 ; Do above for inferiors
HLRZ T1,0(P) ; Restore current fork
POP P,T2 ; Restore previous CTTY os superior
HRRZS T2 ; Clear fork from LH (saving stack space)
RET ; Done
TNXEND
END