Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
6-1-monitor/fork.mac
There are 53 other files named fork.mac in the archive. Click here to see a list.
;[SRI-NIC]XS:<SU-61SU>FORK.MAC.2, 5-Dec-86 13:50:24, Edit by MKL
;;[SRI-NIC]SRC:<6-1-MONITOR>FORK.MAC.5, 18-Apr-86 14:05:36, Edit by MKL
;;Fix CFFAT routine so we don't get an ILMNRF bughlt
;;[SRI-NIC]SS:<6-1-MONITOR>FORK.MAC.3, 30-Oct-85 20:43:09, Edit by MKL
;;get rid of call to PKOKFK
; *** Edit 7254 to FORK.MAC by MRASPUZZI on 9-Mar-86, for SPR #20965
; Prevent GLFNF bughlts by reinstalling edit 1868
;------------------------- Autopatch Tape # 13 -------------------------
;------------------------- Autopatch Tape # 12 -------------------------
; Edit 7173 to FORK.MAC by PALMIERI on 23-Oct-85 (TCO 6.1.1542)
; Move modules NIUSR and LLMOP to an extended section. This required the
; changing of some global routine names in LLMOP; Therefor the changes to
; MEXEC, JSYSA, and FORK.
; Edit 7146 to FORK.MAC by TBOYLE on 10-Sep-85, for SPR #19847 (TCO 6-1-1537)
; Fix 30-bit argument address problems.
; Edit 7109 to FORK.MAC by WAGNER on 26-Jul-85, for SPR #17842 (TCO 6-1-1498)
; Fix GFRKH% to not TAKE .FHSUP IN AC2, but will take in AC 1
;TCO 6.1.1498 Change GFRKH% to not take .FHSUP in AC2, but will in AC1
; UPD ID= 2299, SNARK:<6.1.MONITOR>FORK.MAC.151, 17-Jul-85 11:17:19 by LEACHE
;TCO 6.1.1478 Reinitialize datablock size in argblock of recursive PDVOP
;<6-1-MONITOR.FT6>FORK.MAC.2, 12-Aug-85 17:05:12, Edit by WHP4
; FT6 merge
;Stanford changes:
; Release PUP and PKOPR% resources when doing a KFORK%
; CFORK% returns correct error if system resources exhausted
;
; UPD ID= 2076, SNARK:<6.1.MONITOR>FORK.MAC.150, 3-Jun-85 14:36:21 by MCCOLLUM
;TCO 6.1.1406 - Update copyright notice.
; UPD ID= 2036, SNARK:<6.1.MONITOR>FORK.MAC.149, 31-May-85 10:06:30 by MOSER
;TCO 6.1.1411 - FIX UP FLKTIM FOREVER
; UPD ID= 1986, SNARK:<6.1.MONITOR>FORK.MAC.148, 17-May-85 15:13:08 by MCCOLLUM
;TCO 6.1.1397 - Kill newly created fork after MSETPT error in CFK4
; UPD ID= 1878, SNARK:<6.1.MONITOR>FORK.MAC.147, 4-May-85 12:29:06 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1751, SNARK:<6.1.MONITOR>FORK.MAC.146, 12-Apr-85 15:45:37 by TBOYLE
;TCO 6.1.1318 - fix handling of handle counts by SPLFK% with suicide option.
; UPD ID= 1729, SNARK:<6.1.MONITOR>FORK.MAC.145, 8-Apr-85 14:35:26 by MCCOLLUM
;TCO 6.1.1238 - Fix BUG. documentation
; UPD ID= 1687, SNARK:<6.1.MONITOR>FORK.MAC.144, 26-Mar-85 15:28:58 by LOMARTIRE
;TCO 6.1.1288 - Make the RT%DIM bit work as documented
; UPD ID= 1684, SNARK:<6.1.MONITOR>FORK.MAC.143, 25-Mar-85 15:08:28 by MCCOLLUM
;TCO 6.1.1287 - Change an ITERR to a RETERR in .CFORK.
; UPD ID= 1587, SNARK:<6.1.MONITOR>FORK.MAC.142, 5-Mar-85 10:53:24 by WAGNER
;TCO 6.1.1229 - *PERFORMANCE* Modify SETJSB to check if ourselves
; UPD ID= 1481, SNARK:<6.1.MONITOR>FORK.MAC.141, 5-Feb-85 17:18:33 by GLINDELL
; TCO 6.1.1174 - EPCAP% jsys and ACJ
; UPD ID= 1426, SNARK:<6.1.MONITOR>FORK.MAC.140, 29-Jan-85 15:40:23 by MCCOLLUM
;TCO 6.1.1163 - Do not clear SYSFK entry until after CLNZSC succeeds in KSELF
; UPD ID= 1182, SNARK:<6.1.MONITOR>FORK.MAC.139, 11-Dec-84 14:12:08 by LEACHE
;Change EHLJSB conditional to EXTJSB
; UPD ID= 1051, SNARK:<6.1.MONITOR>FORK.MAC.138, 13-Nov-84 01:04:08 by GROSSMAN
;TCO 6.1.1045 - Add NI% JSYS reset code to KSELF.
; UPD ID= 5020, SNARK:<6.MONITOR>FORK.MAC.137, 26-Oct-84 13:58:23 by LEACHE
;Add code (under EHLJSB conditional) for extended JSB
; UPD ID= 4807, SNARK:<6.MONITOR>FORK.MAC.136, 17-Sep-84 10:00:42 by PURRETTA
;Update copyright notice
; UPD ID= 4741, SNARK:<6.MONITOR>FORK.MAC.135, 24-Aug-84 09:43:02 by PAETZOLD
;TCO 6.2193 - Prevent IDFOD2 BUGCHKs from long form RFSTS% at RFSLN2.
; UPD ID= 4639, SNARK:<6.MONITOR>FORK.MAC.134, 31-Jul-84 14:34:34 by GLINDELL
;More TCO 6.2153 - fix MOVEI/MOVX
; UPD ID= 4636, SNARK:<6.MONITOR>FORK.MAC.133, 31-Jul-84 12:28:36 by TBOYLE
;COMMENTS FOR WFORK% AND USE OF FKSPL.
; UPD ID= 4631, SNARK:<6.MONITOR>FORK.MAC.132, 30-Jul-84 13:55:31 by GLINDELL
;Tco 6.2153 - fix section 0/section local confusion in PDVOP% jsys
; UPD ID= 4554, SNARK:<6.MONITOR>FORK.MAC.131, 18-Jul-84 10:52:30 by MOSER
;TCO 6.2125 - SYNCRONOUS KFORK
; UPD ID= 4453, SNARK:<6.MONITOR>FORK.MAC.130, 12-Jul-84 10:35:49 by CDUNN
;More TCO 6.1127 Make KFORK% call SCSKIL in SCSJSY to delete any connects
;the fork may have had.
; UPD ID= 4440, SNARK:<6.MONITOR>FORK.MAC.129, 5-Jul-84 16:51:56 by GROSSMAN
;TCO 6.2118 - Fix UTFRK% function UT%TRP so that forks don't get started at
; PC of ITRAP in user mode if their PC was changed via SFORK%.
; UPD ID= 4389, SNARK:<6.MONITOR>FORK.MAC.128, 26-Jun-84 19:03:26 by PAETZOLD
;TCO 6.2110 - Use correct index register when testing FKEFR in TFRKSR.
; UPD ID= 4348, SNARK:<6.MONITOR>FORK.MAC.127, 15-Jun-84 16:03:18 by TBOYLE
;TCO 6.2090 - Replace TCO 6.2075 - Do not allow indirection or indexing
; UPD ID= 4325, SNARK:<6.MONITOR>FORK.MAC.126, 12-Jun-84 13:28:35 by MOSER
;TCO 6.2086 - FIX SHROFN UNMAP INDEX FILE
; UPD ID= 4301, SNARK:<6.MONITOR>FORK.MAC.125, 4-Jun-84 23:01:56 by MOSER
;REFERENCE SC%CTC SYMBOLICLY
; UPD ID= 4273, SNARK:<6.MONITOR>FORK.MAC.124, 30-May-84 21:21:58 by MOSER
;TCO 6.2059 ADD SETVGN TO RESTORE FORK VIRGINITY
; UPD ID= 4263, SNARK:<6.MONITOR>FORK.MAC.123, 30-May-84 17:59:40 by TBOYLE
;TCO 6.2075 - Make pointers to .POADR in PDVs work the way they should.
; UPD ID= 4225, SNARK:<6.MONITOR>FORK.MAC.122, 16-May-84 15:42:11 by TBOYLE
;More TCO 6.2056 - unblk1 code nosked, be sure fork was blocked, see
; if on TRMLST rather than checking if TRMTST, remove KSELFJ, keep
; whole code to the killing with fork lock locked.
; UPD ID= 4223, SNARK:<6.MONITOR>FORK.MAC.121, 15-May-84 16:26:38 by MOSER
;TCO 6.2061 - PREVENT NOSKED PAGE FAULT IN SFORK
; UPD ID= 4203, SNARK:<6.MONITOR>FORK.MAC.120, 9-May-84 17:02:32 by TBOYLE
;More TCO 6.2056 - Change the value of FLKOWN during the NOSKED splice.
; UPD ID= 4186, SNARK:<6.MONITOR>FORK.MAC.119, 8-May-84 15:40:15 by TBOYLE
;More TCO 6.2056 - Make KSELFJ also call DASFKH to free fork handles.
; UPD ID= 4150, SNARK:<6.MONITOR>FORK.MAC.118, 30-Apr-84 12:26:01 by TBOYLE
;TCO 6.2056 Use FKSPL bit in TRMTST in case of race condition.
; UPD ID= 4133, SNARK:<6.MONITOR>FORK.MAC.117, 25-Apr-84 11:12:15 by LOMARTIRE
;TCO 6.2046 - Add GSWFRK to return system wide fork number given handle
; UPD ID= 4046, SNARK:<6.MONITOR>FORK.MAC.116, 4-Apr-84 16:27:12 by TBOYLE
;More TCO 6.2017 For non WHL: don't use SETJFK on .FHSUP, code explicitly.
; UPD ID= 4015, SNARK:<6.MONITOR>FORK.MAC.115, 31-Mar-84 16:14:24 by PAETZOLD
;TCO 6.2019 - Use ADJSPs
; UPD ID= 3997, SNARK:<6.MONITOR>FORK.MAC.114, 28-Mar-84 15:19:03 by TBOYLE
;More TCO 6.2017 Add comments to SPLFK code in .WFORK, KSELF, .SPLFK
; UPD ID= 3971, SNARK:<6.MONITOR>FORK.MAC.112, 24-Mar-84 23:11:07 by TBOYLE
;More TCO 6.2017 Fix a bug in .wfork on restart, and fix unblk1 at splfk4
; UPD ID= 3965, SNARK:<6.MONITOR>FORK.MAC.111, 23-Mar-84 18:56:54 by TBOYLE
;More TCO 6.2017 Change KFORK to use subroutine to remove fork. New KSELFJ
; routine will perform suicidal death. End of new SPLFK will disable
; interrupts and enter KSELFJ.
; UPD ID= 3920, SNARK:<6.MONITOR>FORK.MAC.110, 13-Mar-84 17:48:23 by TBOYLE
;More TCO 6.2017 Fix error return, to goto EFRKR.
; UPD ID= 3918, SNARK:<6.MONITOR>FORK.MAC.109, 13-Mar-84 17:15:34 by TBOYLE
;More TCO 6.2017 Fix the calls to SFRKV, XSFRK%, and some bugs.
; UPD ID= 3862, SNARK:<6.MONITOR>FORK.MAC.108, 6-Mar-84 17:32:45 by TBOYLE
;More TCO 6.2017 Fix the code, and do the error recovery.
; UPD ID= 3859, SNARK:<6.MONITOR>FORK.MAC.107, 5-Mar-84 18:44:12 by TBOYLE
;More TCO 6.2017 Fix the code.
; UPD ID= 3858, SNARK:<6.MONITOR>FORK.MAC.106, 5-Mar-84 17:52:33 by TBOYLE
;More TCO 6.2017 Fix the new code.
; UPD ID= 3855, SNARK:<6.MONITOR>FORK.MAC.105, 5-Mar-84 16:51:50 by TBOYLE
;More SPLFK, TCO 6.2017, Fix the old code, subroutinize.
; UPD ID= 3854, SNARK:<6.MONITOR>FORK.MAC.104, 5-Mar-84 15:53:09 by TBOYLE
;New SPLFK% Replace self with inferior fork, start, destroy old self.
; UPD ID= 3797, SNARK:<6.MONITOR>FORK.MAC.103, 29-Feb-84 01:42:04 by TGRADY
;IMPLEMENT GLOBAL JOB NUMBERS
; IN .SJPRI, DON' COMPARE JOB NUMBER TO NJOBS...USE GL2LCL TO CONVERT IT
; UPD ID= 3631, SNARK:<6.MONITOR>FORK.MAC.102, 1-Feb-84 22:08:05 by MURPHY
;Flush refs to SYMPAG
; UPD ID= 3626, SNARK:<6.MONITOR>FORK.MAC.101, 1-Feb-84 18:56:49 by MOSER
;MORE 6.1748 - COMPARE TO LOWQ NOT MAXQ
; UPD ID= 3445, SNARK:<6.MONITOR>FORK.MAC.99, 12-Jan-84 14:19:52 by PAETZOLD
;TCO 6.1929 - Change FKJOBN to FKJBN
; UPD ID= 3341, SNARK:<6.MONITOR>FORK.MAC.98, 19-Dec-83 09:56:04 by TSANG
;TCO 6.1913 - Make .POADE ending address available
; UPD ID= 3296, SNARK:<6.MONITOR>FORK.MAC.97, 12-Dec-83 15:57:31 by LOMARTIRE
;TCO 6.1860 - Make routine CLNZSC global
; UPD ID= 3267, SNARK:<6.MONITOR>FORK.MAC.96, 6-Dec-83 17:25:20 by MOSER
;TCO 6.1828 - PREVENT HUNG JOBS - UNLOCK DEVLKK
; UPD ID= 3266, SNARK:<6.MONITOR>FORK.MAC.95, 6-Dec-83 17:06:38 by MOSER
;TCO 6.1748 - CHECK ARGS FOR SJPRI AND SPRIW
; UPD ID= 3259, SNARK:<6.MONITOR>FORK.MAC.94, 6-Dec-83 10:05:40 by MOSER
;TCO 6.1887 - PREVENT FLKINT DOING TFORK .TFRES
; UPD ID= 3115, SNARK:<6.MONITOR>FORK.MAC.93, 8-Nov-83 09:01:45 by MCINTEE
;~6.0 - Remove NSP% jsys
; UPD ID= 3054, SNARK:<6.MONITOR>FORK.MAC.92, 21-Oct-83 19:30:09 by MURPHY
;Remove init of JOBNO from .CFORK - it is done in FKSET now.
;Suppress BP$xxx breakpoint symbols.
; UPD ID= 3010, SNARK:<6.MONITOR>FORK.MAC.91, 7-Oct-83 23:25:33 by TGRADY
;TCO 6.1821 - don't use XRMS, since it breaks lots of old applications
; UPD ID= 3005, SNARK:<6.MONITOR>FORK.MAC.90, 7-Oct-83 17:56:00 by GUNN
;~6.0 Add call to LLMRSF from KSEF0 to clean up LLMOP resources on KFORK%.
; UPD ID= 2883, SNARK:<6.MONITOR>FORK.MAC.89, 9-Sep-83 10:59:38 by TBOYLE
;More TCO 6.1788 - fix GFRKS correctly.
; UPD ID= 2878, SNARK:<6.MONITOR>FORK.MAC.88, 7-Sep-83 10:48:59 by TBOYLE
;TCO 6.1788 - Correct off by one bug in GFRKS%.
; UPD ID= 2728, SNARK:<6.MONITOR>FORK.MAC.87, 22-Jul-83 14:58:34 by PAETZOLD
;TCO 6.1733 - Remove NETKFK call as NCP has gone away.
; UPD ID= 2698, SNARK:<6.MONITOR>FORK.MAC.86, 15-Jul-83 17:57:59 by TAMBURRI
;Two instruction edit to 2652 to pass correct args to GETSEG.
; UPD ID= 2661, SNARK:<6.MONITOR>FORK.MAC.85, 4-Jul-83 14:54:20 by HALL
;TCO 6.1689 - Move fork tables.
; Remove one more direct reference
; UPD ID= 2652, SNARK:<6.MONITOR>FORK.MAC.84, 1-Jul-83 15:23:28 by TAMBURRI
;TCO 6.1712 Remember and use the section number of the current PA1050
; UPD ID= 2648, SNARK:<6.MONITOR>FORK.MAC.83, 29-Jun-83 21:23:04 by MCLEAN
;REMOVE RFSTS: IN PREVIOUS EDIT IT CAUSES A MUUO SINCE RFSTS JSYS IS USED HERE
; UPD ID= 2640, SNARK:<6.MONITOR>FORK.MAC.82, 27-Jun-83 16:19:52 by CHALL
;TCO 6.1673 MRFSTS- Add special check for signal JFN
; UPD ID= 2625, SNARK:<6.MONITOR>FORK.MAC.81, 22-Jun-83 14:04:14 by HALL
;TCO 6.1689 - Move fork tables to extended section
; Reference fork tables via DEFSTRs
; UPD ID= 2455, SNARK:<6.MONITOR>FORK.MAC.80, 11-May-83 08:42:58 by MCINTEE
;Move calls to release DECnet resources (6.1) in KSELF to after the CLZFF
; UPD ID= 2375, SNARK:<6.MONITOR>FORK.MAC.79, 29-Apr-83 14:24:00 by MURPHY
;TCO 6.1635 - Use MONENV instead of MONFLG to init flag word.
; UPD ID= 2280, SNARK:<6.MONITOR>FORK.MAC.78, 16-Apr-83 19:12:41 by PAETZOLD
;TCO 6.1557 - TCP Merge - Delete old edit history - Update copyright.
; UPD ID= 2247, SNARK:<6.MONITOR>FORK.MAC.77, 12-Apr-83 13:16:55 by MCINTEE
;Remove IFNDEF FTNSPSRV
; UPD ID= 2220, SNARK:<6.MONITOR>FORK.MAC.76, 8-Apr-83 13:55:02 by TSANG
;TCO 6.1580 - Use JRST MRETN instead of JSP T2,ITRAP1
; UPD ID= 2097, SNARK:<6.MONITOR>FORK.MAC.75, 28-Mar-83 17:37:36 by MURPHY
;Minor cleanup.
; UPD ID= 2052, SNARK:<6.MONITOR>FORK.MAC.74, 21-Mar-83 18:03:26 by MURPHY
;GET RID OF OBSOLETE SEARCH PROKL
; UPD ID= 1874, SNARK:<6.MONITOR>FORK.MAC.73, 23-Feb-83 21:45:30 by MURPHY
;TCO 6.1514 - Use ITERX instead of JSP T2,ITRAP.
; UPD ID= 1869, SNARK:<6.MONITOR>FORK.MAC.72, 23-Feb-83 14:25:36 by HALL
;TCO 6.1511 - Make RESET JSYS undo SWTRP (Add CLRTRP)
; UPD ID= 1797, SNARK:<6.MONITOR>FORK.MAC.71, 14-Feb-83 14:35:03 by MCINTEE
;Still more TCO 6.1484 - remove conditional from CALL EVRKIL
; UPD ID= 1753, SNARK:<6.MONITOR>FORK.MAC.70, 3-Feb-83 13:15:03 by MCINTEE
;More TCO 6.1484 - Put CALL EVRKIL under IFN FTNSPSRV
; UPD ID= 1750, SNARK:<6.MONITOR>FORK.MAC.69, 3-Feb-83 10:32:49 by GRANT
; Previous edit should say KSELF, not .RESET
; UPD ID= 1748, SNARK:<6.MONITOR>FORK.MAC.68, 3-Feb-83 10:22:05 by GRANT
;TCO 6.1484 - In .RESET, check for DECnet event reader fork
; UPD ID= 1722, SNARK:<6.MONITOR>FORK.MAC.67, 28-Jan-83 16:01:57 by MURPHY
;More 6.1475 - Use macro for setting PCS so all CPU types work.
; UPD ID= 1696, SNARK:<6.MONITOR>FORK.MAC.66, 26-Jan-83 07:34:12 by MCINTEE
;Remove conditional from CALL NTCOFF (6.1 now has net top change int)
; UPD ID= 1689, SNARK:<6.MONITOR>FORK.MAC.65, 20-Jan-83 18:32:42 by MURPHY
;TCO 6.1475 - Fix starting PA1050 in non-0 section.
; UPD ID= 1624, SNARK:<6.MONITOR>FORK.MAC.64, 6-Jan-83 16:16:30 by CHALL
;Move call to .NSPRS to KSELF from .RESET
; UPD ID= 1568, SNARK:<6.MONITOR>FORK.MAC.63, 22-Dec-82 19:12:09 by NICHOLS
;Add DECnet-36 code under IFE FTNSPSRV
; UPD ID= 1548, SNARK:<6.MONITOR>FORK.MAC.62, 21-Dec-82 08:08:16 by MOSER
;TCO 6.1409 - REINSTALL FLKINT DON'T DISMS WHEN UNLOCKING FORK LOCK
; UPD ID= 1501, SNARK:<6.MONITOR>FORK.MAC.61, 1-Dec-82 12:15:50 by MOSER
;TCO 6.1208 - CHECK MINOR STATE IN TRMTST
; UPD ID= 1493, SNARK:<6.MONITOR>FORK.MAC.60, 30-Nov-82 15:57:41 by MOSER
;TCO 6.1133 - PREVENT HUNG JOBS WHEN JSYS TRAPPING
; UPD ID= 1468, SNARK:<6.MONITOR>FORK.MAC.59, 19-Nov-82 14:24:48 by MOSER
;MORE TCO 6.1376
; UPD ID= 1464, SNARK:<6.MONITOR>FORK.MAC.58, 18-Nov-82 13:52:17 by MOSER
;TCO 6.1376 - PREVENT FLKTIM-FLKNS
; UPD ID= 1036, SNARK:<6.MONITOR>FORK.MAC.57, 4-Aug-82 14:04:05 by WALLACE
;TCO 6.1104 - Place initialization of CTSSBK and call to CLRCTS
; under FTDYN instead of FTCTS since Known Library List is in CTS
; State Block
; UPD ID= 954, SNARK:<6.MONITOR>FORK.MAC.55, 22-Jun-82 15:34:18 by MURPHY
;TCO 5.1.1036 - Prevent confusion in GCVEC% when getting -1 PATADR.
; UPD ID= 929, SNARK:<6.MONITOR>FORK.MAC.54, 14-Jun-82 09:58:48 by HALL
;TCO 6.1156 - Don't clear ADRBRK when killing fork
; UPD ID= 891, SNARK:<6.MONITOR>FORK.MAC.53, 9-Jun-82 22:55:51 by MURPHY
;TCO 6.1147 - Move bugdefs from BUGS.MAC to here and put them in-line.
; UPD ID= 873, SNARK:<6.MONITOR>FORK.MAC.52, 8-Jun-82 09:44:14 by MILLER
;TCO 6.1157. Fix GJCAPS to inhibit "temporary capabilities".
; UPD ID= 872, SNARK:<6.MONITOR>FORK.MAC.51, 8-Jun-82 09:00:19 by MCINTEE
;Typo in previous edit
; UPD ID= 865, SNARK:<6.MONITOR>FORK.MAC.50, 7-Jun-82 10:52:25 by HALL
;TCO 6.1156 - Allow exec mode address break
; Decrement user mode break count at KSELF
; UPD ID= 789, SNARK:<6.MONITOR>FORK.MAC.49, 26-May-82 19:11:23 by WALLACE
;TCO 6.1105 - Add Canonical Terminal Support
; Call to CLRCTS (Clear CTS State Information) when fork is killed
; Initialize the CTS State Block (CTSSBK) to zero at fork creation
; UPD ID= 729, SNARK:<6.MONITOR>FORK.MAC.48, 11-May-82 10:47:51 by HALL
;TCO 6.1000 - Support the 2080
; SFRKV - Set monitor's AC blocks when starting fork at SFRKV1
; Set user AC blocks when forcing user mode flags (SFRKV,SFORK0)
; UPD ID= 711, SNARK:<6.MONITOR>FORK.MAC.47, 9-May-82 14:17:35 by HALL
;TCO 6.1000 - Support the 2080
; Make GETDAT and GETDMS set up data correctly for the KC
; UPD ID= 706, SNARK:<6.MONITOR>FORK.MAC.46, 9-May-82 13:01:09 by HALL
;TCO 6.1000 - Support the 2080
; Change contents of new flags word for user mode to include CAB
; (CFORK, KSELF)
; Change contents of new flags word for monitor mode to include CAB
; and PAB (KFORK, MSFRK)
; Make extended RFSTS return only the flags bits that users should see
; Make SFORK1 store full word of flags
; UPD ID= 636, SNARK:<6.MONITOR>FORK.MAC.45, 13-Apr-82 15:24:42 by MURPHY
;TCO 6.1091 - Fix SCVEC% -1.
; UPD ID= 525, SNARK:<6.MONITOR>FORK.MAC.44, 18-Mar-82 03:21:24 by PAETZOLD
;TCO 5.1761 - Fix LOKK macro in SCTSET
; UPD ID= 498, SNARK:<6.MONITOR>FORK.MAC.43, 15-Mar-82 14:41:31 by MILLER
;TCO 6.1066. ADD CALL TO INTCLR
; UPD ID= 468, SNARK:<6.MONITOR>FORK.MAC.42, 11-Mar-82 21:46:50 by PAETZOLD
;TCO 5.1751 - Zero PATLEV when zeroing PATADR in SEVC
; UPD ID= 452, SNARK:<6.MONITOR>FORK.MAC.41, 11-Mar-82 07:02:28 by HALL
;TCO 6.1000 - Support the 2080
; Add search of PROKL temporarily.. XGTPW JSYS expects to know bits
; in the page fail word.
; UPD ID= 429, SNARK:<6.MONITOR>FORK.MAC.40, 1-Mar-82 09:45:29 by MURPHY
;More 5.1697 - try for XRMS.EXE and XPAT.EXE
; UPD ID= 359, SNARK:<6.MONITOR>FORK.MAC.39, 29-Jan-82 11:39:29 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= 352, SNARK:<6.MONITOR>FORK.MAC.38, 26-Jan-82 18:42:29 by MURPHY
;DITTO
; UPD ID= 345, SNARK:<6.MONITOR>FORK.MAC.37, 24-Jan-82 23:49:24 by MURPHY
;TCO 5.1697 - XSSEV%, etc. Move GETPAT and GETDMS from MEXEC.MAC to here.
; UPD ID= 321, SNARK:<6.MONITOR>FORK.MAC.36, 19-Jan-82 08:05:37 by MILLER
;MORE OF THE SAME
; UPD ID= 319, SNARK:<6.MONITOR>FORK.MAC.34, 18-Jan-82 19:00:20 by MILLER
;TCO 5.1678 again. Release TTY if top fork and FRKTTY is set
; UPD ID= 318, SNARK:<6.MONITOR>FORK.MAC.33, 18-Jan-82 17:49:02 by MILLER
; UPD ID= 315, SNARK:<6.MONITOR>FORK.MAC.32, 18-Jan-82 14:49:22 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= 288, SNARK:<6.MONITOR>FORK.MAC.31, 9-Jan-82 19:39:07 by PAETZOLD
;TCO 5.1662 - Unlock FKLOCK during error processing for MSETPT in CFK4
; UPD ID= 205, SNARK:<6.MONITOR>FORK.MAC.30, 11-Nov-81 18:06:46 by HALL
;Fix typo in previous edit
; UPD ID= 203, SNARK:<6.MONITOR>FORK.MAC.29, 11-Nov-81 16:37:11 by HALL
;TCO 6.1037 - ADD PDL OVERFLOW TO SWTRP JSYS
;TCO 6.1000 - ADD SW%NMI TO SWTRP JSYS (NEEDED FOR 2080)
; UPD ID= 189, SNARK:<6.MONITOR>FORK.MAC.28, 6-Nov-81 12:32:11 by MURPHY
;TCO 5.1608 - extended address for MSFRK.
; UPD ID= 138, SNARK:<6.MONITOR>FORK.MAC.27, 19-Oct-81 15:54:40 by COBB
;TCO 6.1029 - CHANGE SE1CAL TO EA.ENT
; UPD ID= 113, SNARK:<6.MONITOR>FORK.MAC.26, 16-Oct-81 17:13:29 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= 112, SNARK:<6.MONITOR>FORK.MAC.25, 16-Oct-81 12:23:57 by MURPHY
;Ignore FH%EPN bit in fork handles.
; 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
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
;OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1976, 1985.
;ALL RIGHTS RESERVED.
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 T2,PATADR(1)
JUMPL T2,GCV1 ;NEGATIVE - JUST RETURN IT
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)
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: SETPCS T2 ;SET PCS TO SECTION OF ENTRY VECTOR
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: SETPCS T2 ;SET PCS TO SECTION OF ENTRY VECTOR
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::
IFN KLFLG,<
MOVE P1,FFL ;GET FLAGS WORD WITH OP CODE AND AC AND PCS
>
IFN KCFLG,<
MOVE P1,FFL ;GET FLAGS WORD WITH CAB AND PAB AND PCS
HRR P1,KIMOAC ;GET OP CODE AND AC TO LOOK LIKE KL
> ;END OF IFN KCFLG
MOVE P2,FPC ;GET PC WORD
MOVE P3,KIMUEF ;GET EFFECTIVE ADDRESS WORD
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 T1,PATADR ;FORCED INCOMPATABLILITY?
ITERR(ILINS4) ;YES - GIVE ERROR.
MOVE T1,PATADR ;Get the possible entry vector
HRROI T2,[ASCIZ /SYS:PA1050.EXE/]
HRROI T3,[ASCIZ /SYS:EPAT.EXE/] ;EXTENDED VERSION
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::
IFN KLFLG,<
MOVE P1,FFL ;GET FLAGS WORD WITH OP CODE AND AC AND PCS
>
IFN KCFLG,<
MOVE P1,FFL ;GET FLAGS WORD WITH CAB AND PAB AND PCS
HRR P1,KIMOAC ;GET OP CODE AND AC TO LOOK LIKE KL
> ;END OF IFN KCFLG
MOVE P2,FPC ;GET PC WORD
MOVE P3,KIMUEF ;GET EFFECTIVE ADDRESSS WORD
MCENTR ;ENTER MONITOR CONTEXT
MOVE T1,DMSADR ;Get address of entry vector
HRROI T2,[ASCIZ/SYS:RMS.EXE/]
SETZM T3 ;MAKE SURE WE DON'T TRY AN EXTENDED FLAVOR
; HRROI T3,[ASCIZ /SYS:XRMS.EXE/] ;EXTENDED ADR VERSION
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
; T3/ String pointer to file name of possible extended version
; CALL GETSEG
;
; Returns:
; +1: No such file (GTJFN failed)
; +2: Success, entry vector from file in T1
;
; Clobbers T1, T2
;
GETSEG: ASUBR <GETSG1,GETSG2,GETSG3,GETSG4>
SAVEAC <Q1,Q2>
MOVE Q1,EVLNTH ;Save old entry vector
MOVE Q2,EVADDR
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
MOVEM T1,GETSG4 ;SAVE FLAGS FOR RETRY
MOVE T2,GETSG3 ;TRY EXTENDED VERSION FIRST
GTJFN
IFSKP.
MOVEM T1,GETSG4 ;HAVE EXTENDED VERSION, SAVE JFN
SKIPG T2,GETSG1 ;Get the address of the entry vector
IFSKP.
HLRZ T1,(T2) ;Get the section number from previous vector
TRZ T1,770000 ; ...so we reuse section,,Zap extraneous flags
ELSE.
MOVEI T1,.FHSLF ;This fork
CALL FFUSEC ;FIND FREE USER SECTION
RET ;ALL FULL
ENDIF.
BLCAL. DGET,<GETSG4,[GT%BAS],0,0,T1> ;GET INTO SPECIFIED SECTION
RET
ELSE.
MOVE T1,GETSG4 ;RECOVER FLAGS
MOVE T2,GETSG2 ;NON-EXT FILE NAME
GTJFN ;Get a JFN on file
RET ;Error-- return +1 from GETSEG
HRLI T1,.FHSLF ;Get into this process
GET ;Get it
ERJMP R ;FAIL
ENDIF.
DMOVE T1,Q1 ;GET OLD ENTRY VECTOR
EXCH T1,EVLNTH ;Put old entry vector back, get one from file in T1
EXCH T2,EVADDR
RETSKP ;Return +2 from GETSEG
ENDAS.
;DO EXTENDED GET - CALLED FROM ABOVE AS CONVENIENT WAY TO BUILD
;ARG BLOCK FOR GET
DGET: BLSUB. <DGJFN,DGFLG,DGAB1,DGAB2,DGAB3>
MOVE T1,DGJFN
HRLI T1,.FHSLF
TXO T1,GT%ARG ;SAY ARG BLOCK PTR IN T2
XMOVEI T2,DGFLG ;AND PUT IT THERE
GET ;GET INTO SECTION SPECIFIED BY DGAB3
ERJMP R
RETSKP
ENDBS.
;FIND FREE USER SECTION
; T1/ FORK HANDLE
; CALL FFUSEC
; RETURN +1: FAILED, no free sections or unexpected failures of RSMAP%, SMAP%
; +2: SUCCESS, T1/ section number
FFUSEC: ASUBR <FFUA1,FFUA2>
MOVEI T1,2 ;START WITH SECTION 2
MOVEM T1,FFUA2
DO.
HRL T1,FFUA1 ;SPECIFIED FORK
RSMAP% ;FIND OUT ABOUT SECTION
CAME T1,[-1] ;EMPTY?
IFSKP.
SETZ T1, ;YES, CREATE PRIVATE SECTION
MOVE T2,FFUA2
HRL T2,FFUA1
MOVX T3,SM%RD!SM%WR!SM%EX+1
SMAP%
ERJMP R
MOVE T1,FFUA2 ;RETURN SECTION CREATED
RETSKP
ENDIF.
AOS T1,FFUA2 ;SECTION NOT FREE, STEP TO NEXT
CAIG T1,(VSECNO) ;BEYOND END?
LOOP. ;NO, CHECK THIS ONE
RET ;YES, RETURN FAILURE
ENDDO.
ENDAS.
;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 CKPRWV ;CHECK WORD FOR LEGALITY
ITERR (ARGX22) ;INVALID BITS
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 CKPRWV ;CHECK WORD FOR LEGALITY
ITERR (ARGX22) ;INVALID BITS
CALL FLOCK ;GET FORK LOCK IN CASE THIS JOB
CALL GL2LCL ;CONVERT GLOBAL JOB NUMBER TO LOCAL
JRST SJPRI1 ;ILLEGAL JOB NUMBER
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
;CKPRWV - CHECK PRIORITY WORD IN USERS AC2 FOR .SJPRI AND .SPRIW JSYSES
;
;RETURN +1: ILLEGAL VALUES
; +2: VALUES ARE LEGAL
CKPRWV: SAVEAC <T1> ;PRESERVE T1 FOR CALLERS
UMOVE T2,2 ;GET PRIORITY WORD
LOAD T1,JP%MXQ,T2 ;GET MIN Q
LOAD T2,JP%MNQ,T2 ;AND MAX Q
CAIG T2,LOWQ ;MIN > MAX?
CAILE T1,LOWQ+1 ;MAX > MAX+1?
RET ;ERROR
RETSKP ;ALL IS OK
;GET AND SET PRIMARY IO JFN'S
.GPJFN::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK
MOVE 2,PRIMRY(1)
UMOVEM 2,2
JRST CLFRET
.SPJFN::MCENT
XCTU [SKIPN 2] ;PROVIDING A VALID VALUE?
ITERR (DESX3) ;NO. DISALLOW IT THEN
CALL FLOCK ;LOCK THE FORK STRUCTURE
MOVX T2,<CALL SPJFN1> ;ROUTINE TO EXECUTE
CALL MAPFKH
NOP ;WON'T BLOCK
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
JRST MRETN
SPJFN1: CALL SKIIF
JRST FRKE2
CALL SETLF1
UMOVE 2,2
MOVEM 2,PRIMRY(1)
JRST CLRLFK
;GET TRAP WORDS FROM FORK
.GTRPW::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFK ;MAP PSB
MOVE 2,UTRSW(1) ;TRAP STATUS WORD
TXNN T2,TWUSR ;SETUP BITS IN OLD FORMAT
TXO T2,TSW%MN ;MONITOR MODE REFERENCE
TXNE T2,TWWRT
TXO T2,TSW%WT ;WRITE REF
TXO T2,TSW%RD ;READ ALWAYS
UMOVEM 2,1 ;RETURNED IN 1
HRL 2,UMUUOW(1) ;MUUO WORD
HRR 2,UMUUOW+1(1)
UMOVEM 2,2 ;RETURNED IN 2
JRST CLFRET
;XGTPW
; 1/fork handle,,0
; 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
LOAD T2,FKJO%,(T1) ;GET JOB NUMBER
STOR T2,FKJBN ; AND SET IT FOR NEW FORK
LOAD T2,FKJS%,(T1) ;GET SPT INDEX FOR JSB
STOR T2,FKJSB ; AND SET IT FOR NEW FORK
IFN EXTJSB,<
LOAD T2,FKJP%,(T1) ;Get SPT index for extended JSB
STOR T2,FKJPT ; And set it 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,PRIMRY
MOVEM 2,PRIMRY(1)
MOVE 2,JOBBIT
MOVEM 2,JOBBIT(1) ;PASS PRIORITY
SETZM CAPMSK(1)
SETZM CAPENB(1)
FTDYN < SETZM CTSSBK(T1) ;Initially No CTS State Block
> ;End of Conditional Assembly
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
JE FKIIF,(FX),CFK5 ;IF NO INTERRUPT PENDING, ASSUME INIT SUCCEEDED
MOVE 2,BITS+.ICMSE ;GOT INT. SEE IF FATAL
OPSTR <TDNN T2,>,FKIBX,(FX) ;WAS IT?
JRST CFK5 ;NO. LET IT GO ON
;Here on fatal error
CFFAT: CALL CLRLFK ;YES. CLEAR MAPPING
POP P,1 ;GET LOCAL INDEX
CALL SETJFK ;GET JOB-WIDE FORK HANDLE
IFE NICSW,<
CALL KFORK1 ;ZAP THE FORK
>;IFE NICSW
IFN NICSW,<
move p2,p
adjsp p,1
CALL KFORK1 ;ZAP THE FORK
adjsp p,-1
>;IFN NICSW
CALL FUNLK ;RELEASE FORK LOCK
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)
MOVX T3,USRCTX ;FLAGS WORD FOR 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
LOAD T3,FKUP%,(T1)
HRLZ T1,T3 ;SOURCE IS THIS FORK
LOAD T3,FKUPT
HRLZ T2,T3 ;DESTINATION IS NEW FORK
MOVSI 3,(PTRW)
MOVEI 4,PGSIZ
CALL MSETPT ;DO FOR ALL PAGES
JRST [ ADJSP P,-3 ;FIX UP STACK POINTER
JRST CFFAT] ;HANDLE FATAL ERROR
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
LOAD T1,FKPS%,(T1) ;GET SPT INDEX FOR PSB OF THIS FORK
HRLS T1 ; INTO LEFT HALF
HRRI 1,1 ;THIS FORK, SOURCE SECTION 1
LOAD T2,FKPSB ;GET SPT INDEX FOR PSB OF NEW FORK
HRLS T2 ; INTO LEFT HALF
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
;Wait for fork to become blocked.
;Accepts:
; T1/ fork handle for fork we're waiting for
; CALL WAITFK
;Returns +1: always, after waiting for the event
WAITFK: HRRI 1,WTFKT
MDISMS
RET
;Scheduler test. Called with fork handle in T1. Returns 1(T4) if fork
;is blocked.
RESCD ;SCHEDULER TEST, MUST BE RESIDENT
WTFKT: JE FKBL%,(T1),0(T4) ;IF NOT BLOCKED, DON'T WAKE UP CALLER
JRST 1(4) ;FORK IS BLOCKED. WAKE UP CALLER
ASSJFK: MOVE 1,@FREJFK
EXCH 1,FREJFK
SUBI 1,FKPTRS
RET
SWAPCD
;SPLICE FORK STRUCTURE
; 1/ FORK HANDLE OF NEW SUPERIOR
; 2/ FORK HANDLE OF FORK TO BECOME INFERIOR
; RETURNS +2: SUCCESS, WITH 1/ FORK HANDLE OF 2 RELATIVE TO 1
DEFINE SPLERR (ERN,JMP)<
JRST [CALL RALLI ;RESUME ALL INFERIORS
ERRJMP (ERN,JMP)]>
.SPLFK:: MCENT
TRVAR <F1,F2,F3>
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL FALLI ;FREEZE ALL OF CALLER'S INFERIORS
UMOVE Q1,T1
TXNE Q1,SF%EXT ;IS THIS AN EXTENDED CALL?
JRST SPLFK4 ;YES, DO SPECIALLY..
XCTU [HRRZ T1,T1] ;GET RFH OF NEW SUPERIOR
CALL SETJFK ;GET JOB FORK HANDLE OF 1
MOVEM T1,F1
CALL SKIIF ;IS 1 INFERIOR OR EQ TO SELF?
SPLERR(SPLFX1,EFRKR) ;NO
XCTU [HRRZ T1,T2] ;GET 2
CALL SETJFK ;GET JOB HANDLE OF 2
MOVEM T1,F2
CAME T1,FORKN ;IS 2 STRICTLY INFERIOR TO SELF?
CALL SKIIF
SPLERR(SPLFX2,EFRKR) ;NO
MOVE T1,F1 ;GET 1
MOVE T2,F2 ;GET 2
CALL SKIIFA ;IS 1 ALREADY EQ OR INFERIOR TO 2?
JRST .+2 ;NO, OK
SPLERR(SPLFX3,EFRKR) ;YES, ERROR
MOVE T1,F1 ;GET F1
SKIPN T1,FKJTB(T1) ;DOES F1 HAVE A JTB?
TROA T1,7777 ;NO, THERE IS NO MONITOR
LOAD T1,JTIMP,(T1) ;YES, GET F1'S MONITOR
MOVE T2,F2 ;GET F2
SKIPN T2,FKJTB(T2) ;DOES F2 HAVE A JTB?
TROA T2,7777 ;NO, THERE IS NO MONITOR
LOAD T2,JTIMP,(T2) ;YES, GET F2'S MONITOR
CAIE T1,(T2) ;F1 AND F2 HAVE THE SAME MONITOR?
CAMN T2,F1 ;OR IS F1 THE IMMEDIATE MONITOR OF F2?
CAIA ;YES, OK.
CALL SPLFK3 ;NO. UPDATE TRAP ENVIRONMENTS
CALL SPLFK9 ;DO THE SPLICE
MOVE T1,F1 ;GET 1
CALL SETLF1 ;MAP PSB OF 1
MOVSI T1,0(T1) ;SETUP ARG FOR GRFKH
HRR T1,F2 ;PSB OFFSET ,, JOB HANDLE
CALL GRFKH ;GET RELATIVE HANDLE FOR 2 RELATIVE TO 1
SETZ T1,
UMOVEM T1,T1
CALL CLRLFK
HRRZ T1,F2 ;NEW INFERIOR
HRRZ FX,SYSFK(T1)
SETONE FKFR1,(FX) ;NEW INFERIORS ALWAYS BECOME FROZEN
CALL RALLI ;RESUME ALL INFERIORS
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
SMRETN
; UPDATE JSYS TRAP ENVIRONMENTS DUE TO SPLICING
; F2 HAS ITS OLD JSYS TRAP ENVIRONMENT REMOVED AND A NEW ONE ADDED.
; THE NEW ENVIRONMENT IS EITHER THE SAME AS F1'S OR IS THE ENVIRONMENT
; F1 INDIRECTLY SET FOR F2 (BY MONITORING ONE OF F2'S SUPERIORS)
SPLFK3: MOVE P1,F2 ;F2
MOVE P2,F1 ;F1
PUSH P,FKJTB(P2) ;SAVE F1'S JTB, IF ANY.
MOVE P4,T2 ;SAVE F2'S MONITOR
SKIPA P3,P1 ;START WITH IMD. MON. OF F2 AND
SPFK3A: MOVE P3,T1 ;FIND OUT IF F1 IS A MON. OF F2
SKIPN T1,FKJTB(P3) ;GET THE NEXT MONITOR UP THE CHAIN
JRST SPFK3B ;NO MORE IN CHAIN
LOAD T1,JTIMP,(T1) ;WHO IS THE MONITOR?
CAIE T1,(P2) ;IS IT F1?
JRST SPFK3A ;NO, KEEP LOOKING.
PUSH P,FKJTB(P1) ;SAVE F2'S CURRENT JTB
CALL NEWJTB ;GET A NEW BLOCK
POP P,FKJTB(P1) ;RESTORE OLD BLOCK, ADDR OF NEW IN T2
MOVEM T2,0(P) ;USE IT AS NEW ENVIRONMENT FOR F2
HRL T1,FKJTB(P3) ;COPY F1'S INFERIOR'S BLOCK
HRR T1,T2 ;TO NEW BLOCK FOR F2
BLT T1,JTBSIZ(T2) ;RETAINING ENV OF F2 SET BY F1
SPFK3B: HRRZ T1,P1 ;FIND SUPERIOR OF F2
ADD T1,SUPERP ;BUILD NEEDED POINTER
LDB T1,T1 ;GET FORK
CAIN P4,(T1) ;IS F2'S MONITOR SAME AS F2'S SUPERIOR?
CALL RELJTB ;YES. RELEASE JTB POINTER TO BY FK IN P1
POP P,FKJTB(P1) ;F2'S NEW JSYS TRAP ENVIRONMENT
CALLRET TFINF ;UPDATE F2'S INFERIORS (FORK IN P1)
;CONTINUE WITH SPLICE NOW THAT THE
;JSYS TRAP ENVIRONMENTS ARE THE SAME
; DO THE SPLICE.
; F1 IS THE NEW SUPERIOR AND F2 IS THE NEW INFERIOR
SPLFK9:
NOSKED ;NOSKED WHILE CHANGING POINTERS
MOVE T1,F2
ADD T1,SUPERP ;MAKE PTR TO SUPERIOR OF 2
LDB T1,T1 ;GET IT
ADD T1,INFERP ;MAKE PTR TO FIRST INFERIOR
SPLFK1: LDB T2,T1 ;SEARCH FOR 2
CAMN T2,F2
JRST SPLFK2 ;FOUND IT
MOVE T1,T2
ADD T1,PARALP
JRST SPLFK1 ;CONTINUE SEARCH
;REMOVE 2 FROM THE INFERIOR LIST OF ITS SUPERIOR
SPLFK2: ADD T2,PARALP
LDB T3,T2 ;GET SUCCESSOR
DPB T3,T1 ;PATCH AROUND 2
;NOW MAKE 2 BE THE FIRST INFERIOR OF 1
MOVE T1,F2
MOVE T2,F1
ADD T2,INFERP ;MAKE PTR TO INFERIOR LIST OF 1
LDB T3,T2 ;GET CURRENT FIRST INFERIOR OF 1
DPB T1,T2 ;MAKE 2 NEW FIRST INFERIOR OF 1
ADD T1,PARALP
DPB T3,T1 ;CONC REST OF INFERIOR LIST TO 2
;NOW UPDATE TO SHOW 1 IS SUPERIOR OF 2
MOVE T1,F2
ADD T1,SUPERP ;MAKE PTR TO SUPERIOR OF 2
MOVE T2,F1
DPB T2,T1 ;PUT 1 AS SUPERIOR OF 2
OKSKED
RET
SPLFK4: TXZ Q1,SF%EXT ;REMOVE FLAG FROM ARG BLOCK ADDRESS
XCTU [HRRZ P1,.SFLEN(Q1)] ;GET WORD COUNT FROM USER
CAIGE P1,2 ;LONG ENOUGH FOR FUNCTION CODE?
SPLERR(SPLBTS,EFRKR) ;NO, ERROR, BLOCK TOO SHORT
UMOVE T1,.SFCOD(Q1) ;GET FUNCTION CODE
CAIE T1,.SFUNS ;IS IT .SFUNS (ONLY ONE SO FAR)
SPLERR(SPLBFC,EFRKR) ;NO, ERROR, BAD FUNCTION CODE.
CAIGE P1,4 ;DOES WORD COUNT INCLUDE FLAGS?
SPLERR(SPLBTS,EFRKR) ;NO, ERROR, BLOCK TOO SHORT
UMOVE T1,.SFUFL(Q1) ;GET FLAGS
TXNN T1,SF%GO
IFSKP. ;IF SF%GO..
CAIGE P1,5 ;IS THERE ROOM FOR ENTRY VECTOR.
SPLERR(SPLBTS,EFRKR) ;NO, ERROR
ENDIF.
TXNN T1,SF%ADR ;IF SF%ADR
IFSKP. ;IS THERE ROOM FOR PC FLAGS AND ADDRESS
CAIGE P1,6 ;NO, ERROR
SPLERR(SPLBTS,EFRKR)
ENDIF.
; SET UP F1, F2, F3 AND CHECK FOR ERRORS
MOVE T1,FORKN
ADD T1,SUPERP
LDB T1,T1
MOVEM T1,F1 ;F1 IS OUR SUPERIOR
XCTU [HRRZ T1,.SFUIN(Q1)]
CALL SETJFK
MOVEM T1,F2 ;F2 IS THE NEW INFERIOR
CAME T1,FORKN
CALL SKIIF ;BE SURE F2 IS STRICTLY INFERIOR TO SELF
SPLERR(SPLFX2,EFRKR)
MOVEI T1,.FHSLF
CALL SETJFK
MOVEM T1,F3 ;F3 IS US
; DO THE XSFRK% OR SFRKV NOW WHILE WE HAVE A VALID HANDLE. NOTHING
; WILL HAPPEN YET ANYWAY BECAUSE F2 IS FROZEN. WE ALSO CATCH ANY
; ERRORS HERE.
CALL SPLFK5 ;SETUP AND CALL APPROPRIATE JSYS.
JRST [CALL RALLI ;RESUME INFERIORS
MOVE T1,LSTERR
JRST EFRKR] ;ERROR RETURN
MOVE T1,F1 ;KILL ANY JSYS TRAPS TO F1
MOVEI Q1,.TFRAL
CALL TFSR
NOSKED ;EXCHANGE FORKN NUMBERS BETWEEN F3 AND F2
MOVE T2,FORKN ;GET OUR FORKN NUMBER
MOVE T1,F2
CALL SETLF1 ;MAP NEW INFERIOR
EXCH T2,FORKN(T1) ;SWAP FORK NUMBERS
PUSH P,T2 ;DON'T LOSE T2
CALL CLRLFK ;UNMAP NEW INFERIOR
POP P,T2
MOVEM T2,FORKN ;COMPLETE SWAP OF FORKN NUMBERS
CALL SPSWAP ;SWAP INFO BETWEEN F3 AND F2
CALL SPLFK9 ;CHANGE FORK STRUCTURE BASED ON F1,F2
HRRZ T1,FORKN ;VIA OUR FORKN
ADD T1,SUPERP ;GET SUPERIOR FORKN
LDB T1,T1
HRRZ FX,SYSFK(T1) ;GET SYSTEM ID OF SUPERIOR.
SETONE FKSPL,(FX) ;SET INFERIOR HAS SPLICED EVENT.
MOVE T1,FORKN ;GET NEW VALUE OF FORKN FOR US.
MOVEM T1,FLKOWN ;FIX THE OWNER OF FLOCK WHILE WE STILL HAVE IT
DO. ;WAKE SUPERIOR IF IT IS IN TRMTST FOR US.
JE FKBL%,(FX),ENDLP. ;IF NOT BLOCKED, THERE IS NO SCHEDULER TEST
LOAD T1,FKWTL ;BLOCKED, SEE WHERE IT IS?
CAIE T1,TRMLST ;WAITING FOR TERMINATION?
IFSKP.
LOAD T1,FKSTD,(FX) ;YES, FOR WHICH FORK?
CAMN T1,FORKX ;WAITING FOR US?
CALL UNBLK1 ;YES, THEN UNBLOCK.
ENDIF.
ENDDO.
OKSKED
CALL RALLI ;RESUME INFERIORS
MOVE T1,F3 ;THIS IS OUR BROTHER WHO WAS INFERIOR
CALL RFORK3 ;ALSO RESUME OUR BROTHER WHO WAS INFERIOR
CALL RFORK1 ;THIS NEEDS TO BE DONE ALSO, FOR SOME REASON.
MOVE T1,FORKN ;GET JOB FORK NUMBER
CALL DASFKH ;DEASSIGN FORK HANDLES
CALL KFORK3 ;REMOVE FROM FORK STRUCTURE
CALL FUNLK ;UNLOCK, WE ARE NOW OUT OF FORK STRUCTURE.
; THE FOLLOWING IS WHAT IS NECESSARY TO DO THE EQUIVALENT OF KSELF FOR ONES
; OWN JOB. THE CODE JUST ABOVE DOES WHAT .KFORK WHAT HAVE DONE.
MOVE 7,FORKX
MOVX T1,FKPSI1 ;DEFERRED INTERRUPT STATE
STOR T1,FKINX,(FX) ;THIS MAKES US NON-INTERRUPTIBLE
JRST KSELF1 ;ENTER KSELF CODE IN THE RIGHT PLACE.
SMRETN
; setup and call appropriate JSYS based on flags.
SPLFK5: UMOVE T1,.SFUFL(Q1)
TXNN T1,SF%CON ;continue fork specified?
IFSKP. ;yes, do it.
MOVX T1,SF%CON ;LH T1/ continue flag for XSFRK%
XCTU [HRR T1,.SFUIN(Q1)] ;RH T1/ obtain inferior to continue
XSFRK%
ERJMP [RET] ;error return
RETSKP ;good return
ENDIF.
TXNN T1,SF%ADR ;start fork at address?
IFSKP. ;yes, do it.
UMOVE T1,.SFUIN(Q1) ;T1/ inferior handle
UMOVE T2,.SFUA1(Q1) ;T2/ PC flags,,0
UMOVE T3,.SFUA2(Q1) ;T3/ PC address
XSFRK%
ERJMP [RET] ;error return
RETSKP ;good return
ENDIF.
TXNN T1,SF%GO ;start fork at entry vector?
IFSKP. ;yes, do it.
UMOVE T1,.SFUIN(Q1) ;T1/ inferior handle
UMOVE T2,.SFUA1(Q1) ;T2/ entry vector address
SFRKV
ERJMP [RET] ;error return
RETSKP ;good return
ENDIF.
RETSKP ;if no flags, then leave as is, good return.
; swap information between forks.
SPSWAP:
MOVEI T4,SYSFK ;MAKE F3 BECOME F2 AND VICE VERSA
CALL SPEXCH
CALL FHEXCH ;swap back the fork handle counts.
MOVEI T4,CTTAB ;controlling terminal
CALL SPEXCH
MOVEI T4,FKJTB ;JSYS traps
CALL SPEXCH
MOVEI T4,FKPSIE ;PSI related
CALL SPEXCH
MOVEI T4,FKDPSI ;PSI related
CALL SPEXCH
RET
;
; EXCHANGES INFORMATION IN JOB TABLES.
; T4/ JOB TABLE NAME
; F3 AND F2 INDICATE TGHE ONES TO EXCHANGE
;
SPEXCH:
MOVE T1,T4
ADD T1,F3 ;PTR TO TABLE(F3)
MOVE T3,0(T1)
MOVE T2,T4
ADD T2,F2 ;PTR TO TABLE(F2)
EXCH T3,0(T2)
MOVEM T3,0(T1)
RET
;
; EXCHANGE FORK HANDLE COUNTS BETWEEN FORK F3 AND F2.
;
FHEXCH: MOVE T1,F2 ;JFH OF FORK F2
MOVE T2,F3 ;JFH OF FORK F3
LOAD T3,FKHCNT,(T1)
LOAD T4,FKHCNT,(T2)
STOR T3,FKHCNT,(T2)
STOR T4,FKHCNT,(T1) ;SWAP COMPLETE
RET
ENDTV.
;.KFORK - KILL FORKS
;
; DESTROYS Q2,FX,P1,P2
;
; REGISTER USAGE - P1 IS COUNT OF FORKS KILLED
; P2 IS POINTER TO LIST OF KILLED FORKS
.KFORK::MCENT
MOVEI T1,0(T1)
CAIN T1,-4 ;ALL INFERIORS?
JRST KFORK2 ;YES
CALL FLOCK ;1 FORK, LOCK THE FORK STRUCTURE
CALL SETJFK ;GET SYSTEM FORK INDEX
CAMN 1,FORKN ;SELF?
ERRJMP(KFRKX2,ITFRKR) ;YES, NOT PERMITTED
CALL SKIIF ;INFERIOR?
JRST FRKE2 ;NO, NOT PERMITTED
SETZ P1, ;ZERO COUNT OF FORKS KILLED
MOVE P2,P ;GET STORAGE POINTER
ADJSP P,1 ;STORAGE FOR 1 FORK
CALL KFORK1 ;KILL IT
CALL FUNLK ;UNLOCK FORK STRUCTURE
CALL KFKWAT ;WAIT FOR COMPLETION
ADJSP P,-1 ;REMOVE STORAGE
JRST MRETN ;AND DONE
KFORK2: CALL FLOCK ;LOCK FORK STRUCTURE
HRRZ T1,FORKN
CALL MAPINF ;FREEZE ALL TO INSURE INTERRUPTIBILITY
CALL FFORK1
CALL KALLI ;KILL ALL INFERIORS (RETURNS FLOCK UNLOCK)
JRST MRETN ;AND DONE
KFORK1: HRLM T1,0(P)
CALL FFORK1 ;FREEZE ALL TO INSURE INTERRUPTIBILITY
HLRZ T1,0(P)
XHLLI Q2,20 ;GET CURRENT SECTION
HLLM Q2,0(P)
KFORK0: CALL DASFKH ;DEASSIGN LOCAL FORK HANDLE
MOVE Q2,T1
HRRZ FX,SYSFK(Q2)
CAMN FX,FORKX ;THIS FORK?
ERRJMP(KFRKX2,ITFRKR) ;CAN'T KILL SELF
CALL KFORK3 ;remove fork from structure
CALL SETLF1 ;MAP PSB
CALL SUSFK ;SUSPEND FORK
MOVE T2,FORKX ;GET SYSTEM FORK INDEX FOR SELF
MOVEM T2,PAC+4(T1) ;LEAVE IT IN AC4 OF VICTIM
SETZM INTDF(T1) ;MAKE VICTIM NON-INTERRUPTABLE
MOVX T2,MONENV ;MONITOR CONTEXT FLAGS WORD
MOVEM T2,PFL(T1) ;SET IT FOR DESTINATION PROCESS
MOVE T2,[MSEC1,,KSELF]
MOVEM T2,PPC(T1) ;START IT SO AS TO KILL ITSELF
AOS P1 ;COUNT FORKS KILLED
AOS P2 ;ADVANCE STORAGE POINTER
MOVEM FX,(P2) ;SAVE FORK INDEX
SETONE FKKIL ;SAY FORK IS WAITING TO DIE
CALL UNBLK1 ;NOW ALLOW FORK TO RUN
OKSKED ;MATCH NOSKED IN SUSFK
CALL CLRLFK
SETZ T1,
MOVEI T2,FPG0A
MOVEI T3,FPG3+1-FPG0 ;CLEAR FORK TEMP PAGES
CALL MSETMP
RET
;KILL ALL INFERIORS OF THIS FORK - MUST BE CALLED FLOCK LOCKED
; UNLOCKS IT FOR RETURN
KALLI: SETZ P1, ;INIT COUNT OF FORKS KILLED
MOVE P2,P ;GET POINTER TO STORAGE
ADJSP P,NUFKS ;GET SOME ROOM
DO.
HRRZ T1,FORKN
ADD T1,INFERP
LDB T1,T1 ;GET NEXT INFERIOR
JUMPE T1,[CALL FUNLK ;NO MORE UNLOCK FORK STR
CALL KFKWAT ;AND WAIT
ADJSP P,-NUFKS ;CLEAR SPACE
RET] ;AND DONE
CALL KFORK0 ;KILL ALL INFERIORS TOO
JRST TOP.
ENDDO.
; remove fork from structure, called by KSELF and KSELFJ.
; T1/ job fork number, destroys T3,T4
KFORK3: MOVE T3,T1
ADD T3,SUPERP
LDB T3,T3 ;GET SUPERIOR
ADD T3,INFERP
KFK01: LDB T4,T3 ;GET NEXT PARALLEL
CAIN T4,0(T1) ;DESIRED FORK?
JRST KFK02 ;YES
MOVE T3,T4
ADD T3,PARALP
JRST KFK01
KFK02: ADD T4,PARALP ;FOUND FORK TO BE KILLED IN LIST
LDB T4,T4
DPB T4,T3 ;PUT NEXT IN LAST, REMOVING FORK FROM LIST
RET
;WAIT FOR FORKS TO DIE - CALLING FORK MUST NOT HAVE FLOCK
KFKWAT: SOJL P1,R ;ALL DONE RETURN
HRL T1,(P2) ;GET FORK INDEX
HRRI T1,KFKTST ;AND ROUTINE
MDISMS ;WAIT FOR FORK TO DIE
SOJA P2,KFKWAT ;DECREMENT STORAGE POINTER AND LOOP
RESCD
;SCHEDULER TEST FOR ABOVE
KFKTST: JE FKKL%,(T1),RSKP ;IF FLAG IS CLEAR DONE WAITING
RET ;KEEP WAITING
SWAPCD
;FORK KILL SELF
; 4/ FORK WHICH INITIATED KSELF
BP$021:! ;(KSELF): BREAKPOINT FOR KFORK
;ASSUMES FORKX HAS SUICIDAL FORK INDEX
KSELF::
MOVE FX,FORKX
MOVX T1,FKPSI1
STOR T1,FKINX,(FX) ;DISABLE ANY FURTHER INTERRUPTS
MOVX T1,USRCTX ;SET UMODF AND CAB FOR USER MODE
MOVEM T1,FFL
SETZM FPC
MCENTR ;GET INTO REASONABLE MONITOR STATE
KSELF1: CALL ABTBUF ;FLUSH TCP BUFFERS FOR THIS FORK
MOVEI T1,0(FX) ;GET FORK HANDLE
CALL SCSKIL ;DEALLOCATE ANY SCS% RESOURCES
PUSH P,T2 ;SAVE
SETZ T2, ;CLEAR ALL FORK'S ENTRIES ON STACK
CALL JSBSTF ;GO PROCESS DEALLOCATION LIST
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]
SKIPE T2,PDVS ;ANY PDVAS STORED?
CALL RELJFR ;YES, RELEASE THEM
SETZM PDVS ;SAY NO PDVAS STORED ANYMORE
OKINT ;DONE WITH FREE SPACE STUFF, SO ALLOW INTERRUPTS AGAIN
FTDYN < CALL CLRCTS ;Clear all CTS State Information
> ;End of Conditional Assembly
CALL INTCLR ;CLEAR PROCESSOR DEPENDENT STUFF
CALL EVRKIL ;CHECK FOR DECNET EVENT READER
CALL NTCOFF ;CLEAR THE NETWORK CHANGE INTERRUPT TABLE
JFCL ;IGNORE
CALL NIJKFK## ;Reset NI% JSYS stuff
MOVEI T1,0(FX) ;GET FORK HANDLE
SETZ T2,0 ;CLEAR ALL FORK'S ENTRIE
CALL GOKFRE
POP P,T2 ;RESTORE T2
CAMN FX,ACJFN ;CHECK FOR ACJ FORK
CALL ACJKIL ;KILL ACJ NOW
SETOM INTDF
MOVEM T4,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,(T1) ;DOES THIS JOB HAVE DIAG RESOURCES?
CALL DGFKIL ;YES. GO RELEASE THIS PROCESSES SET
CALL MTAKFK ;KILL MTA ONLINE/OFFLINE PSI INTERRUPTS
IFN STANSW,<
IFN PUPSW,<
CALL PUPKFK ;RELEASE PUP RESOURCES
>;IFN PUPSW
IFE NICSW,<
CALL PKOKFK ;RELEASE PKOPR% RESOURCES
>;IFE NICSW
>;IFN STANSW
HLRZ T1,DSPSFK ;GET DSK PSI FORK
CAIN FX,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.
UNLOKK DEVLKK ;RELEASE DEVICE LOCK
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
;Clean up the effect of setting address break. Decrement the count of users
;who have address break set. We cannot zero ADRBRK here, because address break
;is still turned on in the hardware. When the process goes to HLTFK1, it will
;go through KISSAV, which will turn off address break in the hardware. Note
;that this code must not be executed twice for this fork, because that would
;cause a second SOS of USERBK.
SKIPE ADRBRK ;HAVE ADDRESS BREAK SET NOW?
SOS USERBK ;YES. DECREMENT NUMBER OF USERS BREAKING
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
IFE FTNSPSRV,<
CALL RELSAB ;FREE DECNET SABs (Session Control Arg Blk)
;**; [7173] Change 1 line at KSEF0+21 HMP 23-Oct-85
CALL LLMRFK## ;[7173] Release any LLMOP resources
>
SOS FKCNT ;COUNT OF FORKS
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL KALLI ;KILL ALL FORKS AND UNLOCK FLOCK
CALL UNMIDX ;UNMAP THE DIRECTORY AND INDEX FILE
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
LOAD T1,FKUPT ;GET SPT INDEX FOR UPT
LOAD T2,SPTSHC,(T1) ;GET SHARE COUNT OF UPT
PUSH P,T2 ;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: CALL FUNLK
LOAD T1,NOSTR
SKIPE T1 ;IF NO STRUCTURES MOUNTED, SKIP STR CODE
CALL RELSTR ;RELEASE ALL STRUCTURE MOUNTS FOR FORK
SETZRO FKKIL ;FORK IS NOW EFECTIVLY DEAD - TURN OFF FLAG
;..
;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,T2 ;STILL SOME LEFT, FIX STACK
JRST KSEF3] ;GO WAIT FOR A WHILE
POP P,T2 ;SHARE COUNT OF UPT
CAIE T2,1 ;UNSHARED?
JRST KSEF3
CALL FLOCK
HRRZ T4,FORKN ;GET JOB FORK HANDLE FOR SELF
LOAD T1,FKHCNT,(T4) ;GET NUMBER HANDLES OF THIS FORK
JUMPN 1,[MOVSI T1,(1B0) ;NO. MARK IT DELETED THEN
IORM T1,SYSFK(4) ;""
JRST KSEF5] ;AND GO FINISH UP
MOVEI T1,FKPTRS(4) ;NO OTHERS, PUT JOB SLOT BACK ON FREE LIST
EXCH T1,FREJFK
MOVEM T1,@FREJFK
SETOM SYSFK(T4) ;NOTE SLOT AVAILABLE
KSEF5: CALL FUNLK
MOVE FX,FORKX
LOAD T2,FKPSB ;GET SPT INDEX FOR PSB
HRLS T2 ; INTO LEFT HALF
SETZ T1,
HRRI T2,PPLOW ;CLEAR PROCESS MAP FROM PPLOW
MOVEI T4,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
;Here when share count of section 0 map (UPT) is non-zero. Clear map
;again.
KSEF3: MOVEI T1,^D5000
DISMS ;WAIT FOR 5 SECS
LOAD T1,FKUPT ;GET SPT INDEX FOR UPT
LOAD T2,SPTSHC,(T1) ;SHARE COUNT OF UPT
PUSH P,T2
SETZ T1, ;INDICATE CLEARING
LOAD T2,FKUPT ;GET SPT INDEX OF UPT
HRLZS T2 ;UPT,,PAGE 0
KSEF4: HRRZ T3,T2 ;MAKE A GOOD ADDRESS.
SKIPE UPTPGA(T3) ;QUICK CHECK FOR ALREADY EMPTY
CALL SETPT ;BUT NOT USING PMAP
MOVEI Q2,0(T3)
CAIGE Q2,777
AOJA T2,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 FX,SYSFK(1) ;GET SYSTEM WIDE FORK INDEX
;**;[7254] Add 1 line at FFORK1:+1L MDR 9-MAR-86
CAIE FX,-1 ;[7254] Fork exist?
OPSTR <TDNE 2,>,FKINX,(FX) ;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
OPSTR <IORM 2,>,FKINX,(FX)
MOVEI 2,FRZWT
STOR 2,FKSTR,(FX) ;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)
OPSTR <TDNN 2,>,FKINX,(FX) ;FROZEN THIS WAY?
RET ;NO
OPSTRM <ANDCAB 2,>,FKINX,(FX) ;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
JN FKFRJ,(FX),R ;RETURN IF FROZEN BY JSYS TRAP
SETZRO FKFRA,(FX) ;CLEAR ADDRESS BREAK FREEZE
CALL STPFK1 ;SET TO UNFREEZE THIS FORK
SKIPN 2,PIOLDS(1) ;WAS ON WTLST BEFORE FREEZE?
JRST [ CALL UNBLK1 ;UNBLOCK IT
JRST RFORK4]
STOR 2,FKSTX,(FX)
CALL RECONC ;UPDATE WAIT LISTS
RFORK4: CALL CLRSFK ;UNSUSPEND FORK
OKSKED ;MATCH NOSKED IN STPFK1 (SUSFK)
JRST CLRLFK
;(INDIRECTLY) RESUME ALL INFERIORS
RALLI: MOVE T1,FORKN
CALL MAPINF
CALL RFORK3 ;XCTED BY MAPINF
RET
;BREAKPOINT JSYS FOR IDDT
.BPT:: MCENT
JRST HALTF1 ;MAKE LIKE HALTF
;PERPETUAL WAIT - INTERRUPTABLE
.WAIT:: MCENT
WAIT1:: MOVEI 1,JRET
MOVSI T2,FHV2 ;LOWER BLOCK PRIORITY
HDISMS
JRST MRETN
;SPECIAL ROUTINES CALLED FROM HANG-UP CODE TO INDIRECTLY FRREZE OR
;UNFREEZE ALL INFERIORS. THIS TECHNIQUE IS USED (RATHER THAN FFORK
;AND RFORK) IN ORDER TO PRESERVE THE FROZENNESS OF FORKS ACROSS
;A HANGUP ATTATCH SEQUENCE.
;FORK FREEZE INDIRECT:
FFORKI::CALL FLOCK ;LOCK UP THE JOB FORK STRUCTURE
HRRZ T1,FORKN ;GET RELATIVE HANDLE FOR THIS PROCESS
CALL MAPINF ;MAP ALL INFERIORS
CALL FFORK3 ;INDIRECTLY FREEZE THEM ALL
FORKI: CALL UPDTI ;UPDATE TTY PI WORDS
CALL FUNLK ;UNLOCK FORK STRUCTURE
RET ;AND DONE
;RESUME FREEZE INDIRECT
RFORKI::CALL FLOCK ;LOCK UP FORK STRUCTURE
HRRZ T1,FORKN ;GET JOB WIDE INDEX
CALL MAPINF ;MAP ALL INFERIORS
CALL RFORK3 ;INDIRECT RESUME OF ALL INFERIORS
JRST FORKI ;AND DONE
;READ FORK STATUS
.RFSTS::MCENT
TXNE T1,^-<RF%LNG!RF%PRH> ;ANY RESERVED BITS NON-0?
ITERR (DECRSV)
CALL FLOCK ;LOCK THE FORK STRUCTURE
MOVE P1,[-1] ;ASSUME FORK HANDLE IS UNASSIGNED, STATUS=-1
HRRZ T1,T1 ;USE ONLY 18 BITS
TRNE T1,200000 ;LOCAL DESIGNATOR?
JRST RFSTS5 ;NO
CAIN T1,400000 ;SELF?
JRST RFSTS5 ;YES - DONT TRANSLATE HANDLE
CALL RFHJFK ;CONVERT SINGLE FORK RFH TO JRFN
JRST ITFRKR ;ERROR - ERR CODE IN T1
CAIGE T1,NUFKS ;ASSIGNED?
SKIPG SYSFK(T1)
JRST RFSTS7 ;NO-- RETURN -1
JRST RFSTS6 ;YES
RFSTS5: CALL SETJFK ;NOT MULTIPLE FORKS
RFSTS6: HRRZ FX,SYSFK(T1) ;GET SYSTEM FORK INDEX
MOVE P1,T1 ;SAVE JOB INDEX
CALL MRFSTS ;GET FORK STATUS WORD
EXCH P1,T1 ;SAVE STATUS. GET BACK JOB INDEX
CALL SETLF1 ;MAP PSB
RFSTS7: UMOVE T2,1 ;GET USER AC1
TXNE T2,RF%LNG ;LONG FORM RFSTS?
JRST RFSLNG ;YES-- DO LONG FORM
CAMN P1,[EXP -1] ;UNASSIGNED FORK HANDLE?
JRST RFSTSR ;YES-- JUST RETURN STATUS
HLLZ T3,PFL(T1) ;GET FLAGS
MOVE T2,PPC(T1) ;GET PC
TXNN T3,UMODF ;USER MODE?
JRST [ HLLZ T3,UPDL+1(T1) ;NO, USER FLAGS 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
;**;[7146]Add 1 line at RFSLNG:+8L 10-SEP-85 TAB
MOVE P2,Q1 ;[7146]ACTUAL ADDRESS TO USER TABLE.
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!
;**;[7146]Add 1 line at RFSLNG:+12L 10-SEP-85 TAB
ADDI P2,1 ;[7146]SKIP ALSO FOR ADDRESS TO USER TABLE.
RFSLN1:
CALL @RFSLTB-.RFPSW(Q2) ;GET A WORD FOR TABLE INTO T2
;**;[7146]Change 1 line at RFSLN1:+2L 10-SEP-85 TAB
UMOVEM T2,0(P2) ;[7146]STORE THE WORD
ADDI Q2,1 ;BUMP TO NEXT ENTRY
;**;[7146]Add 1 line at RFSLN1:+4L 10-SEP-85 TAB
ADDI P2,1 ;[7146]BUMP ADDRESS FOR USER TABLE
AOBJN Q1,RFSLN1 ;LOOP FOR ALL ITEMS TO BE RETURNED
RFSLN2:
CAME P1,[-1] ;WAS A PSB MAPPED?
CALL CLRLFK ;YES SO 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
;NOTE: This routine returns only those flags that should be visible
;to the user. Although the microcode has stored AC blocks and PCS, if
;the process did an SFM it would not see them. Thus the JSYS does not
;return them.
RFSLFL: MOVE 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]
ANDX T2,EXFLBT ;RETURN ONLY THE FLAGS
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
JE FKBLK,,MRFSTX ;IF NOT WAITING, RETURN ZERO
LOAD T2,FKSTR,(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
LOAD T2,FKINX,(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
LOAD T2,FKSTD,(FX) ;AND GET OLD STATUS
CAIN T2,-1 ;FROZEN BY A SIGNAL JFN?
JRST RFSTS1 ;YES - SAY THE JOB WANTS THE TTY
JUMPE T2,MRFSTX
JRST RFST5
RFSTS1: TLOA T1,.RFSIG ;NOTE FROZEN BY A SIGNAL JFN
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,[MONENV ;SET NEW FLAGS TO 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
SETPCS T1 ;SET PCS TO SECTION NUMBER OF ENTRY VECTOR
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,USRCTX ;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
TXO T2,USRCTX ;SET USER MODE FLAGS AND AC BLOCKS
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)
MOVEM 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: SETZRO FKSTD,(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
JN FKFRZ,(FX),SFORK3 ;IF FROZEN, DON'T START FORK
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)
OKSKED ;MATCH NOSKED IN STPFK (SUSFK)
LOAD T1,FRKTTY,(T2) ;GET CONTROLLING TERMINAL
CALL UPDTI
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,MONENV ;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
TMNN 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
IFQN. FKFRZ,(FX) ;FROZEN?
STOR T2,FKSTD,(FX) ;YES. UPDATE PRE-FREEZE STATE
MOVEM T2,PIOLDS(1)
ELSE.
STOR T2,FKSTX,(FX) ;TERMINATED STATE
CALL CLRSFK ; BUT INTERRUPTIBLE
ENDIF.
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
LOAD 2,FKSTR,(T1) ;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
;TRMTST IS USED TO TEST THE STATE OF THE FORK BASED ON ITS SYSTEM-WIDE
;FORK-ID. **NOTE WELL** THAT ANY SCHEDULER TEST OF THIS KIND MUST USE
;THE SUPERIOR'S FKSPL AND BE PREPARED TO RE-EVALUATE THE JOB-WIDE HANDLE IN
;CASE A SPLICE OCCURS. A SPLICE CAUSES THE FORK TO BECOME ANOTHER. DO NOT
;FORGET TO TEST FKSPL IN THE SCHEDULER TEST AS WELL.
.WFORK::MCENT
CAIN 1,-4 ;ALL INFERIORS?
JRST WFORKA ;YES
CALL FLOCK ;LOCK THE FORK STRUCTURE
MOVE T2,FORKX
SETZRO FKSPL,(T2) ;RESET INFERIOR SPLICED EVENT.
CALL SETJFK ;ONE FORK, GET ITS JOB HANDLE
HRLZ 1,SYSFK(1) ;SETUP TEST ON FORK INDEX
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
HRRI 1,TRMTST
MOVSI T2,FHV1 ;LOW BLOCK PRIORITY
HDISMS
MOVE T1,FORKX
JE FKSPL,(T1),MRETN ;NOT DUE TO INFERIOR SPLICE, A GENUINE RETURN
UMOVE T1,T1
JRST .WFORK ;RE-EVALUATE FORK HANDLE AND DO AGAIN.
WFORKA::MOVSI D,-NLFKS+1 ;NUMBER TO DO
MOVE C,FKPTAB ;GET POINTER TO HANDLES
WFORK3: ILDB A,C ;GET NEXT HANDLE
CAIN A,-1 ;ASSIGNED?
JRST WFORK4 ;NO. LOOP TO NEXT THEN
MOVEI A,.FHSLF+1(D) ;GET NEXT HANDLE
RFSTS ;GET STATUS
CAMN A,[-1] ;IS IT DELETED?
JRST WFORK4 ;YES. GO DO NEXT THEN
LOAD A,RF%STS,A ;GET STATUS
CAIE A,.RFHLT ;HALTED?
CAIN A,.RFFPT ;NO. ERROR ABORT?
JRST MRETN ;YES. RETURN GOOD
WFORK4: AOBJN D,WFORK3 ;NO. LOOK AT ALL LOCALS
MOVEI A,TRMTS1 ;SETUP TEST TO WAIT UNTIL CHANGED
MOVSI T2,FHV1 ;LOW BLOCK PRIORITY
HDISMS
JRST MRETN
RESCD
TRMTST::
JN FKSPL,(FX),1(T4) ;GET OUT IF AN INFERIOR HAS SPLICED.
JE FKBL%,(T1),0(T4) ;DON'T WAKE UP IF FORK IS BLOCKED
LOAD 2,FKSTR,(1) ;GET SCHEDULER TEST
CAIE 2,HALTT ;WAITING BECAUSE TERMINATION?
CAIN 2,FORCTM ;OR FORCED TERM?
JRST 1(4) ;YES
CAIE T2,FRZWT ;FROZEN?
JRST 0(4) ;NO WAIT
LOAD 2,FKSTD,(1) ;GET PRE FREEZE STATE
CAIE 2,HALTT ;HALTED?
CAIN 2,FORCTM ;OR FORCED TERM?
JRST 1(4) ;YES
; JRST TRMTS1 ;WAIT LONGER
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.(HLT,FRKSLF,FORK,SOFT,<SUSFK - Given self as argument>,,<
Cause: Some routine in the monitor has erroneously tried to suspend
itself with SUSFK.
>)
SUSF6: NOSKED
JE FKBLK,,SUSF4 ;IS FORK BLOCKED NOW?
LOAD 2,FKSTR,(FX) ;YES. GET WAITING STATUS
CAIE 2,SUSWT ;ALREADY SUSPENDED OR FROZEN?
CAIN 2,FRZWT
RET
CAIN 2,TCITST ;WAS IN TTYIN WAIT?
JRST [ LOAD 2,FKSTD,(FX) ;YES, GET TERMINAL NUMBER
CALL TTCLFK ;INDICATE NO FORK WAITING
JRST .+1]
SUSF5: SETONE <FKPS0,FKSUS>,(FX) ;SUSPEND FORK REQUEST BIT FOR PSI
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
;Here if fork is not blocked now. Request interrupt and loop back to check
;status
SUSF4: JE FKINX,(FX),SUSF5 ;TRANSITIONAL STATE?
SETONE <FKPS0,FKSUS>,(FX) ;YES. REQUEST INTERRUPT FOR SUSPENSION
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::JE FKBL%,(T1),0(T4) ;DON'T WAKE UP IF FORK ISN'T BLOCKED
LOAD 2,FKSTR,(1) ;GET SCHEDULER TEST
CAIE 2,SUSWT ;SUSPENSION?
CAIN 2,FRZWT
JRST 1(4)
JRST 0(4)
SWAPCD
;CLEAR FORK WHICH HAD BEEN SUSPENDED
CLRSFK: SETZRO FKPS1,(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
SUB Q1,BITS+^D17 ;SUBTRACT [1,,0] FOR CORRECT COUNTING
MOVSI Q2,(GF%GFH!GF%GFS) ;COPY OPTIONAL COMMAND BITS
AND Q2,T2 ; ...
MOVE T2,T1 ;COPY SPECIFIED HANDLE
CALL FLOCK ;FREEZE FORK DATABASE
CALL STJFKR ;CONVERT RFH IN T1 TO JRFN
JRST [CAIE T2,.FHTOP ;TOP FORK?
JRST EFRKR ;NO - ERROR CODE STILL IN T1
HLRZ T1,FORKN ;YES - UNPRIVLEDGED REF TO TOP FORK
TLZ Q2,(GF%GFH) ;PROHIBIT ACQUISITION OF HANDLES
JRST .+1]
HRR Q2,T1 ;SET STARTING FORK JRFN
HRLZ P1,T1 ;SET INITIAL CURRENT FORK
PUSH P,[0] ;DUMMY UP SUPERIOR
CALL GFRKS1 ;WALK THE TREE
POP P,(P) ;SCRAP DUMMY SUPERIOR
CALL FUNLK ;RELEASE FORK LOCK
TLNN Q2,(1B17) ;WERE THERE ENOUGH RFH?
SMRETN ;YES - SKIP RETURN
RETERR(FRKHX6) ;NO - RETURN ERROR CODE
;PREORDER TRANSITION OF A N-ARY TREE
GFRKS1: HLRZ T1,P1 ;GET CURRENT JRFN
HRRZ T2,Q1 ;SAVE NEW BASE ADDR
ADD Q1,BHC+2 ;ALLOCATE NEW BLOCK
AOBJP Q1,[MOVEI T1,GFKSX1 ;SPACE EXHAUSTED
JRST EFRKR] ;ERROR RETURN
XCTU [SETZM (T2)] ;CLEAR OUT NEW BLOCK
XCTU [SETZM 1(T2)] ; ...
XCTU [SETOM 2(T2)] ; ...
XCTU [HRLM P1,(T2)] ;STORE PARALLEL POINTER
HRR P1,T2 ;UPDATE CURRENT POINTER
MOVE T2,-1(P) ;GET SUPERIOR POINTER
HRRZ P2,P1 ;GET ADDRESS ONLY
XCTU [HRLM T2,1(P2)] ;STORE SUPERIOR POINTER
CALL JFKRFH ;SEE IF A HANDLE ALREADY EXISTS
XCTU [HRRM T2,1(P2)] ;RETURN HANDLE OR ZERO
TLNN Q2,(GF%GFH) ;ASSIGN RFH?
JRST GFRKS2 ;NO - GO ON
CALL SKIIF ;IS JRFN IN T1 INFERIOR?
JRST GFRKS2 ;NO - DONT GIVE OUT HANDLE
CALL GFKH ;JRFN STILL IN T1, RETURNS RFH IN T1
TLOA Q2,(1B17) ;ERROR RETURN - RFH EXHAUSTED
XCTU [HRRM T1,1(P2)] ;RETURN RELATIVE FORK HANDLE
GFRKS2: TLNN Q2,(GF%GFS) ;FORK STATUS REQUESTED?
JRST GFRKS3 ;NO - GO ON TO INFERIORS
HLRZ T1,P1 ;YES - GET JRFN
HRRZ FX,SYSFK(T1) ;GET SYSTEM FORK INDEX
CALL MRFSTS ;DO RFSTS
UMOVEM T1,2(P2) ;STORE STATUS.
GFRKS3: HLRZ T1,P1 ;GET JRFN AGAIN
ADD T1,INFERP ;CHECK FOR INFERIORS
LDB T1,T1 ; ...
JUMPE T1,GFRKS4 ;NONE - GO ON TO PARALLEL
PUSH P,P1 ;SAVE RECURSIVE VARIABLES
HRLZ P1,T1 ;GET INF JRFN & CLEAR PAR. PTR
CALL GFRKS1 ;DO ALL INFERIORS
HRRZ P2,(P) ;GET CURRENT BLOCK BACK
XCTU [HRRM P1,(P2)] ;STORE INFERIOR LIST
POP P,P1 ;RESTORE RECURSIVE VARS
GFRKS4: HLRZ T1,P1 ;GET CURRENT JRFN BACK
CAIN T1,(Q2) ;TOP SPECIFIED FORK?
RET ;YES - DONT DO PARALLEL
ADD T1,PARALP ;SEE IF ANY PARALLEL
LDB T1,T1 ; ...
JUMPE T1,R ;NONE - DONE WITH THIS LEVEL
HRL P1,T1 ;LOOP FOR THIS LEVEL
JRST GFRKS1 ; ...
;ROUTINE TO MAP A JRFN TO RFH FROM CURRENT FORK
;T1/ JRFN
; CALL JFKRFH
;RETURNS+1(ALWAYS):
;T1/ JRFN (UNCHANGED)
;T2/ RFH OR 0 IF NONE
;T3/ BYTE POINTER TO FKTAB ENTRY CORRESPONDING TO RFH
JFKRFH: CAIGE T1,NUFKS ;REASONABLE JRFN?
JRST JFKRH1 ;YES - MAP IT
BUG.(CHK,ILJRFN,FORK,SOFT,<JFKRFH - Bad JRFN, ignored>,,<
Cause: Routine JFKRFH was erroneously called with a fork number which
is out of range. The correct range is a value less than NUFKS.
JFKRFH changes a fork number into a fork handle.
>)
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
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
CAIE T2,0 ;WANT "SELF" OF KNOWER?
IFSKP.
MOVE T2,FORKN(T1) ;OH YEAH, COVER THIS SPECIAL CASE
ELSE. ;NO, NORMAL CASE
IDIVI T2,2 ;BUILD A POINTER TO JOB F INDEX
ADD T2,FKPTAB(T3) ; IN THE MAPPED PSB
TLO T2,1 ;OFFSET TO MAPPED PSB BY INDEXING PNTR
LDB T2,T2 ;GET THE DESIRED FORK'S JOB FORK INDEX
ENDIF.
CAIGE T2,NUFKS ;MAKE SURE IT'S ASSIGNED
SKIPGE SYSFK(T2) ;FORK STILL EXIST?
ERRJMP (GFRKX1,EFRKRC) ;NO, RETURN ERROR
MOVEI T1,(T2) ;OK, HERE'S THE DESIRED JOB FORK INDEX
CALL GFKH ;GET A FORK HANDLE IN THIS FORK FOR IT.
ERRJMP (FRKHX6,EFRKRC) ;COULDN'T. NO SPACE LEFT.
UMOVEM T1,T1 ;OK. RETURN H-PRIME TO USER.
CALL CLRLFK
CALL FUNLK ;UNLOCK FORK STRUCTURE
SMRETN ;AND SKIP RETURN TO HIM.
;RELEASE FORK HANDLE JSYS
;CALL
;1/ FORK HANDLE TO BE RELEASED
; RFRKH
;RETURNS+1:
;1/ ERROR CODE
;RETURNS+2:
;SUCCESS - AC UNCHANGED
.RFRKH::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CAMN A,[-1] ;WANT TO DO ALL OF THEM?
JRST RFRKH2 ;YES. GO DO IT THEN
CALL RFRKH0 ;GO DO THE WORK
JRST EFRKR ;FOUND AN ERROR. GO REPORT IT
CALL FUNLK ;FREE THE STRUCTURE
SMRETN ;AND RETURN GOOD
;INTERNAL ROUTINE TO RELEASE A FORK HANDLE
;ACCEPTS: A/ PROCESS RELATIVE FORK HANDLE
;RETURNS: +1 / CAN'T RELEASE HANDLE. REASON IN A
; +2/ HANDLE RELEASED AND ALL RELEVANT JOB FORK
; TABLES CLEANED UP
;WARNING: MUST BE CALLED WITH JOB FORK LOCK LOCKED
RFRKH0: CALL RFHJFK ;MAP RFH IN T1 TO JRFN
RET ;ERROR. CODE IN A
SKIPGE SYSFK(A) ;NOW ASSIGNED?
JRST RFRKH1 ;NO,IS OKAY TO DO IT.
LOAD B,FKHCNT,(A) ;IS INFERIOR. SEE ABOUT COUNT
CAIG B,1 ;NOW BEING SHARED?
JRST [ MOVEI A,FRKHX1 ;CAN'T RELEASE IT
RET] ;SO RETURN AN ERROR
RFRKH1: CALL DASFKH ;DEASSIGN FORK HANDLE
RETSKP ;GOOD RETURN
;ROUTINE TO RELEASE ALL HANDLES
RFRKH2: MOVE D,[-NLFKS+1,,1]
MOVE C,FKPTAB ;BEGINNING POINTER
RFRKH3: ILDB A,C ;GET POINTER
CAIN A,-1 ;IN USE?
JRST RFRKH4 ;NO
MOVEI A,.FHSLF(D) ;YES. GET RELATIVE HANDLE
PUSH P,C ;SAVE POINTER
PUSH P,D ;SAVE COUNTER
CALL RFRKH0 ;GO RELEASE IT
JFCL ;DON'T CARE
POP P,D
POP P,C ;RESTORE REGISTERS
RFRKH4: AOBJN D,RFRKH3 ;DO ALL HANDLES
CALL FUNLK ;FREE THE STRUCTURE
SMRETN ;AND DONE
;PERFORM FORK CONTROL FUNCTION FOR EACH FORK OF MULTIPLE FORK
;HANDLE (I.E. MAP A FUNCTION ONTO ALL FORKS)
; 1/ USER FORK HANDLE (SINGLE OR MULTIPLE)
; 2/ INSTRUCTION TO DO FOR EACH FORK
; CALL MAPFKH
; ;EXECUTE INSTRUCTION WITH JOB-WIDE
; HANDE IN T1
;RETURNS: +1 COROUTINE NEEDS TO BLOCK
; +2 ALL DONE
MAPFKH::CAIL 1,-5 ;IS IT A MULTIPLE FORK DESIGNATOR?
CAILE 1,-3
JRST [ PUSH P,T2 ;SAVE INST
CALL SETJFK ;GET HANDLE
POP P,T2 ;GET INST
XCT T2 ;DO IT
RETSKP ;DONE
RET] ;BLOCK
PUSH P,P6 ;SAVE FRAME POINTER
MOVE P6,P ;ESTABLISH FRAME
PUSH P,T2 ;SAVE INSTRUCTION
CALL MAPFT+5(1) ;DISPATCH TO APPROPRIATE FUNCTION
NOP ;NEVER GETS HERE
MOVE P,P6 ;RESTORE STACK
POP P,P6 ;RESTORE REG
RETSKP ;AND DONE
MAPFT: JRST MAPF5 ;-5, ALL FORKS IN JOB
JRST MAPF4 ;-4, ALL INFERIORS
JRST MAPF3 ;-3, SELF AND ALL INFERIORS
MAPF3: HRRZ 1,FORKN ;SELF
MAPF51: PUSH P,1
XCT 1(P6) ;DO INSTRUCTION
SKIPA ;DONE
JRST MAPBLW ;NEEDS TO BLOCK
POP P,1
MAPF41: ADD 1,INFERP ;DO INFERIORS
MAPF42: LDB 1,1 ;GET NEXT IN LIST
JUMPE 1,MAPF43 ;END OF LIST, RETURN AND SKIP INSTR
HRLM 1,0(P) ;SAVE THIS FORK NUMBER
CALL MAPF41 ;DO INFERIORS OF IT
BUG.(HLT,MAP41F,FORK,SOFT,<MAPF41 failed to skip>,,<
Cause: The MAPFKH routine calls itself recursively in order to
find every fork in a specified tree. For each fork found, the
instruction following the call to MAPFKH is executed. MAPFKH
finally skip-returns in order not to fall into that coinstruction
at .+1. The recursive calls skip-return too, merely because they
fall through the same RETSKP instruction.
The MAP41F BUGHLT should never happen, and is merely a placeholder
for the impossible non-skip return from the recursive call to
MAPFKH.
>)
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
; SETVGN - Restore virginity
;
; Call:
; T1/ Job-relative fork number (JRFN) to be made non-virgin
; CALL CLRVGN or SETVGN
;
; Returns:
; +1: Always, process virginity set or cleared
;
CLRVGN:
SETONE SFNVG,(T1) ;No longer a virgin fork!!
RET ;Return from CLRVGN
SETVGN::SETZRO SFNVG,(T1) ;RESTORE VIRGINITY!!
RET
;
;
; 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
EA.ENT
CAMN 1,FORKX ;CURRENT FORK?
JRST SETLF2 ;YES
LOAD T1,FKPS%,(T1) ;GET SPT INDEX OF PSB
HRLS T1 ; INTO LEFT HALF
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
CAME A,JOBNO ;SEE IF SETJSB'ING OURSELVES
IFSKP.
SETZ A, ;YES, ZERO THE INDEX
RET ;AND JUST RETURN
ENDIF.
PUSH P,FX ;NO, PREPARE TO DO THE MAP
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
MOVE B,CAPENB(A) ;GET ENABLED CAPABILITES
AND B,CAPMSK(A) ;MASK OFF "TEMPORARY" BITS
PUSH P,B ;Save the value
CALL CLRPSB ;UNDO PSB MAPPING
CALLRET PA1 ;RETURN CAPS IN A
;GET SYSTEM WIDE FORK NUMBER (FORKX) GIVEN RELATIVE FORK HANDLE
;
; 1/ RELATIVE FORK HANDLE (NOT MULTIPLE)
;
; CALL GSWFRK
;
;RETURNS: +1 FAILURE WITH: T1/ ERROR CODE
; +2 SUCCESS WITH: T1/ SYSTEM WIDE FORK NUMBER
GSWFRK::CALL STJFKR ;(T1/T1) Get job relative fork number
RET ;Error, return failure with error code in T1
HRRZ T1,SYSFK(T1) ;Get system wide fork number
RETSKP ;Return success
;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
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.(CHK,FKCTNZ,FORK,SOFT,<Fork lock nest count non-zero>,<<JOBNO,JOB>,<FORKN,JBFORK>>,<
Cause: The FLOCK routine has encountered the nest count for the fork lock
being non-zero, which should not be, since the lock has just been
locked for the first time. This is probably due to some other
software not having cleared the nest count from some previous lock.
Data: JOB - Internal Job number whose fork discovered the non-zero
nest count.
JBFORK - Jobwide fork index of the discovering fork.
>)
SETZM FLKCNT
RET]
AOS FLKCNT ;INCREMENT NEST COUNT
MOVE W1,TODCLK ;GET NOW
ADDX W1,FLKTMV ;WHEN IT WILL TIMEOUT
MOVEM W1,FKTIMW ;SET IT
CALLRET FLKITT] ;SUCCESS. CHECK INTERRUPTABILITY AND RETURN
;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: CALL FLKITT ;CHECK INTERRUPTABILITY
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 FLOCK1 ;NO, TRY AGAIN
;WE'VE BEEN WAITING A LONG TIME FOR THIS LOCK. BUGCHK AND THEN
;FORCE IT TO BE UNLOCKED
BUG.(CHK,FLKTIM,FORK,SOFT,<FLOCK - Fork lock timeout>,<<FORKN,JOBFRK>,<JOBNO,JOB>,<FLKOWN,OWNER>>,<
Cause: A fork has been waiting a "long time" for the fork lock.
This bugchk announces that the system is assuming that some fork has
neglected to unlock the fork lock and the waiting fork is being
given the lock even though someone else still has it.
The code could be in error here. The measure of a "long time" is
calculated arbitrarily and can be changed. It is parameter FLKTMV.
Data: JOBFRK - Job fork number of fork desiring the lock
JOB - Internal Job number desiring the lock
OWNER - Job fork number of fork currently holding the lock
>)
IFE DEBUG,< ;IF NOT DEBUGGING
SKIPE DBUGSW ;DEBUG SWITCH NON-ZERO?
IFSKP.
SETZM FLKCNT ;ZERO THE NEST COUNT
SETOM FLKOWN ;CLEAR THE OWNER
SETOM FKLOCK ;TIMEOUT, CLEAR LOCK AND PROCEED
JRST FLOCK1 ;AND GO GET IT
ENDIF.
> ;END IFE DEBUG
MOVE W1,T1
MOVEI T1,^D50000
DISMS ;DON'T COMPLAIN FOR A WHILE
MOVE T1,W1
JRST FLOCK1
;TEST FOR INTERRUPTABILITY
FLKITT: SKIPN FORKN ;TOP FORK?
RET ;INTERRUPTABILITY NOT IMPORTANT IF TOP FORK
SKIPLE INTDF ;INTERRUPTABLE NOW OR WHEN LOCKING?
BUG.(INF,FLKINT,FORK,SOFT,<FLOCK - Called while NOINT>,,<
Cause: The routine FLOCK was called while the calling process was
unable to be interrupted. The calling fork was not nesting the lock
nor was it the top fork of the job. This indicated a logic error
because if this fork was unable to aquire the lock it will DISMS
while NOINT. This can cause a deadly embrace where the fork which
owns the lock will not relenquish it until the fork which has dismissed
is interrupted which will never happen because the fork is NOINT.
Action: Change this into a BUGHLT and look at the resulting dump. This will
allow you to find the erroneous routine.
>)
RET ;RETURN
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
JUMPL 1,FUNLK3 ;IF LOCK < 0 ERROR
FUNLK2: POP P,1 ; WAS MADE TO LOCK IT WHILE THIS FORK
RET
REPEAT 0,< ;FOLLOWING WASTES TIME AND IS USLESS
;IF LOCK WAS .G. 0, SOME OTHER FORK IS/WAS TRYING TO LOCK IT. THIS
;FORK WILL DO A BRIEF WAIT SO AS TO PREVENT HOGGING THE LOCK.
FUNLK1: JUMPL 1,FUNLK3 ;BUG IF LOCK NOT SET AT ALL
MOVEI 1,^D200 ;WAIT FOR 200 MS
DISMS
JRST FUNLK2
>
FUNLK3: BUG.(CHK,FLKNS,FORK,SOFT,<FUNLK - Lock not set>,<<FORKN,JOBFRK>>,<
Cause: The FUNLK routine, which unlocks the fork lock, detected that the
lock was already unlocked. This should not be, since anyone
calling FUNLK to unlock the lock presumably first called FLOCK to
lock it.
Data: JOBFRK - Job fork number of fork desiring the lock
>)
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
EFRKRC: PUSH P,T1 ;SAVE ERROR
CALL CLRLFK ;CLEAR MAPPED PAGE
POP P,T1 ;SNAG ERROR AGAIN
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
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
LOAD T1,FKUP%,(T1) ;GET PT OF SECTION 0
HRLS T1 ; INTO LEFT HALF
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 ;CAN CHANGE 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 STRUCTURE
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
LOAD T3,FKUP%,(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: ADJSP P,-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 ; ...
REPEAT 0,<
BUG.(CHK,NOXRFH,FORK,HARD,<DASFKH - Attempt to deassign nonexistant RFH, ignored>,,<
Cause: This BUG is not documented yet.
Action:
>) > ;END REPEAT 0
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
MOVE P1,PSISYS(1) ;GET STATE OF PI SYSTEM
CALL CLRLFK ;UNLOCK THE FORK STRUCTURE
CALL FUNLK
JUMPN P1,EMRET1 ;TAKE NO SKIP RETURN
SMRETN ;SKIP
.DIR:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;Map PSB and check execute-only
SETOM PSISYS(1)
JRST CLFRET
.AIC:: MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
CALL SETLFX ;Map PSB and check execute-only
IORM 2,PSICHM(1)
ICR: CALL SETAOV ;SET ARITHMETIC OVERFLOW TRAP LOCATION IN UPT
CALL SETPOV ;SET PDL OVERFLOW TRAP LOCATION IN UPT
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
CAIN 1,.TICCC ;CONTROL-C?
JRST [ MOVE 3,CAPENB ;YES, SEE IF LEGAL
TXNN 3,SC%CTC
JRST ATX2E
JRST .+1]
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
ATX2E: ERRJMP(ATIX2,ITFRKR) ;USER LACKS ^C CAPABILITY
;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
LOAD Q2,FKSTR,(FX) ;YES, SEE HOW.
CAIE Q2,FRZWT ;FROZEN?
JRST UPDT8 ;NO
JE FKFRJ,(FX),UPDT2 ;YES. IS IT JSYS TRAP?
JN FKEFR,(FX),UPDT2 ;YES. JSYS TRAP AND ALSO OTHER FREEZE?
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
UMOVE T3,T1 ;Get the user flags
TXNE T3,RT%DIM ;User want to get deferred mask?
UMOVEM T2,T3 ;Yes, return in T3
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
TXNN 3,SC%CTC ;^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
CAME T3,[-1] ;Are they asking for all caps?
IFSKP. ; -yes, make it easier for ACJ to determine
MOVE T3,CAPMSK ; Get possible caps
CAIN T1,.FHSLF ; Enabling ourselves?
ANSKP. ; -no,
TLO T3,(777B17) ; so set all bits determined by superior
AND T3,T2 ; and with the "possible mask" supplied
ENDIF. ;T3 now has caps the user is enabling
GTOKM (.GOCAP,<T3>,MRETN)
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/ FLAGS,,FUNCTION
; T3/ FUNCTION DEPENDENT ARG
;ITRAP ON ANY ILLEGAL ACT
SWTBIT==SW%NMI ;LEGAL BITS
SWTMSK==<-1,,0>^!SWTBIT ;ILLEGAL BITS IN LEFT HALF
.SWTRP::MCENT ;ESTABLISH CONTEXT
UMOVE T1,1 ;GET FORK HANDLE
CALL FLOCK ;LOCK FORK STURCTURE
CALL SETLFK ;MAP FORK
UMOVE T2,2 ;GET ARG
HRRZ T3,T2 ;GET FUNCTION WITHOUT BITS
CAILE T3,.SWRPD ;VALID FUNCTION?
ITERR (ARGX02,<CALL CLRLFK
CALL FUNLK>)
CAIE T3,.SWART ;IS THIS SET ARITHMETIC OVERFLOW?
CAIN T3,.SWSPD ;OR SET PDL OVERFLOW?
JRST [ TXNE T2,SWTMSK ;YES. ANY ILLEGAL BITS IN LEFT HALF?
ITERR (ARGX22,<CALL CLRLFK
CALL FUNLK>)
JRST SWTR2]
TLNE T2,-1 ;NO. DON'T ALLOW ANYTHING IN LEFT HALF
ITERR (ARGX22,<CALL CLRLFK
CALL FUNLK>)
SWTR2: TRNN T2,1 ;IS THIS A "SET" FUNCTION?
JRST [ UMOVE T3,3 ;YES. GET ADDRESS OF BLOCK
HLRZ T4,T3 ;GET SECTION NUMBER
CAIL T4,7777 ;MUST BE LESS THAN 7777
ITERR (ARGX23,<CALL CLRLFK
CALL FUNLK>)
JRST .+1]
CALL @SWTRPT(T2) ;DO THE FUNCTION
JRST CLFRET ;AND DONE
;DISPATCH TABLE FOR SWTRP ARGS
SWTRPT: IFIW!ARTSET ;.SWART - SET ARITHMETIC TRAP
IFIW!ARTGET ;.SWRAT - READ ARITHMETIC TRAP
IFIW!LUUSET ;.SWLUT - SET LUUO BLOCK
IFIW!LUUGET ;.SWRLT - READ LUUO BLOCK
IFIW!PDLSET ;.SWSPD - SET PDL OVERFLOW BLOCK
IFIW!PDLGET ;.SWRPD - READ PDL OVEFLOW BLOCK
;SET ARITHMETIC TRAP
ARTSET: CALL SETART ;SAVE BLOCK ADDRESS AND SET UP UPT
RET ;AND DONE
;READ ARITHMETIC TRAP
ARTGET: MOVE T3,ARTHTR ;GET TRAP VALUE
UMOVEM T3,3 ;STASH IT
RET ;DONE
;SET LUUO DISPATCH ADDRESS
LUUSET: CALL SETLUU ;STORE ADDRESS IN UPT
RET
;READ LUUO DISPATCH ADDRESS
LUUGET: CALL GTLUUB ;GET LUUO BLOCK ADDRESS
UMOVEM T3,3 ;RETURN VALUE
RET ;AND DONE
;SET PDL OVERFLOW TRAP
PDLSET: CALL SETPDL ;SAVE ADDRESS OF BLOCK AND SET UP UPT
RET
;READ PDL OVERFLOW TRAP
PDLGET: MOVE T3,PDOVTR ;GET ADDRESS OF BLOCK
UMOVEM T3,3 ;RETURN TO USER
RET
;CLRTRP - Routine to clear all functions set by SWTRP. Called by RESET JSYS
; CALL CLRTRP
;Returns +1: always
;Works only on this fork
CLRTRP::SETZM T1 ;OFFSET FOR PSB ADDRESSING FOR THIS FORK
SETZM T3 ;INDICATE "CLEAR FUNCTION"
CALL SETART ;CLEAR ARITHMETIC OVERFLOW TRAP WORD
SETZM T3 ;INDICATE "CLEAR FUNCTION"
CALL SETLUU ;CLEAR LUUO BLOCK ADDRESS
SETZM T3 ;INDICATE "CLEAR FUNCTION"
CALL SETPDL ;CLEAR PDL OVERFLOW TRAP WORD
RET
; 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
TMNN FKEFR,(T2) ;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
JN FKEFR,(T1),R ;RETURN IF FORK FROZEN DIRECTLY OR INDIRECTLY
ITERR TFRKX3,<CALL FUNLK> ;NOT FROZEN, LET USER KNOW IT
RET ;YES, FORK IS FROZEN; DIRECT OR INDIRECT
;SET OR REMOVE TRAPS FOR A FORK
;T1/ FORKN OF FORK TO TRAP OR UNTRAP
TFSR: MOVE P1,T1 ;copy forkn
MOVE P3,SUPERP
ADD P3,P1
LDB P3,P3 ;forkn of superior
SKIPN T2,FKJTB(P1) ;do we have a monitor at all?
JRST [ CALL TFIFST ; Some form of setting?
RET ; No, and no monitor so done
CALL NEWJTB ;yes, ret addr. in T2
JRST .+1]
LOAD P2,JTIMP,(T2) ;forkn of our immed. monitor
;P1/ FORKN OF IMMEDIATE INF. TO SET/REMOVE TRAPS FOR
;P2/ FORKN OF P1'S MONITOR
;P3/ FORKN OF P1'S SUPERIOR
CAME P2,P3 ;is my monitor my superior?
JRST [ CALL TFIFST ; A form of set?
RET ; No, & sup. not my mon. so done
CALL NEWJTB ;yes, assign new JTB, ret addr. in T2
LOAD P2,JTIMP,(T2) ;forkn of ITS immed. monitor
JRST .+1]
CAIN Q1,.TFRAL ; Removing all?
JRST [ CALL RELJTB ;yes, release block
CALLRET TFINF3] ;take superior's block and update inf's
CALL TFUBIM ;update JTBIM (im. mon.'s bit table)
CALL TFUALL ;update JTALL
TFINF: MOVE T1,P1 ;pass starting point to mapinf
CALL MAPINF ;do all of his immediate inferiors
CALL TFINF1 ;trap forks inferiors
RET
TFINF1: MOVE P1,T1 ;copy forkn (of inf. fork)
MOVE P3,SUPERP ;get superior pointer
ADD P3,P1
LDB P3,P3 ;get forkn of superior fork
SKIPN T2,FKJTB(P1) ;does this fork have a monitor?
JRST TFINF3 ;no, point to superior's JTB
LOAD P2,JTIMP,(T2) ;P2=forkn of immediate mon for this fork
CAME P2,P3 ;is my monitor my immed. superior?
JRST TFINF3 ;no, point to superior's JTB
CALL TFUALL ;yes, update JTBAL
CALLRET TFINF ;do this forks inferiors, etc.
TFINF3: MOVE T1,FKJTB(P3) ;superior's JTB
MOVEM T1,FKJTB(P1) ;equals inferiors JTB
CALLRET TFINF ;do this forks inferiors, etc.
;UPDATE JTBAL, CALLED WHEN IMMED. MONITOR OF FORK IN P1 IS IT'S SUPERIOR
;P1/ FORKN OF INFERIOR TO SET/REMOVE TRAPS FOR
;P2/ FORKN OF P1'S IMMEDIATE MONITOR (ALSO IT'S SUPERIOR)
TFUALL: MOVSI T4,-JTBTL
HRR T4,FKJTB(P1) ;addr. of inf's JTB
HRRZ T3,FKJTB(P2) ;addr. of monitor's JTB (possibly null)
JUMPE T3,[MOVSI T1,JTBIM(T4) ;this forks JTBIM
HRRI T1,JTBAL(T4) ;equals this forks JTBAL
BLT T1,JTBAL+JTBTL-1(T4)
RET]
TFUAL1: MOVE T1,JTBAL(T3) ;monitor's JTBAL
IOR T1,JTBIM(T4) ;this fork's JTBIM
MOVEM T1,JTBAL(T4) ;this fork's JTBAL
AOS T3
AOBJN T4,TFUAL1
RET
;UPDATE JTBIM, CALLED FOR IMMED. INF. OF EXECUTING FORK ONLY
;P1/ FORKN OF THE IMMED. INF. FORK TO UPDATE
TFUBIM: MOVSI T4,-JTBTL
HRR T4,FKJTB(P1) ;addr. of inf's JTB
MOVE T3,P4 ;addr. of user table
MOVSI T2,(1B0) ; JSYS 0, or UUO trap bit
UMOVE T1,(T3) ; Get word that would be in
CALL TFIFST ; Form of set?
JRST TFUBI2 ; No
CAIE Q1,.TFSJU
CAIN Q1,.TFUUO ; Either form that allows B0 W0?
JRST [ IOR T1,T2 ; Yes, do that
CAIN Q1,.TFUUO ; UUO's only?
MOVE T1,T2 ; Then ignore that from bit tbl
JRST TFUB10]
ANDCAM T2,T1 ; No, remove it
CAIA
TFUBI1: UMOVE T1,(T3) ;user's table
TFUB10: IORM T1,JTBIM(T4) ;ored with existing table (maybe zero)
AOS T3
CAIE Q1,.TFUUO ; If UUO's only, get out
AOBJN T4,TFUBI1
RET
TFUBI2: CAIN Q1,.TFRUU ; Removing UUO traps?
JRST [ MOVE T1,T2 ; Then UUO's only
JRST TFUB20]
ANDCAM T2,T1 ; Can't remove UUO traps this way
CAIA
TFUB21: UMOVE T1,(T3) ;user's table
TFUB20: ANDCAM T1,JTBIM(T4) ;remove from JTB
AOS T3
CAIE Q1,.TFRUU ; If UUO's only, get out
AOBJN T4,TFUBI2
RET
TFIFST: CAIE Q1,.TFSET ; Check if function code is form of set
CAIN Q1,.TFSJU
JRST RSKP
CAIN Q1,.TFUUO
JRST RSKP
RET ; No form of set
;ASSIGN A NEW Jsys Trap Block (JTB)
;P1/ FORKN OF FORK TO ASSIGN TABLE
;RETURNS: +1 ALWAYS
;T2/ ADDRESS OF JTB
NEWJTB: MOVE T1,JTBFRE ;FREE STORAGE BIT TABLE
JFFO T1,.+2
BUG.(CHK,NWJTBE,FORK,SOFT,<No free JTB blocks>,,<
Cause: Word JTBFRE in the JSB has bit n on if JSYS trap block n is
available. The NEWJTB routine assigns trap blocks, looking in JTBFRE
for a bit on. If no bit is found to be on in JTBFRE, the NWJTBE bugchk
occurs.
>)
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: CALL FLOCK ;TFORK RESET
MOVSI T1,77 ;CLEAR PSI CHANNEL FOR TRAPS
STOR T1,JTMCN ;CAUSE MONITORED FORKS TO BYPASS US
MOVE T1,[XWD .TFRAL,-4] ;REMOVE TRAPS FROM ALL INFERIORS
TFORK ; Forks must be frozen; this has side
; effect of forcing forks queued with
; traps to this fork to bypass it
ERJMP [CALL FUNLK ; Not all forks frozen
ITERX] ; LSTERR is already set from last ITERR
; At this point should scan the JSYS trap Q (FKJTQ) & deQ forks waiting
; on this fork and force them to resume at JTRLCK. If the forks are all
; frozen, then this should have happened already (in susend PSI code)
RTFRK
ERJMP [CALL FUNLK ; Can't buy a handle
ITERX] ; LSTERR is already set from last ITERR
JUMPE T1,TFOR61 ;WAS A TRAP PENDING?
UTFRK
TFOR61: MOVE T2,FORKX ;CLEAR PENDING TRAP PSI (IF ANY)
SETZRO FKIJT,(T2) ;WHICH MAY HAVE OCCURED AFTER
;NOINT AND BEFORE TFORK
SETOM JTLCK ;CLEAR THE LOCK
CALLRET FUNLK
;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
LOAD T2,FKSTR,(FX)
CAIE T2,FRZWT ; Is it frozen
JRST UTFRK0 ; No, NOOP
JE FKFRJ,(FX),UTFRK0 ; NOOP if not trapped?
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
TLNN P2,(UT%TRP) ; Caller want us to bomb JSYS?
IFSKP.
MOVE T2,PFL(T1) ; Get the trapped process's flags
TXNN T2,UMODF ; Is it a user mode PC?
IFSKP.
SETZM SLOWF(T1) ; Yes, setup proper JSYS context
MOVEM T2,UPDL+1(T1) ; Setup flags for return from ITRAP
MOVEM T2,UPDL+3(T1) ; Gotta go here too
MOVE T2,PPC(T1) ; Fetch user mode PC
MOVEM T2,UPDL+0(T1) ; Setup PC for return from ITRAP
MOVEM T2,UPDL+2(T1) ; Gotta go here too
MOVX T2,MONENV ; Get flags for monitor mode startup
MOVEM T2,PFL(T1) ; Install them in the other process
ENDIF.
XMOVEI T2,ITRAP ; Get new PC to start process at
HRRM T2,PPC(T1) ; Install it in the trapped processes PCB
XMOVEI T2,. ;FAKE PC AS IF JSP
MOVEM T2,PAC+T2
ENDIF.
MOVX T2,JTFRZ%
OPSTRM <ANDCAB T2,>,FKINX,(FX) ; Clear JSYS trap freeze
TXNE T2,FRZBB% ; Is fork still frozen?
JRST [SETOM INTDF(T1) ;YES, MAKE IT OKINT
JRST UTFRK0] ;AND FINISH UP
SKIPN T2,PIOLDS(T1) ; No, resume it
JRST [ CALL UNBLK1 ; Unblock fork
JRST UTFRK3]
STOR T2,FKSTX,(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>,OURSIZ,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
SKIPN A ;YES, IS IT ZERO?
HRLOI A,377777 ;YES, SO ASSUME THE LARGEST 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
TXNE A,IFIW ;If section number of address of name string
HLL A,.POADR+PD0 ; is IFIW 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,OURSIZ ;Save size of block
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
MOVE B,OURSIZ ;Get block size
MOVEM B,.POCT2+OURBLK ;Set it up
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
; Note: should be a 30-bit address.
; Callers should resolve IFIW words.
; 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
MOVX B,PM%EPN ;Extended page numbers
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