Trailing-Edge
-
PDP-10 Archives
-
BB-M780B-SM
-
monitor-sources/fork.mac
There are 53 other files named fork.mac in the archive. Click here to see a list.
; UPD ID= 41, SNARK:<5.1.MONITOR>FORK.MAC.4, 8-Sep-82 15:20:08 by COBB
;TCO 5.1.1060 - Use correct register (T2) for EDIT 2645 (below) at TRMTST
; UPD ID= 90, FARK:<5-WORKING-SOURCES.MONITOR>FORK.MAC.7, 12-Aug-82 11:11:44 by MOSER
;EDIT 2645 - CHECK MINOR FORK STATE IN TRMTST
; UPD ID= 74, FARK:<5-WORKING-SOURCES.MONITOR>FORK.MAC.5, 29-Jul-82 12:52:28 by TSANG
;Edit 2636 - Check for negative before check for LH non-0 in GCVEC%.
; UPD ID= 62, FARK:<5-WORKING-SOURCES.MONITOR>FORK.MAC.4, 11-Jun-82 13:13:57 by DONAHUE
;Edit 2627 - Don't let GJCAPS return privileges the job shouldn't have
; UPD ID= 40, FARK:<5-WORKING-SOURCES.MONITOR>FORK.MAC.3, 6-May-82 15:38:43 by MOSER
;EDIT 2617 - OKINT FROZEN FORK WHEN UNTRAPPING.
; UPD ID= 575, SNARK:<5.MONITOR>FORK.MAC.45, 13-Apr-82 17:01:28 by PAETZOLD
;TCO 5.1774 - Fix SCVEC% -1.
; UPD ID= 561, SNARK:<5.MONITOR>FORK.MAC.44, 24-Mar-82 09:19:57 by PAETZOLD
;TCO 5.1768 - Turn FLKTIM lock reset code back on
; UPD ID= 550, SNARK:<5.MONITOR>FORK.MAC.42, 18-Mar-82 03:20:39 by PAETZOLD
;TCO 5.1761 - Fix LOKK macro in SCTSET
; UPD ID= 533, SNARK:<5.MONITOR>FORK.MAC.41, 11-Mar-82 21:44:51 by PAETZOLD
;TCO 5.1751 - Zero PATLEV when zeroing PATADR in SEVC
; UPD ID= 447, SNARK:<5.MONITOR>FORK.MAC.40, 29-Jan-82 11:29:37 by WALLACE
;TCO 5.1706 - Fix three problems with XGTPW%: 1) Properly return
; page trap address from page fail word. 2) Get OpCode from right
; half of MUUO OpCode word. 3) Fix counter so the number of words
; requested by user will be returned. Count was off by one.
;TCO 5.1703 - Initialize Previous Context Section (PCS) to section
; number of entry vector in the SFRKV% routine, SFRKV5
;TCO 5.1702 - Make .POLOC function of PDVOP% return the number of
; available PDVA's in the left half of argument block word .POCT2
; as well as the actual number of PDVA's returned in the right half
; UPD ID= 443, SNARK:<5.MONITOR>FORK.MAC.39, 26-Jan-82 18:43:41 by MURPHY
;DITTO
; UPD ID= 439, SNARK:<5.MONITOR>FORK.MAC.38, 25-Jan-82 00:01:20 by MURPHY
;TCO 5.1697 - XSSEV%, etc. Move GETPAT and GETDMS from MEXEC.MAC to here.
; UPD ID= 431, SNARK:<5.MONITOR>FORK.MAC.37, 22-Jan-82 07:03:52 by GRANT
;Typo in previous edit
; UPD ID= 430, SNARK:<5.MONITOR>FORK.MAC.36, 22-Jan-82 06:47:12 by GRANT
;TCO 5.1695 - Add "interruptable test" to WAIT JSYS
; UPD ID= 414, SNARK:<5.MONITOR>FORK.MAC.35, 19-Jan-82 08:03:49 by MILLER
;MORE OF THE SAME
; UPD ID= 412, SNARK:<5.MONITOR>FORK.MAC.33, 18-Jan-82 18:43:02 by MILLER
;TCO 5.1678 again. Release TTY if top fork and FRKTTY is set
; UPD ID= 411, SNARK:<5.MONITOR>FORK.MAC.32, 18-Jan-82 17:46:59 by MILLER
; UPD ID= 409, SNARK:<5.MONITOR>FORK.MAC.31, 18-Jan-82 14:27:07 by MILLER
;TCO 5.1678. Don't call TTYDAS for FRKTTY TTY when fork goes away
; Make sure TTY in SCTTY is assigned to this job
; UPD ID= 388, SNARK:<5.MONITOR>FORK.MAC.30, 9-Jan-82 19:37:19 by PAETZOLD
;TCO 5.1662 - Unlock FKLOCK during error processing for MSETPT in CFK4
; UPD ID= 313, SNARK:<5.MONITOR>FORK.MAC.29, 6-Nov-81 12:29:18 by MURPHY
;TCO 5.1608 - extended address for MSFRK.
; UPD ID= 306, SNARK:<5.MONITOR>FORK.MAC.27, 3-Nov-81 15:51:46 by FLEMMING
; UPD ID= 268, SNARK:<5.MONITOR>FORK.MAC.26, 16-Oct-81 17:15:21 by MURPHY
;More TCO 5.1265 - Ignore FH%EPN bit in fork handles.
; UPD ID= 267, SNARK:<5.MONITOR>FORK.MAC.25, 16-Oct-81 17:10:06 by WALLACE
;TCO 5.1558 - Make .PONAM function of PDVOP% include section number of
; the PDVA in the addresses of a name string if no section number is
; specified in the PDV.
; UPD ID= 237, SNARK:<5.MONITOR>FORK.MAC.24, 2-Oct-81 13:14:47 by SCHMITT
;TCO 5.1548 - OKINT Jsys trapped process if not resumed in UTFRK JSYS
; UPD ID= 84, SNARK:<5.MONITOR>FORK.MAC.23, 30-Jul-81 07:10:33 by FLEMMING
;add code for XGTPW
; UPD ID= 50, SNARK:<5.MONITOR>FORK.MAC.22, 19-Jul-81 06:38:39 by FLEMMING
;TCO 5.1422 - turn on PM%EPN when PMAPping away section 0
; UPD ID= 45, SNARK:<5.MONITOR>FORK.MAC.21, 17-Jul-81 16:18:16 by MURPHY
;TCO 5.1398 - SKIP RETURN FROM MSETPT
; UPD ID= 1993, SNARK:<5.MONITOR>FORK.MAC.20, 14-May-81 13:22:18 by HALL
;Temporary addition to previous edit -- wait a while after FLKTIM BUGCHK
; UPD ID= 1928, SNARK:<5.MONITOR>FORK.MAC.19, 4-May-81 09:47:40 by GRANT
;Add FORKN optional data to FLKNS; don't commandeer the lock after a FLKTIM
; UPD ID= 1875, SNARK:<5.MONITOR>FORK.MAC.18, 23-Apr-81 16:11:33 by SCHMITT
;More TCO 5.1296 - Change around previous edit
; UPD ID= 1869, SNARK:<5.MONITOR>FORK.MAC.17, 22-Apr-81 11:05:59 by SCHMITT
;TCO 5.1296 - Call CLRVGN before loading ACS in CFK1
; UPD ID= 1658, SNARK:<5.MONITOR>FORK.MAC.16, 10-Mar-81 09:06:42 by FLEMMING
; UPD ID= 1602, SNARK:<5.MONITOR>FORK.MAC.15, 27-Feb-81 09:52:42 by FLEMMING
;tco 5.1265 - fix RMAP returning wrong access information
; UPD ID= 1441, SNARK:<5.MONITOR>FORK.MAC.14, 15-Jan-81 15:52:20 by FLEMMING
;add code for SMAP/RSMAP
; UPD ID= 1328, SNARK:<5.MONITOR>FORK.MAC.13, 1-Dec-80 16:11:13 by OSMAN
;tco 5.1205 - Add XGVEC and XSVEC jsyses
;tco 5.1204 - Add XSFRK jsys
; UPD ID= 1284, SNARK:<5.MONITOR>FORK.MAC.12, 18-Nov-80 14:39:44 by OSMAN
;Fixups for runing programs in other sections
;Use only right half of .JBSA and .JBREN
; UPD ID= 1196, SNARK:<5.MONITOR>FORK.MAC.11, 25-Oct-80 12:14:59 by HALL
;TCO 5.1180 - MOVE THE DST TO NON-ZERO SECTION
; KFORK -- MAKE KILLED FORK START IN SECTION 1 AT KSELF
; UPD ID= 1084, SNARK:<5.MONITOR>FORK.MAC.10, 1-Oct-80 11:59:27 by MURPHY
;FIX ACVAR
; UPD ID= 1012, SNARK:<5.MONITOR>FORK.MAC.9, 12-Sep-80 14:21:45 by OSMAN
;tco 5.1145 - Fix SCTTY to not thaw frozen forks.
; UPD ID= 962, SNARK:<5.MONITOR>FORK.MAC.8, 25-Aug-80 16:26:39 by ENGEL
;TCO 5.1136 - ADD DEVLKK
; UPD ID= 840, SNARK:<5.MONITOR>FORK.MAC.7, 5-Aug-80 16:19:37 by OSMAN
;tco 5.1109 - Add PDVOP%
; UPD ID= 795, SNARK:<5.MONITOR>FORK.MAC.6, 24-Jul-80 09:21:26 by OSMAN
;Add temporary .PDVOP for until real one is in
; UPD ID= 709, SNARK:<5.MONITOR>FORK.MAC.5, 26-Jun-80 17:01:06 by SANICHARA
;TCO 5.1085 - ALLOW CH 23 TO USER ASSIGNABLE
; UPD ID= 670, SNARK:<5.MONITOR>FORK.MAC.4, 17-Jun-80 16:36:34 by KONEN
;TCO 5.1068 - DO DESTRUCTIVE PMAP IN KSELF IF OF%DUD IS ON
; UPD ID= 564, SNARK:<5.MONITOR>FORK.MAC.3, 28-May-80 15:18:52 by ZIMA
;TCO 5.1049 - FIX SECURITY CHECK IN MSFRK
; UPD ID= 435, SNARK:<5.MONITOR>FORK.MAC.2, 13-Apr-80 15:13:22 by OSMAN
; UPD ID= 427, SNARK:<4.1.MONITOR>FORK.MAC.250, 13-Apr-80 14:34:51 by OSMAN
;<OSMAN.MON>FORK.MAC.2, 10-Apr-80 17:51:10, EDIT BY OSMAN
;Shorten source by using FRKTTY instead of FKCTYP
; UPD ID= 392, SNARK:<4.1.MONITOR>FORK.MAC.249, 31-Mar-80 13:59:57 by OSMAN
;tco 4.1.1132 - Fix EPCAP to always trim AC3 according to what fork's allowed
;capabilities are, regardless of wheel.
; UPD ID= 283, SNARK:<4.1.MONITOR>FORK.MAC.248, 20-Feb-80 17:55:31 by MURPHY
;MAKE FKINT BITS FULL-WORD DEF
; UPD ID= 225, SNARK:<4.1.MONITOR>FORK.MAC.247, 25-Jan-80 11:28:38 by GRANT
;TCO 4.2598 - ADD CHECK FOR PRARG JSB FREE SPACE TO KSELF
; UPD ID= 62, SNARK:<4.1.MONITOR>FORK.MAC.246, 29-Nov-79 16:34:15 by MILLER
;ONE MORE TIME. FIX UP FKLOCK WHEN NEXTING
; UPD ID= 58, SNARK:<4.1.MONITOR>FORK.MAC.245, 29-Nov-79 13:39:57 by MILLER
;TCO 4.1.1036. FKLOCK ALWAYS NESTS WITHIN A PROCESS
; UPD ID= 56, SNARK:<4.1.MONITOR>FORK.MAC.244, 29-Nov-79 12:26:58 by MILLER
;MORE.... FIX FLOCK, FLOCKN AND FUNLKI
; UPD ID= 52, SNARK:<4.1.MONITOR>FORK.MAC.243, 29-Nov-79 10:28:37 by MILLER
;TCO 4.1.1026. ADD FUNLKI ENTRY
; UPD ID= 38, SNARK:<4.1.MONITOR>FORK.MAC.242, 28-Nov-79 11:06:55 by MILLER
;TCO 4.2582 AGAIN. SET FKTIMW LARGE WHEN UNLOCKED
; UPD ID= 35, SNARK:<4.1.MONITOR>FORK.MAC.241, 28-Nov-79 10:58:26 by MILLER
; UPD ID= 32, SNARK:<4.MONITOR>FORK.MAC.239, 28-Nov-79 10:50:56 by MILLER
;TCO 4.2582. ADD CHECK AND SET FOR FKTIMW
; UPD ID= 16, SNARK:<4.1.MONITOR>FORK.MAC.240, 27-Nov-79 10:29:05 by OSMAN
;Document FLKTIM
; UPD ID= 8, SNARK:<4.1.MONITOR>FORK.MAC.239, 21-Nov-79 14:52:34 by OSMAN
;<4.1.MONITOR>FORK.MAC.238, 16-Nov-79 14:50:41, EDIT BY ENGEL
;PUT INTERNAL LINE NUMBER INTO T2 AT CALL TO STTOPF IN SCTT3
;<4.MONITOR>FORK.MAC.237, 9-Nov-79 16:24:20, EDIT BY HALL
;CIS JSYS - DON'T CLEAR PSXSIR BECAUSE LEVTAB AND CHNTAB AREN'T CLEARED
;<4.MONITOR>FORK.MAC.236, 3-Nov-79 07:54:32, EDIT BY R.ACE
;FIX NON-ZERO SECTION DELETION IN KSELF
;<4.MONITOR>FORK.MAC.235, 29-Oct-79 10:44:21, EDIT BY MILLER
;FIX CODE AT MAPBLW
;<4.MONITOR>FORK.MAC.234, 20-Oct-79 14:03:28, EDIT BY MILLER
;TWO CHANGES. EDIT BY HALL: APPLY PCS IN FKHPTN IF
; FORK HANDLE IS SELF AND SECTION NUMBER IS 0. EDIT BY MILLER:
; FIX MAPFKH TO ALLOW COROUTINE TO SPECIFY BLOCKING
;<4.MONITOR>FORK.MAC.232, 12-Oct-79 13:28:27, EDIT BY MURPHY
;FURTHER REVISION OF SFORK TO PREVENT RACES
;<4.MONITOR>FORK.MAC.231, 9-Oct-79 15:36:26, EDIT BY MILLER
;BRACKET CODE IN SFORK THAT PROCESSES GETOK AND JSB STACK
; WITH OKSKED AND NOSKED
;<4.MONITOR>FORK.MAC.230, 1-Oct-79 15:43:34, EDIT BY HALL
;REMOVE ENTRY FKHPTA FROM ROUTINE FKHPTN -- NEED TO PROHIBIT PMAP
;AT A HIGHER LEVEL THAN THIS IF AT ALL
;<4.MONITOR>FORK.MAC.229, 1-Oct-79 15:34:03, EDIT BY HALL
;XSIR - FIX BUG IN XOR FOR LEVTAB
;CIS - CLEAR FLAG FOR EXTENDED SIR
;<4.MONITOR>FORK.MAC.228, 1-Oct-79 08:18:56, EDIT BY R.ACE
;FIX COMPUTATION OF END OF CHANNEL TABLE AND LEVEL TABLE
;<4.MONITOR>FORK.MAC.227, 29-Sep-79 14:51:06, EDIT BY HALL
;FKHPTN - REMOVE TEMPORARY COMMENT AND ALREADY-COMMENTED-OUT LITERAL
;RESTORE RIR, MAKE XRIR
;RESTORE SIR, MAKE XSIR
;<4.MONITOR>FORK.MAC.226, 28-Sep-79 18:50:17, EDIT BY HELLIWELL
;<4.MONITOR>FORK.MAC.225, 28-Sep-79 18:09:42, EDIT BY HELLIWELL
;TEST FOR PSUTPS IN KSELF AND CALLS TTDTPS IF SET
;THIS REMOVES THE FORK # FROM ANY TTY DATABASES WHICH MAY HAVE IT
;SET FOR NON-CONTROLLING TERMINAL INTERRUPTS
;<4.MONITOR>FORK.MAC.224, 26-Sep-79 15:47:14, EDIT BY HALL
;RFACS - CALL BLTMU1 INSTEAD OF BLTMU FOR EXTENDED ADDRESSING
;CFK1 AND .SFACS - CALL BLTUM1 INSTEAD OF BLTUM FOR EXTENDED ADDRESSING
;<4.MONITOR>FORK.MAC.223, 21-Sep-79 13:44:43, EDIT BY MURPHY
;MAKE SUSFK RETURN NOSKED LIKE IT USTA - PREVENTS RACES
;<4.MONITOR>FORK.MAC.222, 13-Sep-79 11:10:29, EDIT BY HALL
;FUNLK - IMPROVE EDIT 220 BY DETECTING OVERLY DECREMENTED FLKCNT
;<OSMAN.MON>FORK.MAC.1, 10-Sep-79 15:30:33, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>FORK.MAC.220, 7-Sep-79 17:24:31, EDIT BY HALL
;FUNLK - DON'T LET FLKCNT GO BELOW ZERO
;<4.MONITOR>FORK.MAC.219, 30-Aug-79 08:48:14, EDIT BY R.ACE
;FIX BAD FORK INDEX IN FFORK1
;<4.MONITOR>FORK.MAC.218, 17-Aug-79 10:55:49, EDIT BY HALL
;PTNFKH - CONVERT PAGE NUMBER IN NON-ZERO SECTION TO ABSOLUTE
;PAGE NUMBER, RETURN +1 AND +2
;<4.MONITOR>FORK.MAC.217, 11-Aug-79 07:55:29, EDIT BY HALL
;ADD NEW ENTRY POINT TO FLOCK TO ALLOW NESTED LOCKING.
;<4.MONITOR>FORK.MAC.216, 28-Jul-79 11:53:52, EDIT BY R.ACE
;RIR - INDEX BY T1 WHEN LOADING FROM CHNTAB AND LEVTAB
;<4.MONITOR>FORK.MAC.215, 26-Jul-79 15:22:19, EDIT BY HALL
;RIR - FIX LOADING OF LEVTAB INTO T2 FOR OLD STYLE RIR
;<4.MONITOR>FORK.MAC.214, 15-Jul-79 11:40:14, EDIT BY HALL
;FKHPTN - DON'T GIVE PMAPX4 ERROR WHEN NON-ZERO SECTION IS
;MAPPED TO AN OFN
;<4.MONITOR>FORK.MAC.213, 13-Jul-79 16:19:39, EDIT BY HALL
;PROVIDE EXTENDED VERSIONS OF SIR AND RIR
;<4.MONITOR>FORK.MAC.212, 21-Jun-79 14:44:05, EDIT BY DBELL
;MORE TCO 4.2283 - MAKE CFORK SET SFSRT IF CR%ST WAS SET
;<4.MONITOR>FORK.MAC.211, 14-Jun-79 12:13:54, EDIT BY DBELL
;FIX TCO 4.2283 BY CORRECTLY OBTAINING JOB FORK NUMBER
;<4.MONITOR>FORK.MAC.210, 11-Jun-79 19:53:24, EDIT BY DBELL
;TCO 4.2283 - DON'T ALLOW SFORK TO DO CONTINUES UNTIL FORK HAS BEEN STARTED
;<4.MONITOR>FORK.MAC.209, 8-Jun-79 14:07:18, EDIT BY DBELL
;TCO 4.2280 - FIX RACE IN CFORK CONCERNING ASSIGNMENT OF JOB FORK SLOTS
;<4.MONITOR>FORK.MAC.208, 10-May-79 15:35:45, EDIT BY HALL
;TCO 4.2243 - FIX TWO BUGS IN .FFORK - PRESERVE T1 OVER CALL
;TO FFORK1, AND FIX UP T2 BEFORE GETTING THE CONTROLLING TERMINAL
;FOR CALLING FORK
;<4.MONITOR>FORK.MAC.207, 30-Apr-79 17:51:56, EDIT BY MILLER
;MAKE FLOCK WAIT TIME 200 MS
;<4.MONITOR>FORK.MAC.206, 23-Apr-79 13:58:36, Edit by MCLEAN
;RETURN EPCAP TO WHAT IT WAS EARLIER.....
;<4.MONITOR>FORK.MAC.205, 21-Apr-79 19:56:40, Edit by MCLEAN
;DUMB IDEA BUT MAKE .EPCAP QUIETLY RETURN ON GETOK FAILURE
;<4.MONITOR>FORK.MAC.204, 14-Apr-79 22:36:12, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.203, 14-Apr-79 22:16:42, Edit by MCLEAN
;ADD KILL FOR ACJ FORK
;<4.MONITOR>FORK.MAC.202, 11-Apr-79 12:53:33, Edit by MCLEAN
;FIX FORK COUNT IN CFORK TO BE EARLIER
;<4.MONITOR>FORK.MAC.201, 5-Apr-79 11:51:18, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.200, 5-Apr-79 11:47:19, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.199, 5-Apr-79 11:23:02, Edit by MCLEAN
;REMOVE 1ST ARG FROM GTOKM
;<4.MONITOR>FORK.MAC.198, 4-Apr-79 13:17:58, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.197, 4-Apr-79 13:16:58, Edit by MCLEAN
;FIX .CFORK SO GETOK IS EARLIER
;<4.MONITOR>FORK.MAC.196, 4-Apr-79 13:08:15, Edit by MCLEAN
;MAKE .GOCFK RETURN CURRENT NUMBER NOT NEXT NUMBER IF SUCCESS
;<4.MONITOR>FORK.MAC.195, 23-Mar-79 11:13:14, EDIT BY HALL
;FLOCK - PRINT FORK NUMBER AND JOB NUMBER IN FLKTIM BUGCHK
;<4.MONITOR>FORK.MAC.194, 22-Mar-79 13:10:42, Edit by MCLEAN
;FIX CALLS TO GOKFRE TO HAVE CORRECT ARGUMENTS AND MAKE NTCOFF NOT SKIP OVER MOVEI
;<4.MONITOR>FORK.MAC.193, 13-Mar-79 18:08:16, Edit by HURLEY
;REMOVE GETOK FROM FORK
;<4.MONITOR>FORK.MAC.192, 11-Mar-79 21:00:35, Edit by MCLEAN
;FIX GETOK IN EPCAP AND FORK
;<4.MONITOR>FORK.MAC.191, 4-Mar-79 17:18:08, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>FORK.MAC.190, 18-Feb-79 13:45:23, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.189, 18-Feb-79 13:33:29, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.188, 18-Feb-79 13:30:58, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.187, 18-Feb-79 13:27:05, Edit by MCLEAN
;MORE GETOK FIXES FOR FORK COUNT AND EPCAP
;<4.MONITOR>FORK.MAC.186, 17-Feb-79 13:41:25, EDIT BY DBELL
;IN KSELF, RELEASE PAGE USED BY MDDT
;<4.MONITOR>FORK.MAC.185, 8-Feb-79 13:47:31, EDIT BY MILLER
;FIX SFORK CONTINUE NOT TO LOSE BLOCKED STATE
;<4.MONITOR>FORK.MAC.184, 16-Jan-79 11:03:59, EDIT BY MILLER
;CHECK FOR SECTION ZERO PAGE IN FKHPTN AND DO FAST COMPUTATION OF PTN.PN
;<4.MONITOR>FORK.MAC.183, 15-Jan-79 14:06:18, Edit by KONEN
;ADD CHECK FOR ALLOWING USE OF STR, EVEN IF NOT INCREMENTED
;<4.MONITOR>FORK.MAC.182, 2-Jan-79 16:05:24, Edit by MCLEAN
;FIX EPCAP SO GETOK IS ONLY FOR A CHANGE
;<4.MONITOR>FORK.MAC.181, 21-Dec-78 11:23:45, EDIT BY ENGEL
;CLEAN UP NETWORK TOPOLOGY CHANGE INTERRUPT TABLES AT KSELF
;<4.MONITOR>FORK.MAC.180, 19-Dec-78 15:30:56, EDIT BY MURPHY
;ADD BLOCK PRIORITY TO VARIOUS SCHED CALLS
;<4.MONITOR>FORK.MAC.179, 17-Dec-78 01:26:31, Edit by MCLEAN
;FIX SUSFK SO IT RETURNS OKSKED
;<4.MONITOR>FORK.MAC.178, 11-Dec-78 18:45:38, Edit by MCLEAN
;FIX EPCAP TO GIVE CORRECT WORD TO GETOK
;<4.MONITOR>FORK.MAC.177, 7-Dec-78 14:29:05, EDIT BY MURPHY
;NEW SWAP LOGIC
;<4.MONITOR>FORK.MAC.176, 9-Nov-78 13:26:19, EDIT BY OSMAN
;ADD WAIT1::
;<KONEN>FORK.MAC.3, 10-Aug-78 11:15:17, Edit by KONEN
;ADD CODE TO KSELF TO CLEAR FORK STRUCTURE MOUNTS
;<4.MONITOR>FORK.MAC.174, 23-Oct-78 15:10:14, EDIT BY MILLER
;BE CKSED WITH FORK LOCK LOCKED
;<4.MONITOR>FORK.MAC.173, 13-Oct-78 13:36:35, EDIT BY R.ACE
;CHANGE SMAP TO SMAP%
;<4.MONITOR>FORK.MAC.172, 19-Sep-78 06:48:56, EDIT BY R.ACE
;TCO 4.2013 - ADDED CHKINT TO EIR JSYS
;<4.MONITOR>FORK.MAC.171, 16-Sep-78 13:46:58, EDIT BY MILLER
;MORE FIXES TO MSFRK
;<4.MONITOR>FORK.MAC.170, 16-Sep-78 13:37:18, EDIT BY MILLER
;MAKE ANY FORK STARTED WITH MSFRK HAVE PRIROITY
;<4.MONITOR>FORK.MAC.169, 15-Sep-78 11:02:42, EDIT BY MILLER
;ALLOW SJPRI IF CALL IS FROM MONITOR
;<4.MONITOR>FORK.MAC.168, 28-Aug-78 08:14:09, EDIT BY MILLER
;ADD FKHPTA TO ALLOW "MAPPING" OF ANY SECTION
;<4.MONITOR>FORK.MAC.167, 18-Aug-78 12:46:50, EDIT BY MILLER
;DISALLOW FKHPTN IF SECTION IS A "FILE SECTION"
;<4.MONITOR>FORK.MAC.166, 17-Aug-78 08:58:22, EDIT BY MILLER
;MAKE FKHPTN ACCEPT ANY VALID SECTION
;<4.MONITOR>FORK.MAC.165, 15-Aug-78 14:17:01, Edit by PORCHER
;MAKE SFORK-SF%CON LEAVE PRE-FREEZE STATE ALONE
; IF PROCESS NOT HALTED OR FORCED TERMINATION
;<4.MONITOR>FORK.MAC.164, 15-Aug-78 08:04:50, EDIT BY MILLER
;MAKE NOOP WITH SF%CON A NOOP IF FORK NOT HALTED
;<4.MONITOR>FORK.MAC.163, 31-Jul-78 13:26:35, EDIT BY MILLER
;<4.MONITOR>FORK.MAC.162, 28-Jul-78 13:42:23, EDIT BY MILLER
;MORE FIXES TO SMAP CODE
;<4.MONITOR>FORK.MAC.161, 28-Jul-78 09:25:45, EDIT BY MILLER
;FIX SMAP REFERECNE
;<4.MONITOR>FORK.MAC.160, 28-Jul-78 01:18:47, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.159, 25-Jul-78 15:02:48, Edit by PORCHER
;MORE...
;<4.MONITOR>FORK.MAC.158, 25-Jul-78 12:00:36, Edit by PORCHER
;TCO 1952 - ADD SF%CON FUNCTION TO SFORK - CONTINUE PROCESS
;ALLOW WHEELS TO DIDDLE EXECUTE-ONLY PROCESSES
;<4.MONITOR>FORK.MAC.157, 25-Jul-78 08:10:20, EDIT BY MILLER
;DO AN SMAP IN KSELF
;<4.MONITOR>FORK.MAC.156, 19-Jul-78 01:58:29, Edit by MCLEAN
;<4.MONITOR>FORK.MAC.155, 18-Jul-78 00:12:27, Edit by MCLEAN
;TCO 1939 KILL MAGTAPE ONLINE/OFFLINE PSI'S ON KILLING FORKS
;<4.MONITOR>FORK.MAC.154, 6-Jul-78 16:52:11, EDIT BY MILLER
;TCO 1929 AGAIN. FIX SJPRI TO SCAN MAPPED JSB AND FIND ALL FORKS IN JOB
;<4.MONITOR>FORK.MAC.153, 6-Jul-78 07:26:34, EDIT BY MILLER
;MORE FIXES FOR LOW AND HIGH Q (TCO 1929)
;<4.MONITOR>FORK.MAC.152, 5-Jul-78 16:09:16, EDIT BY MILLER
;TCO 1929. INT PROCESS WHENVER PRIORITY MIGHT EFFECT FKMNQ
;<4.MONITOR>FORK.MAC.151, 19-Jun-78 21:54:32, EDIT BY BOSACK
;<1BOSACK>FORK.MAC.1000, 5-Jun-78 18:42:33, EDIT BY BOSACK
;<4.MONITOR>FORK.MAC.149, 19-Jun-78 14:48:45, Edit by MCLEAN
;TCO 1908 GETOK JSYS ADD OF GOKFRE
;<4.MONITOR>FORK.MAC.148, 18-Jun-78 17:32:29, Edit by MCLEAN
;REMOVE EXTRANEOUS CODE IN .CIS
;<4.MONITOR>FORK.MAC.147, 26-May-78 09:02:43, EDIT BY MILLER
;FIX ERROR IN RFSTS. NEED TO PRESERVE TO OVER CALL TO MRFSTS
;<4.MONITOR>FORK.MAC.146, 23-May-78 11:33:27, Edit by PORCHER
;MORE ON TCO # 1912 - LONG FORM OF RFSTS CALL
;<4.MONITOR>FORK.MAC.145, 24-Apr-78 16:15:26, Edit by BORCHEK
;MORE NSW FIXES
;<4.MONITOR>FORK.MAC.144, 22-Apr-78 18:27:20, Edit by BORCHEK
;NSW FIXES TO GFRKH FROM BBN
;<4.MONITOR>FORK.MAC.143, 22-Apr-78 15:50:30, Edit by BORCHEK
;DELETE EXTRA OKINT IN SCTT0:
;<4.MONITOR>FORK.MAC.141, 16-Apr-78 04:45:51, Edit by BORCHEK
;FIX TTY ASSIGNED TO OTHER JOB BUG IN SCTTY
;<4.MONITOR>FORK.MAC.140, 7-Apr-78 15:27:45, Edit by PORCHER
;TCO # 1912 - ADD LONG FORM OF RFSTS CALL
;<4.MONITOR>FORK.MAC.139, 10-Mar-78 10:17:27, EDIT BY MILLER
;TCO 1189. FIX SJPRI TO STORE WORD IN JOBSKD
;<4.MONITOR>FORK.MAC.138, 9-Mar-78 14:19:10, EDIT BY MILLER
;SURROUND MOST OF SJPRI WITH NOSKED AND OKSKED
;<4.MONITOR>FORK.MAC.137, 9-Mar-78 08:17:55, EDIT BY MILLER
;MAKE SURE UNSED PC BITS NOT RETURNED IN RFSTS
;<4.MONITOR>FORK.MAC.136, 17-Feb-78 13:40:13, Edit by PORCHER
;Allow CCL start offsets in SFRKV
;Fix NOSKED BLT to/from user space in RFACS/SFACS
;<4.MONITOR>FORK.MAC.135, 15-Feb-78 12:57:38, EDIT BY MILLER
;MODIFY RFSTS TO RETURN 30-BIT PC IF NOT SECTION 0
;<4.MONITOR>FORK.MAC.134, 30-Jan-78 15:00:25, EDIT BY MILLER
;ALLOW ANY FORK IN SWTRP
;<4.MONITOR>FORK.MAC.133, 30-Jan-78 14:38:30, EDIT BY MILLER
;MORE FIXES TO SWTRP
;<4.MONITOR>FORK.MAC.132, 30-Jan-78 13:32:25, EDIT BY MILLER
;MORE TCO 1880 FIXES
;<4.MONITOR>FORK.MAC.131, 30-Jan-78 13:23:42, EDIT BY MILLER
;TCO 1880 AGAIN. CHANGE ERROR CODES
;<4.MONITOR>FORK.MAC.130, 30-Jan-78 13:18:05, EDIT BY MILLER
;TCO 1880. ADD SWTRP JSYS
;<4.MONITOR>FORK.MAC.129, 28-Jan-78 23:14:44, Edit by PORCHER
;<4.MONITOR>FORK.MAC.128, 28-Jan-78 15:17:58, EDIT BY PORCHER
;<4.MONITOR>FORK.MAC.125, 27-Jan-78 11:17:34, EDIT BY PORCHER
;Add Execute-Only checks to JSYSes
;<4.MONITOR>FORK.MAC.124, 19-Jan-78 14:50:18, EDIT BY PORCHER
;Add bits and routines for Execute-Only
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH PROLOG
TTITLE FORK
;FORK CONTROLLING JSYSES AND FUNCTIONS - D. MURPHY
;LOCAL ITEMS DECLARED IN STG.MAC
EXTN <DEVKFK>
;ITEMS DEFINED IN APRSRV FOR SWTRP
EXTN <SETART,SETLUU,GTLUUB>
;AC DEFINITIONS USED HEREIN
DEFAC (FX,Q3) ;FORK INDEX
;DATA STRUCTURES REFERENCED ONLY IN SWPMON
;Definitions for SYSFK in JSB (index by JRFN)
;Bit 0 set indicates JRFN not in use
DEFSTR(SFEXO,SYSFK,1,1) ;Fork is Execute-Only if set
DEFSTR(SFNVG,SYSFK,2,1) ;Fork is not "virgin" if set
DEFSTR(SFGXO,SYSFK,3,1) ;Fork can PMAP into execute-only forks
; because it is doing an execute-only GET
DEFSTR(SFSRT,SYSFK,4,1) ;FORK HAS BEEN STARTED
;Bits 5 to 8 are unused
DEFSTR(FKHCNT,SYSFK,17,9) ;COUNT OF HANDLES ON A GIVEN FORK
;Bits 18 to 35 is the system fork number
SWAPCD
;XSVEC% allows a global PC to be specified for the entry vector address
.XSVEC::MCENT
CALLRET SEVEC0 ;USE COMMON CODE
;GET/SET ENTRY VECTOR
.SEVEC::MCENT
HRRZ C,B ;GET ADDRESS PART OF ENTRY VECTOR
HLRZ B,B ;GET LENGTH
CALLRET SEVEC0 ;USE COMMON CODE
;SEVEC0 is common routine for setting entry vectors
;
;Accepts: A/ fork handle
; B/ length
; C/ address
SEVEC0: CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;Map PSB and check for execute-only
CAIN B,0
CAIE C,0
CAIA
JRST SEV1 ;ALL-0 IS LEGAL
CAIN B,<JRST>B53 ;10/50 STYLE?
JRST SEV1 ;YES
CAIL B,1000
ESVX1: ERRJMP(SEVEX1,ITFRKR) ;NOT LEGAL
SEV1: MOVEM B,EVLNTH(A) ;SAVE LENGTH
MOVEM C,EVADDR(A) ;SAVE ADDRESS
JRST CLFRET
.XGVEC::MCENT
CALL FLOCK
CALL SETLFK
DMOVE B,EVLNTH(A) ;GET VECTOR
XCTU [DMOVEM B,B] ;TELL USER
CALLRET CLFRET
.GEVEC::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
HRL B,EVLNTH(A) ;GET LENGTH
HRR B,EVADDR(A) ;GET ADDRESS PART (WITHOUT SECTION FOR NOW)
GCV1: UMOVEM 2,2
JRST CLFRET
;GET/SET COMPATIBILITY ENTRY VECTOR AND PARAMETERS
.GCVEC::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
MOVE 2,PATADR(1)
;**;[2636] Add 1 line at .GCVEC+3L YKT 29-JUL-82
JUMPL T2,GCV1 ;[2636] CHECK FOR NEGATIVE
TLNE T2,-1 ;EXTENDED FIELDS?
ITERR XSEVX3,<CALL FKLERR> ;YES, CAN'T READ WITH THIS JSYS
HRL T2,PATLEV(T1) ;LENGTH
MOVE 3,PATUPC(1)
HRL 3,PATU40(1)
UMOVEM 3,3
JRST GCV1
.SCVEC::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;Map PSB and check for execute-only
IFL. T2 ;NEG ARG?
SETOM PATADR(T1) ;YES, MEANS PREVENT LOADING OF PA1050
SETZM PATLEV(T1) ;TCO 5.1.1036
JRST CLFRET
ENDIF.
HLRZM T2,PATLEV(T1) ;SAVE LENGTH
XCTU [XHLLI T2,.] ;DEFAULT SECTION
MOVEM 2,PATADR(1)
HRRM 3,PATUPC(1)
HLRM 3,PATU40(1)
JRST CLFRET
;GET/SET RMS (FORMERLY DMS) ENTRY VECTOR
;GET DMS ENTRY VECTOR
;ACCEPTS IN 1/ FORK HANDLE
; GDVEC
;RETURNS +1: ALWAYS
; 2/ LENGTH ,, ENTRY VECTOR ADDRESS
.GDVEC::MCENT
CALL FLOCK ;LOCK FORK STRUCTURE
CALL SETLFK ;MAP IN PSB OF FORK
MOVE 2,DMSADR(1) ;GET ENTRY VECTOR
TLNE T2,-1 ;ENTENDED ADDRESS?
ITERR XSEVX3,<CALL FKLERR> ;YES, CAN'T READ WITH THIS JSYS
HRL T2,DMSLEV(T1) ;LENGTH
JRST GCV1 ;GIVE THESE TO USER
;SET DMS ENTRY VECTOR
;ACCEPTS IN 1/ FORK HANDLE
; 2/ LENGTH ,, ENTRY VECTOR ADDRESS
.SDVEC::MCENT
CALL FLOCK ;LOCK FORK STRUCTURE
CALL SETLFX ;Map PSB and check for execute-only
HLRZM T2,DMSLEV(T1) ;SAVE LENGTH
XCTU [XHLLI T2,.] ;DEFAULT SECTION
MOVEM T2,DMSADR(T1) ;SAVE DMS ENTRY VECTOR
UMOVE 3,4(2) ;GET POINTER TO PC WORD
HRRM 3,DMSUPC(1) ;SAVE ADR OF WHERE TO PUT PC
UMOVE 3,3(2) ;GET POINTER TO JSYS LOCATION
HRRM 3,DMSU40(1) ;SAVE ADR OF WHERE TO PUT JSYS
JRST CLFRET ;EXIT UNLOCKING PSB
;Extended SET/GET special entry vector - i.e. RMS or PA1050
; T1/ vector type code ,, fork handle
; T2/ length
; T3/ 30-bit address. bit 0 = 1 for extended vector format, = 0
; for non-extended format
.XSSEV::MCENT
CALL FLOCK
CALL SETLFX ;MAP PSB, ETC.
XCTU [HLRZ T2,T1] ;GET VECTOR TYPE
CAIL T2,SEVTL
ITERR XSEVX1,<CALL FKLERR> ;ILLEGAL VECTOR TYPE
HRRZ T2,SEVTB(T2) ;DISPATCH TO APPROPRIATE CODE
JRST 0(T2)
.XGSEV::MCENT
CALL FLOCK
CALL SETLFK ;MAP PSB
XCTU [HLRZ T2,T1] ;GET VECTOR TYPE
CAIL T2,SEVTL
ITERR XSEVX1,<CALL FKLERR> ;ILLEGAL VECTOR TYPE
HLRZ T2,SEVTB(T2) ;DISPATCH TO APPROPRIATE CODE
JRST 0(T2)
;DISPATCH FOR SPECIAL VECTOR TYPES
; GET ROUTINE ,, SET ROUTINE
SEVTB: PHASE 0
.XSEVC::! GEVC,,SEVC ;TOPS10 COMPATIBILITY PKG.
.XSEVD::! GEVD,,SEVD ;RMS
DEPHASE
SEVTL==.-SEVTB
;GET/SET PA1050 ENTRY VECTOR
GEVC: MOVE T2,PATLEV(T1) ;LENGTH
UMOVEM T2,T2
MOVE T3,PATADR(T1) ;ADDRESS
UMOVEM T3,T3
JRST CLFRET
SEVC: UMOVE T2,T2 ;GET LENGTH
IFLE. T2
MOVEM T2,PATADR(T1) ;CLEAR
SETZM PATLEV(T1)
JRST CLFRET ;DONE
ENDIF.
CAIGE T2,.SVRPC ;LONG ENOUGH FOR REQUIRED WORDS?
ITERR XSEVX2,<CALL FKLERR> ;NO, INVALID LENGTH
MOVEM T2,PATLEV(T1) ;SAVE LENGTH
UMOVE T2,T3 ;GET ADDRESS
MOVEM T2,PATADR(T1) ;SAVE IT
CALL SETPVV ;SET PC AND UUO WORDS
JRST CLFRET ;RELEASE LOCKS AND RETURN
;GET PA1050 PC AND UUO WORDS
; T1/ FORK PSB OFFSET
; T2/ ENTRY VECTOR ADDRESS
SETPVV: UMOVE T3,.SVRPC(T2) ;GET POINTERS FROM VECTOR
TXNN T3,VSECNO ;SECTION NUMBER SUPPLIED?
HLL T3,T2 ;NO, DEFAULT TO SAME AS ENTRY VECTOR
MOVEM T3,PATUPC(T1)
UMOVE T3,.SV40(T2)
TXNN T3,VSECNO ;SECTION?
HLL T3,T2 ;NO, DEFAULT IT
MOVEM T3,PATU40(T1)
RET
;GET/SET RMS VECTOR
GEVD: MOVE T2,DMSLEV(T1) ;LENGTH
UMOVEM T2,T2
MOVE T3,DMSADR(T1) ;ADDRESS
UMOVEM T3,T3
JRST CLFRET ;DONE
SEVD: UMOVE T2,T2 ;GET LENGTH OF VECTOR
IFE. T2
SETZM DMSADR(T1) ;CLEAR
JRST CLFRET ;DONE
ENDIF.
CAIGE T2,.SVRPC ;LONG ENOUGH FOR REQUIRED WORDS?
ITERR XSEVX2,<CALL FKLERR> ;NO
MOVEM T2,DMSLEV(T1) ;SAVE LENGTH
UMOVE T2,T3 ;GET ADDRESS
MOVEM T2,DMSADR(T1)
CALL SETDVV ;SET PC AND UUO POINTERS
JRST CLFRET ;UNLOCK AND RETURN
;SET PC AND UUO WORD POINTERS
; T1/ FORK PSB OFFSET
; T2/ ENTRY VECTOR ADDRESS
SETDVV: UMOVE T3,.SVRPC(T2) ;GET POINTERS FROM VECTOR
TXNN T3,VSECNO ;SECTION?
HLL T3,T2 ;NO, DEFAULT IT
MOVEM T3,DMSUPC(T1)
UMOVE T3,.SV40(T2)
TXNN T3,VSECNO ;SECTION?
HLL T3,T2 ;NO, DEFAULT IT
MOVEM T3,DMSU40(T1)
RET
;HERE ON FIRST OCCURRANCE OF MUUO IN FORK. MAP TOPS10 COMPATIBILITY
;MODULE INTO USER ADDRESS SPACE.
;THIS CODE ALSO IMPLEMENTS THE VIROS/TOPS10 TEST UUO. IF
;THE USER DOES A GETTAB (CALLI 41) WITH ARGUMENT 112,,11 (TABLE
;11, WORD 112) THEN BITS 18-23 TELL WHAT KIND OF MONITOR IT IS.
;IN PARTICULAR, 4 MEANS VIROS.
;THIS CODE CHECKS FOR THIS SPECIFIC CALLI AND ARGUMENT SO THAT
;THE USER PROGRAM CAN EXECUTE IT WITHOUT ACTUALLY INVOKING THE
;COMPATIBILITY MODULE.
GETPAT::DMOVE P1,FFL ;SAVE PC AND MUUO WORD
MOVE P3,KIMUEF
MCENTR ;GETS HERE FROM UUO HANDLER
HRLZ T1,P1 ;LOOK AT UUO
HRR T1,P3
TLZ 1,(777B17) ;DON'T LOOK AT AC, I, X
CAME 1,[047000,,41] ;WAS IT A CALLI 41 ?
JRST GETPA1 ;NO, CONTINUE
LDB 2,[POINT 4,P1,30] ;YES, CHECK ARGUMENT
UMOVE 1,0(2) ;GET CONTENTS OF DESIGNATED AC
CAME 1,[112,,11] ;IS IT MAGIC NUMBER?
JRST GETPA1 ;NO, CONTINUE
MOVEI 1,4B23 ;YES, RETURN ANOTHER MAGIC NUMBER
UMOVEM 1,0(2) ;RETURN IT IN DESIGNATED AC
SMRETN
GETPA1: SKIPGE PATADR ;FORCED INCOMPATABLILITY?
ITERR(ILINS4) ;YES - GIVE ERROR.
HRROI 2,[ASCIZ /SYS:PA1050.EXE/]
CALL GETSEG ;Get PA1050
ITERR(ILINS3) ;NO FILE
MOVEM T1,PATLEV ;SAVE LENGTH
MOVEM T2,PATADR ;ADDRESS
SETZ T1, ;NO PSB OFFSET
CALL SETPVV ;SET PC AND UUO POINTERS
SKIPG T1,PATADR ;SHOULD HAVE IT NOW
ITERR ILINS3 ;BAD FILE
TXNN T1,XS%EEV ;EXTENDED FORMAT VECTOR?
IFSKP.
MOVE T1,PATUPC ;YES, GET ITS ADDRESS
DMOVE T2,P1 ;GET FLAGS, PC
XCTU [DMOVEM T2,0(T1)] ;PASS THEM TO PA1050
MOVE T1,PATU40 ;PTR TO UUO WORD
MOVE T2,P3 ;MOVE UUO WORD TO PA1050
UMOVEM T2,0(T1)
ELSE.
MOVE T1,PATUPC ;NON-EXTENDED FORMAT, GET PTR TO PC
MOVE T2,P2 ;CONSTRUCT OLD STYLE FLAGS,,PC
HLL T2,P1
UMOVEM T2,0(T1) ;PASS IT TO PA1050
MOVE T1,PATU40 ;PTR TO UUO WORD
MOVE T2,P3 ;CONSTRUCT OLD STYLE UUO WORD
HRL T2,P1
UMOVEM T2,0(T1)
ENDIF.
MOVE T1,PATADR
ADDI T1,.SVINE ;INITIAL ENTRY IS OFFSET
MOVEM T1,-1(P) ;CHANGE RETURN PC TO ENTER PA1050
JRST MRETN ;GO TO COMPATIBILITY
;HERE ON FIRST RAF JSYS TO LOAD RMS.EXE INTO FORK ADDRESS SPACE
GETDMS::DMOVE P1,FFL ;SAVE PC AND UUO WORD
MOVE P3,KIMUEF
MCENTR ;ENTER MONITOR CONTEXT
HRROI T2,[ASCIZ/SYS:RMS.EXE/]
CALL GETSEG ;Get RMS into this process
ITERR(ILINS5) ;NO FILE
MOVEM T1,DMSLEV ;SAVE LENGTH
MOVEM T2,DMSADR ;ADDRESS
SETZ T1, ;NO PSB OFFSET
CALL SETDVV ;SET PC AND UUO POINTERS
MOVE T1,DMSADR ;NOW SETUP PC AND UUO WORD
TXNN T1,XS%EEV ;EXTENDED FORMAT VECTOR?
IFSKP.
MOVE T1,DMSUPC ;PTR TO PC
XCTU [DMOVEM P1,0(T1)] ;PASS IT TO RMS
MOVE T1,DMSU40 ;PTR TO UUO WORD
UMOVEM P3,0(T1) ;PASS UUO WORD TO RMS
ELSE.
MOVE T1,DMSUPC ;OLD FORMAT VECTOR, GET PTR TO PC
MOVE T2,P2 ;CONSTRUCT OLD STYLE FLAGS, PC
HLL T2,P1
UMOVEM T2,0(T1) ;PASS IT TO RMS
MOVE T1,DMSU40 ;PTR TO UUO WORD
MOVE T2,P3 ;CONSTRUCT OLD STYLE UUO WORD
HRL T2,P1
UMOVEM T2,0(T1)
ENDIF.
MOVE T1,DMSADR
ADDI T1,.SVINE
MOVEM T1,-1(P) ;CHANGE PC TO ENTER RMS
JRST MRETN
; GETSEG - Get a segment into this process
;
; Call:
; T2/ String pointer to file name of segment
; CALL GETSEG
;
; Returns:
; +1: No such file (GTJFN failed)
; +2: Success, entry vector from file in T1
;
; Clobbers T1, T2
;
GETSEG:
MOVE T1,FORKN ;Get current JRFN
CALL CKNXOR ;Skip if not execute-only
SKIPA T1,[EXP GJ%PHY!GJ%SHT!GJ%OLD] ;Execute-only-- make sure physical SYS:
MOVX T1,GJ%SHT!GJ%OLD ;Not execute-only, just get file
GTJFN ;Get a JFN on file
RET ;Error-- return +1 from GETSEG
PUSH P,EVLNTH ;Save old entry vector
PUSH P,EVADDR
HRLI T1,.FHSLF ;Get into this process
GET ;Get it
POP P,T2 ;Restore old entry vector
POP P,T1
EXCH T1,EVLNTH ;Put old entry vector back, get one from file in T1
EXCH T2,EVADDR
RETSKP ;Return +2 from GETSEG
;SET SCHEDULER PRIORITY WORD
; 1/ FORK HANDLE
; 2/ PRIORITY WORD
; SPRIW
.SPRIW::MCENT
MOVE 2,CAPENB
TRNN 2,SC%WHL+SC%OPR
ITERR(WHELX1) ;MUST BE PRIVILEGED
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
SPRI1: UMOVE 2,2
MOVEM 2,JOBBIT(1)
MOVE T2,FORKN(T1) ;GET JOB-WIDE INDEX
HRRZ T2,SYSFK(T2) ;GET SYSTEM INDEX
CALL SETPRF ;INTERRUPT PROCESS
JRST CLFRET
;SET PRIORITY WORD FOR ANOTHER JOB
; 1/ JOB NUMBER
; 2/ PRIORITY WORD
; SJPRI
.SJPRI::MCENT
MOVE 2,CAPENB
CALL CKMMOD ;SEE IF MONITOR OR USER
TRNE 2,SC%WHL+SC%OPR ;USER. SEE IF PRIVILEGED
SKIPA ;MONITOR OR PRIVILEGED
ITERR(WHELX1)
CALL FLOCK ;GET FORK LOCK IN CASE THIS JOB
CAIL 1,0 ;LEGAL JOB NUMBER?
CAIL 1,NJOBS
JRST SJPRI1 ;NO
CALL MAPJSB ;GET THE JSB MAPPED
JRST SJPRI1 ;NON-EX JOB
UMOVE T2,2 ;GET PRIORITY WORD
MOVEM T2,JOBSKD(T1) ;STORE IT
MOVE P1,T1 ;GET JSB OFFSET
HRLI P1,-NUFKS ;FORM AOBJN POINTER
SJPRI2: SKIPGE T2,SYSFK(P1) ;THIS FORK ACTIVE?
JRST SJPRI3 ;NO. GO ON
HRRZS T2 ;YES. GET FORK HANDLE
CALL SETPRF ;UPDATE ITS PRIORITY
SJPRI3: AOBJN P1,SJPRI2 ;DO ALL PROCESSES
JRST CLFRET ;AND DONE
SJPRI1: CALL FUNLK
ITERR (SJPRX1) ;NON-EXISTANT JOB
;GET AND SET PRIMARY IO JFN'S
.GPJFN::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
MOVE 2,PRIMRY(1)
UMOVEM 2,2
JRST CLFRET
.SPJFN::MCENT
XCTU [SKIPN 2] ;PROVIDING A VALID VALUE?
ITERR (DESX3) ;NO. DISALLOW IT THEN
CALL FLOCK ;LOCK THE FORK STRUCTURE
MOVX T2,<CALL SPJFN1> ;ROUTINE TO EXECUTE
CALL MAPFKH
NOP ;WON'T BLOCK
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
JRST MRETN
SPJFN1: CALL SKIIF
JRST FRKE2
CALL SETLF1
UMOVE 2,2
MOVEM 2,PRIMRY(1)
JRST CLRLFK
;GET TRAP WORDS FROM FORK
.GTRPW::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK ;MAP PSB
MOVE 2,UTRSW(1) ;TRAP STATUS WORD
TXNN T2,TWUSR ;SETUP BITS IN OLD FORMAT
TXO T2,TSW%MN ;MONITOR MODE REFERENCE
TXNE T2,TWWRT
TXO T2,TSW%WT ;WRITE REF
TXO T2,TSW%RD ;READ ALWAYS
UMOVEM 2,1 ;RETURNED IN 1
HRL 2,UMUUOW(1) ;MUUO WORD
HRR 2,UMUUOW+1(1)
UMOVEM 2,2 ;RETURNED IN 2
JRST CLFRET
;XGTPW
; 1/0,,fork handle
; 2/address of data block
; XGTPW%
;where data block is
; number of words in data block (including this one)
;return .+1 always, data block filled in with last page fail word and MUUO
.XGTPW::MCENT
UMOVE P1,(T2) ;NUMBER OF WORDS TO RETURN
SUBI P1,1 ;ACCOUNT FOR THE COUNT WORD
JUMPL P1,[ITERR (ARGX17)]
AOS P2,T2 ;WHERE TO STORE THE ANSWERS
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK ;MAP THE PSB
MOVE T3,UTRSW(T1) ;GET LAST PAGE FAIL WORD
MOVEI T2,0 ;ASSUME LAST PAGE FAIL WAS A READ IN EXEC MODE
TXNE T3,TWUSR ;USER OR MONITOR?
TXO T2,PF%USR ;USER
TXNE T3,TWWRT ;READ OR WRITE REFERENCE?
TXO T2,PF%WTF ;WRITE
CALL PUTWRU ;STORE THE ANSWER IF THE USER PROVIDED ROOM
LOAD T2,TWVADR,UTRSW(T1);Get the virtual address
CALL PUTWRU ;STORE THAT
HRLZ T2,UMUUOW(T1) ;Get MUUO OpCode AC,
CALL PUTWRU ;STORE THAT
MOVE T2,UMUUOW+1(T1) ;MUUO E FIELD
CALL PUTWRU ;STORE THAT
JRST CLFRET ;UNMAP THE PSB AND RETURN
PUTWRU: SOSL P1 ;DECREMENT COUNT, DON'T STORE IF EXHAUSTED
UMOVEM T2,(P2) ;STORE ANSWER
AOJA P2,R ;INCREMENT TO NEXT PLACE TO STORE AND RETURN
;FORK CREATION AND CONTROL JSYS'S
.CFORK::MCENT
MOVE T1,FKCNT ;COUNT OF FORKS
ADDI T1,2 ;CORRECT COUNT FOR THIS CREATION AND INITIAL JOB'S FORK
HRRZ T2,GTOKPR+.GOCFK ;GET COUNT OF FORKS
CAMG T1,T2 ;AND DO GETOK IF REQUIRED
JRST CFGOK ;NO PROCEED WITHOUT GETOK
SOS T1 ;MAKE CURRENT NUMBER
GTOKM (.GOCFK,<T1>,[RETERR ()])
CFGOK: CALL FLOCK ;LOCK THE FORK STRUCTURE
MOVEI T1,-1
CALL GFKH ;GET LOCAL HANDLE
ERRJMP(FRKHX6,EFRKR) ;NONE
PUSH P,T1 ;SAVE IT
NOSKED
MOVE T2,DRMFRE ;GET FREE SWAPPING SPACE
CAMG T2,DRMLV0 ;SPACE LEFT?
JRST CFBAD ;NO. DON'T CREATE THE FORK
MOVE T2,SPTC ;CURRENT SPT COUNT
CAML T2,SPC2 ;ROOM LEFT?
JRST CFBAD ;NO
SKIPE FREFK ;ROOM IN SYSTEM?
SKIPN FREJFK ;ROOM IN JOB?
JRST CFBAD ;NO
CALL ASSFK ;YES, ASSIGN FORK IN SYSTEM
CALL ASSJFK ;AND ASSIGN FORK IN JOB
PUSH P,T1 ;SAVE JOB FORK HANDLE
AOS FKCNT ;UPDATE THIS JOBS FORK COUNT
MOVE T1,FORKX
MOVE T1,FKJOB(T1) ;GET JOB NO AND JSB
MOVEM T1,FKJOB(FX) ;SET FOR NEW FORK
CALL WTCONC ;PUT FORK ON WAIT LIST
OKSKED
; ..
;CFORK ...
BP$019: ;BREAKPOINT FOR CREATE SUBFORK
HRLZ T1,FX
CALL WAITFK ;WAIT FOR IT TO INITIALIZE
POP P,T1 ;RESTORE JOB FORK HANDLE
HRRZM FX,SYSFK(T1)
;Note that this clears all the
; flag bits in LH of SYSFK
MOVEI T2,1 ;INDICATE 1 HANDLE ON THIS FORK
STOR T2,FKHCNT,(T1) ; ...
SETZM FKPTRS(T1)
SETZM FKPSIE(T1)
SETZM FKDPSI(T1)
HRRZ T2,FORKN ;PUT NEW FORK INTO STRUCTURE LISTS
MOVEI Q2,FKPTRS(T2)
HLL Q2,INFERP
LDB T3,Q2 ;GET INFERIORS OF THIS FORK
DPB T1,Q2 ;PUT NEW FORK AT HEAD OF IT
MOVEI Q2,FKPTRS(T1)
HLL Q2,SUPERP
DPB T2,Q2 ;THIS FORK IS SUPERIOR OF NEW FORK
HLL Q2,PARALP
DPB T3,Q2 ;OTHER INFERIORS ARE PARALLEL TO NEW FORK
LOAD T4,FRKTTY,(T2) ;GET CTTY
STOR T4,FRKTTY,(T1) ;PUT SUPERIOR'S CTTY IN INFERIOR
PUSH P,T1
CALL SETLF1 ;MAP PSB OF NEW FORK
; ..
;CFORK ...
MOVE 2,0(P) ;NEW FORK'S JOB HANDLE
MOVEM 2,FORKN(1)
ADDM T2,JTBLK(T1) ;MAKE INFERIOR POINT TO CORRECT FKJTB
MOVE T3,@JTBLK ;GET EXECUTING FORK'S MONITOR, IF ANY
MOVEM T3,FKJTB(T2) ;SAME ENVIRONMENT TO INFERIOR
MOVE 2,JOBNO
MOVEM 2,JOBNO(1)
MOVE 2,PRIMRY
MOVEM 2,PRIMRY(1)
MOVE 2,JOBBIT
MOVEM 2,JOBBIT(1) ;PASS PRIORITY
SETZM CAPMSK(1)
SETZM CAPENB(1)
SETZM PDVS(1) ;SAY NO PDVS YET
MOVEI 2,LSTRX1 ;INITIALIZE LAST ERROR CODE TO NONE
MOVEM 2,LSTERR(1)
POP P,4 ;GET JOB WIDE INDEX
MOVE 2,0(P) ;LOCAL HANDLE
ANDI 2,377777 ;MASK OFF FORK BIT
IDIVI 2,2 ;GET FKTAB INDEX
ADD 2,FKPTAB(3) ;GET PROPER BYTE POINTER
DPB 4,2 ;STORE LOCAL POINTER
MOVX 2,PSIIF% ;CHECK IF FORK WAS PROPERLY INITED
TDNN 2,FKINT(7) ;WAS IT?
JRST CFK5 ;YES
MOVE 2,BITS+.ICMSE ;GOT INT. SEE IF FATAL
TDNN 2,FKINTB(7) ;WAS IT?
JRST CFK5 ;NO. LET IT GO ON
NOINT ;PREVENT UNWANTED INTS
CALL CLRLFK ;YES. CLEAR MAPPING
CALL FUNLK ;RELEASE FORK LOCK
POP P,1 ;GET LOCAL INDEX
KFORK ;ZAP THE FORK
OKINT ;FORK PROPERLY KILLED. ALLOW INTS AGAIN
RETERR (CFRKX3) ;GIVE NO RESOURCES ERROR
; ..
;CFORK...
CFK5: UMOVE T2,1 ;GET ARG
TXNE T2,CR%MAP ;Same map?
CALL CFK4 ;YES
TXNE T2,CR%CAP ;Give special capabilities?
CALL CFK3
TXNE T2,CR%ACS ;Load ACs?
CALL CFK1 ;YES
TXNE T2,CR%ST ;Start process?
CALL CFK2
CALL CLRLFK ;UNMAP PSB
POP P,1 ;RETURN LOCAL HANDLE
UMOVEM 1,1
MOVEI T2,0(7) ;GET SYSTEM FORK INDEX
MOVE 7,FORKX ;GET INDEX OF THIS FORK
LOAD T1,FKMNQ ;GET LOCAL MAX Q
MOVE 7,T2 ;RESTORE INDEX OF CREATED FORK
STOR T1,FKMNQ ;SET UP ITS MAX Q
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
SMRETN
CFBAD: OKSKED
ERRJMP(CFRKX3,EFRKR) ;NO ROOM
;FORK CONTROL SUBRS
;Load ACs
CFK1: SAVET
XCTU [MOVE T2,2] ;GET LOC OF INITIAL AC'S
XMOVEI T3,UAC(T1) ;FIND ADDRESS OF SAVE AREA
MOVEI T1,20 ;ALL ACS
CALL BLTUM1 ;TRANSFER AC'S TO MONITOR AND RETURN
MOVE T1,T4 ;GET JRFN
CALLRET CLRVGN ;SET NON-VIRGIN FOR PROCESS
;Start process
CFK2: MOVEI T3,0(T2) ;START ADDRESS
MOVEM T3,PPC(T1)
HRLI T3,(UMODF) ;IN USER MODE
MOVEM T3,PFL(T1)
PUSH P,T1
NOSKED
CALL UNBLK1 ;UNBLOCK IT
OKSKED
MOVE T1,0(P) ;Get PSB address
MOVE T1,FORKN(T1) ;Get JRFN for process
SETONE SFSRT,(T1) ;FLAG THAT FORK HAS BEEN STARTED
CALL CLRVGN ;No longer a Virgin Process
POP P,T1
RET
;Give special capabilities
CFK3: MOVE T3,CAPMSK ;GIVE NEW FORK SAME SPEC CAP
MOVEM T3,CAPMSK(T1)
MOVE T3,CAPENB
MOVEM T3,CAPENB(T1)
RET
;'SAME MAP' BIT - CAUSES MAP OF INFERIOR TO BE FILLED WITH
;IND PTRS TO SUPERIOR
CFK4: PUSH P,1
PUSH P,2
MOVE 1,FORKX
HLLZ 1,FKPGS(1) ;SOURCE IS THIS FORK
HLLZ 2,FKPGS(7) ;DEST IS NEW FORK
MOVSI 3,(PTRW)
MOVEI 4,PGSIZ
CALL MSETPT ;DO FOR ALL PAGES
JRST CFK42 ;FAILURE SO PROPAGATE IT
CALL CKXADR ;EXTENDED ADDRESSING SUPPORTED?
JRST CFK41 ;NO
;SECTION 0 COULD BE HANDLED WITH AN INDIRECT SECTION POINTER AS WELL
; MAYBE FUTURE ...
MOVE 1,FORKX
HRLZ 1,FKPGS(1) ;PSB
HRRI 1,1 ;THIS FORK, SOURCE SECTION 1
HRLZ 2,FKPGS(7) ;PSB
HRRI 2,1 ;NEW FORK, DESTINATION SECTION 1
TXO 3,SM%IND ;MAP VIA INDIRECT POINTERS
MOVEI 4,MXSECN-1 ;ALL SECTIONS
CALL MSETST ;MAP SECTIONS 1 THRU MXSECN
JFCL ;CAN'T HAPPEN
CFK41: MOVE T1,FORKN ;Get current JRFN
CALL CKNXOR ;Is current process Execute-only?
JRST [ MOVE T1,-1(P) ;Yes-- get PSB of new process
MOVE T1,FORKN(T1) ;Get JRFN of new process
CALL SETEXO ;Make new process execute-only also
JFCL ;Can't (should never happen)
JRST .+1]
POP P,2
POP P,1
RET
CFK42: ;HERE TO UNLOCK FKLOCK AND DO ITRAP
CALL FUNLK ;UNLOCK FORK LOCK
ITERR ;AND PASS DOWN ERROR
WAITFK: HRRI 1,WTFKT
MDISMS
RET
RESCD ;SCHEDULER TEST, MUST BE RESIDENT
WTFKT: MOVE T2,FKSWP(T1)
TXNN T2,FKBLK ;FORK BLOCKED?
JRST 0(4) ;NO
JRST 1(4) ;YES
ASSJFK: MOVE 1,@FREJFK
EXCH 1,FREJFK
SUBI 1,FKPTRS
RET
SWAPCD
;SPLICE FORK STRUCTURE
; 1/ FORK HANDLE OF NEW SUPERIOR
; 2/ FORK HANDLE OF FORK TO BECOME INFERIOR
; RETURNS +2: SUCCESS, WITH 1/ FORK HANDLE OF 2 RELATIVE TO 1
DEFINE SPLERR (ERN,JMP)<
JRST [CALL RALLI ;RESUME ALL INFERIORS
ERRJMP (ERN,JMP)]>
.SPLFK:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL FALLI ;FREEZE ALL OF CALLER'S INFERIORS
XCTU [HRRZ T1,T1] ;GET RFH OF NEW SUPERIOR
CALL SETJFK ;GET JOB FORK HANDLE OF 1
PUSH P,T1
CALL SKIIF ;IS 1 INFERIOR OR EQ TO SELF?
SPLERR(SPLFX1,EFRKR) ;NO
XCTU [HRRZ T1,T2] ;GET 2
CALL SETJFK ;GET JOB HANDLE OF 2
PUSH P,T1
CAME T1,FORKN ;IS 2 STRICTLY INFERIOR TO SELF?
CALL SKIIF
SPLERR(SPLFX2,EFRKR) ;NO
MOVE T1,-1(P) ;GET 1
MOVE T2,0(P) ;GET 2
CALL SKIIFA ;IS 1 ALREADY EQ OR INFERIOR TO 2?
JRST .+2 ;NO, OK
SPLERR(SPLFX3,EFRKR) ;YES, ERROR
MOVE T1,-1(P) ;GET F1
SKIPN T1,FKJTB(T1) ;DOES F1 HAVE A JTB?
TROA T1,7777 ;NO, THERE IS NO MONITOR
LOAD T1,JTIMP,(T1) ;YES, GET F1'S MONITOR
MOVE T2,0(P) ;GET F2
SKIPN T2,FKJTB(T2) ;DOES F2 HAVE A JTB?
TROA T2,7777 ;NO, THERE IS NO MONITOR
LOAD T2,JTIMP,(T2) ;YES, GET F2'S MONITOR
CAIE T1,(T2) ;F1 AND F2 HAVE THE SAME MONITOR?
CAMN T2,-1(P) ;OR IS F1 THE IMMEDIATE MONITOR OF F2?
CAIA ;YES, OK.
CALL SPLFK3 ;NO. UPDATE TRAP ENVIRONMENTS
NOSKED ;NOSKED WHILE CHANGING POINTERS
MOVE T1,0(P)
ADD T1,SUPERP ;MAKE PTR TO SUPERIOR OF 2
LDB T1,T1 ;GET IT
ADD T1,INFERP ;MAKE PTR TO FIRST INFERIOR
SPLFK1: LDB T2,T1 ;SEARCH FOR 2
CAMN T2,0(P)
JRST SPLFK2 ;FOUND IT
MOVE T1,T2
ADD T1,PARALP
JRST SPLFK1 ;CONTINUE SEARCH
; UPDATE JSYS TRAP ENVIRONMENTS DUE TO SPLICING
; F2 HAS ITS OLD JSYS TRAP ENVIRONMENT REMOVED AND A NEW ONE ADDED.
; THE NEW ENVIRONMENT IS EITHER THE SAME AS F1'S OR IS THE ENVIRONMENT
; F1 INDIRECTLY SET FOR F2 (BY MONITORING ONE OF F2'S SUPERIORS)
SPLFK3: MOVE P1,-1(P) ;F2
MOVE P2,-2(P) ;F1
PUSH P,FKJTB(P2) ;SAVE F1'S JTB, IF ANY.
MOVE P4,T2 ;SAVE F2'S MONITOR
SKIPA P3,P1 ;START WITH IMD. MON. OF F2 AND
SPFK3A: MOVE P3,T1 ;FIND OUT IF F1 IS A MON. OF F2
SKIPN T1,FKJTB(P3) ;GET THE NEXT MONITOR UP THE CHAIN
JRST SPFK3B ;NO MORE IN CHAIN
LOAD T1,JTIMP,(T1) ;WHO IS THE MONITOR?
CAIE T1,(P2) ;IS IT F1?
JRST SPFK3A ;NO, KEEP LOOKING.
PUSH P,FKJTB(P1) ;SAVE F2'S CURRENT JTB
CALL NEWJTB ;GET A NEW BLOCK
POP P,FKJTB(P1) ;RESTORE OLD BLOCK, ADDR OF NEW IN T2
MOVEM T2,0(P) ;USE IT AS NEW ENVIRONMENT FOR F2
HRL T1,FKJTB(P3) ;COPY F1'S INFERIOR'S BLOCK
HRR T1,T2 ;TO NEW BLOCK FOR F2
BLT T1,JTBSIZ(T2) ;RETAINING ENV OF F2 SET BY F1
SPFK3B: HRRZ T1,P1 ;FIND SUPERIOR OF F2
ADD T1,SUPERP ;BUILD NEEDED POINTER
LDB T1,T1 ;GET FORK
CAIN P4,(T1) ;IS F2'S MONITOR SAME AS F2'S SUPERIOR?
CALL RELJTB ;YES. RELEASE JTB POINTER TO BY FK IN P1
POP P,FKJTB(P1) ;F2'S NEW JSYS TRAP ENVIRONMENT
CALLRET TFINF ;UPDATE F2'S INFERIORS (FORK IN P1)
;CONTINUE WITH SPLICE NOW THAT THE
;JSYS TRAP ENVIRONMENTS ARE THE SAME
;REMOVE 2 FROM THE INFERIOR LIST OF ITS SUPERIOR
SPLFK2: ADD T2,PARALP
LDB T3,T2 ;GET SUCCESSOR
DPB T3,T1 ;PATCH AROUND 2
;NOW MAKE 2 BE THE FIRST INFERIOR OF 1
MOVE T1,0(P)
MOVE T2,-1(P)
ADD T2,INFERP ;MAKE PTR TO INFERIOR LIST OF 1
LDB T3,T2 ;GET CURRENT FIRST INFERIOR OF 1
DPB T1,T2 ;MAKE 2 NEW FIRST INFERIOR OF 1
ADD T1,PARALP
DPB T3,T1 ;CONC REST OF INFERIOR LIST TO 2
;NOW UPDATE TO SHOW 1 IS SUPERIOR OF 2
MOVE T1,0(P)
ADD T1,SUPERP ;MAKE PTR TO SUPERIOR OF 2
MOVE T2,-1(P)
DPB T2,T1 ;PUT 1 AS SUPERIOR OF 2
OKSKED
MOVE T1,-1(P) ;GET 1
CALL SETLF1 ;MAP PSB OF 1
MOVSI T1,0(T1) ;SETUP ARG FOR GRFKH
HRR T1,0(P) ;PSB OFFSET ,, JOB HANDLE
CALL GRFKH ;GET RELATIVE HANDLE FOR 2 RELATIVE TO 1
SETZ T1,
UMOVEM T1,T1
CALL CLRLFK
HRRZ T1,0(P) ;NEW INFERIOR
HRRZ 7,SYSFK(T1)
MOVX T2,FRZB1%
IORM T2,FKINT(7) ;NEW INFERIORS ALWAYS BECOMES FROZEN
CALL RALLI ;RESUME ALL INFERIORS
SUB P,BHC+2
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
SMRETN
;KILL FORKS
.KFORK::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
MOVEI 1,0(1)
CAIN 1,-4 ;ALL INFERIORS?
JRST KFORK2 ;YES
CALL SETJFK ;NO, ANY ONE FORK
CAMN 1,FORKN ;SELF?
ERRJMP(KFRKX2,ITFRKR) ;YES, NOT PERMITTED
CALL SKIIF ;INFERIOR?
JRST FRKE2 ;NO, NOT PERMITTED
CALL KFORK1 ;KILL IT
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
JRST MRETN
KFORK2: HRRZ 1,FORKN
CALL MAPINF ;FREEZE ALL TO INSURE INTERRUPTIBILITY
CALL FFORK1
CALL KALLI ;KILL ALL INFERIORS
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
JRST MRETN
KFORK1: HRLM 1,0(P)
CALL FFORK1 ;FREEZE ALL TO INSURE INTERRUPTIBILITY
HLRZ 1,0(P)
XHLLI 6,20 ;GET CURRENT SECTION
HLLM 6,0(P)
KFORK0: CALL DASFKH ;DEASSIGN LOCAL FORK HANDLE
MOVE 6,1
HRRZ 7,SYSFK(6)
CAMN 7,FORKX ;THIS FORK?
ERRJMP(KFRKX2,ITFRKR) ;CAN'T KILL SELF
MOVE 5,6 ;REMOVE FORK FROM STRUCTURE
ADD 5,SUPERP
LDB 5,5 ;GET SUPERIOR
ADD 5,INFERP
KFK01: LDB 4,5 ;GET NEXT PARALLEL
CAIN 4,0(6) ;DESIRED FORK?
JRST KFK02 ;YES
MOVE 5,4
ADD 5,PARALP
JRST KFK01
KFK02: ADD 4,PARALP ;FOUND FORK TO BE KILLED IN LIST
LDB 4,4
DPB 4,5 ;PUT NEXT IN LAST, REMOVING FORK FROM LIST
MOVE 1,6
CALL SETLF1 ;MAP PSB
CALL SUSFK ;SUSPEND FORK
MOVE 2,FORKX ;GET SYSTEM FORK INDEX FOR SELF
MOVEM 2,PAC+4(1) ;LEAVE IT IN AC4 OF VICTIM
SETZM INTDF(1) ;MAKE VICTIM NON-INTERRUPTABLE
SETZM PFL(1)
MOVE 2,[MSEC1,,KSELF]
MOVEM 2,PPC(1) ;START IT SO AS TO KILL ITSELF
CALL UNBLK1
OKSKED ;MATCH NOSKED IN SUSFK
CALL CLRLFK
SETZ 1,
MOVEI 2,FPG0A
MOVEI 3,FPG3+1-FPG0 ;CLEAR FORK TEMP PAGES
CALL MSETMP
RET
;KILL ALL INFERIORS OF THIS FORK
KALLI: HRRZ 1,FORKN
ADD 1,INFERP
LDB 1,1 ;GET NEXT INFERIOR
JUMPE 1,R ;NO MORE
CALL KFORK0 ;KILL ALL INFERIORS TOO
JRST KALLI
;FORK KILL SELF
; 4/ FORK WHICH INITIATED KSELF
BP$021: ;(KSELF): BREAKPOINT FOR KFORK
;ASSUMES FORKX HAS SUICIDAL FORK INDEX
KSELF:: MOVE 7,FORKX
MOVX T1,FKPSI1
MOVEM 1,FKINT(7) ;DISABLE ANY FURTHER INTERRUPTS
MOVSI 1,(UMODF)
MOVEM 1,FFL
SETZM FPC
MCENTR ;GET INTO REASONABLE MONITOR STATE
MOVEI 1,0(7) ;GET FORK HANDLE
PUSH P,2 ;SAVE
SETZ 2, ;CLEAR ALL FORK'S ENTRIES ON STACK
CALL JSBSTF ;GO PROCESS DEALLOCATION LIST
SKIPE T1,SYMPAG ;ANY PAGE USED BY MDDT?
CALL RELPAG ;YES, RELEASE IT
NOINT ;NOINT IN CASE THERE'S FREE SPACE TO REMOVE
SKIPE T2,PRARGP ;ANY JSB SPACE USED BY PRARG?
JRST [SETZM PRARGP ;ZERO OLD POINTER
CALL PRARGF ;RELEASE THE SPACE
JRST .+1]
MOVEI T1,JSBFRE ;POINT TO POOL FOR PDVA STORAGE
SKIPE T2,PDVS ;ANY PDVAS STORED?
CALL RELFRE ;YES, RELEASE THEM
SETZM PDVS ;SAY NO PDVAS STORED ANYMORE
OKINT ;DONE WITH FREE SPACE STUFF, SO ALLOW INTERRUPTS AGAIN
CALL NTCOFF ;CLEAR THE NETWORK CHANGE INTERRUPT TABLE
JFCL ;IGNORE
MOVEI 1,0(7) ;GET FORK HANDLE
SETZ 2,0 ;CLEAR ALL FORK'S ENTRIE
CALL GOKFRE
POP P,2 ;RESTORE 2
CAMN 7,ACJFN ;CHECK FOR ACJ FORK
CALL ACJKIL ;KILL ACJ NOW
SETOM INTDF
MOVEM 4,P1 ;SAVE FORKX OF SUPERIOR
SETZM PSIBW
CALL DTIALL ;DEASSIGN TERM INTERRUPTS
OPSTR <SKIPE >,PSUTPS ;DID THIS FORK USE .MOTPS MTOPR FUNCTION?
CALL TTDTPS ;YES, SCAN TTYS FOR THIS FORK
MOVE 1,JOBNO ;GET JOB NUMBER OF THIS PROCESS
OPSTR <SKIPE >,DIAFL,(1) ;DOES THIS JOB HAVE DIAG RESOURCES?
CALL DGFKIL ;YES. GO RELEASE THIS PROCESSES SET
CALL NETKFK ;CLEAR FORK FROM NET TABLES
CALL MTAKFK ;KILL MTA ONLINE/OFFLINE PSI INTERRUPTS
HLRZ T1,DSPSFK ;GET DSK PSI FORK
CAIN 7,0(T1) ;SAME AS THIS ONE?
SETZM DSPSFK ;YES CANCEL IT
KSEFW: HRRZ T1,FORKN ;GET SELF
LOAD T2,FRKTTY,(T1) ;GET MY CTTY
CAIN T2,-1 ;JUST THE JOB'S CTTY?
JRST KSEF0 ;YES, NOTHING TO DO.
TRZN T2,1B18 ;CONVERT FROM DESIGNATOR TO LINE NUMBER
JRST KSEF0 ;WASN'T A DESIGNATOR?
CAIGE T2,NLINES ;RANGE CHECK
CAIGE T2,0
JRST KSEF0 ;NOT A VALID LINE
CALL GTTOPF ;GET THE TOP FORK OF CTTY GRP FOR THIS TTY
JRST KSEF0 ;NOT AN ACTIVE LINE
CAME T3,FORKX ;IS IT ME?
JRST KSEF0 ;NO. NOTHING TO DO.
SKIPN FORKN ;IS THIS THE TOP FORK?
IFNSK. ;IF SO
LOKK DEVLKK
CALL TTYDAS ;RELEASE TTY NOW
IFNSK. ;IFF ERROR RETURN
IFL. T1
HRL T1,T2
UNLOKK DEVLKK
MDISMS ;WAIT HERE FOR CONDITION TO IMPROVE
JRST KSEFW ;AND TRY IT AGAIN
ENDIF.
ENDIF.
ELSE.
MOVEI T1,-1 ;CLEAR IT
CALL STTOPF ;SET TO NOT IN USE
ENDIF.
KSEF0: SETO T1,
RFRKH ;GO RELEASE ALL RELEASABLE HANDLES
JFCL
MOVSI T2,.FHSLF
MOVE T3,[PM%CNT+PM%ABT+PM%EPN+1000] ;REQUEST PMAP OF 1000 PAGES
PMAP ;CLEAR ALL PAGES FROM SECTION-ZERO MAP
CALL CLNZSC ;UNMAP PAGES FROM NON-ZERO SECTIONS
JFCL ;DON'T CARE IF SECTIONS STILL EXIST
MOVE T1,FORKX ;GET FORK NUMBER
CALL PIDKFK ;KILL ALL PIDS BELONGING TO THIS FORK
MOVE T1,FORKX
CALL ENQFKR ;DEQ ALL REQUESTS FOR THIS FORK
MOVE T1,FORKX ;CHECK IF THIS FORK OWNS THE UTEST LOCK
CAMN T1,UTLOCK ;...
CALL UTREL ;YES, RELEASE IT
SETOM PRIMRY ;SET PRIMARY I/O TO CONTROLLING TERMINAL
MOVE T1,[CZ%UNR+CZ%ABT+400000] ;REASSIGN STILL-MAPPED+FLUSH NONX FILES
CLZFF ;CLOSE FILES HERE AND BELOW
SOS FKCNT ;COUNT OF FORKS
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL KALLI
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
CALL UNMAPD ;UNMAP THE DIRECTORY AND RELEASE ITS OFN
CALL CLKREL ; Release any clocks for this fork
MOVE T1,JOBNO ;GET JOB NUMBER OF THIS FORK
SKIPE SNPPGS ;THIS FORK SNOOPING?
CALL SNPREL ;YES, GO REMOVE ITS BREAK POINTS
MOVE FX,FORKX
HLRZ 1,FKPGS(7)
LOAD 2,SPTSHC,(1) ;GET SHARE COUNT OF UPT
PUSH P,2 ;SAVE IT FOR LATER CHECK
CALL FLOCK
SKIPN T2,@JTBLK ;DO WE HAVE A JSYS TRAB BLOCK?
JRST KSEF1 ;NO
HRRZ T3,FORKN ;YES, SEE WHETHER IT SHOULD BE RELEASED
ADD T3,SUPERP ;IDENTIFY MY SUPERIOR
LDB T3,T3 ; ..
HRRZ P1,FORKN ;NEED MY FORK NUMBER FOR RELJTB
LOAD T2,JTIMP,(T2) ;MY MONITOR
CAIN T3,(T2) ;IS MY SUPERIOR MY MONITOR?
CALL RELJTB ;YES. RELEASE THE JTB
KSEF1: HRRZ 4,FORKN ;GET JOB FORK HANDLE FOR SELF
LOAD 1,FKHCNT,(4) ;GET NUMBER HANDLES OF THIS FORK
JUMPN 1,[MOVSI 1,(1B0) ;NO. MARK IT DELETED THEN
IORM 1,SYSFK(4) ;""
JRST KSEF5] ;AND GO FINISH UP
MOVEI 1,FKPTRS(4) ;NO OTHERS, PUT JOB SLOT BACK ON FREE LIST
EXCH 1,FREJFK
MOVEM 1,@FREJFK
SETOM SYSFK(4) ;NOTE SLOT AVAILABLE
KSEF5: CALL FUNLK
LOAD T1,NOSTR
SKIPE T1 ;IF NO STRUCTURES MOUNTED, SKIP STR CODE
CALL RELSTR ;RELEASE ALL STRUCTURE MOUNTS FOR FORK
;FINAL RUNDOWN - HAVE TO WAIT FOR THE SHARE COUNTS ON ALL SECTION MAPS
;TO GO TO ZERO. NON-ZERO SECTIONS ARE CHECKED WITH THE CLNZSC ROUTINE.
;SECTION ZERO IS CHECKED WITH BY EXPLICITLY TESTING ITS SHARE COUNT.
;IF ANY SECTIONS ARE STILL SHARED, DISMISS AND TRY AGAIN LATER.
KSEF2: CALL CLNZSC ;DELETE USER'S NON-ZERO SECTIONS
JRST [ POP P,2 ;STILL SOME LEFT, FIX STACK
JRST KSEF3] ;GO WAIT FOR A WHILE
POP P,2 ;SHARE COUNT OF UPT
CAIE 2,1 ;UNSHARED?
JRST KSEF3
MOVE 7,FORKX
HRLZ 2,FKPGS(7)
SETZ 1,
HRRI 2,PPLOW ;CLEAR PROCESS MAP FROM PPLOW
MOVEI 4,PPHI-PPLOW+1 ; TO PPHI
CALL MSETPT ;CLEAR PROCESS MAP
NOP ;IGNORE FAILURES
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
SAVEAC <Q1,Q2> ;GET WORK AC'S
MOVEI Q1,(VSECNO) ;GET HIGHEST SECTION #
SETZ Q2, ;CLEAR COUNT OF SECTIONS I COULDN'T KILL
;LOOP TO SCAN ALL SECTIONS, ATTEMPTING TO DELETE ANY THAT EXIST
CLNZS1: MOVE T1,Q1 ;GET SECTION #
CALL CHKMPS ;DOES THIS SECTION EXIST?
JUMPE T1,CLNZS2 ;NO, SKIP IT
SETO T1, ;YES, GET -1 TO SPECIFY DELETION
MOVSI T2,.FHSLF
HRR T2,Q1 ;GET FORK HANDLE,,SECTION#
MOVE T3,[PM%ABT+1] ;COUNT (DESTRUCTIVE PMAP IF OF%DUD ON)
SMAP% ;TRY TO DELETE THE SECTION
ERJMP [HRRZ T1,LSTERR ;FAILED, GET ERROR CODE
CAIN T1,SMAPX1 ;FAILED BECAUSE STILL SHARED?
AOS Q2 ;YES, COUNT IT
JRST .+1]
CLNZS2: SOJG Q1,CLNZS1 ;LOOP THRU ALL SECTIONS
JUMPE Q2,RSKP ;SKIP RETURN IF ALL DELETED
RET ;SOME SECTION(S) STILL SHARED
;FREEZE FORK
;ACCEPTS:
; T1/ RELATIVE FORK HANDLE
;RETURNS +1: ALWAYS
; ILLEGAL INSTRUCTION TRAP ON ERROR
.FFORK::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
MOVEI 1,0(1)
CAIN 1,-4 ;ALL INFERIORS?
JRST FFORK5 ;YES
;USER WANTS TO FREEZE JUST ONE FORK. GET THE JOB-WIDE FORK HANDLE
;RETURN ERROR IF REQUEST IS FOR SELF, SUPERIOR, OR PARALLEL
CALL SETJFK ;OTHERWISE, ANY SINGLE INFERIOR
CAME 1,FORKN ;REQUESTING FREEZE OF SELF?
CALL SKIIF ;REQUESTING SELF OR INFERIOR?
JRST FRKE1 ;NOT INFERIOR. RETURN ERROR
;DO THE FREEZE. UPDATE TTY PSI INFORMATION IF REQUESTED FORK AND
;REQUESTING FORK HAVE THE SAME CONTROLLING TERMINAL
PUSH P,T1 ;SAVE THE REQUESTED JOB-WIDE INDEX
CALL FFORK1 ;DO THE WORK
POP P,T1 ;RESTORE REQUESTED INDEX
LOAD T1,FRKTTY,(T1) ;HERE'S ONE FORK'S CTTY
HRRZ T2,FORKN ;NOW DO SAME FOR SELF
LOAD T2,FRKTTY,(T2) ;HERE'S MY CTTY
CAIN T1,0(T2) ;ARE THEY THE SAME SOURCE?
CALLRET UPDTIR ;YES. SO GO UPDATE TTY PSI INFO
CALL FUNLK ;NO. SO JUST RELEASE FORK STRUCTURE
MRETNG ;AND RETURN
;HERE WHEN REQUESTED ALL INFERIORS OF THE CALLER. STEP THROUGH
;ALL IMMEDIATE INFERIORS AND, FOR EACH ONE, CALL FFORK1 TO
;FREEZE IT.
FFORK5: HRRZ 1,FORKN ;SELF
CALL MAPINF ;MAP ALL IMMED INFERIORS
CALL FFORK1 ;THROUGH FFORK1
HRRZ T1,FORKN ;GET MY SOURCE OF TERMINAL PSI'S
LOAD T1,FRKTTY,(T1)
CALLRET UPDTIR
;FFORK1 AND FFORK3 - FREEZE A FORK AND ALL OF ITS INFERIORS
;ACCEPTS:
; T1/ JOB-WIDE FORK HANDLE
; CALL FFORK1 - DIRECT FREEZE
; CALL FFORK3 - INDIRECT FREEZE
;RETURNS +1: ALWAYS
FFORK3: SKIPA 2,[FRZB2%] ;INDIRECT FREEZE BIT
FFORK1: MOVX 2,FRZB1% ;DIRECT FREEZE BIT
HRRZ 7,SYSFK(1) ;GET SYSTEM WIDE FORK INDEX
TDNE 2,FKINT(7) ;ALREADY DONE?
RET ;YES
TXNE 2,FRZB1% ;REMEMBER WHICH BIT - B1?
TRO 1,1B18 ;YES
HRLM 1,0(P) ;SAVE CURRENT FORK
TRZ 1,1B18
CALL MAPINF ;DO INDIRECT FREEZE OF INFERIORS
CALL FFORK3
HLRZ T1,0(P) ;GET CURRENT FORKN
TRZ T1,1B18
LOAD T2,FRKTTY,(T1) ;THIS FORK'S CURRENT SOURCE OF PSI'S
PUSH P,Q1 ;SAVE A COUPLE AC'S
PUSH P,Q2 ; ..
MOVEI Q1,0(T1) ;FIND SUPERIOR OF THIS FORK
ADD Q1,SUPERP ; ..
LDB Q1,Q1 ;GET FORK NUMBER
LOAD T1,FRKTTY,(Q1) ;GET CONTROLLING TERMINAL
CAMN T2,T1 ;SAME AS FOR FORK BEING FROZEN?
JRST FFORK4 ;YES, SKIP THE PSI UPDATE
MOVEI T1,0(T2) ;NO, DIFFERENT. SO UPDATE PSI INFO
CALL UPDTI ; FOR THAT TTY
FFORK4: POP P,Q2 ;RESTORE AC'S USED JUST ABOVE
POP P,Q1 ; ..
HLRZ 1,0(P) ;RESTORE FORK PLUS FLAG BIT
XHLLI T2,20 ;GET SECTION #
HLLM T2,0(P) ;SET IT IN RETURN
MOVX 2,FRZB1% ;RESTORE BIT
TRZN 1,1B18 ;B1?
MOVX 2,FRZB2% ;NO, B2
HRRZ 7,SYSFK(1)
CALL SUSFK ;SUSPEND FORK
IORM 2,FKINT(7)
MOVEI 2,FRZWT
HRRM 2,FKSTAT(7) ;SET FROZEN STATE
CALL RECONC ;UPDATE LIST
OKSKED ;MATCH NOSKED IN SUSFK
RET
;(INDIRECTLY) FREEZE ALL INFERIORS
FALLI: MOVE T1,FORKN
CALL MAPINF
CALL FFORK3 ;XCTED BY MAPINF
RET
RESCD
FRZWT:: JRST 0(4) ;FREEZE WAIT SCHED TEST
SWAPCD
;RESUME FORK
.RFORK::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
MOVEI 1,0(1)
CAIN 1,-4 ;ALL INFERIORS?
JRST RFORK5 ;YES
CALL SETJFK
MOVE P1,T1 ;SAVE A COPY OF THE FORK INDEX
CAME 1,FORKN ;CHECK RELATIVITY
CALL SKIIF
JRST FRKE1 ;NOT INFERIOR
CALL RFORK1
LOAD T1,FRKTTY,(P1) ;GET CTTY
CALLRET UPDTIR
RFORK5: HRRZ 1,FORKN
CALL MAPINF ;DO ALL IMMED INFERIORS
CALL RFORK1
HRRZ T1,FORKN
LOAD T1,FRKTTY,(T1) ;FIND THE FORK'S CTTY
CALLRET UPDTIR
RFORK3: SKIPA 2,[FRZB2%] ;INDIRECT FREEZE BIT
RFORK1: MOVX 2,FRZB1% ;DIRECT FREEZE BIT
HRRZ 7,SYSFK(1)
TDNN 2,FKINT(7) ;FROZEN THIS WAY?
RET ;NO
ANDCAB 2,FKINT(7) ;CLEAR THIS TYPE OF FREEZE
TXNE 2,FRZBB% ;ALL TYPES OF FREEZE NOW CLEARED?
RET ;NO, LEAVE FORK FROZEN
HRLM 1,0(P) ;SAVE CURRENT FORK
CALL MAPINF ;CLEAR INDIRECT FREEZE ON INFERIORS
CALL RFORK3
HLRZ 1,0(P)
HRRZ FX,SYSFK(T1) ;SYSTEM FORK INDEX
XHLLI T2,. ;FIND CURRENT SECTION
HLLM T2,0(P) ;SET IT IN RETURN PC
MOVX T2,JTFRZ% ;FROZEN BY JSYS TRAP?
TDNE T2,FKINT(FX) ; ?
RET ;YES. DON'T RESUME.
MOVX T2,ABFRZ% ;CLEAR ADDRESS BREAK FREEZE
ANDCAM T2,FKINT(FX) ; ..
CALL STPFK1 ;SET TO UNFREEZE THIS FORK
SKIPN 2,PIOLDS(1) ;WAS ON WTLST BEFORE FREEZE?
JRST [ CALL UNBLK1 ;UNBLOCK IT
JRST RFORK4]
MOVEM 2,FKSTAT(7)
CALL RECONC ;UPDATE WAIT LISTS
RFORK4: CALL CLRSFK ;UNSUSPEND FORK
OKSKED ;MATCH NOSKED IN STPFK1 (SUSFK)
JRST CLRLFK
;(INDIRECTLY) RESUME ALL INFERIORS
RALLI: MOVE T1,FORKN
CALL MAPINF
CALL RFORK3 ;XCTED BY MAPINF
RET
;BREAKPOINT JSYS FOR IDDT
.BPT:: MCENT
JRST HALTF1 ;MAKE LIKE HALTF
;PERPETUAL WAIT - INTERRUPTABLE
.WAIT:: MCENT
WAIT1:: MOVE T1,FORKX ;GET FORK NUMBER
MOVE T1,FKINT(T1) ;GET INTERRUPT STATUS
TXNN T1,FKPSI1 ;MUST BE
SKIPL INTDF ; INTERRUPTABLE
JRST WAIT2 ;WE'RE NOT
MOVEI 1,JRET
MOVSI T2,FHV2 ;LOWER BLOCK PRIORITY
HDISMS
JRST MRETN
WAIT2: BUG (WAITNI,<<FORKX,FORK>>)
;SPECIAL ROUTINES CALLED FROM HANG-UP CODE TO INDIRECTLY FRREZE OR
;UNFREEZE ALL INFERIORS. THIS TECHNIQUE IS USED (RATHER THAN FFORK
;AND RFORK) IN ORDER TO PRESERVE THE FROZENNESS OF FORKS ACROSS
;A HANGUP ATTATCH SEQUENCE.
;FORK FREEZE INDIRECT:
FFORKI::CALL FLOCK ;LOCK UP THE JOB FORK STRUCTURE
HRRZ T1,FORKN ;GET RELATIVE HANDLE FOR THIS PROCESS
CALL MAPINF ;MAP ALL INFERIORS
CALL FFORK3 ;INDIRECTLY FREEZE THEM ALL
FORKI: CALL UPDTI ;UPDATE TTY PI WORDS
CALL FUNLK ;UNLOCK FORK STRUCTURE
RET ;AND DONE
;RESUME FREEZE INDIRECT
RFORKI::CALL FLOCK ;LOCK UP FORK STRUCTURE
HRRZ T1,FORKN ;GET JOB WIDE INDEX
CALL MAPINF ;MAP ALL INFERIORS
CALL RFORK3 ;INDIRECT RESUME OF ALL INFERIORS
JRST FORKI ;AND DONE
;READ FORK STATUS
.RFSTS::MCENT
TXNE T1,^-<RF%LNG!RF%PRH> ;ANY RESERVED BITS NON-0?
ITERR (DECRSV)
CALL FLOCK ;LOCK THE FORK STRUCTURE
MOVE P1,[-1] ;ASSUME FORK HANDLE IS UNASSIGNED, STATUS=-1
HRRZ T1,T1 ;USE ONLY 18 BITS
TRNE T1,200000 ;LOCAL DESIGNATOR?
JRST RFSTS5 ;NO
CAIN T1,400000 ;SELF?
JRST RFSTS5 ;YES - DONT TRANSLATE HANDLE
CALL RFHJFK ;CONVERT SINGLE FORK RFH TO JRFN
JRST ITFRKR ;ERROR - ERR CODE IN T1
CAIGE T1,NUFKS ;ASSIGNED?
SKIPG SYSFK(T1)
JRST RFSTS7 ;NO-- RETURN -1
JRST RFSTS6 ;YES
RFSTS5: CALL SETJFK ;NOT MULTIPLE FORKS
RFSTS6: HRRZ FX,SYSFK(T1) ;GET SYSTEM FORK INDEX
MOVE P1,T1 ;SAVE JOB INDEX
CALL MRFSTS ;GET FORK STATUS WORD
EXCH P1,T1 ;SAVE STATUS. GET BACK JOB INDEX
CALL SETLF1 ;MAP PSB
RFSTS7: UMOVE T2,1 ;GET USER AC1
TXNE T2,RF%LNG ;LONG FORM RFSTS?
JRST RFSLNG ;YES-- DO LONG FORM
CAMN P1,[EXP -1] ;UNASSIGNED FORK HANDLE?
JRST RFSTSR ;YES-- JUST RETURN STATUS
HLLZ T3,PFL(T1) ;GET FLAGS
MOVE T2,PPC(T1) ;GET PC
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?
TXNE T2,ABFRZ% ; ?
JRST [ TLO T1,.RFABK ;YES, RETURN PROPER CODE
JRST MRFSTX] ; ..
TXNE T2,JTFRZ% ;NO, MAYBE JSYS TRAPPED?
TLOA T1,.RFTRP ;IT IS, FLAG IT.
CAIA
JRST MRFSTX ;AND RETURN THAT
HLRZ T2,FKSTAT(FX) ;AND GET OLD STATUS
JUMPE T2,MRFSTX
JRST RFST5
RFST7: TLO T1,5 ;DISMS'ING
MRFSTX: RET ;COMMON EXIT
;START FORK VIA ENTRY VECTOR
.SFRKV::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETJFK
PUSH P,T1
UMOVE T2,2 ;Get user's start offset
CAIGE T2,0 ;Must be positive number
ERRJMP (SFRVX1,ITFRKR)
HRRZ T3,T2 ;Get position in vector
CAILE T3,1 ;Is offset 0 or 1?
CALL CHKNXS ;No-- make sure not execute-only
CALL SETLF1
MOVE T3,EVLNTH(T1) ;GET SIZE OF VECTOR IN DESTINATION FORK
CAIE T3,<JRST>B53 ;TOPS-10 style vector?
JRST SFKV01 ;No-- go on
MOVEI T3,2 ;Yes-- length is 2
CAMN T2,[XWD 1,0] ;This CCL start position?
JRST SFKV02 ;Yes-- all checking done
SFKV01: CAIL T3,1 ;REASONABLE VECTOR LENGTH?
CAIL T3,1000
JRST SFRKV2 ;NO
CAIL T2,0(T3) ;LEGAL ARG?
JRST SFRKV2 ;NO
SFKV02: MOVEM T2,FORCTC(T1) ;LEAVE FOR FOR TO START SELF
CALL CLRLFK
POP P,T1 ;RECOVER JOB HANDLE
HRRZ T2,FORKN ;GET JOB HANDLE FOR THIS FORK
CAMN T1,T2 ;SAME?
JRST [ CALL FUNLK ;YES, UNLOCK AND CONTINUE IN SAME FORK
CALL SFRKV5 ;CONSTRUCT NEW PC
MOVEM T1,0(P) ;STORE FLAGS
MOVEM T2,-1(P) ;STORE ADDRESS
JRST MRETN] ;RETURN TO IT
CALL STPFK
DMOVE T2,[PCU ;NEW FLAGS, PC - START IN MONITOR
MSEC1,,SFRKV1]
CALLRET SFORK1
SFRKV2: CALL CLRLFK
ERRJMP(SFRVX1,ITFRKR) ;ILLEGAL RELATIVE NUMBER
;FORK STARTS HERE TO LOOK AT ENTRY VECTOR AND GO TO USER
SFRKV1: MOVE P,UPP ;SETUP STACK
CALL SFRKV5 ;CONSTRUCT NEW PC
DMOVEM T1,FFL ;SETUP FLAGS AND PC
JRST GOUSR ;RETURN TO IT
;CONSTRUCT ADDRESS FROM ENTRY VECTOR PARAMETERS
SFRKV5: MOVE T1,EVADDR ;ENTRY VECTOR ADDRESS
HLRZ T2,T1 ;Get section number of entry vector
XSFM T3 ;Get flags and possibly bad PCS
STOR T2,EXPCS,T3 ;Store new PCS in flags-PC doubleword
XMOVEI T4,SFRKV6 ;Get continue address for flags-PC doubleword
XJRSTF T3 ;Set previous context section and continue
SFRKV6: HRRZ T2,FORCTC ;RELATIVE ADDRESS
MOVE T3,EVLNTH ;GET SIZE OF ENTRY VECTOR
CAIE T3,<JRST>B53 ;OLD STYLE?
IFSKP.
HLLZ T1,T1 ;GET SECTION OF PGM
CAIN T2,0 ;YES, 0 MEANS .JBSA
XCTU [HRR T1,.JBSA(T1)]
CAIN T2,1 ;1 MEANS .JBREN
XCTU [HRR T1,.JBREN(T1)]
HLRZ T2,FORCTC ;Get start offset (non-0 only for .JBSA)
ENDIF.
ADD T2,T1 ;COMPLETE ADDRESS
MOVX T1,UMODF ;MAKE IT A USER PC
RET
;Start fork at specific starting address
;
;Accepts from user space:
; T1/ control flags,,fork handle
; T2/ PC flags
; T3/ PC address
.XSFRK::MCENT
UMOVE T1,T1 ;GET CONTROL FLAGS AND FORK HANDLE
XCTU [DMOVE T2,T2] ;GET PC FLAGS AND ADDRESS
CALLRET SFORK0 ;EXIT THROUGH COMMON CODE
;Start fork in starting address section
;
;Accepts from user space:
; T1/ control flags,,fork handle
; T2/ PC flags,,PC address without section
.SFORK::MCENT
UMOVE T1,T1 ;GET CONTROL FLAGS AND FORK HANDLE
XCTU [HLLZ T2,T2] ;GET PC FLAGS FROM LH OF USER'S AC2
XCTU [HRRO T3,T2] ;USE STARTING ADDRESS SECTION AND 18-BIT ADDRESS FROM USER'S AC2
CALLRET SFORK0 ;FINISH WITH COMMON ROUTINE
;SFORK0 is the worker routine for both SFORK and XSFRK jsyses.
;
;Accepts: T1/ control flags and fork handle
; T2/ PC flags
; T3/ PC address, -1 in left half means use s.a. section
SFORK0: TRVAR <CFLAGS,PCFLGS,PCADDR>
MOVEM T1,CFLAGS ;SAVE ARGS
MOVEM T2,PCFLGS
MOVEM T3,PCADDR
TXNE T1,^-<SF%CON!SF%PRH> ;ANY UNKNOWN BITS SET?
ITERR (DECRSV) ;YES-- GIVE ERROR
CALL FLOCK ;LOCK THE FORK STRUCTURE
HRRZ T1,CFLAGS ;GET FORK HANDLE
CALL SETJFK
MOVE T2,CFLAGS ;GET FLAGS/PROCESS HANDLE FROM USER
TXNE T2,SF%CON ;CONTINUE PROCESS ONLY?
JRST [ PUSH P,T1 ;SAVE JOB-WIDE HANDLE
OPSTR <SKIPN>,SFSRT,(T1) ;HAS FORK BEEN STARTED?
ITERR (FRKHX5,<CALL FUNLK>) ;NO, UNLOCK AND GIVE ERROR
HRRZ FX,SYSFK(T1) ;GET SYSTEM HANDLE
CALL MRFSTS ;GET STATUS OF FORK
LOAD T2,RF%STS,T1 ;GET STATUS
POP P,T1 ;RESTORE HANDLE
CAIE T2,.RFHLT ;HALTED?
CAIN T2,.RFFPT ;OR FORCED TERMINATION?
SKIPA ;YES
JRST CLFLK0 ;NO. RETURN NOW
CALL STPFK ;YES. STOP IT BEFORE STARTING IT
JRST SFORK2] ;AND PROCEED
;PROCESS TO BE STARTED-- MUST SETUP CONTEXT
CALL CHKNXS ;Check for execute-only
CALL STPFK ;STOP FORK
MOVE T3,PCADDR ;IF XSFRK JSYS, CALLER SUPPLIED SECTION
SKIPGE PCADDR
HLL T3,EVADDR(T1) ;IF SFORK JSYS, USE STARTING ADDRESS SECTION
HLLZ T2,PCFLGS ;GET PC FLAGS
TLZ T2,(UIOF+2037B17) ;USER I/O, CALFRMMON, IDX AND IND OFF
TLO T2,(UMODF) ;AND USER ON
CALLRET SFORK1 ;DO COMMON CODE
;COMMON CODE FRO SFRKV%, SFORK%, XSFRK%, MSFRK%
; T1/ OFFSET ADDRESS TO OBJECT FORK PSB
; T2/ NEW FLAGS
; T3/ NEW PC
SFORK1: SETOM SLOWF(T1) ;NORMALIZE FLAG
PUSH P,PFL(T1)
HLLM T2,PFL(T1) ;PUT FLAGS
MOVEM T3,PPC(T1) ;AND PC
HRRZ T2,FORKN(T1) ;GET JOB FORK NUMBER
SETONE SFSRT,(T2) ;FLAG THAT FORK HAS BEEN STARTED
POP P,T2 ;OLD FLAGS
TXNE T2,UMODF ;FORK WAS IN USER MODE?
JRST SFORK2 ;YES, ACS ALREADY IN RIGHT PLACE
HRRZ T2,ACBAS(T1)
CAIGE T2,<UACB>B39 ;IN NESTED MONITOR CALL?
JRST SFORK2 ;NO, ACS ALREADY IN RIGHT PLACE
MOVSI T2,UACB(T1) ;MUST MOVE ACS FROM AC STACK
HRRI T2,UAC(T1) ; TO SAVED BLOCK 1
BLT T2,UAC+17(T1)
SFORK2: HRRZS FKSTAT(FX) ;CLEAR LH IN CASE FROZEN
SETZM PIOLDS(T1) ;SET PRE-FREEZE STATE TO RUNNING
PUSH P,T1 ;SAVE PSB POINTER
HLLZ T2,PSIBIP(T1) ;PASS FORK'S CURRENT INTERRUPT STATE
HRRZ T1,FORKN(T1) ;GET THIS FORKS JOB ID
HRRZ T1,SYSFK(T1) ;GET SYSTEM ID
PUSH P,T1 ;SAVE FORK
PUSH P,T2 ;SAVE PSB STATE
OKSKED ;MUST DO THIS IN CASE JSBSTF OR GOKFRE BLOCK
CALL JSBSTF ;GO DO ANY DEALLOCATIONS
POP P,T2 ;RESTORE T2
POP P,T1 ;GET FORK AGAIN
CALL GOKFRE ;FREE GETOK REQUESTS
CALL SUSFK ;MAKE SURE FORK STILL SUSPENDED
POP P,T1 ;RECOVER PSB POINTER
MOVX T2,FRZBA%
TDNE T2,FKINT(FX) ;FORK FROZEN?
JRST SFORK3 ;YES, DON'T START IT NOW
PUSH P,T1
CALL UNBLK1 ;UNBLOCK IT
POP P,T1
CALL CLRSFK ;NOW CLEAR SUSPENSION
SFORK3: MOVE T2,FORKN(T1) ;FIND THAT FORK'S CTTY
ADD T2,T1 ;GET OFFSET (T1 MIGHT CONTAIN MORE THAN 18 BITS)
LOAD T1,FRKTTY,(T2) ;GET CONTROLLING TERMINAL
CALL UPDTI
OKSKED ;MATCH NOSKED IN STPFK (SUSFK)
CALLRET CLFRET
;MONITOR SFORK, CAN START IN MONITOR SPACE
; T1/ FORK HANDLE
; T2/ EXTENDED START ADDRESS
.MSFRK::MCENT
MOVE 3,0(P) ;THIS IS LEGAL IF CALLED FROM
MOVE 4,CAPENB ;MONITOR MODE, OR IF SC%WHL OR
TLNE 3,(UMODF) ;OPERATOR CAPABILITIES ARE PRESENT
TXNE 4,SC%WHL+SC%OPR ;TEST CAPS
JRST .+2
ITERR(CAPX1) ;USER LACKS CAPABILITY
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETJFK
CALL STPFK ;SAME STUFF AS SFORK
MOVEI T2,MFRKWD ;GET PRIORITY WORD FOR MONITOR FORKS
SKIPN JOBSKD ;DOES JOB HAVE PRIORITY?
SKIPE JOBBIT(T1) ;NO. DOES THE PROCESS ALREADY HAVE SOME?
SKIPA ;YES. DON'T SET IT
MOVEM T2,JOBBIT(T1) ;DOESN'T
MOVX T2,PCU ;NEW FLAGS
UMOVE T3,T2 ;NEW PC
CALLRET SFORK1
;STOP FORK, USED BY SEVERAL FORK JSYS'S
STPFK: CALL SKIIF ;JOB FORK NUMBER IN 1, IS INFERIOR?
JRST FRKE2 ;NO
STPFK1: MOVE 6,1
HRRZ 7,SYSFK(6)
CAMN 7,FORKX ;THIS SAME FORK?
JRST FRKE1 ;YES, ILLEGAL
CALL SETLF1 ;MAP PSB
CALLRET SUSFK ;SUSPEND FORK
;READ/SET FORK AC'S
.RFACS::MCENT
XCTU [MOVES 0(2)] ;Test existence/writeability before NOSKED
XCTU [MOVES 17(2)] ; of whole block
CALL FACS
MOVEI T1,20 ;ALL ACS
EXCH T2,T3 ;GET ARGS IN RIGHT ORDER
CALL BLTMU1 ;DO BLT TO USER
JRST FACSR ;RETURN
.SFACS::MCENT
XCTU [SKIP 0(2)] ;Test existnece before NOSKED
XCTU [SKIP 17(2)] ; of whole block
CALL FACS
MOVEI T1,20 ;MOVE ACS
CALL BLTUM1 ;MOVE ACS TO MONITOR
; JRST FACSR ;RETURN
FACSR: OKSKED
JRST CLFRET
;COMMON AC ROUTINE
FACS: CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETJFK ;ONE FORK ONLY
CALL SKIIF ;AND IT MUST BE INFERIOR
JRST FRKE2 ;NOT INFERIOR
CALL CHKNXS ;Check for execute-only process
MOVE 6,1
HRRZ 7,SYSFK(6)
CALL SETLF1 ;MAP PSB
NOSKED
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
MOVX 3,FRZBA%
TDNE 3,FKINT(7) ;FROZEN?
JRST [ HRLM 2,FKSTAT(7) ;YET, UPDATE PRE-FREEZE STATE
MOVEM 2,PIOLDS(1)
JRST HFORK2]
MOVEM 2,FKSTAT(7) ;TERMINATED STATE
CALL CLRSFK ;BUT INTERRUPTABLE
HFORK2: MOVE 1,0(P)
ADD 1,SUPERP ;GET SUPERIOR
LDB 1,1
HRRZ 1,SYSFK(1) ;GET SYSTEM INDEX
CALL SUPUB0 ;WAKEUP SUPERIOR IF NECESSARY
HFORK3: MOVE T1,0(P)
OKSKED ;MATCH NOSKED IN STPFK (SUSFK)
CALL CLRLFK
POP P,T3 ;FORKN OF OTHER FORK
LOAD T1,FRKTTY,(T3) ;GET CONTROLLING TERMINAL
CALLRET UPDTI ;UPDATE TERM INT WORD
;CALL FROM TTY SERVICE TO RESOLVE FORK CONFLICT
TTFRKT::SKIPGE FKPT(1) ;FORK STILL EXISTS?
RET ;NO
HRRZ 2,FKSTAT(1) ;GET ITS STATUS
CAIE 2,TCITST ;STILL WAITING FOR TTY?
RET ;NO
MOVSI 3,-NUFKS ;SETUP TO SEARCH FOR FORK
SKIPL 2,SYSFK(3) ;THIS SLOT IN USE?
CAIE 1,0(2) ;AND HAS CORRECT FORKX?
AOBJN 3,.-2 ;NO
JUMPGE 3,R ;RETURN IF NOT FOUND IN THIS JOB
PUSH P,A ;SAVE FORK HANDLE IN CASE
MOVEI 1,0(3) ;FORKN OF OTHER FORK
CALL SKIIF ;IS IT INFERIOR
JRST [ MOVEI T1,^D1000 ;NO, WAIT AWHILE
DISMS
POP P,A ;GET BACK HANDLE OF THE FORK
JRST TTFRKT] ;TRY AGAIN
POP P,0(P) ;CLEAN UP STACK
SAVEPQ ;SAVE ALL PERMANENT REGS
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL HFORK1 ;HALT THE OTHER GUY
CALLRET FUNLK ;UNLOCK AND RETURN
;WAIT FOR FORK TO TERMINATE
.WFORK::MCENT
CAIN 1,-4 ;ALL INFERIORS?
JRST WFORKA ;YES
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETJFK ;ONE FORK, GET ITS JOB HANDLE
HRLZ 1,SYSFK(1) ;SETUP TEST ON FORK INDEX
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
HRRI 1,TRMTST
MOVSI T2,FHV1 ;LOW BLOCK PRIORITY
HDISMS
JRST MRETN
WFORKA::MOVSI D,-NLFKS+1 ;NUMBER TO DO
MOVE C,FKPTAB ;GET POINTER TO HANDLES
WFORK3: ILDB A,C ;GET NEXT HANDLE
CAIN A,-1 ;ASSIGNED?
JRST WFORK4 ;NO. LOOP TO NEXT THEN
MOVEI A,.FHSLF+1(D) ;GET NEXT HANDLE
RFSTS ;GET STATUS
CAMN A,[-1] ;IS IT DELETED?
JRST WFORK4 ;YES. GO DO NEXT THEN
LOAD A,RF%STS,A ;GET STATUS
CAIE A,.RFHLT ;HALTED?
CAIN A,.RFFPT ;NO. ERROR ABORT?
JRST MRETN ;YES. RETURN GOOD
WFORK4: AOBJN D,WFORK3 ;NO. LOOK AT ALL LOCALS
MOVEI A,TRMTS1 ;SETUP TEST TO WAIT UNTIL CHANGED
MOVSI T2,FHV1 ;LOW BLOCK PRIORITY
HDISMS
JRST MRETN
RESCD
TRMTST::MOVE T2,FKSWP(T1)
TXNN T2,FKBLK ;FORK BLOCKED?
JRST 0(4) ;NO
HRRZ T2,FKSTAT(1)
CAIE T2,HALTT ;WAITING BECAUSE TERMINATION?
CAIN T2,FORCTM ;OR FORCED TERM?
JRST 1(4) ;YES
;**;[2645]ADD 6 LINES AT TRMTST:+7L TAM 12-AUG-82
CAIE T2,FRZWT ;[2645]FROZEN?
JRST 0(4) ;[2645]NO WAIT
HLRZ T2,FKSTAT(1) ;[2645]GET PRE FREEZE STATE
CAIE T2,HALTT ;[2645]HALTED?
CAIN T2,FORCTM ;[2645]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: MOVX 1,FKPSI0+SUSFK% ;SUSPEND FORK REQUEST BIT FOR PSI
IORM 1,FKINT(7) ;LEAVE IT FOR SPECIFIED FORK
MOVEI 2,0(7)
CALL PSIR4 ;INTERRUPT THE FORK
OKSKED
MOVSI 1,0(7) ;SETUP SCHEDULER TEST TO WAIT
HRRI 1,SUSFKT ;UNTIL FORK HAS SUSPENDED ITSELF
MOVSI T2,FHV5 ;HIGHER BLOCK PRIORITY
HDISMS
JRST SUSF6 ;NOW CHECK IT AGAIN
SUSF4: SKIPN FKINT(7) ;TRANSITIONAL STATE?
JRST SUSF5 ;NO
MOVX 1,FKPSI0+SUSFK% ;YES, REQUEST INTERRUPT
IORM 1,FKINT(7)
MOVEI 2,0(7)
CALL PSIR4
OKSKED ;THEN WAIT TO BE SURE IT WAS RECEIVED
MOVEI 1,^D50
DISMS
JRST SUSF6 ;AND CHECK AGAIN
;SCHEDULER TEST FOR SUSPENSION
RESCD
SUSFKT::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: MOVX T2,FKPSI1
ANDCAM 2,FKINT(FX) ;CLEAR PSI STARTING STATE
PUSH P,1
SETZ 1,
MOVE 2,FX
CALL PSIRQB ;REQUEST TO RECHECK PENDING PSI'S
POP P,1
RET
;MAP ALL IMMEDIATE INFERIORS OF FORK IN 1
; EXECUTES +1 FOR EACH FORK
; RETURNS +2
MAPINF: ADD 1,INFERP
MAPIF1: LDB 1,1
JUMPE 1,MAPIF2
HRLM 1,0(P)
HRRZ T2,0(P) ;GET CALLER PC
XCT 0(T2) ;EXECUTE INSTRUCTION AT CALL+1
HLRZ 1,0(P)
ADD 1,PARALP
JRST MAPIF1
MAPIF2: XHLLI 2,20 ;FIND CURRENT SECTION
HLLM 2,0(P) ;RESTORE IT FOR RETSKP
JRST RSKP ;RETURN
;GET FORK STRUCTURE
;RETURNS A COPY OF THE JOB FORK STRUCTURE FROM A SPECIFIED
;STARTING POINT DOWNWARD.
;CALL
;1/ HANDLE ON INITIAL FORK
;2/ FLAGS - GF%GFH TO GET RELATIVE FORK HANDLES, GF%GFS TO DO RFSTS
;3/ -LENGTH,,START ADDR OF USER AREA TO RETURN FORK STRUCTURE IN
;EACH FORK IS REPRESENTED IN THE STRUCTURE BY A 3 WORD BLOCK:
;WD0: PARALLEL PTR,,INFERIOR PTR
;WD1: SUPERIOR PTR,,RELATIVE FORK HANDLE(IF REQUESTED)
;WD3: STATUS WORD (IF REQUESTED - ELSE -1)
;NOTE: EVEN IF GF%GFH IS OFF,PREVIOUSLY ACQUIRED FORK HANDLES WILL BE
; GIVEN FOR FORKS APPEARING IN THE RETURNED STRUCTURE.
;AC USAGE
;GLOBALS
;Q1/ REMAINING FREE AREA,,NEXT FREE CELL (USER ADDR)
;Q2/ GF%GFH!GF%GFS - COPIES OF UAC2; B17 - LOCAL FLAG
; FOR RFH SPACE EXHAUSTED. RH CONTAINS JRFN OF STARTING FORK
;RECURSIVE VARIABLES
;P1/ CURRENT JRFN,,USER ADDR OF CORRESPONDING BLOCK
.GFRKS::MCENT
HRRZ T1,T1 ;IGNORE LH T1
MOVE Q1,T3 ;INITIALIZE FREE POINTER
MOVSI Q2,(GF%GFH!GF%GFS) ;COPY OPTIONAL COMMAND BITS
AND Q2,T2 ; ...
MOVE T2,T1 ;COPY SPECIFIED HANDLE
CALL FLOCK ;FREEZE FORK DATABASE
CALL STJFKR ;CONVERT RFH IN T1 TO JRFN
JRST [CAIE T2,.FHTOP ;TOP FORK?
JRST EFRKR ;NO - ERROR CODE STILL IN T1
HLRZ T1,FORKN ;YES - UNPRIVLEDGED REF TO TOP FORK
TLZ Q2,(GF%GFH) ;PROHIBIT ACQUISITION OF HANDLES
JRST .+1]
HRR Q2,T1 ;SET STARTING FORK JRFN
HRLZ P1,T1 ;SET INITIAL CURRENT FORK
PUSH P,[0] ;DUMMY UP SUPERIOR
CALL GFRKS1 ;WALK THE TREE
POP P,(P) ;SCRAP DUMMY SUPERIOR
CALL FUNLK ;RELEASE FORK LOCK
TLNN Q2,(1B17) ;WERE THERE ENOUGH RFH?
SMRETN ;YES - SKIP RETURN
RETERR(FRKHX6) ;NO - RETURN ERROR CODE
;PREORDER TRANSITION OF A N-ARY TREE
GFRKS1: HLRZ T1,P1 ;GET CURRENT JRFN
HRRZ T2,Q1 ;SAVE NEW BASE ADDR
ADD Q1,BHC+2 ;ALLOCATE NEW BLOCK
AOBJP Q1,[MOVEI T1,GFKSX1 ;SPACE EXHAUSTED
JRST EFRKR] ;ERROR RETURN
XCTU [SETZM (T2)] ;CLEAR OUT NEW BLOCK
XCTU [SETZM 1(T2)] ; ...
XCTU [SETOM 2(T2)] ; ...
XCTU [HRLM P1,(T2)] ;STORE PARALLEL POINTER
HRR P1,T2 ;UPDATE CURRENT POINTER
MOVE T2,-1(P) ;GET SUPERIOR POINTER
HRRZ P2,P1 ;GET ADDRESS ONLY
XCTU [HRLM T2,1(P2)] ;STORE SUPERIOR POINTER
CALL JFKRFH ;SEE IF A HANDLE ALREADY EXISTS
XCTU [HRRM T2,1(P2)] ;RETURN HANDLE OR ZERO
TLNN Q2,(GF%GFH) ;ASSIGN RFH?
JRST GFRKS2 ;NO - GO ON
CALL SKIIF ;IS JRFN IN T1 INFERIOR?
JRST GFRKS2 ;NO - DONT GIVE OUT HANDLE
CALL GFKH ;JRFN STILL IN T1, RETURNS RFH IN T1
TLOA Q2,(1B17) ;ERROR RETURN - RFH EXHAUSTED
XCTU [HRRM T1,1(P2)] ;RETURN RELATIVE FORK HANDLE
GFRKS2: TLNN Q2,(GF%GFS) ;FORK STATUS REQUESTED?
JRST GFRKS3 ;NO - GO ON TO INFERIORS
HLRZ T1,P1 ;YES - GET JRFN
HRRZ FX,SYSFK(T1) ;GET SYSTEM FORK INDEX
CALL MRFSTS ;DO RFSTS
UMOVEM T1,2(P2) ;STORE STATUS.
GFRKS3: HLRZ T1,P1 ;GET JRFN AGAIN
ADD T1,INFERP ;CHECK FOR INFERIORS
LDB T1,T1 ; ...
JUMPE T1,GFRKS4 ;NONE - GO ON TO PARALLEL
PUSH P,P1 ;SAVE RECURSIVE VARIABLES
HRLZ P1,T1 ;GET INF JRFN & CLEAR PAR. PTR
CALL GFRKS1 ;DO ALL INFERIORS
HRRZ P2,(P) ;GET CURRENT BLOCK BACK
XCTU [HRRM P1,(P2)] ;STORE INFERIOR LIST
POP P,P1 ;RESTORE RECURSIVE VARS
GFRKS4: HLRZ T1,P1 ;GET CURRENT JRFN BACK
CAIN T1,(Q2) ;TOP SPECIFIED FORK?
RET ;YES - DONT DO PARALLEL
ADD T1,PARALP ;SEE IF ANY PARALLEL
LDB T1,T1 ; ...
JUMPE T1,R ;NONE - DONE WITH THIS LEVEL
HRL P1,T1 ;LOOP FOR THIS LEVEL
JRST GFRKS1 ; ...
;ROUTINE TO MAP A JRFN TO RFH FROM CURRENT FORK
;T1/ JRFN
; CALL JFKRFH
;RETURNS+1(ALWAYS):
;T1/ JRFN (UNCHANGED)
;T2/ RFH OR 0 IF NONE
;T3/ BYTE POINTER TO FKTAB ENTRY CORRESPONDING TO RFH
JFKRFH: CAIGE T1,NUFKS ;REASONABLE JRFN?
JRST JFKRH1 ;YES - MAP IT
BUG(ILJRFN)
JRST JFKRH3 ;ACT AS IF NOT FOUND
JFKRH1: MOVEI T2,.FHSLF ;CHECK IF SELF FIRST
HRRZ T3,FORKN ; ...
CAMN T1,T3 ;SELF?
RET ;YES - RETURN
MOVE T4,[-NLFKS+1,,1] ;SETUP COUNT
MOVE T3,FKPTAB ;SETUP INIITAL POINTER
JFKRH2: ILDB T2,T3 ;GET JRFN CORRESPONDING TO RFH IN T4
CAIN T2,(T1) ;MATCH?
JRST JFKRH4 ;YES - RETURN RFH
AOBJN T4,JFKRH2 ;NO - LOOP
JFKRH3: SETZ T2, ;NO MATCH - RETURN 0
RET
JFKRH4: MOVEI T2,400000(T4) ;BUILD CORRESPONDING RFH
RET
;ROUTINE TO MAP A SINGLE LOCAL RFH TO A JRFN
;NOTE THE DIFFERENCE BETWEEN RFHJFK AND SETJFK/STJFKR.
;RFHJFK ALLOWS ONLY LOCAL FORK HANDLES AND IGNORES THE ISSUE
;OF HAVING A HANDLE ON A PREVIOUSLY KILLED FORK. RFHJFK SHOULD
;ONLY BE USED WHEN THE CALLER IS PREPARED TO HANDLE THIS
;CASE (RFSTS, RFRKH FOR EXAMPLE). SETJFK/STJFKR ARE INTENDED FOR
;MOST USES. THEY ALLOW ALL NON MULTIPLE HANDLES AND SUCCEED ONLY
;IF THERE IS A LIVE FORK UNDER THE GIVEN HANDLE.
;T1/ RFH
; CALL RFHJFK
;RETURNS+1(ERROR):
;T1/ ERROR CODE
;RETURNS+2(SUCCESS):
;T1/ JRFN
;ALL OTHER ACS UNCHANGED
RFHJFK: CAIL T1,400001 ;REASONABLE LOCAL HANDLE?
CAIL T1,400000+NLFKS ; ...
JRST FRKESR ;NO - FIGURE OUT ERROR CODE
TRZ T1,400000 ;YES - GET LOCAL INDEX
PUSH P,T2 ;BE TRANSPARENT WRT ACS
IDIVI T1,2 ;BUILD BYTE POINTER
ADD T1,FKPTAB(T2) ; ...
POP P,T2 ;RESTORE T2
LDB T1,T1 ;GET JRFN
CAIN T1,-1 ;IN USE?
JRST FRKE1R ;NO, GIVE ERROR RETURN
RETSKP ;SUCCESS RETURN
;GET FORK HANDLE.
;CALL WITH T1/ HANDLE ON KNOWING FORK, T2/ HANDLE IN
; KNOWING FORK ON DESIRED FORK
;
;RETURNS A (POSSIBLY NEW) HANDLE IN T1 USABLE BY CALLER.
.GFRKH:: MCENT ;ESTABLISH CONTEXT
CALL FLOCK ;LOCK FORK STRUCTURE
HRROI T2,(T2)
CAME T2,[-1,,.FHSUP] ;ASKING FOR HANDLE ON SUP?
JRST GFRKH1 ;NO
CALL STJFKR ;GET JOB FORK INDEX IN T1
ERRJMP (GFRKX1,EFRKR) ;ERROR
ADD T1,SUPERP ;FORK POINTER TO FKPTRS
LDB T1,T1 ;GET JOB HANDLE OF TARGET FORK
CALL GFKH ;MAKE LOCAL HANDLE
ERRJMP (FRKHX6,EFRKR) ;NONE LEFT
UMOVEM T1,T1 ;RETURN HANDLE TO USER
JRST GFRKH3 ;RETURN TO CALLER
GFRKH1: TRNN T2,200000
ANDI T2,377777
CAIL T2,0 ;NEGATIVE IS ILLEGAL
CAIL T2,NLFKS ;A LEGIT FORK HANDLE?
ERRJMP (GFRKX1,EFRKR) ;NO. FAIL RETURN NONSKIP
CALL SETLF0 ;OK, SET UP THE PSB OF KNOWER
IDIVI T2,2 ;BUILD A POINTER TO JOB F INDEX
ADD T2,FKPTAB(T3) ; IN THE MAPPED PSB
TLO T2,1 ;OFFSET TO MAPPED PSB BY INDEXING PNTR
LDB T2,T2 ;GET THE DESIRED FORK'S JOB FORK INDEX
CAIL T2,NUFKS ;MAKE SURE IT'S ASSIGNED
JRST GFRKH2 ;CAN'T BE
SKIPGE SYSFK(T2) ;FORK STILL EXIST?
GFRKH2: ERRJMP (GFRKX1,EFRKR) ;NO, RETURN ERROR
MOVEI T1,(T2) ;OK, HERE'S THE DESIRED JOB FORK INDEX
CALL GFKH ;GET A FORK HANDLE IN THIS FORK FOR IT.
ERRJMP (FRKHX6,EFRKR) ;COULDN'T. NO SPACE LEFT.
UMOVEM T1,T1 ;OK. RETURN H-PRIME TO USER.
CALL CLRLFK
GFRKH3: CALL FUNLK ;UNLOCK FORK STRUCTURE
SMRETN ;AND SKIP RETURN TO HIM.
;RELEASE FORK HANDLE JSYS
;CALL
;1/ FORK HANDLE TO BE RELEASED
; RFRKH
;RETURNS+1:
;1/ ERROR CODE
;RETURNS+2:
;SUCCESS - AC UNCHANGED
.RFRKH::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CAMN A,[-1] ;WANT TO DO ALL OF THEM?
JRST RFRKH2 ;YES. GO DO IT THEN
CALL RFRKH0 ;GO DO THE WORK
JRST EFRKR ;FOUND AN ERROR. GO REPORT IT
CALL FUNLK ;FREE THE STRUCTURE
SMRETN ;AND RETURN GOOD
;INTERNAL ROUTINE TO RELEASE A FORK HANDLE
;ACCEPTS: A/ PROCESS RELATIVE FORK HANDLE
;RETURNS: +1 / CAN'T RELEASE HANDLE. REASON IN A
; +2/ HANDLE RELEASED AND ALL RELEVANT JOB FORK
; TABLES CLEANED UP
;WARNING: MUST BE CALLED WITH JOB FORK LOCK LOCKED
RFRKH0: CALL RFHJFK ;MAP RFH IN T1 TO JRFN
RET ;ERROR. CODE IN A
SKIPGE SYSFK(A) ;NOW ASSIGNED?
JRST RFRKH1 ;NO,IS OKAY TO DO IT.
LOAD B,FKHCNT,(A) ;IS INFERIOR. SEE ABOUT COUNT
CAIG B,1 ;NOW BEING SHARED?
JRST [ MOVEI A,FRKHX1 ;CAN'T RELEASE IT
RET] ;SO RETURN AN ERROR
RFRKH1: CALL DASFKH ;DEASSIGN FORK HANDLE
RETSKP ;GOOD RETURN
;ROUTINE TO RELEASE ALL HANDLES
RFRKH2: MOVE D,[-NLFKS+1,,1]
MOVE C,FKPTAB ;BEGINNING POINTER
RFRKH3: ILDB A,C ;GET POINTER
CAIN A,-1 ;IN USE?
JRST RFRKH4 ;NO
MOVEI A,.FHSLF(D) ;YES. GET RELATIVE HANDLE
PUSH P,C ;SAVE POINTER
PUSH P,D ;SAVE COUNTER
CALL RFRKH0 ;GO RELEASE IT
JFCL ;DON'T CARE
POP P,D
POP P,C ;RESTORE REGISTERS
RFRKH4: AOBJN D,RFRKH3 ;DO ALL HANDLES
CALL FUNLK ;FREE THE STRUCTURE
SMRETN ;AND DONE
;PERFORM FORK CONTROL FUNCTION FOR EACH FORK OF MULTIPLE FORK
;HANDLE (I.E. MAP A FUNCTION ONTO ALL FORKS)
; 1/ USER FORK HANDLE (SINGLE OR MULTIPLE)
; 2/ INSTRUCTION TO DO FOR EACH FORK
; CALL MAPFKH
; ;EXECUTE INSTRUCTION WITH JOB-WIDE
; HANDE IN T1
;RETURNS: +1 COROUTINE NEEDS TO BLOCK
; +2 ALL DONE
MAPFKH::CAIL 1,-5 ;IS IT A MULTIPLE FORK DESIGNATOR?
CAILE 1,-3
JRST [ PUSH P,T2 ;SAVE INST
CALL SETJFK ;GET HANDLE
POP P,T2 ;GET INST
XCT T2 ;DO IT
RETSKP ;DONE
RET] ;BLOCK
PUSH P,P6 ;SAVE FRAME POINTER
MOVE P6,P ;ESTABLISH FRAME
PUSH P,T2 ;SAVE INSTRUCTION
CALL MAPFT+5(1) ;DISPATCH TO APPROPRIATE FUNCTION
NOP ;NEVER GETS HERE
MOVE P,P6 ;RESTORE STACK
POP P,P6 ;RESTORE REG
RETSKP ;AND DONE
MAPFT: JRST MAPF5 ;-5, ALL FORKS IN JOB
JRST MAPF4 ;-4, ALL INFERIORS
JRST MAPF3 ;-3, SELF AND ALL INFERIORS
MAPF3: HRRZ 1,FORKN ;SELF
MAPF51: PUSH P,1
XCT 1(P6) ;DO INSTRUCTION
SKIPA ;DONE
JRST MAPBLW ;NEEDS TO BLOCK
POP P,1
MAPF41: ADD 1,INFERP ;DO INFERIORS
MAPF42: LDB 1,1 ;GET NEXT IN LIST
JUMPE 1,MAPF43 ;END OF LIST, RETURN AND SKIP INSTR
HRLM 1,0(P) ;SAVE THIS FORK NUMBER
CALL MAPF41 ;DO INFERIORS OF IT
BUG(MAP41F)
HLRZ 1,0(P) ;GET FORK NUMBER BACK
XCT 1(P6) ;DO THIS FORK
SKIPA ;DONE
JRST MAPBLW ;NEEDS TO BLOCK
HLRZ 1,0(P)
ADD 1,PARALP ;POINT TO NEXT IN LIST
JRST MAPF42
MAPF43: XHLLI T2,20 ;GET CURRENT SECTION
HLLM T2,0(P)
RETSKP
MAPF4: HRRZ 1,FORKN ;GET SELF
JRST MAPF41 ;DO INFERIORS
MAPF5: HLRZ 1,FORKN ;GET TOP
JRST MAPF51 ;DO THAT AND INFERIORS
;COROUTINE INDICATED TO BLOCK
MAPBLW: MOVE P,P6 ;GET PROPER FRAME
POP P,P6 ;RESTORE P6
RET ;AND INDICATE BLOCK UP
;FORK RELATIVITY TESTS
;SKIP IF FORK IN 1 IS SELF OR INFERIOR TO SELF
SKIIF:: PUSH P,2
HRRZ 2,FORKN ;GET SELF
CALL SKIIFA ;DO TEST
JRST PB2 ;RETURN NO SKIP
SKISF2: POP P,2
JRST RSKP
;SKIP IF FORK IN 1 IS SAME AS OR INFERIOR TO FORK IN 2
SKIIFA::HRLM 2,0(P) ;SAVE FORK NUMBER
SKIIF4: CAIN 1,0(2) ;SAME?
JRST SKIIF1 ;YES
ADD 2,INFERP ;NO, GET POINTER TO INFERIOR LIST
SKIIF2: LDB 2,2 ;NEXT INFERIOR
JUMPE 2,SKIIF6 ;END OF LIST
CALL SKIIFA ;IS THIS FORK OR INFERIOR?
JRST SKIIF5 ;NO
SKIIF1: HLRZ 2,0(P) ;SUCCEEDS, RETURN +2
XHLLI T4,20 ;FIND CURRENT SECTION
HLLM T4,0(P) ;SET IN RETURN
RETSKP ;AND RETURN +2
SKIIF6: HLRZ 2,0(P)
XHLLI T4,20 ;RESTORE SECTION NUMBER
HLLM T4,0(P)
RET ;FAILS RETURN +1
SKIIF5: ADD 2,PARALP ;LOOK PARALLEL
JRST SKIIF2
;SKIP IF FORK IN 1 IS SUPERIOR OF THIS FORK
SKISF:: PUSH P,2
HRRZ 2,FORKN
SKISF1: CAIN 1,0(2)
JRST SKISF2 ;SAME, RETURN GOOD
JUMPE 2,PB2 ;END OF LIST, RETURN BAD
ADD 2,SUPERP ;GET SUPERIOR POINTER
LDB 2,2
JRST SKISF1
;SKIMIF - SKIP IF FORK IN T1 IS IMMED INF OF EXECUTING FORK
SKIMIF: PUSH P,T1 ;MAKE TRANSPARENT TO T1
ADD T1,SUPERP ;GET SUPERIOR OF FORK IN T1
LDB T1,T1
CAMN T1,FORKN ;IS IT ME?
AOS -1(P) ;YES, SKIP RETURN.
POP P,T1 ;RESTORE CALLER'S ARG
RET
;Execute-Only process tests
; CHKNXS - Check for SELF or not execute-only
;
; Call:
; Fork structure is locked
; T1/ Job-relative fork number (JRFN) to be tested
; CALL CHKNXS
;
; Returns:
; +1: Always
; Process is now non-virgin
;
; ITRAPs if fork cannot be manipulated because it is execute-only
;
CHKNXS::
CALL CKNXSR ;Skip if OK
JRST ITFRKR ;Invalid-- ITRAP
RET ;Return from CHKNXS
;
;
; CKNXSR - Skip if not execute-only or SELF
; CKNXOR - Skip if not execute-only
;
; Call:
; Fork structure is locked
; T1/ Job-relative fork number (JRFN) to be tested
; CALL CKNXSR/CKNXOR
;
; Returns:
; +1: Check failed,
; T1/ Error code (FRKHX8)
; +2: Not execute-only (or SELF)
; Process is now non-virgin
;
CKNXSR:
CAMN T1,FORKN ;This SELF?
JRST CHKNX2 ;Yes, it's OK
CKNXOR::
JE SFEXO,(T1),CHKNX2 ;Jump if not execute-only
PUSH P,T1 ;Save the JRFN
MOVE T1,CAPENB ;Get enabled capability mask
TXNE T1,SC%WHL ;Is calling process a WHEEL?
JRST CHKNX1 ;Yes-- let him play
MOVE T1,FORKN ;GET OUR INDEX
JN SFGXO,(T1),[ POP P,T1 ;XONLY GET JSYS, SO ALLOW
RETSKP]
POP P,T1 ;Clean JRFN from stack
MOVEI T1,FRKHX8 ;Can't manipulate execute-only process
RET ;Return +1 with error code in T1
;
CHKNX1:
POP P,T1 ;Restore JRFN
CHKNX2:
CALL CLRVGN ;No longer virgin process
RETSKP ;Return +2 from CHKNXS/CHKNXO
;
;
; SETEXO - Set execute-only process
;
; Call:
; Fork structure is locked
; T1/ Job-relative fork number (JRFN) to be made execute-only
; CALL SETEXO
;
; Returns:
; +1: Cannot set execute-only becuase process is not virgin
; +2: Process is now execute-only
;
SETEXO::
JN SFNVG,(T1),R ;If not virgin, then can't be execute-only
SETONE SFEXO,(T1) ;Now process is execute-only
CALL CLRVGN ;No longer virgin
RETSKP ;Return +2 from SETEXO
;
;
; CLRVGN - Make process non-virgin
;
; Call:
; T1/ Job-relative fork number (JRFN) to be made non-virgin
; CALL CLRVGN
;
; Returns:
; +1: Always, process is now not virgin
;
CLRVGN:
SETONE SFNVG,(T1) ;No longer a virgin fork!!
RET ;Return from CLRVGN
;
;
; SETGXO/CLRGXO - Enable/Disable for execute-only GET
;
; Call:
; CALL SETGXO/CLRGXO
;
; Returns:
; +1: Always
;
SETGXO::
PUSH P,T1 ;Save register
MOVE T1,FORKN ;Get current JRFN
SETONE SFGXO,(T1) ;Set execute-only GET flag
JRST CLRGX1 ;Restore T1 and return
;
CLRGXO::
PUSH P,T1 ;Save register
MOVE T1,FORKN ;Get current JRFN
SETZRO SFGXO,(T1) ;Reset execute-only GET bit
CLRGX1:
POP P,T1 ;Restore T1
RET ;Return from SETGXO/CLRGXO
;
;
; SETLFX - Map PSB and check for execute-only
;
; This routine is available for a common sequence of functions:
; - Convert RFH to JRFN
; - Check for execute-only
; - Map PSB of process
;
; Call:
; Fork structure is locked
; T1/ Process relative fork handle (RFH)
; CALL SETLFX
;
; Returns:
; +1: Always,
; T1/ Address of PSB
;
; ITRAPs under a variety of fork-handle conditions
;
SETLFX::
CALL SETJFK ;Convert RFH to JRFN
CALL CHKNXS ;Make sure not execute-only or SELF
CALLRET SETLF1 ;Map PSB of process, and return from SETLFX
SUBTTL MISCELLANEOUS ROUTINES
;MAP PSB OF FORK, GIVEN USER HANDLE IN 1
;RETURN WITH OFFSET TO MAPPED PSB IN 1
;DOES NOT CLOBBER T2 OR T3
SETLFK::
REPEAT 0,< ;This is antiquated by capability checking
TRNE 1,200000 ;SPECIAL DESIGNATOR?
JRST FRKES ;NOT ALLOWED
> ;End of REPEAT 0
SETLF0: CALL SETJFK ;GET JOB FORK INDEX
SETLF1::HRRZS T1
HRRZ 1,SYSFK(1) ;GET SYSTEM FORK INDEX
SETLF3: NOINT
SE1CAL
CAMN 1,FORKX ;CURRENT FORK?
JRST SETLF2 ;YES
HRL T1,FKPGS(T1) ;GET PSB OF DESIGNATED FORK
HRRI T1,PSBM0-PSBPGA+PSBPG ;GET MAP OFFSET FOR THE PSB
PUSH P,2
PUSH P,T3 ;SAVE T3 AS WELL
MOVE 2,[PTRW+FPG1A]
MOVEI T3,2 ;MAP PSB AND STACK PAGE
CALL MSETMP ;DO IT
MOVEI 1,FPG1A-PSBPGA ;RETURN OFFSET USUAL PSB TO MAP PSB
JRST PB3
SETLF2: SETZ 1, ;USE CURRENT PSB, NO OFFSET
RET
;CLEAR MAPPING OF FPG1. USED BY LFK, PSB, JSB.
CLRJSB::
CLRPSB::
CLRLFK::SKIPN PSBM0+FPG1 ;NOW MAPPED?
JRST CLRLFX ;NO
SETZ 1,
MOVEI 2,FPG1A
MOVEI T3,2 ;CLEAR FPG1 AND FPG2
CALL MSETMP ;DO IT
CLRLFX: OKINT
RET
;MAPJSB - ROUTINE TO MAP ANOTHER JOB'S JSB
;
;ACCEPTS IN T1/ JOB NUMBER
; CALL MAPJSB
;RETURNS: +1 FAILED, NO SUCH JOB
; +2 SUCCESS, WITH T1/ OFFSET SUCH THAT JSB(T1) REFERS TO
; 'JSB' IN OTHER JOB'S JSB.
MAPJSB:: NOSKED ;PREVENT JOB FROM LOGGING OUT
SKIPGE JOBRT(T1) ;THIS JOB EXIST ?
RETBAD (,<OKSKED>) ;NO, FAIL
CALL SETJSB ;YES, MAP THE JSB
OKSKED ;PERMIT SCHEDULING AGAIN
RETSKP ;DONE, RETURN SUCCESS
;SETUP JSB FOR ANOTHER JOB
; 1/ JOB NUMBER
; RETURN +1 WITH JSB MAPPED INTO FPG1A,
; 1/ OFFSET SUCH THAT JSB(1) REFERS TO 'JSB' IN OTHER JOB'S JSB
SETJSB:: NOINT
PUSH P,FX
HRRZ FX,JOBPT(A) ;GET TOP FORK OF OTHER JOB
LOAD A,FKJSB ;GET JSB OF OTHER JOB
MOVE B,[PTRW+FPG1A]
CALL SETMPG ;MAP JSB INTO FPG1
MOVEI A,FPG1A-JSBPGA
POP P,FX
RET
;SETUP TOP FORK PSB FOR ANOTHER JOB
; 1/ JOB NUMBER
; RETURN +1 WITH PSB MAPPED INTO FPG1,
; 1/ OFFSET SUCH THAT PSB(1) REFERS TO 'PSB' IN OTHER JOB'S PSB
SETPSB::HRRZ A,JOBPT(A) ;GET TOP FORK OF OTHER JOB
JRST SETLF3 ;GO DO THE REST
;GET CAPABILITIES OF ANOTHER JOB
; 1/ JOB NUMBER
; RETURN +1,
; 1/ CAPMSK OF DESIGNATED JOB FROM TOP FORK
GJCAPS:: CALL SETPSB ;GET OTHER JOB'S PSB
;**;[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 OUT ONES WE SHOULDN'T HAVE
PUSH P,B ;[2627] SAVE IT
CALL CLRPSB ;UNDO PSB MAPPING
POP P,A
RET
;GET JOB FORK HANDLE GIVEN USER HANDLE IN 1
;FOR SINGLE (NOT MULTIPLE) FORK HANDLES ONLY
SETJFK::CALL STJFKR ;DO ACTUAL TRANSLATION
JRST ITFRKR ;ERROR - ITRAP
RET ;SUCCESS
STJFKR::HRRZ T1,T1 ;USE ONLY 18 BITS FOR FORK HANDLE
CAIL T1,-2 ;-1 OR -2?
XCT SETJFT+2(T1) ;YES - TRANSFER TO CORRECT ROUTINE
TXZ T1,FH%EPN ;FLUSH FLAG
CAIN T1,.FHSLF ;SELF?
JRST [ HRRZ T1,FORKN ;YES
RETSKP]
CALL RFHJFK ;LOCAL HANDLE - CONVERT TO JRFN
RET ;ILL FORMED - ERR CODE IN T1
CAIGE T1,NUFKS ;FORK HANDLE ASSIGNED?
SKIPGE SYSFK(T1) ;FORK KILLED?
JRST FRKE1R ;NO TO EITHER QUESTION
RETSKP ;RETURN
SETJFT: JRST GETTPF ;-2, TOP FORK
JRST GETSPF ;-1, SUPERIOR
GETSPF: MOVE T1,[1B9+SC%WHL+SC%OPR] ;DOES USER HAVE CAPABILITY TO
TDNN T1,CAPENB ; REFERENCE SUPERIOR FORK?
JRST FRKE2R ;NO
HRRZ T1,FORKN ;GET SUPERIOR FORK
MOVE T1,FKPTRS(T1)
LSH T1,-^D24
RETSKP
GETTPF: MOVEI T1,SC%WHL+SC%OPR ;DOES USER HAVE CAPABILITY TO
TDNN T1,CAPENB ; REFERENCE TOP FORK?
JRST FRKE2R ;NO
HLRZ T1,FORKN ;YES, GET TOP FORK
RETSKP
;COMMON ROUTINE TO LOCK FORK STRUCTURE
; CALL FLOCK
; RETURN +1: ALWAYS, CLOBBERS NO AC'S
;ALTERNATE ENTRY POINT, FLOCKN, ALLOWS NESTING OF THE LOCK.
;CALLING FLOCKN IMPLIES THAT A CALLER TO EITHER ENTRY THAT FINDS
;THE LOCK ALREADY LOCKED CAN FURTHER LOCK IT IF THE CALLING PROCESS
;IS THE ONE THAT LOCKED IT. A COUNT IS KEPT IN FLKCNT, AND THE
;LOCK IS UNLOCKED ONLY WHEN THE COUNT GOES TO 0. THE LEFT HALF OF
;FLKOWN IS -1 IF NESTING IS ALLOWED, 0 OTHERWISE.
FLOCK::
FLOCKN:: ;DEFINE THIS ENTRY AS WELL
REPEAT 0,< ;NOT CHECKED NOW BECAUSE MLKBLK PROBLEM
SKIPN FORKN ;TOP FORK?
JRST FLOCK1 ;YES, INTERRUPTIBILITY NOT SIGNIFICANT
SKIPL INTDF ;INTERRUPTABLE NOW?
BUG(FLKINT)
>
ACVAR <W1,W2>
FLOCK1: CSKED ;BE CRITICAL IF LOCK WORKS
AOSN FKLOCK ;LOCK SUCCESSFUL?
;THE LOCK WAS PREVIOUSLY UNLOCKED. SAVE THIS FORK INDEX AND INCREMENT
;THE NEST COUNT
JRST [ HRRZ W2,FORKN ;GET OUR JOB-WIDE FORK HANDLE
MOVEM W2,FLKOWN ;SAVE IT AS THE OWNER
SKIPE FLKCNT ;IF NOT ZERO, SOMETHING IS WRONG
CALL [ BUG (FKCTNZ,<<JOBNO,JOB>,<FORKN,JBFORK>>)
SETZM FLKCNT
RET]
AOS FLKCNT ;INCREMENT NEST COUNT
MOVE W1,TODCLK ;GET NOW
ADDI W1,^D120000 ;WHEN IT WILL TIMEOUT
MOVEM W1,FKTIMW ;SET IT
RET] ;SUCCESS
;SOMEONE HAS IT INCREMENTED. SUCCEED IF IT IS OUR FORK, AND INCREMENT
;THE NEST COUNT
ECSKED ;LOCK NOT SUCCESSFUL, ALLOW INTERRUPTS
HRRZ W1,FORKN ;GET US
CAME W1,FLKOWN ;ARE WE THE OWNER?
JRST FLOCK3 ;NO. GO WAIT THEN
AOS FLKCNT ;YES. INCREMENT NEST COUNT
SOS FKLOCK
RET ;SUCCESS
;SOMEONE ELSE HAS THE LOCK. WAIT A WHILE.
FLOCK3: MOVE W1,T1 ;PRESERVE T1
MOVEI T1,^D200 ;WAIT 200 MS BEFORE RECHECKING
DISMS
MOVE T1,W1 ;RESTORE T1
MOVE W1,TODCLK ;GET NOW
CAMG W1,FKTIMW ;HAS THE LOCK TIMED OUT YET?
JRST FLOCK2 ;NO, KEEP WAITING
;WE'VE BEEN WAITING A LONG TIME FOR THIS LOCK. BUGCHK AND THEN
;FORCE IT TO BE UNLOCKED
BUG(FLKTIM,<<FORKN,JOBFRK>,<JOBNO,JOB>,<FLKOWN,OWNER>>)
SETZM FLKCNT ;ZERO THE NEST COUNT
SETOM FLKOWN ;CLEAR THE OWNER
SETOM FKLOCK ;TIMEOUT, CLEAR LOCK AND PROCEED
FLOCK2: JRST FLOCK1
ENDAV. ;END ACVAR
;FUNLK - COMMON ROUTINE TO UNLOCK FORK STRUCTURE
; CALL FUNLK
; RETURN +1: ALWAYS, CLOBBERS NO AC'S
;NOTE: THIS CODE COULD CAUSE FLKCNT TO GO NEGATIVE IN THE FOLLOWING
;CASE: FORK 1 LOCKS FKLOCK AND INCREMENTS FLKCNT TO 1, FORK 2 TIMES
;OUT THE LOCK AND SETS FLKCNT TO 0, FORK 2 LOCKS THE LOCK AND LATER
;UNLOCKS IT. WHEN FORK 1 FINALLY UNLOCKS THE LOCK, THE COUNT IS ALREADY
;ZERO. THIS CODE FORCES THE COUNT TO BE NO LESS THAN ZERO.
FUNLK:: PUSH P,1 ;BE TRANSPARENT TO ALL AC'S
SOSLE FLKCNT ;DECREMENT THE NEST COUNT
JRST [ POP P,T1
RET] ;NOT THE LAST TIME. DONE
SETOM FLKOWN ;CLEAR OWNER OF LOCK
SETZM FLKCNT ;MAKE SURE THE COUNT IS ZERO
MOVX T1,1B1 ;GET VERY LARGE TIME
MOVEM T1,FKTIMW ;AND SAY IT NEVER TIMES OUT
SETO 1,
EXCH 1,FKLOCK ;CLEAR LOCK, GET PREVIOUS VALUE
ECSKED ;NO LONGER CRITICAL
JUMPN 1,FUNLK1 ;IF LOCK WAS 0, THEN NO ATTEMPT
FUNLK2: POP P,1 ; WAS MADE TO LOCK IT WHILE THIS FORK
RET
;IF LOCK WAS .G. 0, SOME OTHER FORK IS/WAS TRYING TO LOCK IT. THIS
;FORK WILL DO A BRIEF WAIT SO AS TO PREVENT HOGGING THE LOCK.
FUNLK1: JUMPL 1,FUNLK3 ;BUG IF LOCK NOT SET AT ALL
MOVEI 1,^D200 ;WAIT FOR 200 MS
DISMS
JRST FUNLK2
FUNLK3: BUG(FLKNS,<<FORKN,JOBFRK>>)
JRST FUNLK2
;ENTRY FROM PMAP ERROR TO UNLOCK FKLOCK IF THIS PROCESS HAS IT
FUNLKI::SKIPL INTDF ;MUST BE NOINT
SKIPGE FKLOCK ;AND LOCK MUST BE LOCKED
RET ;NOT. WE CAN'T HOLD IT THEN
HRRZ CX,FORKN ;GET US
CAME CX,FLKOWN ;ARE WE THE OWNER?
RET ;NO
CALLRET FUNLK ;YES. UNLOCK IT AND RETURN
;COMMON EXIT FROM FORK JSYS. CLEAR LOCAL PSB MAPPING, DO UNLOCK AND MRETN
CLFRET::CALL CLRLFK
CLFLK0: CALL FUNLK ;UNLOCK THE FORK STRUCTURE
JRST MRETN
;COMMON ERROR EXITS FROM FORK JSYS'S
FKLERR: CALL CLRLFK
CALLRET FUNLK
FRKE1: MOVEI 1,FRKHX1 ;'ILLEGAL FORK HANDLE'
JRST ITFRKR ;GO UNLOCK AND ITRAP
FRKE2: MOVEI 1,FRKHX2 ;'ILLEG REF TO SUPERIOR'
JRST ITFRKR ;GO UNLOCK AND TRAP
FRKE3: MOVEI 1,FRKHX3 ;'MULTIPLE FORK HANDLE NOT LEGAL'
JRST ITFRKR
FRKE4: MOVEI A,FRKHX7 ;RELATIVE PAGE NUMBER TOO LARGE
JRST ITFRKR ;GO UNLOCK AND TRAP
;ERROR RETURN FROM FORK JSYS
EFRKR: CALL FUNLK ;UNLOCK THE FORK STRUCTURE
RETERR() ;RETURN ERROR CODE ALREADY IN 1
FRKES: CALL FRKESR ;DETERMINE ERROR CODE
;; JRST ITFRKR ;ITRAP
;ITRAP RETURN FROM FORK JSYS
ITFRKR: CALL FUNLK ;UNLOCK THE FORK STRUCTURE
ITERR() ;RETURN ERROR CODE ALREADY IN 1
;COMMON NON-SKIP ERROR RETURNS FROM FORK JSYS'S
FRKE1R: MOVEI T1,FRKHX1 ;ILLEGAL FORK HANDLE
RET
FRKE2R: MOVEI T1,FRKHX2 ;ILLEGAL REFERENCE TO SUPERIOR
RET
FRKE3R: MOVEI T1,FRKHX3 ;MULTIPLE FORK HANDLE ILLEGAL
RET
;HERE TO FIGURE OUT WHICH OF THE ABOVE TO RETURN
FRKESR: HRRZ T1,T1 ;USE ONLY RH
CAIE T1,-1 ;CHECK SUPERIOR OR TOP FORK
CAIN T1,-2 ; ...
JRST FRKE2R ;ILLEGAL SUPERIOR
CAIL T1,-5 ;MULTIPLE FORK HANDLE?
CAILE T1,-3 ; ...
JRST FRKE1R ;NO, RANDOMNESS
JRST FRKE3R ;SUPERIOR ILLEGAL
;TRANSLATE FKH.PN TO PTN.PN
; FKHPTX - return error if execute-only and not SELF
; FKHPTN - normal entry
;ACCEPTS:
; T1/ FORK HANDLE,,PAGE NUMBER
; T2/ ACCESS BITS (PM%EPN) IF .FHSLF OR SECTION 0
; CALL FKHPTN
; OR
; CALL FKHPTX
;RETURNS +1: ERROR
; T1/ ERROR CODE
; +2: SUCCESS
; T1/ PTN,,PN
; T3/ SECTION ACCESS BITS IF NON-ZERO SECTION
;PRESERVES T2
FKHPTX::STKVAR <SAV3,SAV2,SAV1>
MOVEM T2,SAV2 ;SAVE T2
SETO T2, ;Flag to check execute-only
JRST FKHP1 ;Continue . . .
FKHPTN::STKVAR <SAV3,SAV2,SAV1>
MOVEM T2,SAV2 ;SAVE T2
SETZ T2, ;Flag no execute-only check
;FKHP1 - COMMON ENTRY
; T2/ -1 IF WANT TO RETURN ERROR FOR EXECUTE-ONLY
; 0 OTHERWISE
FKHP1: CALL FLOCK ;LOCK THE FORK STRUCTURE
TLNN T1,^-<.FHSLF> ;IS THIS MY FORK?
TRNE T1,777000 ;YES. IS THERE A SECTION NUMBER
JRST FKHP0 ;ANOTHER FORK OR SECTION NO. WAS SPECIFIED
MOVE T3,SAV2 ;GET ACCESS BITS (PM%EPN)
TXNE T3,PM%EPN ;EIGHTEEN BIT PAGE NUMBERS SUPPLIED BY USER?
JRST FKHP0 ;YES, DON'T USE PC SECTION
LOAD T3,VSECNO,UPDL ;GET USER'S PC SECTION
DPB T3,[POINT 9,T1,26] ;PUT IT INTO THE PAGE NUMBER
FKHP0: MOVEM T1,SAV1 ;SAVE PAGE NO. INCLUDING SECTION
LDB T3,[POINT 9,T1,26] ;GET SECTION NUMBER FROM ARG
CAILE T3,(VSECNO) ;A VALID SECTION?
JRST FKHPE1 ;NO
HLRZ T1,T1
CALL STJFKR ;GET JOB FORK INDEX
JRST FKHPER ;ILLEGAL - ERROR CODE IN 1
JUMPE T2,FKHP2 ;Skip check if call to FKHPTN
CALL CKNXSR ;Execute-only process?
JRST FKHPER ;Yes, return error
;..
;..
FKHP2: CALL SKIIF ;SELF OR INFERIOR TO SELF?
JRST [ MOVSI T2,(1B9) ;NOT INFERIOR
TDNN T2,CAPENB ;ALLOWED TO MAP SUPERIOR?
JRST FKHPE2 ;NO
MOVE T2,T1 ;YES, SAVE OBJECT FORK
CALL GETSPF ;GET HANDLE OF SUPERIOR
EXCH T1,T2
CAME T1,T2 ;IS OBJECT FORK IMMED SUPERIOR?
JRST FKHPE2 ;NO
JRST .+1]
HRRZ T2,SAV1 ;GET PAGE NUMBER FROM ARG
CAIGE T2,1000 ;NON-ZERO SECTION WANTED?
JRST [ HRRZ T1,SYSFK(T1) ;NO. GET SYSTEM FORK HANDLE
HLL T1,FKPGS(T1) ;GET PT OF SECTION ZERO
HRR T1,T2 ;AND COPY PAGE NUMBER AS WELL
MOVEM T1,SAV1 ;SAVE ANSWER
MOVX T1,PTWR ;ALL ACCESS ALLOWED TO SECTION 0
MOVEM T1,SAV3 ;SAVE THAT
JRST FKHP3] ;AND DONE
CALL SETLF1 ;MAP FORK'S PSB
MOVE T2,SAV1 ;GET BACK ORIGINAL ARG
LDB T3,[POINT 9,T2,26] ;GET SECTION # FROM ARG
ADD T1,T3 ;COMPUTE INDEX INTO OTHER PSB
CALL SECIND ;GET SECTION POINTER
JUMPE T1,[ ;IF NONE,
CALL CLRLFK ;UNMAP PSB
JRST FKHPE1] ;GIVE PROPER ERROR
MOVEM T1,SAV3 ;SAVE SECTION POINTER
LOAD T3,SPTX,T1 ;GET SPT INDEX OF PAGE TABLE
ANDI T2,777 ;GET PAGE OFFSET IN SECTION
HRL T2,T3 ;FORM PTN.PN
MOVEM T2,SAV1 ;SAVE RESULT
CALL CLRLFK ;UNMAP PSB
FKHP3: MOVE T1,SAV3 ;GET SECTION POINTER
TXO T1,PTCPY ;PAGE ACCESS DETERMINES COPY ON WRITE
CALL GPAC ;CONVERT HARDWARE ACCESS BITS TO USER BITS
MOVE T3,T1 ;RETURN ANSWER IN T3
MOVE T1,SAV1 ;GET BACK ARG
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
MOVE T2,SAV2 ;RESTORE AC
RETSKP ;SUCCESS RETURN
FKHPE1: SKIPA T1,[ARGX06] ;ILLEGAL PAGE NUMBER
FKHPE2: MOVEI T1,FRKHX2 ;ILLEGAL SUPERIOR MANIPULATION
FKHPER: MOVE T2,SAV2 ;RESTORE AC
CALL FUNLK ;UNLOCK FORK LOCK
RETBAD () ;ERROR RETURN
;PTNFKH - TRANSLATE PTN TO FKH
;ACCEPTS:
; T1/ PTN,,PN FOR A FORK'S PAGE
; CALL PTNFKH
;RETURNS +1: ERROR
; T1/ ERROR CODE
; +2: SUCCESS,
; T1/ LOCAL FORK HANDLE,,PAGE NUMBER IF PAGE CAN BE IDENTIFIED
; OR
; T1/ -1 IF PAGE CAN'T BE IDENTIFIED
;THIS ROUTINE IS CALLED BY THE RMAP JSYS WHEN IT HAS ALREADY
;DETERMINED THAT THE PAGE OF INTEREST IS OWNED BY A FORK.
;THE PAGE TABLE MAY BE A PAGE TABLE FOR ANY SECTION IN THE USER'S
;ADDRESS SPACE
PTNFKH::STKVAR <PTNFPT,PTNFPS,PTNFPN>
HRRZM T1,PTNFPN ;SAVE PAGE NUMBER
CALL FLOCK ;LOCK THE FORK STRUCTURE
HLRZ T2,T1 ;GET PTN
MOVEM T2,PTNFPT ;SAVE IT
HRRZ T1,SPTH(T2) ;GET THE OWNING FORK
HLRZ T3,FKPGS(T1) ;GET SECTION 0 PAGE TABLE
CAME T3,PTNFPT ;THE ONE WE WERE GIVEN?
JRST PTNF6 ;NO. GO TRY FOR NON-ZERO SECTION
;HERE WHEN IT IS THE FORK'S SECTION 0 PAGE TABLE. GET ITS
;JOB-WIDE INDEX
MOVSI 3,-NUFKS ;SETUP FOR SCAN OF JOB FORK TABLE
PTNF3: SKIPGE T2,SYSFK(3) ;HAVE A USABLE HANDLE?
JRST PTNF2 ;NO. SKIP IT THEN
CAIN T1,0(T2) ;IS IT THE FORK WE WANTED?
JRST [ HRRZ T1,T3 ;YES. GET HANDLE INTO AC
JRST PTNF1] ;GO CONVERT IT
PTNF2: AOBJN 3,PTNF3
SETOB T1,PTNFPN ;NOT FOUND, RETURN -1
JRST PTNF4
;..
;..
;HERE WHEN IT'S NOT THE FORK'S SECTION 0 PAGE TABLE
;SEE IF IT'S A NON-ZERO SECTION TABLE
PTNF6: CALL SETLF3 ;MAP THAT FORK'S PSB
MOVEM T1,PTNFPS ;SAVE INDEX TO PSB
MOVE T3,T1 ;FORM AN AOBJN POINTER TO SECTION TABLE
HRLI T3,-MXSECN-1
PTNF8: HRRZ T1,T3 ;SET SECIND ARGUMENT
CALL SECIND ;GET POINTER (FOLLOW INDIRECT POINTERS)
ANDX T1,STGADM ;GET SPT INDEX
CAMN T1,PTNFPT ;IS THIS THE ONE WE WANTED?
JRST [ HRRZ T2,T3 ;YES. CLEAR LEFT HALF
SUB T2,PTNFPS ;COMPUTE SECTION NUMBER
LSH T2,PGSFT ;MOVE IT TO PAGE NUMBER
ADDM T2,PTNFPN ;COMPUTE NEW PAGE NUMBER
MOVE T1,PTNFPS ;GET OFFSET INTO OTHER PSB
MOVE T1,FORKN(T1) ;GET JOB-WIDE FORK HANDLE
MOVEM T1,PTNFPS ;SAVE FORK HANDLE
CALL CLRLFK ;UNMAP THE PSB
MOVE T1,PTNFPS ;RESTORE FORK HANDLE
JRST PTNF1] ;GO CONVERT
AOBJN T3,PTNF8 ;TRY THE NEXT FORK
;DIDN'T FIND IT. PROBABLY THIS SPT SLOT WAS A SECTION TABLE
;FOR A FORK THAT HAS SINCE UNSMAP'D IT. THERE IS STILL A POINTER
;TO IT IN THE FORK OF INTEREST, AND THE OWNING FORK HAS BEEN
;CHANGED TO BE THE TOP FORK OF THE JOB.
CALL CLRLFK ;UNMAP THE PSB
SETOM T1 ;INDICATE UNKNOWN
JRST PTNF9 ;GO FINISH
;HERE WHEN FORK HAS BEEN FOUND. T1/ JOB-WIDE HANDLE. CONVERT
;TO LOCAL HANDLE AND FINISH
PTNF1: CALL GFKH ;CONVERT TO LOCAL HANDLE
RETBAD(FRKHX6,<CALL FUNLK>)
HRLS T1 ;GET PTN INTO LEFT HALF
PTNF4: HRR T1,PTNFPN ;PN INTO RIGHT HALF
PTNF9: CALL FUNLK ;UNLOCK THE FORK STRUCTURE
RETSKP
;FIND OR INSERT LOCAL FORK HANDLE
; 1/ PSB OFFSET (GRFKH ONLY) ,, JOB FORK INDEX
;GFKH GETS HANDLE RELATIVE TO SELF
;GRFKH GET HANDLE RELATIVE TO FORK WHOSE PSB IS IN LH 1
GFKH: MOVEI 1,0(1) ;LEAVE LH 0 FOR SELF
GRFKH: PUSH P,2
PUSH P,3
PUSH P,4
HLRE 3,1 ;GET PSB OFFSET
HRRZ 2,FORKN(3) ;GET JOB HANDLE FOR F1
PUSH P,3 ;SAVE PSB OFFSET
ADD 3,FKPTAB ;MAKE PTR TO FKTAB
MOVE 4,[XWD -NLFKS+1,1]
CAIN 2,0(1) ;IS IT SELF?
SOJA 4,GFKH4 ;YES, 0
HRLI 1,400000 ;USE LH TO REMEMBER ANY EMPTY ENTRIES
GFKH1: ILDB 2,3 ;LOOK AT NEXT HALF-WORD
CAIN 2,-1 ;ASSIGNED?
JRST GFKH2 ;NO
CAIN 2,0(1) ;IS GIVEN?
JRST GFKH4 ;YES
GFKH3: AOBJN 4,GFKH1
HRRZ 3,1
SKIPL SYSFK(3) ;FORK STILL EXTANT?
TLNE 1,400000 ;NOT FOUND, ROOM TO ADD ENTRY?
JRST POP41 ;NO, RETURN NOSKIP
HLRZ 3,1 ;GET INDEX OF FIRST FREE ENTRY
IDIVI 3,2 ;CONSTRUCT POINTER TO IT
ADD 3,FKPTAB(4)
ADD 3,0(P) ;OFFSET TO PROPER PSB
DPB 1,3 ;STORE JOB INDEX IN ENTRY
HRRZ 2,1 ;GET REQUESTED JRFN
CAIN 2,-1 ;FREE ENTRY REQUESTED?
JRST GFKH5 ;YES - DONT UP COUNT
HRRZ 4,1
LOAD 2,FKHCNT,(4) ;NO - INCR COUNT OF HANDLES ON THIS FORK
ADDI 2,1 ; ...
STOR 2,FKHCNT,(4) ;UPDATE COUNT
GFKH5: HLRZ 4,1
GFKH4: MOVEI 1,400000(4) ;RETURN LOCAL HANDLE WITH BIT
AOS -4(P)
POP41: SUB P,BHC+1 ;FLUSH OFFSET
JRST PB4
GFKH2: TLNE 1,400000 ;FIRST EMPTY SLOT?
HRLI 1,0(4) ;YES, SAVE INDEX
JRST GFKH3
;DEASSIGN LOCAL FORK HANDLE GIVEN JOB HANDLE IN 1
DASFKH: PUSH P,2
PUSH P,3
PUSH P,4
CALL JFKRFH ;SEE IF A HANDLE EXISTS
JUMPN T2,DASFK1 ; ...
; BUG(NOXRFH)
JRST PB4 ;IGNORE ATTEMPT
DASFK1: MOVEI 2,-1 ;PUT A -1 WHERE ENTRY WAS
DPB 2,3
LOAD T2,FKHCNT,(T1) ;GET COUNT OF HANDLES ON THIS FORK
SUBI T2,1 ;DECREMENT
STOR T2,FKHCNT,(T1) ; ...
SKIPGE SYSFK(T1) ;WAS THIS FORK KILLED?
SKIPE T2 ;AND NO REMAINING HANDLES?
JRST PB4 ;NO - RETURN
MOVEI T2,FKPTRS(T1) ;YES - RELEASE JRFN NOW
EXCH T2,FREJFK ; ...
MOVEM T2,@FREJFK ; ...
SETOM SYSFK(T1)
JRST PB4
;TABLE OF BYTE POINTERS, HALF WORD
POINT 18,FKTAB,-1
FKPTAB: POINT 18,FKTAB,17
POINT 18,FKTAB,35
SUBTTL JSYS'S FOR SOFTWARE INTERRUPT SYSTEM
;SIR JSYS
;ACCEPTS:
; T1/ FORK HANDLE
; T2/ (ADDRESS OF LEVEL TABLE,,ADDRESS OF CHANNEL TABLE)
; SIR
;RETURNS +1: ALWAYS
; ILLEGAL INSTRUCTION INTERRUPT ON FAILURE
.SIR:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;Map PSB and check execute-only
XSFM T4 ;GET FLAGS WORD, INCLUDING PCS
TXNE T4,EXPCS ;IS PCS NON-ZERO?
ERRJMP(SIRX2,ITFRKR) ;NO. DON'T ALLOW OLD STYLE SIR
JUMPE 2,SIR1 ;ALL 0 IS LEGAL
HLRZ 3,2 ;GET ADDRESSES GIVEN
MOVEI 4,0(2)
CAIL 3,20 ;BOTH .GE. 20?
CAIGE 4,20
ERRJMP(SIRX1,ITFRKR) ;NO
SIR1: HRRZM T2,PSCHNT(1) ;SAVE ADDRESS OF CHNTAB
HLRZM T2,PSLEVT(T1) ;SAVE ADDRESS OF LEVTAB
SETZRO PSXSIR,(T1) ;INDICATE NOT EXTENDED SIR
JRST CLFRET
;XSIR JSYS
;ACCEPTS:
; T1/ FORK HANDLE
; T2/ ADDRESS OF ARGUMENT BLOCK
;ARGUMENT BLOCK:
; LENGTH OF THIS BLOCK (3)
; ADDRESS OF LEVEL TABLE
; ADDRESS OF CHANNEL TABLE
; XSIR
;RETURNS +1: ALWAYS,
; ILLEGAL INSTRUCTION INTERRUPT ON FAILURE
;THIS IS AN EXTENDED SIR JSYS. IT IS USED BY PROGRAMS THAT WILL
;RUN IN NON-ZERO SECTIONS.
.XSIR:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;MAP PSB AND CHECK EXECUTE-ONLY
UMOVE T4,2 ;GET ADDRESS OF ARGUMENT BLOCK
UMOVE T3,0(T4) ;GET SIZE OF THIS TABLE
TLNE T3,-1 ;CAN'T BE THIS BIG
ERRJMP (ARGX05,ITFRKR) ;ARGUMENT BLOCK TOO BIG
CAIGE T3,.SICHT+1 ;CAN'T BE TOO SMALL EITHER
ERRJMP(ARGX04,ITFRKR) ;ARGUMENT BLOCK TOO SMALL
UMOVE T2,.SILVT(T4) ;GET ADDRESS OF LEVEL TABLE
UMOVE T3,.SICHT(T4) ;GET ADDRESS OF CHANNEL TABLE
SKIPN T2 ;OK FOR BOTH TO BE ZERO
SKIPE T3
SKIPA ;NOT BOTH ZERO. CONTINUE
JRST [ SETZRO PSXSIR,(T1) ;BOTH ZERO. CLEAR EXTENDED SIR FLAG
JRST XSIR4] ;GO FINISH
;DON'T ALLOW CHNTAB OR LEVTAB TO BE IN THE AC'S
HRRZ P2,T2 ;GET OFFSET IN THE SECTION FOR LEVTAB
CAIGE P2,20 ;IS IT LESS THAN 20?
TLNE T2,777776 ;YES. SECTION 0 OR 1?
SKIPA ;OK
ERRJMP(SIRX1,ITFRKR) ;YES. INDICATE ERROR
HRRZ P3,T3 ;GET OFFSET IN SECTION FOR CHNTAB
CAIGE P3,20 ;IT IS LESS THAN 20?
TLNE T3,777776 ;YES. SECTION 0 OR 1?
SKIPA
ERRJMP(SIRX1,ITFRKR) ;YES. INDICATE ERROR
;..
;DON'T LET THE CHANNEL TABLE OR THE LEVEL TABLE GO BEYOND THE
;END OF ITS SECTION.
;..
MOVE P2,T3
ADDI P2,^D35 ;GET ADDRESS OF LAST WORD IN CHAN TABLE
XOR P2,T3 ;SEE IF START AND END ARE IN SAME SECTION
TLNE P2,-1 ;ARE THEY?
ERRJMP(XSIRX1,ITFRKR) ;NO. ERROR
MOVE P2,T2
ADDI P2,2 ;GET ADDRESS OF LAST WORD IN LEVEL TABLE
XOR P2,T2 ;SEE IF START AND END ARE IN SAME SECTION
TLNE P2,-1 ;ARE THEY?
ERRJMP(XSIRX2,ITFRKR) ;NO. ERROR
SETONE PSXSIR,(T1) ;INDICATE EXTENDED SIR WAS DONE
XSIR4: MOVEM T2,PSLEVT(T1) ;SAVE ADDRESS OF LEVEL TABLE
MOVEM T3,PSCHNT(T1) ;SAVE ADDRESS OF CHANNEL TABLE
JRST CLFRET ;RETURN SUCCESS
.EIR:: MCENT
REPEAT 0,< ;This is antiquated by capability checking
TRNE 1,200000 ;SPECIAL?
ITERR(FRKHX1) ;ILLEGAL
> ;End of REPEAT 0
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETJFK
CALL CHKNXS ;Check if specified process is execute-only or not SELF
PUSH P,SYSFK(1) ;REMEMBER FORK INDEX
CALL SETLF1 ;MAP PSB
SETZM PSISYS(1) ;0 IS ON
POP P,2
SKIPN PSIBW(1) ;ANY BREAKS WAITING?
JRST CLFRET ;NO
SETZ 1, ;YES, INITIATE SERVICE
NOSKED
CALL PSIRQB
OKSKED
CHKINT ;GET ANY PENDING BREAKS TO BE SEEN
JRST CLFRET
;SKIP IF PSI SYSTEM ENABLED
.SKPIR::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
SKIPN PSISYS(1)
TDZA P1,P1 ;SET UP FOR SKIP RETURN
SETO P1,
CALL CLRLFK ;UNLOCK THE FORK STRUCTURE
CALL FUNLK
JUMPN P1,EMRET1 ;TAKE NO SKIP RETURN
SMRETN ;SKIP
.DIR:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;Map PSB and check execute-only
SETOM PSISYS(1)
JRST CLFRET
.AIC:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;Map PSB and check execute-only
IORM 2,PSICHM(1)
ICR: CALL SETOV0 ;RECOMPUTE TRAP LOCATION
JRST CLFRET
.DIC:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;Map PSB and check execute-only
ANDCM 2,MONCHN(1) ;DISALLOW MONITOR RESERVED CHANNELS
ANDCAM 2,PSICHM(1)
JRST ICR
;INITIATE INTERRUPT ON CHANNEL
; 1/ FORK HANDLE
; 2/ CHANNEL MASK
; IIC
; RETURN +1 ALWAYS
;FOR MONITOR USE, SEE IICSLF IN SCHED
.IIC:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETJFK
CALL CHKNXS ;Check if specified process is execute-only or not SELF
PUSH P,1
CALL SETLF1 ;MAP DEST PSB
UMOVE 2,2
ANDCM 2,MONCHN(1) ;DISALLOW MON RESERVED CHANS
PUSH P,2
CALL CLRLFK
POP P,2
POP P,1
MOVE 1,SYSFK(1)
EXCH 1,2
NOSKED
CALL PSIRQB
OKSKED
CHKINT ;GET IT SEEN
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
JRST MRETN
.RCM:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
MOVE 1,PSICHM(1)
JRST RETA1
;READ PSI IN PROGRESS AND WAITING MASKS
.RWM:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
MOVE 2,PSIBIP(1)
UMOVEM 2,2 ;REPORT BREAKS IN PROGRESS IN 2
MOVE 1,PSIBW(1)
RETA1: UMOVEM 1,1 ;RETURN VALUE IN 1
JRST CLFRET
.SIRCM::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;Map PSB and check execute-only
CAIN 1,0 ;SELF?
JRST FRKE1 ;ILLEGAL
MOVEM 2,SUPCHN(1)
JRST CLFRET
.RIRCM::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
MOVE 2,SUPCHN(1)
RETA2: UMOVEM 2,2
JRST CLFRET
;RIR JSYS
;ACCEPTS:
; T1/FORK HANDLE
; RIR
;RETURNS +1: ALWAYS
; T2/ (ADDRESS OF LEVEL TABLE,,ADDRESS OF CHANNEL TABLE)
; ILLEGAL INSTRUCTION INTERRUPT ON FAILURE
;IT IS ILLEGAL TO DO THIS JSYS IF THE INTERRUPT SYSTEM WAS SET
;UP VIA XSIR.
.RIR:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
JN PSXSIR,(T1),[ ERRJMP(RIRX1,ITFRKR)] ;XSIR WAS DONE PREVIOUSLY
HRL T2,PSLEVT(T1) ;GET LEVEL TABLE
HRR T2,PSCHNT(T1) ;GET CHANNEL TABLE
JRST RETA2
;XRIR JSYS
;ACCEPTS:
; T1/ FORK HANDLE
; T2/ ADDRESS OF ARGUMENT BLOCK
; XRIR
;RETURNS +1: ALWAYS
;ARGUMENT BLOCK:
; UNCHANGED
; ADDRESS OF LEVEL TABLE
; ADDRESS OF CHANNEL TABLE
;ILLEGAL INSTRUCTION INTERRUPT ON FAILURE
.XRIR::
MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;MAP PSB AND CHECK EXECUTE-ONLY
UMOVE T4,2 ;GET ADDRESS OF ARGUMENT BLOCK
UMOVE T3,0(T4) ;GET SIZE OF THIS TABLE
TLNE T3,-1 ;CAN'T BE THIS BIG
ERRJMP (ARGX05,ITFRKR) ;ARGUMENT BLOCK TOO BIG
CAIGE T3,.SICHT+1 ;CAN'T BE TOO SMALL EITHER
ERRJMP(ARGX04,ITFRKR) ;ARGUMENT BLOCK TOO SMALL
MOVE T2,PSLEVT(T1) ;GET LEVEL TABLE
UMOVEM T2,1(T4) ;RETURN TO USER
MOVE T2,PSCHNT(T1) ;GET CHANNEL TABLE
UMOVEM T2,2(T4) ;RETURN TO USER
JRST CLFRET ;RETURN
;ACTIVATE TERMINAL INTERRUPT
; 1/ TERMINAL CODE ,, CHANNEL NUMBER
; ATI
; RETURN +1: ALWAYS.
.ATI:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
HLRZ 1,1
CAIL 1,^D36 ;REASONABLE TERM CODE?
ATIE1: ERRJMP(TERMX1,ITFRKR) ;NO
CAIE 1,3 ;CONTROL-C?
JRST .+4 ;NO
MOVE 3,CAPENB ;YES, SEE IF LEGAL
TLNN 3,(1B0)
ATX2E: ERRJMP(ATIX2,ITFRKR) ;USER LACKS ^C CAPABILITY
CALL GETCHA
XCTU [HRRZ 3,1] ;GET CHANNEL NUMBER
CAIG 3,^D5 ;LEGAL CHANNEL NUMBER?
JRST ATI3 ;YES
CAIL 3,^D23 ;ALLOW CH23 AND ABOVE ALSO
CAILE 3,^D35
ERRJMP(ATIX1,ITFRKR) ;NO
ATI3: DPB 3,2 ;ASSIGN IT TO THIS CODE
HRRZ 4,FORKN
MOVE 3,BITS(1)
IORM 3,FKPSIE(4)
LOAD T1,FRKTTY,(T4) ;GET CONTROLLING TERMINAL
CALL UPDTI ;UPDATE JOB WORD
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
MRETNG
;DEACTIVATE TERMINAL INTERRUPT
; 1/ TERMINAL CODE
; DTI
; RETURN +1: ALWAYS, UNLESS ITRAP
.DTI:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CAIL 1,0
CAIL 1,^D36 ;REASONABLE CODE?
JRST ATIE1 ;NO
HRRZ 2,FORKN
MOVE 6,BITS(1)
ANDCAM 6,FKPSIE(2) ;CLEAR FROM THIS FORK
LOAD T1,FRKTTY,(T2) ;GET CONTROLLING TERMINAL
UPDTIR: CALL UPDTI ;UPDATE JOB WORDS
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
JRST MRETN
;UPDATE JOB TPSI WORDS BY SCANNING FORK WORDS
;TTY DESIGNATOR IN T1 AT CALL
UPDTI: TRNN T1,1B18 ;IS IT A TTY DESIGNATOR?
RET ;NOPE, DO NOTHING.
SAVEQ ;GET SOME MORE WORK AC'S
MOVSI T3,-NUFKS ;SETUP TO SCAN ALL FORKS OF JOB
SETZB T4,Q1 ;IOR PSI AND DPSI WORDS
UPDT0: HRRZ Q2,SYSFK(T3) ;GET FORKX OF THE FORK
CAIN Q2,-1 ;DOES THE FORK EXIST?
JRST UPDT2 ;NO, SKIP OVER IT
LOAD Q2,FRKTTY,(T3) ;GET CONTROLLING TERMINAL
CAIN Q2,0(T1) ;IS IT THE ONE WE WERE CALLED WITH?
JRST UPDT1 ;YES! GO UPDATE THE PSI WORDS
UPDT2: AOBJN T3,UPDT0
MOVEI T2,(T1) ;MOVE TO AC FOR TTYSRV
CAIN T2,-1 ;IS THE CALLING ARG THE JOB CTTY?
JRST UPDT4 ;YES.
TRZ T2,1B18 ;MAYBE NOT
CAMN T2,CTRLTT ;CHECK IN LINE NUMBER FORM
JRST UPDT4 ;IT IS.
CAIGE T2,NLINES ;NOPE. THIS THING IS A LEGAL TTY, I HOPE?
CAIGE T2,0
RET ;NO, IT WASN'T. ALL FOR NOW.
JRST UPDT5 ;YES, GO STORE PSI WORDS
UPDT4: AND T4,TTJTIW ;ALLOW ONLY ENABLED BITS
MOVEM T4,TTSPSI
AND Q1,TTJTIW
MOVEM Q1,TTSDPS ;DEFERRED CODES
SKIPGE T2,CTRLTT ;IF ATTACHED
RET
UPDT5: MOVEM T4,T1 ;SET LINE'S PSI WORDS
MOVEM Q1,T3 ; ..
CALLRET TTSINT
UPDT1: HRRZ FX,SYSFK(T3) ;GET THE SYSTEM FORKX
MOVEI T2,(FX) ;KEEP A COPY
CALL CHKWT ;IS THE FORK DISMISSED?
JRST UPDT3 ;NO
HRRZ Q2,FKSTAT(FX) ;YES, SEE HOW.
CAIE Q2,FRZWT ;FROZEN?
JRST UPDT8 ;NO
PUSH P,Q2 ;YES, SAVE STATE
MOVX Q2,JTFRZ% ;IS IT A JSYS TRAP FREEZE?
TDNN Q2,FKINT(FX) ; ..
JRST UPDT6 ;NO, ORDINARY FREEZE
MOVX Q2,FRZBB% ;IS IT JSYS TRAP AND ALSO OTHER FREEZE?
TDNN Q2,FKINT(FX) ; ..
JRST UPDT7 ;NO, JUST JSYS TRAP FREEZE
UPDT6: POP P,Q2 ;SOME OTHER FREEZE. EXCLUDE THIS FORK.
JRST UPDT2 ; ..
UPDT7: POP P,Q2
UPDT8: CAIE Q2,HALTT ;WHAT OTHER KIND OF WAIT IS IT?
CAIN Q2,FORCTM ;HALT OR FORCED TERMINATION?
JRST UPDT2 ;YES. DON'T INCLUDE THIS FORK'S PSI BITS
UPDT3: IOR T4,FKPSIE(T3) ;INCLUDE THESE BITS. THIS FORK COUNTS FOR
IOR Q1,FKDPSI(T3) ; PSI COLLECTION PURPOSES
JRST UPDT2 ;ON TO MORE FORKS
;DEASSIGN ALL TERMINAL INTERRUPTS FOR THIS FORK
DTIALL::HRRZ T1,FORKN
SETZM FKPSIE(T1)
LOAD T1,FRKTTY,(T1) ;GET CONTROLLING TERMINAL
CALLRET UPDTI ;UPDATE AND RETURN
;CLEAR PSI SYSTEM
.CIS:: MCENT
NOINT ;PREVENT INTERRUPTION
SETZM PSIBIP
SETZM PSIBW
MOVE T1,[IOWD NPSIPG*PGSIZ,PSIPGA] ;SET UP STACK POINTER
MOVEM 1,PSIPT ;RESET PSI STORAGE
MOVE T1,FORKX ;GET ID OF THIS PROCESS
SETZ 2, ;CLEAR ALL FORK'S ENTRIES ON STACK
CALL JSBSTF ;GO MAKE SURE IT IS CLEAN
MOVE T1,FORKX ;GET ID OF THIS PROCESS
SETZ T2,0
CALL GOKFRE ;FREE GETOKK REQUESTS
OKINT ;ALLOW INTS NOW
JRST MRETN
;READ/SET TERMINAL INTERRUPT WORD
.RTIW:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
HRRZS T1
CAIN 1,-5 ;WHOLE JOB?
JRST [ MOVE 2,TTJTIW ;YES
JRST RTIW1]
CALL SETJFK ;GET JOB INDEX
MOVE 2,FKDPSI(1) ;DEFERRED CODES
UMOVEM 2,3 ;RETURNED IN 3
MOVE 2,FKPSIE(1)
RTIW1: UMOVEM 2,2
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
JRST MRETN
.STIW:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
HRRZS T1
CAIN 1,-5
JRST [ MOVE 3,CAPENB
TLNN 3,(1B0) ;^C CAPABILITY?
JRST ATX2E ;NO, DON'T PERMIT CHANGE TO JOB TI
MOVEM 2,TTJTIW ;SET JOB MASK WORD
MOVEI T1,-1 ;JOB CONTROLLING TERMINAL
JRST STIW2] ;GO UPDATE AND RET
CALL SETJFK
CALL CHKNXS ;Check if specified process is execute-only or not SELF
UMOVE 3,3 ;GET DEFERRED CODES
UMOVE 4,1 ;GET THE FLAGS
TXNE 4,ST%DIM ;USER WANT TO SET DEFERRED MASK?
MOVEM 3,FKDPSI(1) ;YES, SET THE DEFERRED CODES
EXCH 2,FKPSIE(1) ;SET NEW, REMEMBER OLD
XOR 2,FKPSIE(1) ;DIFFERENCES
SKIPE MONCHN(1) ;RESERVED MON CHANS EXIST?
TLZN 2,(1B16) ;AND ^P BEING CHANGED?
JRST STIW1 ;NO
MOVE 3,BITS+20 ;YES, PUT ^P BACK LIKE IT WAS
XORM 3,FKPSIE(1)
STIW1: LOAD T1,FRKTTY,(T1) ;GET CONTROLLING TERMINAL
STIW2: CALL UPDTI ;UPDATE JOB TIW
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
JRST MRETN
;SPECIAL CAPABILITIES CONTROL
.RPCAP::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETJFK
CALL SETLF1
MOVE 2,CAPMSK(1)
UMOVEM 2,2 ;RETURN POSSIBLE IN 2
MOVE 3,CAPENB(1)
UMOVEM 3,3 ;ENABLED IN 3
JRST CLFRET
.EPCAP::MCENT
HRRZ Q1,CAPENB ;CHECK FOR CHANGE
HRRZ Q2,T3 ;REQUESTED
CAMN Q1,Q2
JRST EPCNGO ;NO
GTOKM (.GOCAP,<T3>)
EPCNGO: CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETJFK
CALL SKIIF
ERRJMP(FRKHX2,ITFRKR) ;INFERIORS ONLY
CALL SETLF1
JUMPE 1,[XOR 3,CAPMSK(1) ;IF SELF, DON'T MODIFY 14-17
TLZ 3,(17B17)
XOR 3,CAPMSK(1)
JRST EPC1]
MOVE 4,CAPMSK
TLO 4,(777B17) ;9-17 DETERMINED BY SUPERIOR
AND 2,4
MOVEM 2,CAPMSK(1)
EPC1: AND 3,CAPMSK(1) ;ONLY ALLOW MODES IN MASK
MOVEM 3,CAPENB(1)
JRST CLFRET
;SWTRP JSYS. SET AND READ USER-MODE TRAPS. CALLING SEQUENCE IS:
; T1/ FORK HANDLE
; T2/ FUNCTION
; T3/ FUNCTION DEPENDENT ARG
;ITRAP ON ANY ILLEGAL ACT
.SWTRP::MCENT ;ESTABLISH CONTEXT
UMOVE T1,1 ;GET FORK HANDLE
CALL FLOCK ;LOCK FORK STURCTURE
CALL SETLFK ;MAP FORK
UMOVE T2,2 ;GET ARG
SKIPL T2 ;VALID FUNCTION?
CAILE T2,.SWRLT ;VALID FUNCTION?
ITERR (ARGX02,<CALL CLRLFK
CALL FUNLK>)
CALL @SWTRPT(T2) ;YES. DO THE FUNCTION
ITERR (,<CALL CLRLFK
CALL FUNLK>)
JRST CLFRET ;AND DONE
;DISPATCH TABLE FOR SWTRP ARGS
SWTRPT: IFIW!ARTSET
IFIW!ARTGET
IFIW!LUUSET
IFIW!LUUGET
;SET ARITHMETIC TRAP
ARTSET: UMOVE T3,3 ;GET VALUE
CALL SETART ;CHECK VALUE
RETBAD (ARGX20) ;CAN'T USE IT
RETSKP ;AND DONE
;READ ARITHMETIC TRAP
ARTGET: MOVE T3,ARTHTR ;GET TRAP VALUE
UMOVEM T3,3 ;STASH IT
RETSKP ;DONE
;SET LUUO DISPATCH ADDRESS
LUUSET: UMOVE T3,3 ;GET IT
CALL SETLUU ;VERIFY IT
RETBAD (ARGX21) ;BAD. CAN'T USE IT
RETSKP ;AND DONE
;READ LUUO DISPATCH ADDRESS
LUUGET: CALL GTLUUB ;GET LUUO BLOCK ADDRESS
UMOVEM T3,3 ;RETURN VALUE
RETSKP ;AND DONE
; Jsys Traps jsyses (TFORK, RTFRK and UTFRK)
;TFORK JSYS - FOR SETTING AND REMOVING TRAPS
;1: XWD function code, fork handle
;2: XWD channel #, number of bits in bit table
;3: Address of bit table
;FUNCTION CODES:
; 0: (.TFSET) Set traps as specified by bit table
; 1: (.TFRAL) Remove all traps set by this fork
; 2: (.TFRTP) Remove traps set by this fork as specified by bit table
; 3: (.TFSPS) Set JSYS trap PSI chan from LH(2); 77=>Don't PSI on trap
; 4: (.TFRPS) Read JSYS trap PSI chan into LH(2)
; 5: (.TFTST) Test if self is monitored: Ret with 2=-1/0 for yes/no
; 6: (.TFRES) Trap reset-remove traps from all inferiors, clear PSI chan
; 7: (.TFUUO) Set UUO traps for fork
; 8: (.TFSJU) Set both UUO and JSYS traps (combine 1 & 7)
; 9: (.TFRUU) Remove UUO traps
; Returns +1 always
.TFORK::MCENT
MOVE Q2,T2 ; Get chan #, # bits set in bit tbl
MOVE P4,T3 ; Bit tbl addr
HRR Q2,T1 ; Make channel, fork handle
HLRZ Q1,T1 ; Function code
CAIL Q1,0 ; Range check the function code
CAILE Q1,.TFRUU
ITERR TFRKX1 ; Bad code, abort
CALL @TFFUN(Q1) ;DO USER'S FUNCTION
MRETNG ; Return a success
TFFUN: IFIW!TFRKSR ; 0 set traps
IFIW!TFRKSR ; 1 remove traps
IFIW!TFRKSR ; 2 remove all
IFIW!TFORK3 ; 3 set channel
IFIW!TFORK4 ; 4 read channel
IFIW!TFORK5 ; 5 test if trapped
IFIW!TFORK6 ; 6 Reset
IFIW!TFRKSR ; 7 UUO traps set
IFIW!TFRKSR ; 8 combine 1 & 7
IFIW!TFRKSR ; 9 Remove UUO traps
TFRKSR: CALL FLOCK ;LOCK FORK STRUCTURE
MOVEI T1,(Q2) ;FORK HANDLE
CAIN T1,-4 ;ALL INFERIORS?
JRST TFSRA ;YES
CALL STJFKR ;CONVERT REL. HANDLE TO JOB FORK INDEX
ITERR TFRKX2,<CALL FUNLK>
CALL SKIMIF ;IS IT AN IMMEDIATE INFERIOR?
ITERR TFRKX2,<CALL FUNLK> ;NO, ERROR
CALL CHKNXS ;Check if specified process is execute-only or not SELF
HRRZ T2,SYSFK(T1) ;SYSTEM FORK INDEX
MOVE T2,FKINT(T2)
TXNN T2,FRZBB% ;IS THE FORK FROZEN?
ITERR TFRKX3,<CALL FUNLK> ;NO, TELL THE USER
CALL TFSR ;SET OR REMOVE THE TRAPS
CALLRET FUNLK ;UNLOCK FORK STRUCTURE AND RET
TFSRA: HRRZ T1,FORKN
CALL MAPINF
CALL TFFRZ ;CHECK ALL FORKS FOR FROZENNESS
HRRZ T1,FORKN
CALL MAPINF
CALL TFSR
CALLRET FUNLK
TFFRZ: HRRZ T1,SYSFK(T1) ;JOB FORK NO. TO SYSTEM FORK INDEX
MOVE T1,FKINT(T1) ;FORK'S STATE
TXNN T1,FRZBB% ;IS THE FORK FORZEN?
ITERR TFRKX3,<CALL FUNLK> ;NO, LET USER KNOW IT
RET ;YES, FORK IS FROZEN; DIRECT OR INDIRECT
;SET OR REMOVE TRAPS FOR A FORK
;T1/ FORKN OF FORK TO TRAP OR UNTRAP
TFSR: MOVE P1,T1 ;copy forkn
MOVE P3,SUPERP
ADD P3,P1
LDB P3,P3 ;forkn of superior
SKIPN T2,FKJTB(P1) ;do we have a monitor at all?
JRST [ CALL TFIFST ; Some form of setting?
RET ; No, and no monitor so done
CALL NEWJTB ;yes, ret addr. in T2
JRST .+1]
LOAD P2,JTIMP,(T2) ;forkn of our immed. monitor
;P1/ FORKN OF IMMEDIATE INF. TO SET/REMOVE TRAPS FOR
;P2/ FORKN OF P1'S MONITOR
;P3/ FORKN OF P1'S SUPERIOR
CAME P2,P3 ;is my monitor my superior?
JRST [ CALL TFIFST ; A form of set?
RET ; No, & sup. not my mon. so done
CALL NEWJTB ;yes, assign new JTB, ret addr. in T2
LOAD P2,JTIMP,(T2) ;forkn of ITS immed. monitor
JRST .+1]
CAIN Q1,.TFRAL ; Removing all?
JRST [ CALL RELJTB ;yes, release block
CALLRET TFINF3] ;take superior's block and update inf's
CALL TFUBIM ;update JTBIM (im. mon.'s bit table)
CALL TFUALL ;update JTALL
TFINF: MOVE T1,P1 ;pass starting point to mapinf
CALL MAPINF ;do all of his immediate inferiors
CALL TFINF1 ;trap forks inferiors
RET
TFINF1: MOVE P1,T1 ;copy forkn (of inf. fork)
MOVE P3,SUPERP ;get superior pointer
ADD P3,P1
LDB P3,P3 ;get forkn of superior fork
SKIPN T2,FKJTB(P1) ;does this fork have a monitor?
JRST TFINF3 ;no, point to superior's JTB
LOAD P2,JTIMP,(T2) ;P2=forkn of immediate mon for this fork
CAME P2,P3 ;is my monitor my immed. superior?
JRST TFINF3 ;no, point to superior's JTB
CALL TFUALL ;yes, update JTBAL
CALLRET TFINF ;do this forks inferiors, etc.
TFINF3: MOVE T1,FKJTB(P3) ;superior's JTB
MOVEM T1,FKJTB(P1) ;equals inferiors JTB
CALLRET TFINF ;do this forks inferiors, etc.
;UPDATE JTBAL, CALLED WHEN IMMED. MONITOR OF FORK IN P1 IS IT'S SUPERIOR
;P1/ FORKN OF INFERIOR TO SET/REMOVE TRAPS FOR
;P2/ FORKN OF P1'S IMMEDIATE MONITOR (ALSO IT'S SUPERIOR)
TFUALL: MOVSI T4,-JTBTL
HRR T4,FKJTB(P1) ;addr. of inf's JTB
HRRZ T3,FKJTB(P2) ;addr. of monitor's JTB (possibly null)
JUMPE T3,[MOVSI T1,JTBIM(T4) ;this forks JTBIM
HRRI T1,JTBAL(T4) ;equals this forks JTBAL
BLT T1,JTBAL+JTBTL-1(T4)
RET]
TFUAL1: MOVE T1,JTBAL(T3) ;monitor's JTBAL
IOR T1,JTBIM(T4) ;this fork's JTBIM
MOVEM T1,JTBAL(T4) ;this fork's JTBAL
AOS T3
AOBJN T4,TFUAL1
RET
;UPDATE JTBIM, CALLED FOR IMMED. INF. OF EXECUTING FORK ONLY
;P1/ FORKN OF THE IMMED. INF. FORK TO UPDATE
TFUBIM: MOVSI T4,-JTBTL
HRR T4,FKJTB(P1) ;addr. of inf's JTB
MOVE T3,P4 ;addr. of user table
MOVSI T2,(1B0) ; JSYS 0, or UUO trap bit
UMOVE T1,(T3) ; Get word that would be in
CALL TFIFST ; Form of set?
JRST TFUBI2 ; No
CAIE Q1,.TFSJU
CAIN Q1,.TFUUO ; Either form that allows B0 W0?
JRST [ IOR T1,T2 ; Yes, do that
CAIN Q1,.TFUUO ; UUO's only?
MOVE T1,T2 ; Then ignore that from bit tbl
JRST TFUB10]
ANDCAM T2,T1 ; No, remove it
CAIA
TFUBI1: UMOVE T1,(T3) ;user's table
TFUB10: IORM T1,JTBIM(T4) ;ored with existing table (maybe zero)
AOS T3
CAIE Q1,.TFUUO ; If UUO's only, get out
AOBJN T4,TFUBI1
RET
TFUBI2: CAIN Q1,.TFRUU ; Removing UUO traps?
JRST [ MOVE T1,T2 ; Then UUO's only
JRST TFUB20]
ANDCAM T2,T1 ; Can't remove UUO traps this way
CAIA
TFUB21: UMOVE T1,(T3) ;user's table
TFUB20: ANDCAM T1,JTBIM(T4) ;remove from JTB
AOS T3
CAIE Q1,.TFRUU ; If UUO's only, get out
AOBJN T4,TFUBI2
RET
TFIFST: CAIE Q1,.TFSET ; Check if function code is form of set
CAIN Q1,.TFSJU
JRST RSKP
CAIN Q1,.TFUUO
JRST RSKP
RET ; No form of set
;ASSIGN A NEW Jsys Trap Block (JTB)
;P1/ FORKN OF FORK TO ASSIGN TABLE
;RETURNS: +1 ALWAYS
;T2/ ADDRESS OF JTB
NEWJTB: MOVE T1,JTBFRE ;FREE STORAGE BIT TABLE
JFFO T1,.+2
BUG (NWJTBE)
MOVE T3,BITS(T2) ;MARK BLOCK AS ASSIGNED
ANDCAM T3,JTBFRE
IMULI T2,JTBSIZ ; Adr=(blk #*size)+ JTB pg adr+1
ADDI T2,JTBOFF ;FIRST WORD IS FREE BIT TABLE
HRLZI T1,JTBAL(T2)
HRRI T1,JTBAL+1(T2)
SETZM JTBAL(T2)
BLT T1,JTBSIZ-1(T2) ;CLEAR BOTH BIT TABLES
HRRZ T1,FORKN
MOVEM T1,JTBMN(T2) ;SET JTIMP TO FORK EXECUTING TFORK
MOVEM T2,FKJTB(P1) ;MAKE INF. FORK POINT TO JTB
RET
;RELEASE Jsys Trap Block
;P1/ FORKN OF FORK THAT HAS BLOCK ASSIGNED (TO BE RELEASED)
RELJTB: SKIPN T1,FKJTB(P1) ;GET ADDRESS OF JTB
RET ;IF THERE ISN'T A BLOCK ASSIGNED, RETRUN
SETZM FKJTB(P1) ;SAY FORK IS NO LONGER TRAPPED
SUBI T1,JTBOFF
IDIVI T1,JTBSIZ
MOVE T1,BITS(T1)
IORM T1,JTBFRE ;RELEASE BLOCK
RET
TFORK3: HLRZ T2,Q2 ;GET CHANNEL FROM COPY OF USER'S AC2
CAILE T2,^D35 ;LEGAL CHANNEL?
MOVEI T2,77 ;NO, ASSUME NO PSI'S WANTED
STOR T2,JTMCN ;SET THE CHANNEL
RET
TFORK4: LOAD T2,JTMCN ;GET CHANNEL NUMBER
XCTU [HRLM T2,2] ;RETURN IT IN LEFT HALF OF USER'S AC2
RET
TFORK5: SETZ T2, ;ASSUME NOT MONITORED
SKIPE @JTBLK ;ARE WE MONITORED?
SETO T2, ;YES, THEN SAY SO
UMOVEM T2,2 ;RETURN IN USER'S AC2
RET
TFORK6: NOINT ;TFORK RESET
MOVSI T1,77 ;CLEAR PSI CHANNEL FOR TRAPS
STOR T1,JTMCN ;CAUSE MONITORED FORKS TO BYPASS US
MOVE T1,[XWD .TFRAL,-4] ;REMOVE TRAPS FROM ALL INFERIORS
TFORK ; Forks must be frozen; this has side
; effect of forcing forks queued with
; traps to this fork to bypass it
ERJMP [OKINT ; Not all forks frozen
JSP T2,ITRAP] ; LSTERR is already set from last ITERR
; At this point should scan the JSYS trap Q (FKJTQ) & deQ forks waiting
; on this fork and force them to resume at JTRLCK. If the forks are all
; frozen, then this should have happened already (in susend PSI code)
RTFRK
ERJMP [OKINT ; Can't buy a handle
JSP T2,ITRAP] ; LSTERR is already set from last ITERR
JUMPE T1,TFOR61 ;WAS A TRAP PENDING?
UTFRK
TFOR61: MOVX T1,PSIJT% ;CLEAR PENDING TRAP PSI (IF ANY)
MOVE T2,FORKX ;WHICH MAY HAVE OCCURED AFTER
ANDCAM T1,FKINT(T2) ;NOINT AND BEFORE TFORK
SETOM JTLCK ;CLEAR THE LOCK
OKINT
RET
;RTFRK JSYS - READ TRAPPED FORK
; Returns +1 always with:
; 1: Relative fork handle; 0=> no fork currently trapped
; 2: JSYS instruction or UUO that caused fork to be trapped
.RTFRK::MCENT
LOAD T1,JTFRK ; Get job fork index
MOVE T2,JTTRW ; Get trapped JSYS or UUO instruction
JUMPE T1,RTFRK1 ; T1=0 if no fork trapped
PUSH P,T1 ; Save it
PUSH P,T2
CALL GFKH ; Get relative fork handle
ITERR FRKHX6 ; No handles left
MOVEM T1,-1(P) ; Save relative handle
NOSKED ; Prevent sched while clearing lock
SETZRO JTFRK ; Clear trapped fork
SETZM JTTRW ; And JSYS or UUO that we trapped on
CALL JTULCK
OKSKED
POP P,T2 ; JSYS or UUO
POP P,T1 ; Relative fork handle
RTFRK1: UMOVEM T1,1 ; Return stuff to user
UMOVEM T2,2
MRETNG
; UTFRK JSYS - Untrap fork
; Used to resume a trapped fork after a JSYS trap
; 1: Flags,,User handle for fork to untrap
; Flags: B0 (UT%TRP) ITRAP JSYS (or do ERJMP/ERCAL if present)
; Returns: +1 always
; NOOP if fork is not trapped or if executing fork is not permitted
; to untrap the fork (i.e. not forked trapped to or its superior).
.UTFRK::MCENT
MOVE P2,1 ; Get flags & fork handle
MOVEI T1,(P2) ; Check fork handle
TRNE T1,200000 ; Multiple?
ITERR FRKHX3 ; Not allowed
CALL FLOCK ; Nail down structure
CALL SETJFK ; Get job fork index
CALL SKIIF ; Is it an inferior?
ITERR FRKHX2,<CALL FUNLK> ; No, tell user
CALL CHKNXS ;Check if specified process is execute-only or not SELF
HRRZ FX,SYSFK(T1) ; FORKX of fork
CALL SETLF1 ; Map PSB
MOVEI P1,0(T1) ; Save offset to the PSB
MOVES PSBPGA(P1) ; Touch to aviod NOSKED page fault
NOSKED ; Let no others run
CALL CHKWT ; Fork waiting?
JRST UTFRK0 ; No, NOOP
HRRZ T2,FKSTAT(FX)
CAIE T2,FRZWT ; Is it frozen
JRST UTFRK0 ; No, NOOP
MOVX T2,JTFRZ%
TDNN T2,FKINT(FX) ; Fork trapped?
JRST UTFRK0 ; No, NOOP
LOAD T3,JTMNI,(P1) ; Job index of fork trapped to
CAMN T3,FORKN ; Same as executing fork?
JRST UTFRK2 ; Yes.
HRRZ T1,T3 ; Job index of fork trapped to
MOVE T2,FORKN
CALL SKIIFA ; Is that fork inf to ex. fork?
JRST UTFRK0 ; No, NOOP
UTFRK2: MOVEI T1,0(P1) ; Offset to fork's PSB
MOVEI T2,ITRAP
TLNE P2,(UT%TRP) ; Caller want us to bomb JSYS?
HRRM T2,PPC(T1) ; Yes, do that
MOVX T2,JTFRZ%
ANDCAB T2,FKINT(FX) ; Clear JSYS trap freeze
TXNE T2,FRZBB% ; Is fork still frozen?
;**;[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)
SETOM INTDF(T1) ; Since process not resumed, OKINT it
CALL RECONC ; Update wait lists
UTFRK3: CALL CLRSFK ; Clear FKINT bit 1
UTFRK0: OKSKED ; NOOP exit
CALL CLRLFK
CALL FUNLK
MRETNG
; SCTTY - Set fork controlling TTY (Terminal PSI)
; 1: Function code,,fork handle
; 2: Source designator (only tty designator implemented)
; Function codes:
; 0: (.SCRET) Return designator for fork in 2
; 1: (.SCSET) Set fork controlling TTY
; 2: (.SCRST) Clear fork controlling TTY (restores job CTTY)
.SCTTY::MCENT
CALL FLOCK ; Prevent meddling
HRRZ P1,1 ; Get fork
MOVE P2,2 ; Get designator
HLRZ P3,1 ; Function number
HRRZ T1,P1 ; Fork
CALL STJFKR ; Job fork number
ITERR(FRKHX1,<CALL FUNLK>)
CALL SKIIF ; Is fork an inferior?
ITERR(FRKHX2,<CALL FUNLK>) ; No, that's not legal
HRRZ P1,T1 ; Update to Job fork number
CAIL P3,0 ; Check range on functions
CAILE P3,.SCRST ; In range?
ITERR(SCTX1,<CALL FUNLK>) ; Undefined function code
XCT SCTFUN(P3) ; Do it
CALL FUNLK ; Returns here successful
MRETNG
SCTFUN: CALL SCTT0 ; Return CTTY for fork
CALL SCTSET ; Set CTTY
CALL SCTCLR ; Clear it (reset to JOB's)
SCTT0: LOAD T2,FRKTTY,(P1) ;GET CONTROLLING TERMINAL
UMOVEM T2,2 ; And hand to user
RET
CHKSCT: MOVX T1,SC%SCT ; Allowed to fiddle CTTY's?
TDNN T1,CAPENB ; ..
ITERR (SCTX4,<CALL FUNLK>)
RET ; OK
; Function to set a new controlling TTY for a fork and its inferiors
SCTSET: STKVAR <TTLNUM>
CALL CHKSCT ; Quit if not allowed to do this
MOVE T2,P2 ; Get designator
TRZN T2,1B18 ; DES = 4XXXXX?
ITERR(DESX1,<CALL FUNLK>) ; No
CAIGE T2,NLINES ; Check as a legal line #
CAIGE T2,0
ITERR(DESX1,<CALL FUNLK>) ; Isn't
LOKK DEVLKK
MOVEM T2,TTLNUM
MOVEI T1,.TTDES(T2) ;GET DESIGNATOR
CALL CHKDEV ;VERIFY ACCESS
ITERR (,<UNLOKK DEVLKK
CALL FUNLK>) ;CAN'T
TMNN DV%ASN,DEVCHR(T2) ;ASSIGNED BY THIS JOB?
ITERR (DEVX2,<UNLOKK DEVLKK ;NO. NOT ASSIGNED AT ALL THEN
CALL FUNLK>)
MOVE T2,TTLNUM
CAMN T2,CTRLTT ; Job CTTY?
ITERR(SCTX3,<UNLOKK DEVLKK
CALL FUNLK>)
CALL GTTOPF ; 3 := TOP FK FOR WHICH THIS TTY IS CTTY
CAIA ; CAN'T FAIL. GIVE ERROR IF IT DOES
CAIE T3,-1 ; Null fork?
ITERR(SCTX2,<UNLOKK DEVLKK
CALL FUNLK>)
MOVEI T1,-2 ; This is just a "different" value
CALL STTOPF ; SET TOP FORK TO "ASSIGNING"
UNLOKK DEVLKK
MOVE T3,P2 ; Retrieve original designator
JRST SCTT21 ; Enter mainline
; Function to remove special controlling terminal from a fork and
; its inferiors. It reverts to the job's CTTY.
SCTCLR: CALL CHKSCT ; Is process privileged to do this?
MOVEI T3,-1 ; Restore fork CTTY to job CTTY
;Here to set the designator in T3 to be the controlling terminal
; for the fork in P1.
SCTT21: MOVE P3,T3 ; New designator
HRRZ T2,FORKN ; Fork number of self
HRRZ T1,P1 ; Job fork number we are setting
CAIN T2,0(P1) ; Setting own CTTY?
CALL MAPINF ; Yes, freeze inferiors only
CALL FFORK3 ; Freeze forks (updates TTPSI words)
HRRZ T1,P1 ; Job number we are setting
HLRZ T4,FORKN ; Top job fork
MOVEI Q1,(T1) ; Compute pointer to its superior
ADD Q1,SUPERP ; ..
LDB Q1,Q1 ; Job fork number of its superior
MOVEI T2,377777 ; NULL designator, just something that
; the previous CTTY won't be.
CAIE T4,0(T1) ; Fork being changed=top job fork?
LOAD T2,FRKTTY,(Q1) ; Get designator of superior's old CTTY
HRRZ T3,P3 ; New designator for desired fork's ctty
CALL SCTT3 ; Set new CTTY for fork and inferiors
CAIN T3,-1 ; Was that all set to job CTTY?
JRST SCTT22 ; Yes, skip following stuff
MOVEI T2,-400000(T3) ; It's a real line. Must set it to know
PUSH P,T1 ; what FORKX to poke on an interrupt char
HRRZ T1,SYSFK(T1) ; Get system FORKX for that fork.
CALL STTOPF ; Set top fork in TTYSRV data base
POP P,T1 ; Restore job fork number
SCTT22: HRRZ T2,FORKN
CAIN T2,0(P1) ; Resume the forks that we froze
CALL MAPINF
CALL RFORK3 ; Resume forks (updates TTPSI words)
RET
; Change the CTTY for some fork and its inferiors
;1/ Job fork index
;2/ Superior fork's prev CTTY designator
;3/ New CTTY designator for fork in 1
SCTT3: LOAD T4,FRKTTY,(T1) ;GET OLD CTTY
STOR T3,FRKTTY,(T1) ; And store NEW
CAIE T4,0(T3) ; New CTTY=old CTTY?
CAIN T4,0(T2) ; Prev CTTY same as sup's prev CTTY?
JRST SCTT5 ; Yes
;Here if this fork is getting a new CTTY, and it also used to have
; a CTTY which wasn't the same as its superior's CTTY.
CAIN T4,-1 ; Was prev CTTY job CTTY?
JRST SCTT4 ; Yes, no need to fix TTFRK1
MOVEI Q2,0(T4) ; No, prev des (assumed to be TTY des)
TRZN Q2,1B18 ; Convert to line #
JRST SCTT4 ; Not a TTY designator
CAIGE Q2,NLINES ; Is it valid?
CAIGE Q2,0
JRST SCTT4 ; No, don't touch TTFRK1
PUSH P,T1 ; Shuffle some AC's for TTYSRV calls
PUSH P,T2 ; ..
MOVEI T2,(Q2) ; Line number
SETO T1,0 ; CLEAR ALL BITS IN TERMINAL PSI WORD
CALL CLRINT ; ..
MOVEI T2,(Q2) ; Line number
CALL STTOPF ; AND SET -1 AS TOP FORK FOR THIS TTY
POP P,T2 ; Restore ac's
POP P,T1 ; ..
SCTT4:
;Here if a different "superior's CTTY" must be told to inferiors
PUSH P,T2 ; Save this fork's SUPERIOR's previous CTTY
MOVEI T2,0(T4) ; Set prev CTTY for inferiors to be old
; CTTY of this fork.
JRST SCTT6 ; Go tell the inferiors
; Here if the "Superior's CTTY" to be told to inferiors is same as
; the one this fork was told
SCTT5: PUSH P,T2 ; Save this fork's superior's previous CTTY
SCTT6: HRLM T1,0(P) ; Save current fork
CALL MAPINF
CALL SCTT3 ; Do above for inferiors
HLRZ T1,0(P) ; Restore current fork
POP P,T2 ; Restore previous CTTY os superior
HRRZS T2 ; Clear fork from LH (saving stack space)
RET ; Done
SUBTTL Program Data Vector (PDVOP% jsys)
;The PDVOP% jsys manipulates program data vectors.
;
;Accepts: AC1/ function
; AC2/ arg block address
;
;Returns+1: always (unless error) function performed
PD0LEN==1+.POADE ;SIZE BLOCK NEEDED TO HOLD ENTIRE ARG BLOCK
.PDVOP::MCENT ;DELCARE JSYS CONTEXT
TRVAR <<OURBLK,PD0LEN>,LOCUPT,LOCBLK,DATBLK,PPOMAR,POMAR,POLMAP,POPAGE,SAVPER,NREM,NEWPVS,ADRREM,PDFRKN,PONEW,FNDLOW,FNDHGH,PDVN,PDVLST,PSBOFF,PARLEN,PARAD,PCODE,<PD0,PD0LEN>>
SETOM DATBLK ;NO BLOCK HERE YET
SETOM LOCBLK ;NO BLOCK NEEDED TO RELEASE YET
SETOM POLMAP ;NO MAPPED PAGE YET
SETOM POPAGE ;NO WINDOW ADDRESS YET
UMOVE D,A ;GET USER'S FUNCTION CODE
CAIL D,0 ;DISALLOW NEGATIVE ARG
CAIL D,PDVAMX ;DISALLOW BLOATED ARG
ITERR (ARGX02) ;"INVALID FUNCTION"
UMOVE B,B ;GET USER'S ARGUMENT BLOCK ADDRESS
MOVEM B,PARAD ;REMEMER IT
UMOVE A,.POCT1(B) ;GET SIZE OF USER'S ARGUMENT BLOCK
MOVEM A,PARLEN ;REMEMBER ARGUMENT BLOCK LENGTH
LSH D,1 ;ACCOUNT FOR TABLE BEING PAIRS
MOVEM D,PCODE ;REMEMBER CODE
CAILE A,PD0LEN ;MAKE SURE WE HAVE ROOM FOR ARGUMENT BLOCK
ITERR (ARGX05) ;"ARGUMENT BLOCK TOO LONG" (PICKY PICKY!)
HRRZ C,PDVTAB+1(D) ;GET REQUIRED OFFSET
CAMG A,C ;MAKE SURE ARGUMENT BLOCK IS LONG ENOUGH
ITERR (ARGX04) ;"ARGUMENT BLOCK TOO SMALL"
XMOVEI C,PD0 ;GET ADDRESS FOR OUR COPY OF ARG BLOCK
CALL BLTUM ;COPY ARG BLOCK FROM USER SPACE TO OUR COPY
MOVE A,.POADE+PD0 ;GET POSSIBLE ENDING ADDRESS ARG
MOVE B,PARLEN ;GET USER'S ARG BLOCK LENGTH
CAIG B,.POADE ;DID USER SUPPLY AN ENDING ADDRESS?
HRLOI A,377777 ;NO, SO ASSUME NO LARGE BOUND
CAILE B,.POADR ;NO ERROR POSSIBLE IF .POADR NOT SUPPLIED
CAML A,.POADR+PD0 ;MAKE SURE ENDING ADDRESS AS LARGE AS STARTING ADDRESS
CAIA
ITERR (PDVX01) ;"ENDING ADDRESS MUST BE AS LARGE AS STARTING ADDRESS"
MOVEM A,.POADE+PD0 ;IN CASE NO ENDING ADDRESS GIVEN, USE LARGE VALUE
MOVE A,.POADR+PD0 ;GET POSSIBLE LOW BOUND
CAIG B,.POADR ;IS ONE SUPPLIED?
MOVEI A,0 ;NO, SO ASSUME 0.
MOVEM A,.POADR+PD0
CALL FLOCK ;DON'T LET FORK STRUCTURE CHANGE WHILE WE'RE DOING THINGS
MOVE A,.POPHD+PD0 ;GET FORK HANDLE
CALL SETJFK ;GET FORK NUMBER
MOVEM A,PDFRKN ;REMEMBER FORK NUMBER
MOVE D,PCODE ;GET OFFSET INTO TABLE
MOVX B,PDXOKF ;GET BIT SAYING EXECUTE-ONLY FORKS OK
TDNN B,PDVTAB+1(D) ;DON'T WORRY ABOUT XONLY IF FLAG ON
CALL CHKNXS ;MAKE SURE FORK ISN'T EXECUTE-ONLY
MOVE A,.POPHD+PD0 ;GET PROCESS HANDLE
CALL SETLFK ;MAP IN PSB OF APPROPRIATE FORK
MOVEM A,PSBOFF ;REMEMBER OFFSET FOR PSB
MOVE B,PDVS(A) ;GET ADDRESS OF PDVA BLOCK (OR 0 IF NONE)
CAIN B,0 ;IS THERE ANY BLOCK YET?
SKIPA A,[1] ;NO, PRETEND BLOCK ONLY HAS HEADER
HRRZ A,(B) ;YES, GET LENGTH OF BLOCK
SOJ A, ;SUBTRACT ONE FOR HEADER
MOVEM A,PDVN ;REMEMBER NUMBER OF PDVAS IN BLOCK
AOJ B, ;GET ADDRESS OF ACTUAL LIST OF PDVAS
MOVEM B,PDVLST ;REMEMBER WHERE LIST OF PDVAS BEGINS
MOVE A,PCODE ;GET VERIFIED FUNCTION CODE
CALL @PDVTAB(A) ;DO THE SPECIFIED FUNCTION
CALL POCLEN ;UNMAP WINDOW PAGE IF NECESSARY
JRST CLFRET ;GIVE SUCCESS RETURN, UNLOCKING ALL.
DEFINE FEN (SYMBUL,HEISST) ;MACRO TO ALLOW ORDER-INDEPENDENT DISPATCH ASSIGNMENT
< SYMNAM==.'SYMBUL ;;MAKE REAL SYMBOL
RELOC PDVTAB+2*SYMNAM ;;GET TO CORRECT TABLE LOCATION
DTBDSP SYMBUL ;;PUT DISPATCH ADDRESS IN TABLE
HEISST ;;REMEMBER HIGHEST REQUIRED ARG OFFSET
IFG SYMNAM-PDVAMX,< ;;KEEP TRACK OF LENGTH OF TABLE
PDVAMX==SYMNAM+1>
RELOC PDVTAB+2*PDVAMX ;;GET OUT OF TABLE IN CASE IT'S DONE
>
PDVAMX==0 ;;INITIALIZE TABLE SIZE TO 0
;As defined by the FEN macro, PDVTAB is organized like this:
;
; PDVTAB: address for function 0
; flags,,highest arg block offset needed for function 0
; address for function 1
; flags,,highest arg block offset needed for function 1
; . . .
;
; address n
; flags,,highest offset n
;
; PDVAMX == n + 1 (i.e. PDVAMX is number of functions)
;The following flags may appear in PDVTAB entries:
PDXOKF==1B0 ;execute-only forks are O.K.
PDVTAB: FEN POGET,PDXOKF!.PODAT ;GET LIST OF PDVA'S
FEN POADD,.PODAT ;ADD SOME PDVAS TO THE LIST
FEN POREM,.POPHD ;REMOVE SOME
FEN POLOC,PDXOKF!.PODAT ;LOCATE PDVAS HAVING GIVEN NAME
FEN POVER,PDXOKF!.POADR ;GET VERSION NUMBER
FEN PONAM,PDXOKF!.POADR ;GET PROGRAM NAME
;In all the function-specific routines, the following argument
;block words have the same meaning when relevant:
; .POCT1/ total number of words in argument block
; .POPHD/ process handle
;POVER reads the version word out of a particular PDV.
;This function is needed for execute-only forks.
;
;Accepts: .POADR/ PDVA of PDV being read
; .POCT2/ must contain at least 1
; .PODAT/ address in which to store version word
;
;Returns+1: (user's .PODAT)/version word
; user's .POCT2/ 1
POVER: CALL VERPDV ;VERIFY THAT WE'RE DEALING WITH A PDV
SKIPG .POCT2+PD0 ;IS THERE ROOM FOR THE ONE WORD
JRST [ MOVE A,PARAD ;NO, GET USER'S ARG BLOCK ADDRESS
XCTU [SETZM .POCT2(A)] ;TELL USER NOTHING WAS RETURNED
RET]
MOVE A,.POADR+PD0 ;GET PDVA
ADDI A,.PVVER ;GET ADDRESS OF VERSION WORD
CALL GETWRD ;READ VERSION WORD
MOVE B,.PODAT+PD0 ;GET ADDRESS INTO WHICH RESULT SHOULD BE STORED
UMOVEM A,0(B) ;GIVE USER THE RESULT
MOVEI A,1
MOVE B,PARAD
UMOVEM A,.POCT2(B) ;TELL USER ONE WORD WAS RETURNED
RET
;PONAM reads the ASCIZ program name from a particular PDV.
;This function is needed for execute-only forks.
;
;Accepts: .POADR/ PDVA of PDV to be read
; .POCT2/ maximum number of words we've room for
; .PODAT/ address to store ASCIZ name in
;
;Returns+1: user's .POCT2/ real length,,length of returned string
PONAM: CALL VERPDV ;MAKE SURE WE'RE DEALING WITH A PDV
MOVEI Q1,0 ;NUMBER OF WORDS RETURNED SO FAR
MOVE P1,.PODAT+PD0 ;GET ADDRESS INTO WHICH NAME SHOULD BE STORED
MOVE A,.POADR+PD0 ;GET PDVA
ADDI A,.PVNAM ;GET ADDRESS OF POINTER TO NAME
CALL GETWRD ;READ ADDRESS OF PROGRAM NAME
TLNN A,777777 ;If section number of address of name string
HLL A,.POADR+PD0 ; is zero then use section number of PDVA
MOVE Q2,A ;REMEMBER ADDRESS OF STRING
PONAM1: MOVE A,Q2 ;GET ADDRESS OF NEXT PART OF STRING
CALL GETWRD ;GET IT FROM OTHER FORK
CAML Q1,.POCT2+PD0 ;HAVE WE RETURNED MAXIMUM NUMBER OF WORDS YET?
JRST PONAM3 ;YES, DON'T STORE OR COUNT
UMOVEM A,0(P1) ;NO, STORE PART OF STRING
AOJ Q1, ;KEEP TRACK OF HOW MANY WORDS HAVE BEEN STORED
PONAM3: AOJ P1, ;STEP TO NEXT DESTINATION ADDRESS
TXNE A,177B6 ;STRING NOT OVER UNTIL NULL SEEN SOMEWHERE IN IT
TXNN A,177B13
JRST PONAM2 ;NULL IN ONE OF FIRST TWO SPOTS, STOP STORING
TXNE A,177B20
TXNN A,177B27
JRST PONAM2 ;NULL IN THIRD OR FOURTH SPOT
TXNE A,177B34
AOJA Q2,PONAM1 ;NO NULL YET, KEEP READING NAME
PONAM2: MOVE A,PARAD ;GET USER'S ARG BLOCK ADDRESS
SUB P1,.PODAT+PD0 ;CALCULATE LENGTH OF NAME
HRL Q1,P1 ;GIVE ACTUAL LENGTH IN LEFT HALF
UMOVEM Q1,.POCT2(A) ;TELL USER HOW MANY WORDS WERE RETURNED
RET
;POADD adds some PDVAs to a process.
;
;Accepts: .POCT2/ number of PDVAs being added
; .PODAT/ address of block of PDVAs
POADD: MOVEI Q1,0 ;NUMBER OF OVERLAPS
MOVE Q2,.POCT2+PD0 ;NUMBER OF PDVAS TO CHECK
MOVX P2,1B0 ;PREVIOUS PDVA CHECKED IN NEW BLOCK
MOVE P1,.PODAT+PD0 ;GET ADDRESS OF LIST OF PDVAS BEING ADDED
POAD1: SOJL Q2,POAD2 ;LEAVE LOOP IF ALL NEW PDVAS CHECKED
UMOVE A,0(P1) ;GET A NEW PDVA
MOVE B,A ;UPPERBOUND IS SAME AS LOWERBOUND
CAMG B,P2 ;MAKE SURE EACH NEW PDVA LARGER THAN PREVIOUS
JRST [ MOVEI A,PDVX02 ;ERROR IF NOT ASCENDING ORDER
JRST POERR]
MOVE P2,B ;REMEMBER LARGEST WE'VE SEEN SO FAR
CALL POFND ;SEE IF THIS PDVA IS ALREADY IN THE LIST
AOJA P1,POAD1 ;NO, GO SCAN THE REST
AOJA Q1,.-1 ;YES, REMEMBER HOW MANY OVERLAPS
POAD2: MOVE A,.POCT2+PD0 ;GET NUMBER OF NEW PDVAS GIVEN BY USER
SUB A,Q1 ;SUBTRACT OVERLAPS
ADD A,PDVN ;ADD NUMBER ALREADY EXISTING TO GET NEW TOTAL
CALL GETPBF ;GET A NEW BLOCK FOR THE EXPANDED LIST
MOVEM A,PONEW ;REMEMBER POINTER TO NEW BLOCK
AOJ A, ;GET FIRST ADDRESS INTO WHICH TO STORE A PDVA
MOVE B,PDVLST ;GET FIRST ADDRESS OF A PDVA IN OLD LIST
MOVE C,.PODAT+PD0 ;GET USER ADDRESS OF FIRST NEW PDVA
MOVE Q1,PDVN ;GET NUMBER OF OLD ONES TO SCAN
MOVE Q2,.POCT2+PD0 ;GET NUMBER OF NEW ONES TO SCAN
POAD3: JUMPE Q1,POAD4 ;PERHAPS NO OLD ONES LEFT TO MERGE
MOVE D,(B) ;THERE IS AN OLD ONE LEFT, GET IT
JUMPE Q2,POAD5 ;JUMP IF NO NEW ONES LEFT TO SCAN
UMOVE P2,0(C) ;THERE IS A NEW ONE LEFT, GET IT
CAMLE D,P2 ;SEE WHICH IS SMALLER
JRST [ MOVEM P2,(A) ;NEW ONE SMALLER STORE IT IN NEW LIST
AOJ C, ;REMEMBER THAT THIS NEW ONE HAS BEEN USED
SOJ Q2, ;REMEMBER HOW MANY NEW ONES LEFT
AOJA A,POAD3] ;KEEP MERGING LISTS
CAMLE P2,D
JRST [ MOVEM D,(A) ;OLD ONE SMALLER, STORE IT.
AOJ B, ;STEP TO ADDRESS OF NEXT OLD ONE
SOJ Q1, ;REMEMBER THAT ONE LESS OLD ONE TO SCAN
AOJA A,POAD3]
MOVEM D,(A) ;THEY'RE EQUAL, STORE ONE OF THEM.
AOJ B, ;ADVANCE ADDRESS OF OLD
AOJ C, ;ADVANCE ADDRESS OF NEW
SOJ Q1, ;DECREASE NUMBER OF OLDS LEFT
SOJ Q2, ;DECREASE NUMBER OF NEWS LEFT
AOJA A,POAD3 ;ADVANCE POINTER TO RESULT AND KEEP MERGING
POAD4: MOVE B,C ;GET USER ADDRESS OF NEXT NEW ONE TO PICK UP
MOVE C,A ;GET NEXT MONITOR ADDRESS INTO WHICH TO STORE
MOVE A,Q2 ;GET NUMBER OF NEW ONES LEFT TO STORE
CALL BLTUM ;COPY REST OF NEW ONES INTO RESULT
CALLRET POSWCH ;GO FINISH UP
POAD5: MOVE C,A ;GET NEXT MONITOR ADDRESS INTO WHICH TO STORE
MOVE A,Q1 ;NEW LIST RAN OUT, GET NUMBER OF OLDS LEFT
CALL XBLTA ;COPY REST OF OLD LIST INTO RESULT
CALLRET POSWCH ;GO SWITCH BLOCKS AND RETURN
;POREM removes some PDVAs for a process.
;
;Accepts: .POADR/ smallest address
; .POADE/ largest address (optional)
;
;All PDVAs in the included address range are removed.
POREM: MOVE A,.POADR+PD0 ;GET LOWERBOUND
MOVE B,.POADE+PD0 ;GET UPPERBOUND
CALL POFND ;DECIDE WHAT'S BEING REMOVED
RET ;NOTHING, SO BYE
MOVEM A,NREM ;REMEMBER NUMBER BEING REMOVED
MOVEM B,ADRREM ;REMEMBER ADDRESS OF BLOCK TO BE REMOVED
SUB A,PDVN ;CALCULATE NEGATIVE PDVAS LEFT AFTER REMOVAL
JUMPE A,POR0 ;HANDLE CASE OF NONE LEFT
MOVN A,A ;GET POSITIVE PDVAS LEFT
CALL GETPBF ;GET NEW BLOCK
MOVEM A,PONEW ;REMEMBER ADDRESS OF NEW BLOCK
AOJ A, ;LOCATE BEGINNING OF PDVAS IN NEW BLOCK
MOVEM A,NEWPVS
MOVE A,ADRREM ;GET BEGINNING OF BLOCK TO REMOVE
SUB A,PDVLST ;CALCULATE NUMBER OF ONES TO PRESERVE IN FRONT OF REMOVAL
MOVE B,PDVLST ;COPY FROM OLD BLOCK
MOVE C,NEWPVS ;COPY INTO NEW BLOCK
CALL XBLTA ;COPY PRESERVED STUFF
MOVE B,ADRREM ;GET ADDRESS OF FIRST REMOVAL
ADD B,NREM ;GET ADDRESS OF FIRST ONE BEYOND REMOVAL
MOVE A,PDVLST ;GET ADDRESS OF FIRST OLD ONE
ADD A,PDVN ;GET SMALLEST ADDRESS BEYOND LIST
SUB A,B ;CALCULATE NUMBER OF PDVAS AFTER REMOVAL
CALL XBLTA ;COPY STUFF BEYOND REMOVAL INTO NEW BLOCK
CALLRET POSWCH ;SWITCH BLOCKS AND RETURN
POR0: SETZM PONEW ;SAY THERE'S NO BLOCK ANYMORE
CALLRET POSWCH ;CLEAR OLD BLOCK AND RETURN
;POSWCH replaces an old PDV block with a new, releasing the space taken up
;by the old.
;
;Accepts: PONEW/ pointer to new block
POSWCH: MOVE B,PONEW ;GET NEW BLOCK ADDRESS
MOVE Q1,PSBOFF ;GET OFFSET INTO PSB
EXCH B,PDVS(Q1) ;STORE NEW POINTER, GET OLD
MOVEI A,JSBFRE ;SAY JSB FREE SPACE
JUMPE B,R ;DON'T TRY TO RELEASE NONEXISTENT BLOCK
CALLRET RELFRE ;RELEASE OLD BLOCK AND RETURN
;POLOC gets the pdvas for pdvs having a specified program name.
;
;Accepts: .POCT2/ maximum pdvas to return
; .POADR/ smallest pdva of interest
; .POADE/ largest pdva of interest
; User's AC3/ pointer to ASCIZ string
;
;Returns: User's .POCT2/ number found,,number returned
; User's .PODAT/ the pdvas
POLOC: MOVE A,.POADR+PD0 ;LOCATE RANGE USER IS INTERESTED IN
MOVE B,.POADE+PD0
CALL POFND
NOP ;WE SHOULD BE ABLE TO HANDLE 0 IN NORMAL FASHION
MOVE P1,B ;REMEMBER WHERE FIRST ONE IS
MOVE Q2,A ;REMEMBER HOW MANY PDVS TO LOOK AT
UMOVE A,C ;GET USER'S POINTER TO NAME
CALL CPYFUS ;COPY NAME INTO OUR ADDRESS SPACE
JRST POX02 ;CAN'T, JSB FULL
HRRZM A,LOCBLK ;REMEMBER POINTER TO FREE SPACE BLOCK WE'RE TYING UP
HRROI A,1(A) ;MAKE BYTE POINTER TO NAME
MOVEM A,LOCUPT ;REMEMBER POINTER TO USER'S STRING
HRRZ B,@LOCBLK ;GET SIZE BLOCK WE'LL NEED FOR READING NAMES INTO
SOJ B, ;DISCOUNT HEADER TO GET SIZE DATA BLOCK
MOVEM B,.POCT2+OURBLK ;SET UP OUR COUNT
AOJ B, ;INCLUDE HEADER TO GET OUR BLOCK
CALL ASGJFR ;GET BLOCK FOR READING NAMES INTO
JRST POX02 ;NO ROOM FOR THIS BLOCK
MOVEM A,DATBLK ;REMEMBER POINTER TO OUR BLOCK
AOJ A, ;GET OVER HEADER
MOVEM A,.PODAT+OURBLK ;ESTABLISH WHERE OUR DATA BLOCK IS
MOVE A,.POPHD+PD0 ;GET FORK WE'RE LOOKING AT
MOVEM A,.POPHD+OURBLK ;SET UP FOR OUR OWN PDVOP% JSYS
MOVEI A,1+.POADR ;SPECIFY HOW MUCH OR OUR ARG BLOCK IS USED
MOVEM A,.POCT1+OURBLK
MOVE Q1,.POCT2+PD0 ;GET MAXIMUM NUMBER OF PDVAS TO RETURN
MOVE P2,.PODAT+PD0 ;GET NEXT ADDRESS TO STORE A PDVA IN
MOVEI P3,0 ;NUMBER OF MATCHING PDVAS FOUND
POL1: SOJL Q2,POL2 ;LEAVE LOOP IF NO MORE PDVAS TO EXAMINE
MOVE A,(P1) ;GET NEXT PDVA OF PDV TO READ
MOVEM A,.POADR+OURBLK ;SAY WHICH PDVA WE WANT THE NAME OF
MOVEI A,.PONAM ;SPECIFY THAT WE ARE READING A NAME
MOVEI B,OURBLK ;TELL PDVOP% WHERE THE ARG BLOCK IS
PDVOP% ;READ THE NAME IN THIS PDV
ERJMP [ MOVE A,LSTERR ;FAILED, TELL CALLER WHY
JRST POERR]
MOVE A,LOCUPT ;GET POINTER TO USER'S STRING
HRRO B,.PODAT+OURBLK ;POINT AT NAME OF CURRENT PDV
STCMP% ;COMPARE THE TWO NAMES
ERJMP [ MOVE A,LSTERR ;FAILED, SO SAY WHY AND DIE.
JRST POERR]
JUMPE A,[ AOJ P3, ;REMEMBER HOW MANY HAVE BEEN FOUND
SOJL Q1,.+1 ;THIS ONE MATCHES, JUMP IF NO ROOM FOR IT
MOVE A,.POADR+OURBLK ;ROOM, GET THE MATCHING ONE
UMOVEM A,(P2) ;STORE IN USER SPACE
AOJA P2,.+1] ;STEP TO NEXT SLOT IN WHICH TO STORE ONE
AOJA P1,POL1 ;LOOP TO EXAMINE REST OF PDVS
POL2: MOVE A,PARAD ;DONE STORING, GET USER'S ARG BLOCK ADDRESS
SUB P2,.PODAT+PD0 ;CALCULATE QUANTITY ACTUALLY RETURNED
HRL P2,P3 ;GIVE NUMBER FOUND,,NUMBER RETURNED
UMOVEM P2,.POCT2(A) ;GIVE TO USER
RET ;DONE
;POGET gets the addresses of PDVs for the specified process.
;
;Accepts: .POCT2/ maximum PDVAs to return
; .POADR/ address to scan up from
; .POADE/ largest address to return (optional)
;
;Returns: user's .POCT2/ number found,,number returned
POGET: MOVE A,.POADR+PD0 ;GET RANGE TO SEARCH
MOVE B,.POADE+PD0
CALL POFND ;FIND INTERESTING SET OF PDVAS
NOP ;IF NONE FOUND, WE'LL "DO" 0
MOVE D,PARAD ;GET USER'S ARG BLOCK ADDRESS
HRL C,A ;GET COUNT BEFORE TRIMMING
CAMLE A,.POCT2+PD0 ;ARE THERE MORE GOOD PDVAS THAN USER WANTS?
MOVE A,.POCT2+PD0 ;YES, TRIM QUANTITY
HRR C,A ;GET NUMBER REALLY BEING DELIVERED
UMOVEM C,.POCT2(D) ;TELL USER HOW MANY PDVAS WE'RE REALLY GIVING.
MOVE C,.PODAT+PD0 ;GET ADDRESS WHERE USER WANTS PDVAS PUT
CALLRET BLTMU ;GIVE USER THE PDVAS
;Come to POGET0 to explicitly return zero (0) PDVAs to the user
POGET0: MOVE D,PARAD ;GET USER'S ARG BLOCK ADDRESS
XCTU [SETZM .POCT2(D)] ;TELL HER NO PDVAS HAVE BEEN RETURNED
RET
;VERPDV verifies that the given pdva is really a pdva.
;
;Accepts: .POADR+PD0/ pdva being verified
;
;Returns+1: yes
VERPDV: MOVE A,.POADR+PD0 ;GET PDVA BEING VERIFIED
MOVE B,A ;WE ONLY WANT TO SEARCH FOR ONE
CALL POFND ;TRY TO FIND THE SPECIFIED PDVA
CAIA ;GIVE ERROR IF NOT FOUND
RET ;IT'S FOUND, SO IT'S O.K.
MOVEI A,PDVX03 ;SAY "NON-PDV GIVEN"
CALLRET POERR ;GO GIVE ERROR
;POFND finds a subset of PDVAs in the stored list.
;
;Accepts: A/ smallest PDVA of interest
; B/ largest PDVA of interest
; PDVLST/ address of first PDVA
; PDVN/ total number of PDVAs in list
;
;Returns+1: no interesting ones found, A/ 0
; +2: A/ number of interesting ones found
; B/ address of first interesting one
POFND: MOVEM A,FNDLOW ;SAVE LOWERBOUND
MOVEM B,FNDHGH ;SAVE UPPERBOUND
MOVE A,PDVLST ;GET SMALLEST POSSIBLE BOUND
MOVE C,PDVN ;GET TOTAL PDVAS TO SCAN
MOVE B,FNDLOW ;GET SMALLEST INTERESTING POSSIBLE PDVA
POF0: SOJL C,RFALSE ;IF COUNT RUNS OUT, WE FOUND NONE
CAMLE B,(A) ;IS THIS PDVA LARGE ENOUGH?
AOJA A,POF0 ;NO, KEEP SCANNING
MOVE B,FNDHGH ;GET LARGEST INTERESTING POSSIBLE PDVA
MOVE D,A ;REMEMBER SMALL INTERESTING ADDRESS
CAIA ;CONSIDER CURRENT WORD WITH UPPERBOUND
POF1: SOJL C,POFDON ;IF COUNT RUNS OUT, WE'VE FOUND ENTIRE SET
CAML B,(A) ;IS TEST PDVA SMALL ENOUGH?
AOJA A,POF1 ;YES, EXPAND RANGE
POFDON: SUB A,D ;CALCULATE NUMBER OF GOOD ADDRESSES OF PDVAS
JUMPLE A,RFALSE ;IF NONE, SAY SO
MOVE B,D ;GET FIRST GOOD ADDRESS
RETSKP ;SKIP TO SAY SOME FOUND
;POX02 is for handling failures from attempts to get free space, when
;the reason is that JSB free space is full.
POX02: MOVEI A,MONX02 ;SAY JSB FULL
CALLRET POERR
;POERR causes ITRAP from PDVOP% jsys, unlocking what's necessary first.
;
;Accepts: A/ error code
POERR: MOVEM A,SAVPER ;SAVE ERROR CODE
CALL POCLEN ;UNMAP POSSIBLE WINDOW
CALL CLRLFK ;UNMAP FORK'S PSB
CALL FUNLK ;UNLOCK FORK STRUCTURE
MOVE A,SAVPER ;GET ERROR CODE
ITERR ;CAUSE ERROR RETURN
;POCLEN does CLEAN up stuff.
POCLEN: SKIPL A,POPAGE ;IS THERE A WINDOW?
CALL RELPAG ;YES, RELEASE IT
MOVEI A,JSBFRE ;PREPARE TO RELEASE FREE SPACE
SKIPL B,LOCBLK ;BLOCK HERE TO RELEASE?
CALL RELFRE ;YES, RELEASE IT
MOVEI A,JSBFRE ;PREPARE TO RELEASE FREE SPACE
SKIPL B,DATBLK ;BLOCK HERE TO RELEASE?
CALL RELFRE ;YES, RELEASE IT
RET
;GETPBF gets a PDV block from JSB free space.
;
;Accepts: A/ number of PDVAs to be stored
;
;Returns+1: A/ address of block, or 0 if none were to be stored
GETPBF: JUMPE A,R ;IF NEED 0 WORDS, RETURN 0
AOS B,A ;LEAVE ROOM FOR HEADER
CALL ASGJFR ;ASSIGN JSB FREE SPACE
JRST POX02 ;CAN'T, JSB FULL
RET
;GETWRD reads a word from another fork in the job.
;
;Accepts: .POPHD+PD0/ fork handle
; A/ address whose contents is to be read
; POLMAP/ number of page currently mapped, or -1
; POPAGE/ page window, or -1 if not set up yet
;
;Returns+1: A/ data from word, or 0 if can't read
GETWRD: MOVEM A,POMAR ;REMEMBER ADDRESS BEING SOUGHT
LSH A,-9 ;MAKE PAGE NUMBER
MOVEM A,PPOMAR ;REMEMBER PAGE
CAMN A,POLMAP ;IS CORRECT PAGE MAPPED ALREADY?
JRST GET1 ;YES, PIECE OF CAKE.
MOVEM A,POLMAP ;NO, SO REMEMBER THAT WE'RE MAPPING IT NOW
SKIPL B,POPAGE ;IS THERE A WINDOW ESTABLISHED YET?
JRST GET2 ;YES
CALL ASGPAG ;NO, GET A PAGE
JRST POX02 ;CAN'T JSB FULL
MOVEM A,POPAGE ;REMEMBER ADDRESS OF WINDOW PAGE
GET2: HRL A,.POPHD+PD0 ;GET FORK HANDLE
HRR A,PPOMAR ;GET DESIRED PAGE
MOVEI B,0 ;.NOT.PM%EPN
CALL FKHPTN ;GET PTN,,PAGE
JRST POERR ;FAILED, ERROR CODE IN A
MOVE B,POPAGE ;GET ADDRESS TO MAP PAGE INTO
TXO B,PM%RD ;SAY WE WANT TO READ IT
CALL SETMPG ;SET UP THE MAPPING
GET1: MOVE A,POPAGE ;GET ADDRESS INTO WHICH DATA IS NOW MAPPED
LDB B,[001100,,POMAR] ;GET OFFSET INTO PAGE
ADD B,A ;MAKE ADDRESS IN WINDOW
MOVEI A,0 ;GET 0 IN CASE DATA CAN'T BE READ
MOVE A,(B) ;REFERENCE THE DATA
ERJMP .+1 ;RETURN 0 IF PAGE UNREADABLE
RET
TNXEND
END