Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
monitor/jsysa.mac
There are 53 other files named jsysa.mac in the archive. Click here to see a list.
; Edit= 8974 to JSYSA.MAC on 30-Sep-88 by GSCOTT
;Prevent LAPRBF BUGCHKs on systems without an NIA20. Add routines SMFLTS and
;TMFLTS which implement SMON and TMON function 74.
; Edit= 8952 to JSYSA.MAC on 26-Aug-88 by GSCOTT
;Change "BREAKIN" BUGCHK to be "BREAKI".
; Edit= 8900 to JSYSA.MAC on 12-Aug-88 by RASPUZZI
;Update BUG. documentation.
;[SRI-NIC]SRC:<MONITOR>JSYSA.MAC.2, 14-Nov-88 15:03:06, Edit by MKL
; v7 merge
;SIERRA::SRC:<6.1.MONITOR.STANFORD>JSYSA.MAC.11, 17-Jan-87 14:05:04, Edit by GROSSMAN
;Also, put in Bjorn Victors ADBRK% fix.
;[SRI-NIC]XS:<SU-61SU>JSYSA.MAC.2, 5-Dec-86 14:57:18, Edit by MKL
;;[SRI-NIC]SS:<6-1-MONITOR>JSYSA.MAC.8, 15-Nov-85 15:47:18, Edit by MKL
;;change password delay stuff at PASPEN
;;SS:<6-1-MONITOR>JSYSA.MAC.4, 28-Oct-85 16:49:50, Edit by KNIGHT
;; ERRMES: instead of SYSTEM:ERRMES.BIN (and no GJ%PHY)
;<6-1-MONITOR>JSYSA.MAC.3, 29-Sep-85 19:42:24, Edit by WHP4
; don't log out jobs for excessive password failures if they have
; wheel or operator privileges (don't need to be enabled, just present)
;<6-1-MONITOR.FT6>JSYSA.MAC.2, 12-Aug-85 17:07:53, Edit by WHP4
;Stanford changes:
; Make CHKPSX more paranoid about garbage at the end of strings
; Make sure ACJ had sometime to do before timing it out at RCVCH7
; Edit= 8850 to JSYSA.MAC on 31-May-88 by RASPUZZI
;Add code to do the TMON% version of .SFSEA and .SFLTS. Also, teach INFO% how
;it must handle ethernet addresses for .SFSEA between remote systems.
; Edit= 8821 to JSYSA.MAC on 7-Apr-88 by RASPUZZI
;Fix oversight in edit 7251. Mainly, restore class in T3 before calling
;CPYCSH.
; UPD ID= 8649, RIP:<7.MONITOR>JSYSA.MAC.18, 18-Feb-88 15:33:19 by RASPUZZI
;TCO 7.1231 - Add routines for SMON% and TMON% to set and return the
; minimum password length for directories.
; UPD ID= 8534, RIP:<7.MONITOR>JSYSA.MAC.17, 9-Feb-88 16:24:10 by GSCOTT
;TCO 7.1218 - Update copyright date.
; UPD ID= 8419, RIP:<7.MONITOR>JSYSA.MAC.16, 4-Feb-88 12:21:58 by GSCOTT
;TCO 7.1210 - Set BREAKI, CRSPAG, GIVTMR, RCVTMR, SPRZRO normally not dumpable.
; UPD ID= 8389, RIP:<7.MONITOR>JSYSA.MAC.15, 27-Jan-88 10:34:29 by GSCOTT
;TCO 7.1200 - Move CRJOB, LOGIN, USAGE JSYSes to JSYSM. Rearrange a little
;code and then add the usual TOC.
; UPD ID= 8327, RIP:<7.MONITOR>JSYSA.MAC.14, 18-Dec-87 14:12:39 by RASPUZZI
;More of TCO 7.1165 - Clear 30 bit address when breakpoint is removed
; UPD ID= 8326, RIP:<7.MONITOR>JSYSA.MAC.13, 18-Dec-87 08:22:47 by RASPUZZI
;More of TCO 7.1165 - Enhance diagram of SNOOP% breakpoint block.
; UPD ID= 8325, RIP:<7.MONITOR>JSYSA.MAC.12, 17-Dec-87 16:28:09 by RASPUZZI
;TCO 7.1165 - Make SNOOP% insert breakpoints correctly for code in non
; 0/1 sections.
; UPD ID= 281, RIP:<7.MONITOR>JSYSA.MAC.11, 10-Nov-87 17:07:18 by MCCOLLUM
;TCO 7.1124 - Change manner TMON% does .SFLGS; key off LGSIDX.
; UPD ID= 273, RIP:<7.MONITOR>JSYSA.MAC.10, 6-Nov-87 15:08:17 by GSCOTT
;TCO 7.1119 - ASZSIX isn't used by anyone so why EXTN it?
; UPD ID= 247, RIP:<7.MONITOR>JSYSA.MAC.9, 4-Nov-87 16:40:36 by MCCOLLUM
;TCO 7.1112 - Use LGSIDX in .LOGIN. Add SMON%/TMON% function .SFLGS
; Look for ACCOUNTS-TABLE.BIN on BS:. Make SPOOL% use SPOOL:
; UPD ID= 181, RIP:<7.MONITOR>JSYSA.MAC.8, 21-Oct-87 17:15:00 by RASPUZZI
;TCO 7.1076 - Add code to enable/disable the CLUDGR SYSYAP and cluster
; sendalls. New functions to SMON%/TMON% - .SFCLU & .SFTMG
; UPD ID= 128, RIP:<7.MONITOR>JSYSA.MAC.7, 23-Sep-87 15:44:31 by MCCOLLUM
;TCO 7.1063 - Check for STRX10 in ACCES%, DELDF%, DIRST% and GTDIR%.
; Add the .SFOFS function to SMON% and TMON%
; UPD ID= 105, RIP:<7.MONITOR>JSYSA.MAC.6, 8-Sep-87 17:24:25 by GSCOTT
;TCO 7.1051 - Maintain new WHOJOB word in LOGIN JSYS.
; UPD ID= 97, RIP:<7.MONITOR>JSYSA.MAC.5, 3-Sep-87 20:35:38 by GSCOTT
; TCO 7.1049 - Range check and allow -1 for line number in USAGE% JSYS.
; UPD ID= 94, RIP:<7.MONITOR>JSYSA.MAC.4, 28-Aug-87 10:42:51 by RASPUZZI
;TCO 7.1046 - Make NTINF% work if line number is 0.
; UPD ID= 18, RIP:<7.MONITOR>JSYSA.MAC.3, 5-Jun-87 11:45:34 by MCCOLLUM
; TCO 7.1010 - Fix up ENACT to check for a null file and return an
; error. Fix RUNDI1 to display a more useful error message.
; *** Edit 7470 to JSYSA.MAC by JROSSELL on 30-Apr-87, for SPR #21396
; Check if a response text is present before checking for a fatal error from a
; QUEUE% JSYS message
; *** Edit 7456 to JSYSA.MAC by GSCOTT on 23-Apr-87, for SPR #19597
; Write session records properly when a job is attached, detached, or its
; session remark is changed. Also make sure session start time is correct.
; *** Edit 7428 to JSYSA.MAC by GSCOTT on 31-Mar-87, for SPR #21421
; Don't enforce password peanlty in ACCESC if user is WHEEL or OPERATOR; this
; prevents FAL jobs from being logged out by malicious users.
; *** Edit 7410 to JSYSA.MAC by RASPUZZI on 22-Jan-87, for SPR #21507
; Fix oversight in NTINF% - make sure that the line is not detached. If so,
; return TTYX04 error to user
; *** Edit 7367 to JSYSA.MAC by RASPUZZI on 24-Sep-86
; Change GIVTMR from a BUGINF to a BUGCHK.
; *** Edit 7351 to JSYSA.MAC by EVANS on 12-Aug-86, for SPR #21270
; Restore edit 3060 - check for unmounted structure in DELDF%. RE edit 3045 to
; EXEC.
; *** Edit 7347 to JSYSA.MAC by WONG on 4-Aug-86
; At UFDSKT, add .USTAL (total allocated pages) to the Disk Usage statistics.
; *** Edit 7341 to JSYSA.MAC by LOMARTIRE on 24-Jul-86
; Add password penalty if password is bad in ACCESC
; *** Edit 7336 to JSYSA.MAC by RASPUZZI on 23-Jul-86, for SPR #21321
; Fix a problem with .CDDRN if it has no data in it to prevent memory
; protection violation errors.
; *** Edit 7334 to JSYSA.MAC by RASPUZZI on 15-Jul-86
; Make sure that the 3 second delay is always a penalty for incorrect passwords
; even with BREAKI turned on.
; *** Edit 7259 to JSYSA.MAC by WONG on 14-Mar-86, for SPR #18580
; Add batch info to Usage Session Record.
; *** Edit 7251 to JSYSA.MAC by MCCOLLUM on 4-Mar-86, for SPR #20801
; Save job class in VERCLS and restore it at VERAC8
; *** Edit 7236 to JSYSA.MAC by GRANT on 5-Feb-86, for SPR #21080
; Fix incorrect node name in USAGE% tape mount entry header record
; Edit 7173 to JSYSA.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 7148 to JSYSA.MAC by MCCOLLUM on 11-Sep-85
; Preserve B over call to ALCMES in RELDEV to prevent ILMNRFs.
; Edit 7117 to JSYSA.MAC by EVANS on 8-Aug-85 (TCO none)
; Do not display every dir name on expunge unmounted structure;
; catch the error earlier, in RCDIR. This replaces edit 3060.
; UPD ID= 2277, SNARK:<6.1.MONITOR>JSYSA.MAC.174, 25-Jun-85 14:24:33 by LEACHE
;TCO 6.1.1474 Remove unnecessary code at LOGI2:
; UPD ID= 2202, SNARK:<6.1.MONITOR>JSYSA.MAC.173, 5-Jun-85 15:07:47 by MELOHN
;TCO 6.1.1428 - Put LAT-STATE SMON code under LAHFLG conditional.
; UPD ID= 2091, SNARK:<6.1.MONITOR>JSYSA.MAC.172, 3-Jun-85 14:48:19 by MCCOLLUM
;TCO 6.1.1406 - Update copyright notice.
; UPD ID= 1994, SNARK:<6.1.MONITOR>JSYSA.MAC.171, 20-May-85 14:29:40 by MCCOLLUM
;TCO 6.1.1401 - Display sixbit structure name in BREAKI BUGINF.
; UPD ID= 1946, SNARK:<6.1.MONITOR>JSYSA.MAC.170, 9-May-85 17:08:55 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1901, SNARK:<6.1.MONITOR>JSYSA.MAC.169, 4-May-85 16:11:10 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1784, SNARK:<6.1.MONITOR>APRSRV.MAC.196, 23-Apr-85 12:40:03 by MCCOLLUM
; UPD ID= 1883, SNARK:<6.1.MONITOR>JSYSA.MAC.168, 4-May-85 14:08:53 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1827, SNARK:<6.1.MONITOR>JSYSA.MAC.167, 25-Apr-85 16:35:48 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1788, SNARK:<6.1.MONITOR>JSYSA.MAC.166, 23-Apr-85 12:50:39 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1731, SNARK:<6.1.MONITOR>JSYSA.MAC.165, 8-Apr-85 15:15:37 by MCCOLLUM
;TCO 6.1.1238 - Fix BUG. documentation
; UPD ID= 1688, SNARK:<6.1.MONITOR>JSYSA.MAC.164, 26-Mar-85 15:30:07 by LOMARTIRE
;TCO 6.1.1289 - Fix the range checking of the arg block in .GTDIR
; UPD ID= 1640, SNARK:<6.1.MONITOR>JSYSA.MAC.163, 14-Mar-85 23:27:57 by PRATT
;TCO 6.1.1271 - Fix QUVERF to not release free space it doesn't have.
; UPD ID= 1592, SNARK:<6.1.MONITOR>JSYSA.MAC.162, 5-Mar-85 18:04:45 by GLINDELL
;TCO 6.1.1234 - fix password bug
; UPD ID= 1563, SNARK:<6.1.MONITOR>JSYSA.MAC.161, 25-Feb-85 08:40:02 by WAGNER
;Modify NIN% so can accept radices up to ^D36, QAR 706379, TCO 6.1.1218
; UPD ID= 1502, SNARK:<6.1.MONITOR>JSYSA.MAC.160, 12-Feb-85 09:26:09 by LEACHE
;Restore missing edit - TCO 5.1.1069. FIX CRJOB
; UPD ID= 1500, SNARK:<6.1.MONITOR>JSYSA.MAC.159, 11-Feb-85 11:36:37 by GLINDELL
; TCO 6.1.1185 - /EXPIRATION date doesnt work, LGTAD uses T2, fix CHKEXP
; UPD ID= 1493, SNARK:<6.1.MONITOR>JSYSA.MAC.158, 8-Feb-85 14:11:15 by MOSER
;MORE 6.1262 - SOME JERK UNMERGED IT
; UPD ID= 1491, SNARK:<6.1.MONITOR>JSYSA.MAC.156, 8-Feb-85 13:25:03 by WAGNER
;MORE OF 6.1265 Change appears not to have made it in sources
; UPD ID= 1482, SNARK:<6.1.MONITOR>JSYSA.MAC.155, 5-Feb-85 17:21:53 by GLINDELL
; TCO 6.1.1176 - fix for PM%EPN and delete process page in PMAP% code
; UPD ID= 1377, SNARK:<6.1.MONITOR>JSYSA.MAC.154, 21-Jan-85 14:49:16 by LEACHE
;TCO 6.1.1133 Use correct disc allocation for accounting file OFN
; UPD ID= 1247, SNARK:<6.1.MONITOR>JSYSA.MAC.153, 31-Dec-84 09:33:19 by LOMARTIRE
;TCO 6.1.1096 - Add the .CFHSC function code to CNFIG% to return HSC node names
; UPD ID= 1090, SNARK:<6.1.MONITOR>JSYSA.MAC.152, 17-Nov-84 16:14:04 by MELOHN
;TCO 6.1.1055 - ADD SMON% to set initial LAT State
; UPD ID= 1052, SNARK:<6.1.MONITOR>JSYSA.MAC.151, 13-Nov-84 01:06:35 by GROSSMAN
;TCO 6.1.1045 - Add NI% JSYS reset code to .RESET.
; UPD ID= 5030, SNARK:<6.MONITOR>JSYSA.MAC.150, 29-Oct-84 09:19:05 by SHTIL
; Finally fix the accounting problem (UPD 4744)
; UPD ID= 5025, SNARK:<6.MONITOR>JSYSA.MAC.149, 28-Oct-84 10:48:43 by PRATT
;TCO 6.1.1022 - Add NTINF% jsys
; UPD ID= 4934, SNARK:<6.MONITOR>JSYSA.MAC.148, 15-Oct-84 13:04:56 by GRANT
;The assembly switch CFSCOD has been eliminated
; UPD ID= 4924, SNARK:<6.MONITOR>JSYSA.MAC.146, 12-Oct-84 09:32:26 by LOMARTIRE
;Fix type in previous edit
; UPD ID= 4922, SNARK:<6.MONITOR>JSYSA.MAC.144, 11-Oct-84 16:36:11 by LOMARTIRE
;TCO 6.2217 - Grant PM%WT automatically on process to file PMAPs.
; UPD ID= 4920, SNARK:<6.MONITOR>JSYSA.MAC.143, 11-Oct-84 10:47:18 by GLINDELL
;TCO 6.1.1021 - change ST%LEN to SY%LEN because of conflict with SERCOD
; UPD ID= 4913, SNARK:<6.MONITOR>JSYSA.MAC.142, 10-Oct-84 17:03:16 by GLINDELL
;TCO 6.1.1021 - 6.1 address space
; IFE FTNSPSRV, Find symbol table through PDV in SNOOP jsys
; UPD ID= 4811, SNARK:<6.MONITOR>JSYSA.MAC.141, 17-Sep-84 10:01:42 by PURRETTA
;Update copyright notice
; UPD ID= 4786, SNARK:<6.MONITOR>JSYSA.MAC.140, 31-Aug-84 14:30:13 by TGRADY
;TCO 6.2214 (QAR 706071) Fix CRJOB use of CRJONJ and JOBONT.
; UPD ID= 4779, SNARK:<6.MONITOR>JSYSA.MAC.139, 30-Aug-84 14:26:10 by TGRADY
; TCO 6.2212 (QAR 706051) Don't give group access rights in .LOGIN until
; after checking password and account string, so the JSYS won't fail and
; in the process give out access rights.
; UPD ID= 4770, SNARK:<6.MONITOR>JSYSA.MAC.138, 29-Aug-84 13:56:32 by TGRADY
; TCO 6.2201 (QAR 706198) - In UFNINI, save the local job index in the USAGE
; queue header
; UPD ID= 4744, SNARK:<6.MONITOR>JSYSA.MAC.137, 24-Aug-84 11:14:04 by SHTIL
;TCO #2131 Let a user set a file account regardless whether he is WHEEL or OPR
; or and under what account he is presently running.(SPR #20108).
; UPD ID= 4738, SNARK:<6.MONITOR>JSYSA.MAC.136, 24-Aug-84 09:40:26 by PAETZOLD
;TCO 6.2191 - Change unsafe SETJSB calls to MAPJSB.
; UPD ID= 4717, SNARK:<6.MONITOR>JSYSA.MAC.135, 20-Aug-84 14:58:30 by TBOYLE
;Clean up CNFIG to use .JBVER instead of 137.
; UPD ID= 4660, SNARK:<6.MONITOR>JSYSA.MAC.134, 7-Aug-84 16:23:20 by HAUDEL
;TCO 6.1263 - Decrement STRLK in .PPNST by call ULKSTR. Change an error
;return in .PPNST to return real error.
; UPD ID= 4644, SNARK:<6.MONITOR>JSYSA.MAC.133, 1-Aug-84 00:18:21 by TGRADY
;TCO 6.2146 - In ALOCRS, use JOBNO as index into JOBDIR, not GBLJNO - QAR 706080
; UPD ID= 4625, SNARK:<6.MONITOR>JSYSA.MAC.132, 28-Jul-84 19:37:47 by GLINDELL
;Tco 6.2151 - first account block on new page in account file gets lost
; UPD ID= 4550, SNARK:<6.MONITOR>JSYSA.MAC.131, 17-Jul-84 14:43:06 by SHTIL
; REMOVE UPD 4381
; UPD ID= 4441, SNARK:<6.MONITOR>JSYSA.MAC.130, 5-Jul-84 17:16:16 by MCCOLLUM
;TCO 6.2120 - Call USTDIR before RETBAD after CALL GL2LCL at ACES01+14
; UPD ID= 4381, SNARK:<6.MONITOR>JSYSA.MAC.129, 25-Jun-84 08:12:05 by SHTIL
;Let a user set a file account regardless whether he is WHEEL or OPR and under
;what account he is presently running.(SPR #20108).
; UPD ID= 4375, SNARK:<6.MONITOR>JSYSA.MAC.128, 22-Jun-84 16:27:16 by TBOYLE
;More of the previous, and move CFS routines to CFSSRV, stuff to PROLOG, etc.
; UPD ID= 4369, SNARK:<6.MONITOR>JSYSA.MAC.127, 20-Jun-84 17:26:20 by TBOYLE
;Cosmetic fixes to CNFIG%
; UPD ID= 4365, SNARK:<6.MONITOR>JSYSA.MAC.126, 20-Jun-84 16:01:01 by TBOYLE
;TCO 6.2104 - Call LOGONM after CTIMON is set for correct checkpointing.
; UPD ID= 4350, SNARK:<6.MONITOR>JSYSA.MAC.125, 15-Jun-84 16:36:34 by TBOYLE
;Fix accounting brokwn by UPD ID 2848
; UPD ID= 4299, SNARK:<6.MONITOR>JSYSA.MAC.124, 4-Jun-84 17:10:37 by TBOYLE
;TCO 6.2082 - Fix security window in CACCT%
; UPD ID= 4290, SNARK:<6.MONITOR>JSYSA.MAC.123, 4-Jun-84 11:26:26 by MCLEAN
;ADD CHANGES FOR DON'T CARE DISK
; UPD ID= 4286, SNARK:<6.MONITOR>JSYSA.MAC.122, 1-Jun-84 17:53:54 by TGRADY
;TCO 6.2076 - Remove edit 3865. It causes empty session records.
; UPD ID= 4279, SNARK:<6.MONITOR>JSYSA.MAC.121, 1-Jun-84 12:18:50 by LOMARTIRE
;Cleanup .CNFIG to use SC.NOD to get node number
; UPD ID= 4266, SNARK:<6.MONITOR>JSYSA.MAC.120, 30-May-84 21:18:41 by MOSER
;TCO 6.2072 - MOVE PSPNTP TO STG
; UPD ID= 4238, SNARK:<6.MONITOR>JSYSA.MAC.119, 23-May-84 09:40:04 by EVANS
;TCO 6.2065 - Get node name for accntg from LLSR, not LLSR(P1)
; UPD ID= 4094, SNARK:<6.MONITOR>JSYSA.MAC.118, 17-Apr-84 17:18:58 by GROSSMAN
;TCO 6.2035 - Implement SMON to set Ethernet address
; UPD ID= 4093, SNARK:<6.MONITOR>JSYSA.MAC.117, 17-Apr-84 17:12:52 by MCLEAN
;TCO 6.2034 FIX SMON FOR ACJ SJPRI TO BE OKINT
; UPD ID= 4066, SNARK:<6.MONITOR>JSYSA.MAC.116, 11-Apr-84 19:03:01 by MOSER
;TCO 6.2023 - LOOK FOR JUMP OPCODE INSTEAD OF ERRONEOUS ERJMP
; UPD ID= 4019, SNARK:<6.MONITOR>JSYSA.MAC.115, 31-Mar-84 16:20:03 by PAETZOLD
;TCO 6.2019 - Use ADJSPs
; UPD ID= 3945, SNARK:<6.MONITOR>JSYSA.MAC.114, 19-Mar-84 13:46:00 by HAUDEL
;Convert global job number to local index in .ALLOC code.
; UPD ID= 3874, SNARK:<6.MONITOR>JSYSA.MAC.113, 7-Mar-84 18:24:32 by TBOYLE
;Fix bugs in CNFIG - Bytepointers bumped by 2, and make .CFNND correct.
; UPD ID= 3865, SNARK:<6.MONITOR>JSYSA.MAC.112, 7-Mar-84 11:10:23 by EVANS
;TCO 6.1971 - Write a USAGE record when changing session remark (SJBSRM:).
; UPD ID= 3837, SNARK:<6.MONITOR>JSYSA.MAC.111, 1-Mar-84 16:25:15 by TGRADY
;Fix QUEUE% Jsys use of job numbers...see QUE03 below.
; UPD ID= 3801, SNARK:<6.MONITOR>JSYSA.MAC.110, 29-Feb-84 01:43:36 by TGRADY
;Implement Global Job numbers
; - In ACES01, if user specifies another job, call GL2LCL to convert it
; from a global job number to a local index
; - In CRJOB1, save Global job number of caller, rather than local index
; - In CRJDSN, call GL2LCL to translate Global job number to local...
; - In .GACCT, translate user-specified Global Job number to a local index
; - In ALOCRS, get caller's job number from GBLJNO, not JOBNO
; - In .SETJB, translate user-specified Global Job number to a local index
; - In UFNI01, use global job number (GBLJNO) in UHJNO, not JOBNO
; - In QUE03, pass global job number in .QJJOB
;
; UPD ID= 3691, SNARK:<6.MONITOR>JSYSA.MAC.108, 15-Feb-84 11:39:12 by TBOYLE
;CNFIG - Put ERJMP .+1 after call to SC.PRT
; UPD ID= 3767, SNARK:<6.MONITOR>JSYSA.MAC.109, 27-Feb-84 10:08:54 by PRATT
;TCO 6.1966 - Set IP%MON in QUEUE% if PCU is not set
; UPD ID= 3691, SNARK:<6.MONITOR>JSYSA.MAC.108, 15-Feb-84 11:39:12 by TBOYLE
;CNFIG - Put ERJMP .+1 after call to SC.PRT
; UPD ID= 3617, SNARK:<6.MONITOR>JSYSA.MAC.107, 1-Feb-84 10:45:39 by PRATT
;TCO 6.1956 - Add .SFXEC offset to SMON and TMON
; UPD ID= 3608, SNARK:<6.MONITOR>JSYSA.MAC.106, 31-Jan-84 15:51:10 by TBOYLE
;CNFIG - Return CI node numbers, fix .CFIHO right half, use HSTSIZ in loops.
; UPD ID= 3607, SNARK:<6.MONITOR>JSYSA.MAC.105, 31-Jan-84 15:36:07 by PRATT
;TCO 6.1958 - Create .QJJOB, fixes QU%NRS PID deletion problem
; UPD ID= 3606, SNARK:<6.MONITOR>JSYSA.MAC.104, 31-Jan-84 15:04:21 by PRATT
;TCO 6.1940 - Massive changes to QUEUE jsys, especially in QUVERF.
; UPD ID= 3602, SNARK:<6.MONITOR>JSYSA.MAC.102, 31-Jan-84 13:08:00 by MOSER
;ADD TMON FUNCTION 64 - .SFMSD - MSCP SERVER DISKS
; UPD ID= 3567, SNARK:<6.MONITOR>JSYSA.MAC.101, 27-Jan-84 16:50:22 by CJOHNSON
;TCO 6.1921 - Make NIN return error if 2**35 or greater is input
; UPD ID= 3564, SNARK:<6.MONITOR>JSYSA.MAC.100, 27-Jan-84 12:04:00 by TBOYLE
;Fix UPD 3482 Remove SEARCH SCAPAR which broke GTDIR%. Use MAXNDS, not C%SYMX!
; UPD ID= 3524, SNARK:<6.MONITOR>JSYSA.MAC.99, 24-Jan-84 14:19:56 by MCCOLLUM
;TCO 6.1952 - Fix call to ASGRES in ALOCRS to request general pool space.
; UPD ID= 3515, SNARK:<6.MONITOR>JSYSA.MAC.98, 23-Jan-84 16:13:01 by PRATT
;TCO 6.1947 - Make .QJxxx symbols local, removed from MONSYM
; UPD ID= 3512, SNARK:<6.MONITOR>JSYSA.MAC.97, 23-Jan-84 11:13:15 by PRATT
;TCO 6.1925 - Fix reverse sense of test of QU%NTB in QUCHK.
; UPD ID= 3511, SNARK:<6.MONITOR>JSYSA.MAC.96, 23-Jan-84 11:07:45 by PRATT
;TCO 6.1926 - Set .IPCCG bit in IPCF header saying "Sent by QUEUE".
; UPD ID= 3498, SNARK:<6.MONITOR>JSYSA.MAC.95, 20-Jan-84 15:14:53 by MOSER
;MORE 6.1562 - REMOVE SMON% .SFSMS SERVER IS NOW STARTED BY SCA
; UPD ID= 3482, SNARK:<6.MONITOR>JSYSA.MAC.94, 19-Jan-84 20:45:37 by TBOYLE
;CNFIG: CF%DCN, CF%ARP, CF%CI, ASC8T7 added, use C%SYM instead of HSTSIZ.
; UPD ID= 3431, SNARK:<6.MONITOR>JSYSA.MAC.93, 10-Jan-84 14:19:28 by TBOYLE
;Add CNFIG% JSYS support.
; UPD ID= 3372, SNARK:<6.MONITOR>JSYSA.MAC.92, 27-Dec-83 11:48:40 by TSANG
;TCO 6.1917 - Check for mounted structure at .DELDF
; UPD ID= 3224, SNARK:<6.MONITOR>JSYSA.MAC.91, 28-Nov-83 15:16:31 by MCINTEE
;TCO 6.1883 - Fix password bug.
; UPD ID= 3123, SNARK:<6.MONITOR>JSYSA.MAC.90, 8-Nov-83 14:00:08 by TSANG
;TCO 6.1848 - INCLUDE THE NODE NAME IN ENTRY HEADER RECORD.
; UPD ID= 3119, SNARK:<6.MONITOR>JSYSA.MAC.89, 8-Nov-83 13:14:09 by CJOHNSON
;TCO 6.1851. Have SFCOC return DESX2 when playing with an assigned tty
; UPD ID= 3037, SNARK:<6.MONITOR>JSYSA.MAC.88, 17-Oct-83 13:42:48 by MILLER
;TCO 6.1623. Include STR and DIR numbers in BREAKI BUGINF
; UPD ID= 3033, SNARK:<6.MONITOR>JSYSA.MAC.87, 12-Oct-83 10:05:24 by MILLER
;TCO 6.1623 again.
; UPD ID= 3032, SNARK:<6.MONITOR>JSYSA.MAC.86, 12-Oct-83 08:56:43 by MILLER
;TCO 6.1623. MAKE PSPNTP RSI so it can be patched.
; UPD ID= 3023, SNARK:<6.MONITOR>JSYSA.MAC.85, 10-Oct-83 17:39:51 by MOSER
;TCO 6.1746 - ALLOW PLOCK OF PAGES IN NON-ZERO SECTION
; UPD ID= 3006, SNARK:<6.MONITOR>JSYSA.MAC.84, 7-Oct-83 17:56:44 by GUNN
;~6.0 Add call to LLMRSF from RSTFK to clean up LLMOP resources on RESET%.
; UPD ID= 2955, SNARK:<6.MONITOR>JSYSA.MAC.83, 28-Sep-83 16:38:40 by MOSER
;TCO 6.1727 - PREVENT HOGGING STRUCTURE LOCK IN PMAP BACKOUT CODE
; UPD ID= 2947, SNARK:<6.MONITOR>JSYSA.MAC.82, 27-Sep-83 20:52:41 by MILLER
;TCO 6.1806. Call CFTADB from STAD
; UPD ID= 2879, SNARK:<6.MONITOR>JSYSA.MAC.81, 7-Sep-83 10:52:43 by TBOYLE
;TCO 6.1787 - Make TMON% leave RH unchanged with .SFSOK function.
; UPD ID= 2848, SNARK:<6.MONITOR>JSYSA.MAC.80, 19-Aug-83 14:29:10 by MURPHY
;Fix ref to data word in USAGE% arg block so local addresses work.
; UPD ID= 2819, SNARK:<6.MONITOR>JSYSA.MAC.79, 9-Aug-83 14:11:57 by PURRETTA
;Missing module name in BUG. macro at SETSPR.
; UPD ID= 2750, SNARK:<6.MONITOR>JSYSA.MAC.78, 22-Jul-83 16:38:51 by PAETZOLD
;TCO 6.1733 - Remove call to NETKFK as NCP has gone away.
; UPD ID= 2746, SNARK:<6.MONITOR>JSYSA.MAC.77, 22-Jul-83 16:33:43 by MURPHY
;TCO 6.1719 - User settable hangup action.
;TCO 6.1568 - User settable carrier off time.
; UPD ID= 2702, SNARK:<6.MONITOR>JSYSA.MAC.76, 18-Jul-83 15:03:47 by MILLER
;TCO 6.1736. Make STDEV return its error
; UPD ID= 2680, SNARK:<6.MONITOR>JSYSA.MAC.74, 6-Jul-83 11:23:26 by TAMBURRI
;Fix a typo from TCO 6.1712. Make HRRZS to HLLZS.
; UPD ID= 2664, SNARK:<6.MONITOR>JSYSA.MAC.72, 5-Jul-83 13:29:05 by MURPHY
;More 6.1525 - Remove hidden symtab, put symtab in extended section.
; UPD ID= 2651, SNARK:<6.MONITOR>JSYSA.MAC.71, 1-Jul-83 15:22:57 by TAMBURRI
;TCO 6.1712 Remember and use the section number of the current PA1050
; UPD ID= 2601, SNARK:<6.MONITOR>JSYSA.MAC.70, 20-Jun-83 15:22:18 by HALL
;TCO 6.1689 - Move fork tables to extended section
; Reference FKPGS via DEFSTR
; UPD ID= 2459, SNARK:<6.MONITOR>JSYSA.MAC.69, 12-May-83 09:56:16 by COBB
;TCO 6.1655 - Fix an off-by-one in GTDIR% (GTDIR5 - a few)
; UPD ID= 2439, SNARK:<6.MONITOR>JSYSA.MAC.68, 6-May-83 11:52:24 by MOSER
;TCO 6.1562 - SMON CHANGE FOR MSCP SERVER
; UPD ID= 2401, SNARK:<6.MONITOR>JSYSA.MAC.67, 3-May-83 13:54:33 by COBB
;TCO 6.1637 - SMON/TMON for SPEAR entry counts...
; UPD ID= 2378, SNARK:<6.MONITOR>JSYSA.MAC.66, 29-Apr-83 14:44:08 by MILLER
;TCO 6.1623 again. Add a few more features
; UPD ID= 2348, SNARK:<6.MONITOR>JSYSA.MAC.65, 26-Apr-83 20:12:44 by MILLER
;TCO 6.1623 again.
; UPD ID= 2340, SNARK:<6.MONITOR>JSYSA.MAC.64, 25-Apr-83 14:19:38 by MILLER
;TCO 6.1623. Add new "illegal password" handling
; UPD ID= 2314, SNARK:<6.MONITOR>JSYSA.MAC.62, 20-Apr-83 06:09:32 by FLEMMING
; UPD ID= 2284, SNARK:<6.MONITOR>JSYSA.MAC.61, 16-Apr-83 19:13:35 by PAETZOLD
;TCO 6.1557 - TCP Merge - Delete old edit history - Update copyright.
; UPD ID= 2246, SNARK:<6.MONITOR>JSYSA.MAC.60, 12-Apr-83 13:16:29 by MCINTEE
;Remove IFNDEF FTNSPSRV
; UPD ID= 2182, SNARK:<6.MONITOR>JSYSA.MAC.59, 6-Apr-83 15:58:27 by COBB
;TCO 6.1594 - Modify the use of debugging features in QUEUE% (related change
; in MONSYM)
; UPD ID= 2174, SNARK:<6.MONITOR>JSYSA.MAC.58, 6-Apr-83 07:14:45 by FLEMMING
; UPD ID= 2134, SNARK:<6.MONITOR>JSYSA.MAC.57, 2-Apr-83 22:50:56 by LEACHE
;TC0 6.1247 Add more password encryption
; UPD ID= 1896, SNARK:<6.MONITOR>JSYSA.MAC.56, 1-Mar-83 15:27:12 by HALL
;TCO 6.1502 - Allow free space outside of section 0
; At least temporarily, make all callers request section 0
; UPD ID= 1868, SNARK:<6.MONITOR>JSYSA.MAC.55, 23-Feb-83 14:22:16 by HALL
;TCO 6.1511 - Make RESET JSYS undo SWTRP (call CLRTRP)
; UPD ID= 1839, SNARK:<6.MONITOR>JSYSA.MAC.55, 20-Feb-83 20:36:54 by MURPHY
;TCO 6.1514 - Don't put error code in AC if ERCAL/ERJMP present.
; UPD ID= 1798, SNARK:<6.MONITOR>JSYSA.MAC.54, 14-Feb-83 14:36:12 by MCINTEE
;Still more TCO 6.1484 - remove conditional from CALL EVRKIL
; UPD ID= 1785, SNARK:<6.MONITOR>JSYSA.MAC.53, 10-Feb-83 15:08:27 by COBB
;More TCO 6.1448 - Add JFCL after call, since NTCOFF always RETSKPs (!)
; UPD ID= 1781, SNARK:<6.MONITOR>JSYSA.MAC.52, 10-Feb-83 11:12:46 by WEETON
;TCO 6.1487 - Allow customers to modify DST conversions
; UPD ID= 1752, SNARK:<6.MONITOR>JSYSA.MAC.51, 3-Feb-83 13:13:39 by MCINTEE
;More TCO 6.1484 - Put CALL EVRKIL under IFN FTNSPSRV
; UPD ID= 1749, SNARK:<6.MONITOR>JSYSA.MAC.50, 3-Feb-83 10:27:56 by GRANT
;TCO 6.1484 - In .RESET, check for DECnet event reader
; UPD ID= 1718, SNARK:<6.MONITOR>JSYSA.MAC.49, 28-Jan-83 13:54:58 by MCINTEE
;Remove IFN FTNSPSRV conditional from CALL NTCOFF (6.1 has net top change int)
; UPD ID= 1699, SNARK:<6.MONITOR>JSYSA.MAC.48, 26-Jan-83 14:22:21 by WEETON
;TCO 6.1401 - Fix ITRLGO BUGCHKs and WAITNI BUGHLTs
; UPD ID= 1644, SNARK:<6.MONITOR>JSYSA.MAC.47, 12-Jan-83 08:34:18 by MCINTEE
;TCO 6.1448 - TYPO
; UPD ID= 1636, SNARK:<6.MONITOR>JSYSA.MAC.46, 10-Jan-83 15:51:58 by COBB
;TCO 6.1448 - Call NTCOFF in RESET% to release entry in NTCTAB (net topo change)
; UPD ID= 1625, SNARK:<6.MONITOR>JSYSA.MAC.45, 6-Jan-83 16:22:37 by CHALL
;Move call to .NSPRS from .RESET to KSELF
; UPD ID= 1569, SNARK:<6.MONITOR>JSYSA.MAC.44, 22-Dec-82 19:20:42 by NICHOLS
;Add FTNSPSRV to distinguish between release 6.0 and 6.1
;.RESET- Add call to .NSPRS to release DECnet connection on RESET
; UPD ID= 1553, SNARK:<6.MONITOR>JSYSA.MAC.43, 21-Dec-82 11:12:20 by MOSER
;TCO 6.1420 - ALLOW PMAP DELETE IF FILE PT NONEXISTANT
; UPD ID= 1497, SNARK:<6.MONITOR>JSYSA.MAC.42, 1-Dec-82 11:49:04 by MOSER
;TCO 6.1195 - USE NODE NAME IN USAGE REC IF ONE SUPPLIED
; UPD ID= 1462, SNARK:<6.MONITOR>JSYSA.MAC.41, 18-Nov-82 13:00:47 by MOSER
;TCO 6.1365 - PREVENT ILPPT3
; UPD ID= 1443, SNARK:<6.MONITOR>JSYSA.MAC.40, 15-Nov-82 13:30:04 by LEACHE
;TCO 6.1371 - Require privs for USAGE function .USCKI
; UPD ID= 1377, SNARK:<6.MONITOR>JSYSA.MAC.39, 25-Oct-82 14:17:20 by MOSER
; UPD ID= 1347, SNARK:<6.MONITOR>JSYSA.MAC.38, 18-Oct-82 12:42:58 by MOSER
;TCO 6.1316 - LOCK ACTLCK EARLIER TO PREVENT PTNON0
; UPD ID= 1308, SNARK:<6.MONITOR>JSYSA.MAC.37, 8-Oct-82 16:08:01 by MOSER
;TCO 6.1300 - PREVENT SPURIOUS RCVTMR BUGCHK
; UPD ID= 1303, SNARK:<6.MONITOR>JSYSA.MAC.36, 8-Oct-82 15:24:51 by MOSER
;TCO 6.1284 - CORRECT DISPOSITION OF ACJ REQUESTS AFTER GIVTMR, RCVTMR
; UPD ID= 1245, SNARK:<6.MONITOR>JSYSA.MAC.35, 26-Sep-82 15:18:43 by LEACHE
;More TCO 6.1247
; UPD ID= 1242, SNARK:<6.MONITOR>JSYSA.MAC.34, 24-Sep-82 15:28:32 by LEACHE
;TCO 6.1247 Add password encryption
; UPD ID= 1231, SNARK:<6.MONITOR>JSYSA.MAC.33, 24-Sep-82 12:05:18 by MILLER
;TCO 5.1.1069. FIX CRJOB
; UPD ID= 1180, SNARK:<6.MONITOR>JSYSA.MAC.32, 14-Sep-82 13:55:13 by MOSER
;TCO 6.1262 - USE TPRCYC FOR OFFLINE EXPIRATION IS SETUP IN GTDIR
; UPD ID= 1179, SNARK:<6.MONITOR>JSYSA.MAC.31, 14-Sep-82 11:13:02 by MOSER
;TCO 6.1265 - CORRECT DEFSTR FOR GOKTRM
; UPD ID= 1129, SNARK:<6.MONITOR>JSYSA.MAC.29, 1-Sep-82 15:39:49 by MCINTEE
;More TCO 6.1230 - Eliminate unneeded checks
; UPD ID= 1118, SNARK:<6.MONITOR>JSYSA.MAC.28, 27-Aug-82 14:44:55 by MCINTEE
;More TCO 6.1230 - A forgotten line
; UPD ID= 1104, SNARK:<6.MONITOR>JSYSA.MAC.27, 23-Aug-82 13:02:22 by MCINTEE
;TCO 6.1230 - Remote alias support for GTDIR%
; UPD ID= 932, SNARK:<6.MONITOR>JSYSA.MAC.26, 14-Jun-82 17:12:32 by HALL
;TCO 6.1000 - Support the 2080
; Provide address break support for the KC, including new functions
; (.ABSRG,.ABRRG,.ABGBR)
; Close race in "clear break" code by using NOSKED
; Call BRKAVL from common point rather than in each function
; Modify old functions (.ABSET and .ABRED) for the KC
; When setting address break, don't call SETBRK. Force reschedule of
; process instead.
; Make "set" function do a "clear" if all bits are zero
; UPD ID= 916, SNARK:<6.MONITOR>JSYSA.MAC.25, 10-Jun-82 08:21:09 by COBB
;TCO 6.1149 - Continued...more clean up, fix typo...
; UPD ID= 896, SNARK:<6.MONITOR>JSYSA.MAC.24, 9-Jun-82 23:11:52 by MURPHY
;TCO 6.1147 - Move bugdefs from BUGS.MAC to here and put them in-line.
; UPD ID= 862, SNARK:<6.MONITOR>JSYSA.MAC.23, 7-Jun-82 10:37:57 by HALL
;TCO 6.1156 - Support exec mode address break
; Lock out user mode address break if exec mode already in effect.
; UPD ID= 811, SNARK:<6.MONITOR>JSYSA.MAC.22, 2-Jun-82 11:14:20 by COBB
;TCO 6.1149 - Add code to not wait for response if QU%NRS is set, clean up
; UPD ID= 757, SNARK:<6.MONITOR>JSYSA.MAC.21, 15-May-82 14:22:37 by MILLER
;TCO 6.1137. Don't do BLT is user specified reply length of 0
; UPD ID= 749, SNARK:<6.MONITOR>JSYSA.MAC.20, 14-May-82 17:00:28 by COBB
;TCO 6.1137 - Turn on page-mode bit in QUEUE% when doing MSEND%
; UPD ID= 651, SNARK:<6.MONITOR>JSYSA.MAC.19, 16-Apr-82 15:36:56 by PAETZOLD
;TCO 6.1095 - Make SMAP check source id section number
; UPD ID= 564, SNARK:<6.MONITOR>JSYSA.MAC.18, 31-Mar-82 15:48:13 by MURPHY
;TCO 6.1074 - New build procedures - take out PROKL
; UPD ID= 532, SNARK:<6.MONITOR>JSYSA.MAC.17, 18-Mar-82 20:02:43 by PAETZOLD
;TCO 5.1763 - Generate quota exceeded interrupt if needed in PMAP77
; UPD ID= 529, SNARK:<6.MONITOR>JSYSA.MAC.16, 18-Mar-82 07:42:59 by HALL
;TCO 6.1000 - Support the 2080
; Add SEARCH PROKL temporarily. RSMAP expects to know about paging data
; UPD ID= 524, SNARK:<6.MONITOR>JSYSA.MAC.15, 18-Mar-82 01:13:00 by PAETZOLD
;TCO 5.1760 - Clear ARPANET connections in RESET jsys
; UPD ID= 516, SNARK:<6.MONITOR>JSYSA.MAC.14, 16-Mar-82 20:55:09 by PAETZOLD
;TCO 5.1759 - Make sure JFN open in PMAP
; UPD ID= 514, SNARK:<6.MONITOR>JSYSA.MAC.13, 16-Mar-82 20:25:33 by PAETZOLD
;TCO 5.1757 - Restore fork handle for SETLFX call in ABCLR
; UPD ID= 469, SNARK:<6.MONITOR>JSYSA.MAC.12, 11-Mar-82 21:47:16 by PAETZOLD
;TCO 5.1751 - Zero PATLEV when zeroing PATADR in RSTFK
; UPD ID= 408, SNARK:<6.MONITOR>JSYSA.MAC.11, 16-Feb-82 11:28:49 by MILLER
;TCO 5.1678 ONCE MORE. Only block for SCTTY conflict if job is logging out.
; UPD ID= 332, SNARK:<6.MONITOR>JSYSA.MAC.10, 20-Jan-82 17:28:09 by COBB
;TCO 6.1057. Add code for QUEUE% jsys
; UPD ID= 325, SNARK:<6.MONITOR>JSYSA.MAC.9, 19-Jan-82 13:14:44 by MILLER
;Once more. More fixes at RELDD3
; UPD ID= 320, SNARK:<6.MONITOR>JSYSA.MAC.8, 18-Jan-82 19:01:49 by MILLER
;TCO 5.1678. More fixes for RELDD3
; UPD ID= 314, SNARK:<6.MONITOR>JSYSA.MAC.7, 18-Jan-82 14:45:02 by MILLER
;TCO 5.1678. Don't RELD SCTTY devices
; UPD ID= 154, SNARK:<6.MONITOR>JSYSA.MAC.6, 21-Oct-81 14:32:36 by PAETZOLD
;TCO 5.1591 - Unlock locked JFN's in PMAP backout code
; UPD ID= 141, SNARK:<6.MONITOR>JSYSA.MAC.5, 19-Oct-81 16:03:05 by COBB
;TCO 6.1029 - CHANGE SE1CAL TO EA.ENT
; UPD ID= 123, SNARK:<6.MONITOR>JSYSA.MAC.4, 18-Oct-81 23:31:24 by PAETZOLD
;More TCO 5.1576 - Clean up the code somewhat
;<6.MONITOR>JSYSA.MAC.3, 16-Oct-81 18:03:45, EDIT BY MURPHY
;TCO 6.1030 - Node names in filespecs; etc.
;Revise DTB format; get rid of double skips on NLUKD, etc.
; UPD ID= 111, SNARK:<6.MONITOR>JSYSA.MAC.2, 15-Oct-81 22:43:48 by PAETZOLD
;TCO 5.1576 - Decrement FILLFW in PMAP back out code if SID was a jfn
; UPD ID= 181, SNARK:<5.MONITOR>JSYSA.MAC.40, 15-Sep-81 16:50:26 by SCHMITT
;TCO 4.1.1051 - Add monitor uptime in UFRSTT record
; UPD ID= 163, SNARK:<5.MONITOR>JSYSA.MAC.39, 10-Sep-81 14:38:48 by PAETZOLD
;TCO 5.1481 - Check for non-seven bit OWGBP's in JSYS calls, add PTRCHK
; UPD ID= 90, SNARK:<5.MONITOR>JSYSA.MAC.38, 5-Aug-81 10:14:58 by LEACHE
;Reinstall TCO 5.1436 correctly
; UPD ID= 87, SNARK:<5.MONITOR>JSYSA.MAC.37, 1-Aug-81 15:56:56 by PAETZOLD
;Remove TCO 5.1436 - It is causing grief
; UPD ID= 85, SNARK:<5.MONITOR>JSYSA.MAC.36, 30-Jul-81 09:44:16 by LEACHE
;TCO 5.1436
;Restore ability of USAGE% to use indexed/indirect secondary argument pointers
; UPD ID= 75, SNARK:<5.MONITOR>JSYSA.MAC.35, 24-Jul-81 16:10:13 by SCHMITT
;TCO 5.1433 - Unlock fork structure on error return from MSETST in .SMAP
; UPD ID= 49, SNARK:<5.MONITOR>JSYSA.MAC.34, 19-Jul-81 06:37:58 by FLEMMING
;TCO 5.1422 - PMAP attempts to create a section when deleting pages
; UPD ID= 46, SNARK:<5.MONITOR>JSYSA.MAC.33, 17-Jul-81 16:18:53 by MURPHY
;TCO 5.1398 - PMAP FAILS PROPERLY ON OVER QUOTA
; UPD ID= 2, SNARK:<5.MONITOR>JSYSA.MAC.32, 9-Jul-81 12:04:03 by MOSER
;TCO 5.1431 - GTDIR bug causing data to be written outside of group lists
; when there are more groups than will fit.
; UPD ID= 2252, SNARK:<5.MONITOR>JSYSA.MAC.31, 24-Jun-81 18:09:27 by MURPHY
;TCO 5.1384 - PMAP bug allowing write of read-only files when mapped with SMAP%.
; UPD ID= 2075, SNARK:<5.MONITOR>JSYSA.MAC.30, 25-May-81 12:03:34 by ZIMA
;TCO 5.1348 - Fix CFIBF, CFOBF, SFCOC, SFMOD, SOBE for noop conditions
; and LSTERR setting on errors.
; UPD ID= 1877, SNARK:<5.MONITOR>JSYSA.MAC.29, 23-Apr-81 17:36:40 by LYONS
;ADD PARANOID CODE TO GTDIR
; UPD ID= 1747, SNARK:<5.MONITOR>JSYSA.MAC.28, 20-Mar-81 06:46:53 by FLEMMING
; UPD ID= 1722, SNARK:<5.MONITOR>JSYSA.MAC.27, 17-Mar-81 04:01:32 by FLEMMING
; UPD ID= 1700, SNARK:<5.MONITOR>JSYSA.MAC.26, 16-Mar-81 08:19:06 by FLEMMING
;add code for XRMAP
; UPD ID= 1661, SNARK:<5.MONITOR>JSYSA.MAC.25, 11-Mar-81 05:56:34 by FLEMMING
; UPD ID= 1657, SNARK:<5.MONITOR>JSYSA.MAC.24, 10-Mar-81 09:06:08 by FLEMMING
; UPD ID= 1603, SNARK:<5.MONITOR>JSYSA.MAC.23, 27-Feb-81 09:53:24 by FLEMMING
;TCO 5.1265 - fix RMAP returning wrong access information
; UPD ID= 1522, SNARK:<5.MONITOR>JSYSA.MAC.22, 6-Feb-81 03:41:01 by FLEMMING
;Create a page table on PMAP from/to a non-existant section
; UPD ID= 1498, SNARK:<5.MONITOR>JSYSA.MAC.21, 26-Jan-81 15:02:25 by ZIMA
;TCO 5.1245 - Fix ERSTR to recognize ERJMP/ERCAL better on errors.
; UPD ID= 1480, SNARK:<5.MONITOR>JSYSA.MAC.20, 22-Jan-81 14:19:44 by ZIMA
;TCO 5.1239 - Fix wild addressing problem in RPACS causing system crashes.
; UPD ID= 1445, SNARK:<5.MONITOR>JSYSA.MAC.19, 15-Jan-81 15:57:18 by FLEMMING
;add code for SMAP/RSMAP
; UPD ID= 1412, SNARK:<5.MONITOR>JSYSA.MAC.18, 6-Jan-81 15:27:43 by SCHMITT
;TCO 5.1226 - Call FKHPTN instead of FRKMAP in RMAP and handle error correctly
;<5.MONITOR>JSYSA.MAC.16, 19-Nov-80 13:39:33, EDIT BY MURPHY
; UPD ID= 1296, SNARK:<5.MONITOR>JSYSA.MAC.15, 19-Nov-80 12:22:32 by MURPHY
;PASS OWNER FORKX TO SECMAP WHEN CREATING PRIVATE SECTION
; UPD ID= 1151, SNARK:<5.MONITOR>JSYSA.MAC.14, 13-Oct-80 11:47:26 by SCHMITT
; UPD ID= 1086, SNARK:<5.MONITOR>JSYSA.MAC.13, 1-Oct-80 12:02:37 by MURPHY
;FIX ACVAR
; UPD ID= 1005, SNARK:<5.MONITOR>JSYSA.MAC.12, 11-Sep-80 18:10:14 by GRANT
;Change MONX01 to MONX05 in ALOCRS routine and FIX the check for it in GETOKM
;Change MONX01 to MONX02 in PLOCK0 routine
; UPD ID= 963, SNARK:<5.MONITOR>JSYSA.MAC.11, 25-Aug-80 16:26:59 by ENGEL
;TCO 5.1136 - ADD DEVLKK
; UPD ID= 927, SNARK:<5.MONITOR>JSYSA.MAC.10, 20-Aug-80 11:10:47 by MILLER
;TCO 5.1135. Assume PA%WRT when creating a private section
; UPD ID= 838, SNARK:<5.MONITOR>JSYSA.MAC.9, 5-Aug-80 10:58:16 by SCHMITT
;TCO 5.1125 - Rewrite BIN1 routine.
; UPD ID= 704, SNARK:<5.MONITOR>JSYSA.MAC.8, 26-Jun-80 10:10:11 by LYONS
;ACJKIL SHOULD BE IN RESCD, NOT SWAPCD AS WE CAN GET THERE FROM SCHEDULER
; UPD ID= 601, SNARK:<5.MONITOR>JSYSA.MAC.6, 4-Jun-80 20:32:07 by MURPHY
; UPD ID= 598, SNARK:<5.MONITOR>JSYSA.MAC.5, 4-Jun-80 12:53:33 by ZIMA
;TCO 5.1059 - Fix infinite disk quota constant at ENAC0 plus several.
; UPD ID= 480, SNARK:<5.MONITOR>JSYSA.MAC.4, 25-Apr-80 16:28:26 by DBELL
;FIX PREVIOUS EDIT
; UPD ID= 449, SNARK:<5.MONITOR>JSYSA.MAC.3, 20-Apr-80 23:09:54 by DBELL
;MORE OF THE SAME
; UPD ID= 448, SNARK:<5.MONITOR>JSYSA.MAC.2, 20-Apr-80 15:44:13 by DBELL
;TCO 5.1022 - MAKE LOGIN JSYS MORE SECURE
; UPD ID= 341, SNARK:<4.1.MONITOR>JSYSA.MAC.266, 18-Mar-80 14:23:21 by GRANT
;At RCVCH7, check GOKLCK before calling ACJKI1 from scheduler
; UPD ID= 337, SNARK:<4.1.MONITOR>JSYSA.MAC.265, 14-Mar-80 14:10:57 by GRANT
;TCO 4.1.1113 - Add special scheduler entry point in ACJKIL
; UPD ID= 278, SNARK:<4.1.MONITOR>JSYSA.MAC.264, 19-Feb-80 14:48:50 by MILLER
; TCO 4.1.1084. HAVE RMAP LOCK THE FORK LOCK
; UPD ID= 265, SNARK:<4.1.MONITOR>JSYSA.MAC.263, 15-Feb-80 11:14:10 by OSMAN
;tco 4.1.1082 - Change two occurances of MOVE Q2,ACTPG to MOVEI Q2,ACTPG.
; UPD ID= 224, SNARK:<4.1.MONITOR>JSYSA.MAC.262, 25-Jan-80 10:44:33 by GRANT
;TCO 4.2598 - MAKE THE RELEASING OF PRARG'S JSB SPACE A SUBROUTINE (PRARGF)
; UPD ID= 111, SNARK:<4.1.MONITOR>JSYSA.MAC.261, 7-Dec-79 16:31:05 by SCHMITT
;TCO 4.1.1051 - Change format of system restart RDB to include monitor uptime
; UPD ID= 71, SNARK:<4.1.MONITOR>JSYSA.MAC.260, 30-Nov-79 12:59:41 by MILLER
;YET MORE PMAP FIXES
; UPD ID= 57, SNARK:<4.1.MONITOR>JSYSA.MAC.259, 29-Nov-79 12:27:10 by MILLER
;FIX PMAPRL TO DO EXTRA OKINT
; UPD ID= 51, SNARK:<4.1.MONITOR>JSYSA.MAC.258, 29-Nov-79 10:28:13 by MILLER
;TCO 4.1.1026 AGAIN
; UPD ID= 50, SNARK:<4.1.MONITOR>JSYSA.MAC.257, 29-Nov-79 09:22:18 by GRANT
;TCO 4.2583 - Make GETOK return an error status block
;TCO 4.2584 - Make GETOK correctly store a user-defined function code
; UPD ID= 40, SNARK:<4.1.MONITOR>JSYSA.MAC.256, 28-Nov-79 13:41:05 by MILLER
;FIX EDIT TO CHKPSX FOR .254
;<4.1.MONITOR>JSYSA.MAC.255, 26-Nov-79 11:03:54, EDIT BY MILLER
;TCO 4.1.1026. LOCK FILLCK AND FKLOCK IN PMAP
;<4.1.MONITOR>JSYSA.MAC.254, 16-Nov-79 15:01:35, EDIT BY ENGEL
;TREAT STRINGS WITH ONLY NULLS AS NULL PASSWORDS FOR CHKPSX
;<4.1.MONITOR>JSYSA.MAC.253, 13-Nov-79 08:49:47, Edit by KONEN
;FIX ACTLCK GETTING UNLOCKED WHEN ALREADY UNLOCKED
;<4.1.MONITOR>JSYSA.MAC.252, 13-Nov-79 07:05:40, EDIT BY R.ACE
;TCO 4.1.1018 - REMOVE EFACT JSYS
;<4.1.MONITOR>JSYSA.MAC.251, 8-Nov-79 15:05:41, Edit by KONEN
;CORRECT SKIP INSTRUCTION IN UFNRAS SO DATA IS MOVED TO USER AREA
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH PROLOG,ACTSYM
TTITLE JSYSA
Subttl Table of Contents
; Table of Contents for JSYSA
;
; Section Page
;
;
; 1. Local Definitions . . . . . . . . . . . . . . . . . . 4
; 2. Local Routines
; 2.1 Perform BOUT (BOUTA) . . . . . . . . . . . . . 5
; 2.2 Perform BIN (BIN1) . . . . . . . . . . . . . . 6
; 2.3 Password Check (PASSWC/CHKPSX) . . . . . . . . 7
; 2.4 Lock Device Tables (LCKDVL) . . . . . . . . . 12
; 2.5 Check 7-Bit Byte Pointer (PTRCHK) . . . . . . 13
; 3. ACCES JSYS . . . . . . . . . . . . . . . . . . . . . . 14
; 4. ADBRK JSYS . . . . . . . . . . . . . . . . . . . . . . 24
; 5. ALLOC JSYS . . . . . . . . . . . . . . . . . . . . . . 31
; 6. CACCT JSYS . . . . . . . . . . . . . . . . . . . . . . 33
; 7. CFIBF JSYS . . . . . . . . . . . . . . . . . . . . . . 37
; 8. CFOBF JSYS . . . . . . . . . . . . . . . . . . . . . . 38
; 9. CNDIR JSYS . . . . . . . . . . . . . . . . . . . . . . 39
; 10. CNFIG JSYS . . . . . . . . . . . . . . . . . . . . . . 40
; 11. DELDF JSYS . . . . . . . . . . . . . . . . . . . . . . 43
; 12. DEVST JSYS . . . . . . . . . . . . . . . . . . . . . . 44
; 13. DIBE JSYS . . . . . . . . . . . . . . . . . . . . . . 45
; 14. DIRST JSYS . . . . . . . . . . . . . . . . . . . . . . 46
; 15. DOBE JSYS . . . . . . . . . . . . . . . . . . . . . . 47
; 16. ERSTR JSYS . . . . . . . . . . . . . . . . . . . . . . 48
; 17. GACCT JSYS . . . . . . . . . . . . . . . . . . . . . . 53
; 18. GETER JSYS . . . . . . . . . . . . . . . . . . . . . . 54
; 19. Access Control . . . . . . . . . . . . . . . . . . . . 55
; 19.1 GETOK JSYS . . . . . . . . . . . . . . . . . . 57
; 19.2 RCVOK JSYS . . . . . . . . . . . . . . . . . . 68
; 19.3 GIVOK JSYS . . . . . . . . . . . . . . . . . . 71
; 19.4 Delete ACJ Fork (ACJKIL) . . . . . . . . . . . 75
; 20. GTABS JSYS . . . . . . . . . . . . . . . . . . . . . . 76
; 21. GTAD JSYS . . . . . . . . . . . . . . . . . . . . . . 77
; 22. GTDIR JSYS . . . . . . . . . . . . . . . . . . . . . . 78
; 23. PLOCK JSYS . . . . . . . . . . . . . . . . . . . . . . 89
; 24. NIN JSYS . . . . . . . . . . . . . . . . . . . . . . . 94
; 25. NOUT JSYS . . . . . . . . . . . . . . . . . . . . . . 96
; 26. NTINF JSYS . . . . . . . . . . . . . . . . . . . . . . 99
; 27. PMAP JSYS . . . . . . . . . . . . . . . . . . . . . . 102
; 28. PPNST JSYS . . . . . . . . . . . . . . . . . . . . . . 113
; 29. PMCTL JSYS . . . . . . . . . . . . . . . . . . . . . . 115
; 30. PRARG JSYS . . . . . . . . . . . . . . . . . . . . . . 118
; 31. QUEUE% JSYS . . . . . . . . . . . . . . . . . . . . . 120
; 32. RELD JSYS . . . . . . . . . . . . . . . . . . . . . . 131
; 33. RESET JSYS . . . . . . . . . . . . . . . . . . . . . . 135
; 34. RFCOC JSYS . . . . . . . . . . . . . . . . . . . . . . 137
; 35. RFMOD JSYS . . . . . . . . . . . . . . . . . . . . . . 138
; 36. RFPOS JSYS . . . . . . . . . . . . . . . . . . . . . . 139
; 37. RMAP JSYS . . . . . . . . . . . . . . . . . . . . . . 140
; 38. RPACS JSYS . . . . . . . . . . . . . . . . . . . . . . 142
Subttl Table of Contents (page 2)
; Table of Contents for JSYSA
;
; Section Page
;
;
; 39. RSMAP JSYS . . . . . . . . . . . . . . . . . . . . . . 143
; 40. SETER JSYS . . . . . . . . . . . . . . . . . . . . . . 145
; 41. SETJB JSYS . . . . . . . . . . . . . . . . . . . . . . 146
; 42. SFCOC JSYS . . . . . . . . . . . . . . . . . . . . . . 151
; 43. SFMOD JSYS . . . . . . . . . . . . . . . . . . . . . . 152
; 44. SFPOS JSYS . . . . . . . . . . . . . . . . . . . . . . 153
; 45. SMAP JSYS . . . . . . . . . . . . . . . . . . . . . . 154
; 46. SMON JSYS . . . . . . . . . . . . . . . . . . . . . . 159
; 47. SNOOP JSYS . . . . . . . . . . . . . . . . . . . . . . 167
; 48. SOBE JSYS . . . . . . . . . . . . . . . . . . . . . . 187
; 49. SOBF JSYS . . . . . . . . . . . . . . . . . . . . . . 188
; 50. SPACS JSYS . . . . . . . . . . . . . . . . . . . . . . 189
; 51. SPOOL JSYS . . . . . . . . . . . . . . . . . . . . . . 191
; 52. STABS JSYS . . . . . . . . . . . . . . . . . . . . . . 193
; 53. STAD JSYS . . . . . . . . . . . . . . . . . . . . . . 194
; 54. STDEV JSYS . . . . . . . . . . . . . . . . . . . . . . 195
; 55. STI JSYS . . . . . . . . . . . . . . . . . . . . . . . 198
; 56. TMON JSYS . . . . . . . . . . . . . . . . . . . . . . 199
; 57. UTEST JSYS . . . . . . . . . . . . . . . . . . . . . . 203
; 58. VACCT JSYS . . . . . . . . . . . . . . . . . . . . . . 207
; 59. End of JSYSA . . . . . . . . . . . . . . . . . . . . . 225
SUBTTL Local Definitions
;This file contains code which implements various JSYSes. This code does not
;require any special AC definitions. Some JSYSes, particularly file-related
;ones, use the GTJFN ac definitions, and these are generally in JSYSF.
SWAPCD
EXTN <HOMSNM,HM1BLK,HM2BLK> ;DEFINED ELSEWHERE
EXTN <MXSTRU>
EXTN <LODPPS,ULDPAG> ;FOR LOCK JSYS ONLY
EXTN <DEQERR> ;IN APRSRV, TO GET ERROR BLOCK
EXTN <SETCLS> ;IN SCHED, SETS CLASS OF JOB
EXTN <.JBVER> ;IN JOBDAT
;Storage
RS(FACTSW) ; Fact switches
RS TADIDT,1 ;INITIAL DAY AND TIME
PPNLH==:4 ;SYSTEM DEFINED PPN LHS
;BIT FOR SETACT (SET ACCOUNT) AND VERACT (VERIFY ACCOUNT)
AC%MCH==:1B1 ;ACCOUNT MATCHES ACCTSR
SUBTTL Local Routines -- Perform BOUT (BOUTA)
;ROUTINES USED BY IO CONVERSION JSYSES TO DO LOGICAL BIN AND BOUT.
;REAL BIN AND BOUT IS DONE IF THE SOURCE/DESTINATION IS A JFN.
;IF IT IS A STRING POINTER, WE DO THE ILDB/IDPB HERE IN ORDER
;THAT THE 'PREVIOUS CONTEXT' IS STILL THE JSYS'S CALLER.
;LOCAL BOUT
; A (PREVIOUS CONTEXT)/ JFN OR STRING PTR
; B/ BYTE
; CALL BOUTA
; RETURN +1 ALWAYS
BOUTA:: PUSH P,A
UMOVE A,1 ; Output designator
TLNN A,777777 ; String pointer?
JRST [ BOUT ;NO, CAN DO BOUT
ERJMP [ ITERR(,<MOVE A,LSTERR>)]
POP P,A
RET]
TLC A,777777 ; Yes
TLCN A,777777 ; Lh = -1?
HRLI A,440700 ; Yes. fill in
XCTBU [IDPB B,A]
UMOVEM A,1
PUSH P,B
SETZ B,
XCTBU [IDPB B,A]
POP P,B
POP P,A
RET
SUBTTL Local Routines -- Perform BIN (BIN1)
;LOCAL BIN
; This routine will return a character from the users input designator
; in T1. If there is a CRLF sequence in the input buffer or string, just
; the LF will be returned. Otherwise, the character read will be returned.
;RETURNS +1: ERROR OR EOF
; +2: BYTE IN B
BIN1:: SAVEAC <T1> ;SAVE T1
UMOVE A,1 ;GET SOURCE DESIGNATOR FROM USER
CALL BIN2 ;GET A BYTE
RET ;ERROR OR EOF
CAIE T2,.CHCRT ;DO WE HAVE A CR?
RETSKP ;NO, RETURN THE CHARACTER TO CALLER
CALL BIN2 ;YES, GET THE NEXT CHARACTER
JRST BIN3 ;ERROR OR EOF, RETURN THE CR TO CALLER
CAIN T2,.CHLFD ;IS THIS CHARACTER A LF?
RETSKP ;YES, RETURN IT TO CALLER
BKJFN ;PUT THE CHARACTER BACK
SKIPA ;IF ERROR HERE, DON'T UPDATE USER'S DESIGNATOR
UMOVEM T1,T1 ;UPDATE DESIGNATOR IN USER'S SPACE
BIN3: MOVEI T2,.CHCRT ;GET THE CR
RETSKP ;AND RETURN SUCCESS
BIN2: TLNN A,777777 ;DO WE HAVE A STRING POINTER?
JRST [ BIN ;NOT STRING PTR, DO REGULAR BIN
ERJMP R ;ERROR OR EOF, RETURN NOW
RETSKP] ;GOT THE CHARACTER, RETURN SUCCESS
TLC A,777777 ;DO WE HAVE A LH OF -1?
TLCN A,777777 ;...
HRLI A,440700 ;YES, MAKE IT A STANDARD BYTE POINTER
XCTBU [ILDB B,A] ;AND GET A BYTE
UMOVEM A,1 ;PUT UPDATED POINTER BACK IN USERS SPACE
RETSKP ;AND RETURN SUCCESS
SUBTTL Local Routines -- Password Check (PASSWC/CHKPSX)
;PASSWORD CHECK FOR INTERNAL USE
; A/ directory number
; B/ password string ptr
;RETURNS +1: INVALID PASSWORD
; A=0, CALLER MUST DISMS FOR 3 SEC
; A=-1, NO PASSWORD WAS GIVEN, NO NEED FOR 3 SEC WAIT
PASSWC::EA.ENT
PUSH P,B
CALL SETDIR
JRST [ POP P,B
RET]
POP P,B
CALL CHKPSX
CAIA
AOS 0(P)
ULKDIR
RET
CHKPSW::UMOVE B,2 ;[7.1200] Entry for LOGIN JSYS
CHKPSX::SAVEQ
JUMPE B,RETO ;If no pointer to password string, return
SKIPN C,JBFLTM ;Has there been a recent failure?
IFSKP. ;If so
ADDI C,MINTVL ;3 minutes since the failure
CAML C,TODCLK ;Has 3 minutes elapsed?
IFSKP. ;If so
SETZM JBFLTM ;No retry time
SETZM JBFLCT ;And no count
ELSE.
MOVE C,JBFLCT ;Get the count
CAIL C,MXFLCT ;Failed too many times?
ANNSK. ;If so
CAIE C,MXFLCT ;First time?
IFSKP. ;If so
MOVE T1,CTRLTT ;Get TTY
MOVE T2,JOBNO ;Get job number
MOVE T2,JOBDIR(T2) ;Get user number
LOAD T3,CURSTR ;Get STR #
MOVE T3,STRTAB(T3) ;GET SDB POINTER
LOAD T3,STRNAM,(T3) ;GET SIXBIT STRUCTURE NAME
MOVE T4,DIRORA ;Get origin of directory
LOAD T4,DRNUM,(T4) ;Get number of DIR
BUG.(INF,BREAKI,JSYSA,SOFT,<Password guess threshold exceeded>,<<T1,CTRLTT>,<T2,USERNO>,<T3,STRNAM>,<T4,DIRNUM>>,<
Cause: Someone has typed more than MXFLCT incorrect passwords. All password
validation attempts by this job will be denied for 3 minutes (MINTVL).
It is possible the person is trying to guess passwords.
Action: See if someone is trying to guess a user's password or if the user is
really making an honest mistake.
Data: CTRLTT - The line number of the job
USERNO - The user number if the job is logged in
STRNAM - The sixbit name of the structure of the target
DIRNUM - The directory number of the target
>,,<DB%NND>) ;[7.1210]
ENDIF.
CAIGE C,MXLOGO ;Time to get rid of this turkey?
IFSKP. ;If so
MOVE T1,JOBNO ;get job number of self
IFN STANSW,<
MOVE T2,CAPMSK ;get possible capabilities
TXNN T2,SC%WHL!SC%OPR ;a winner? don't log them out
>;IFN STANSW
CALL ELOGOO ;Do it via interrupts in case we are NOINT
ENDIF.
CALL PASPEN ;Do a penalty
CALLRET RETO ;and say it's no good
ENDIF.
ENDIF.
TRVAR <CHKPSP,CHKPSO,CHKPSB>
TLC B,777777 ;Build a byte pointer, if necessary
TLCN B,777777
HRLI B,(<POINT 7,0>) ; ...
MOVEM B,CHKPSO ;Save user byte pointer
XCTBU [ILDB B,B] ;Get first byte
JUMPE B,RETZ ;No password string
MOVE B,DIRORA ;Get address of mapped directory
LOAD B,DRPSW,(B) ;Get address of password string
JUMPE B,RETZ ;Return if no address
ADD B,DIRORA ;Get absolute address of password block
MOVE C,1(B) ;Get first word of password string
TLNN C,774000 ;Is first byte nonzero?
JRST RETZ ;No, null password never matches
MOVEM B,CHKPSP ;Save pointer to password block
MOVE A,DIRORA ;Get directory origin
LOAD A,DRPEV,(A) ;Get encryption version
JUMPE A,PNTENC ;Jump if not encrypted
MOVE A,CHKPSO ;Get user pointer
CALL CPYFUS ;Go NOINT, assign 8 words, copy and raise string
JRST RETZ ;JSB full
HRLI A,-7 ;Make lookup pointer
MOVEM A,CHKPSB ;Save it to be released
MOVE B,A ;Get pointer in B
MOVE A,DIRORA ;Get back to directory
LOAD A,DRPEV,(A) ;Get encryption version again
CALL ENCPAS ;Encrypt user password
JRST CHKPS2 ;Failed - probably bad version number
IFE STANSW,<
MOVEI C,(A) ;Point to hashed block
MOVE A,CHKPSP ;Recover pointer to directory password block
MOVEI B,8 ;Check 8 words
CHKPS1: MOVE D,1(A) ;Get a word
CAME D,1(C) ;Same?
JRST CHKPS2 ;No match
ADDI C,1 ;Next word in user password
ADDI A,1 ;Next word in directory password
SOJG B,CHKPS1 ;Iterate 8 times
>;IFE STANSW
IFN STANSW,<
;Compare the passwords a byte at a time, since we may have garbage in the
; last word(s) of either password string.
MOVEI A,1(A) ;Point to start of user password
HRLI A,(POINT 7) ;Set up a local byte pointer
MOVE C,CHKPSP ;Start of directory password
MOVE B,[POINT 7,1(C)] ;Set up an indexed byte pointer
CHKPS1: ILDB Q1,A ;Get byte from user password
ILDB Q2,B ;Get byte from directory password
CAIE Q1,(Q2) ;Match?
JRST CHKPS2 ;No, take failure exit
JUMPN Q1,CHKPS1 ;Keep going until we hit a null byte
>;IFN STANSW
MOVEI A,JSBFRE ;Get free-space pool
MOVE B,CHKPSB ;Get address of password block
CALL RELFRE ;Free the temporary storage
OKINT
JRST PASMAT ;Password matched
CHKPS2: MOVEI A,JSBFRE ;Get free-space pool
MOVE B,CHKPSB ;Get address of password block
CALL RELFRE ;Free the temporary storage
OKINT
JRST RETZ ;Password does not match
;Here if password is not encrypted
PNTENC: MOVEI Q1,MAXLC ;GET MAXIMUM CHARACTERS
MOVSI A,(POINT 7,0(B),35) ;GET BYTE POINTER TO DIRECTORY PASSWRD STRING
CHKPS3: CALL CHKPRD ;GET A BYTE OF USER PASSWORD STRING
CAIL D,"A"+40 ;LOWERCASE?
CAILE D,"Z"+40 ; ...
SKIPA ; ...
SUBI D,40 ;YES, CONVERT IT TO UPPERCASE
ILDB Q3,A ;GET A BYTE OF DIRECTORY PASSWORD STRING
CAME D,Q3 ;DIRECTORY/USER BYTES MATCH?
JRST CHKPS4 ;NO MATCH, GO READ REST OF STRING
JUMPE D,PASMAT ;MATCH
SOJG Q1,CHKPS3 ;COUNT DOWN MAX STRING LENGTH
JRST RETZ ;STRING TOO LONG
CHKPS4: CAIN Q1,MAXLC ;FIRST CHARACTER?
JUMPE D,RETO ;YES, IF NULL, THEN DONT NEED TO WAIT
CHKPS5: JUMPE D,RETZ ;END OF USER'S STRING?
SOJLE Q1,RETZ ;NO, READ ALL CHARACTERS YET?
CALL CHKPRD ;NO, READ WHOLE STRING TO FOUL PAGE
JRST CHKPS5 ; FAULT WATCHERS
;Routine to read a byte from user password string. Protects from address
; break watchers.
CHKPRD: XCTBU [ILDB D,CHKPSO] ;Get next byte
RET
ENDTV.
PASMAT: MOVE Q1,DIRORA ;GET BASE ADDRESS OF DIRECTORY
LOAD A,DRPMU,(Q1) ;GET THE MAXIMUM USE COUNT
JUMPE A,CHKPED ;IF ZERO, NONE SET
LOAD A,DRPCU,(Q1) ;GET THE CURRENT USE COUNT
AOS A ;INCREMENT IT
TLNE A,-1 ;HAS THE COUNT OVERFLOWED INTO LEFT HALF
JRST RETZ ;YES, TREAT IT AN AN INCORRECT PASSWORD
STOR A,DRPCU,(Q1) ;SAVE IT
LOAD B,DRPMU,(Q1) ;GET THE MAXIMUM USE COUNT
CAMLE A,B ;LESS THAN OR EQUAL TO MAXIMUM?
JRST RETZ ;NO, TREAT IT AS AN INCORRECT PASSWORD
CHKPED: LOAD B,DRPED,(Q1) ;GET THE EXPIRATION TIME AND DATE
JUMPE B,RSKP ;IF ZERO, NON SET
CALL LGTAD ;GET THE CURRENT TIME
LOAD B,DRPED,(Q1) ;GET THE EXPIRATION DATE AGAIN
SKIPL A ;WAS THE TIME SET?
CAMLE A,B ;HAS IT EXPIRED?
JRST RETZ ;YES, TREAT IT AS AN INCORRECT PASSWORD
;NOTE THAT IF THE TIME HAS NOT BEEN SET,
;NO PASSWORD WITH AN EXPIRATION DATE SET
;WILL WORK
RETSKP ;NO, THIS IS A GOOD PASSWORD
;CENTRAL ROUTINE TO ISSUE PENALTIES ON USE OF BAD PASSWORDS
PASPEN::
IFE NICSW,<
MOVEI T1,^D3000 ;3 sec. delay
>
IFN NICSW,<
MOVEI T1,^D1000 ;1 sec. delay
>
DISMS% ;Sit it out
AOS JBFLCT ;Delay count
MOVE A,TODCLK ;Get now
MOVEM A,JBFLTM ;And save the time as well
RET
SUBTTL Local Routines -- Lock Device Tables (LCKDVL)
;SET THE DEVICE TABLES LOCK.
;MUST BECOME NOINT SO CONTROL DOESN'T RETURN TO USER WITH LOCK
;SET.
LCKDVL:: NOINT
EA.ENT
LOKK (DEVLKK,<JRST LCKDV1>) ;ATTEMPT LOCK
RET ;SUCESS
LCKDV1: OKINT ;FAILURE, RE-ENABLE INTERRUPTS
CAIA ;SO USER CAN BREAK OUT WITH ^C
JRST LCKDVL ;WAIT SHORT TIME THEN TRY AGAIN
CBLK1 ;THIS RETURNS .-1
SUBTTL Local Routines -- Check 7-Bit Byte Pointer (PTRCHK)
;CHECK IF POINTER IS LOCAL OR 7-BIT OWGBP
;IF LOCAL BYTE POINTER THEN SKIP RETURN
;IF PCS IS NON-ZERO AND SEVEN BIT OWGBP THEN SKIP RETURN
;IF PCS IS NON-ZERO AND NON SEVEN BIT OWGBP THEN NON SKIP RETURN
;IF PCS IS ZERO AND OWGBP THEN NON-SKIP RETURN
;IF 1B12 IS ON (INDICATING GLOBAL BYTE POINTER) THEN NON-SKIP RETURN
;POINTER IN A. A IS DESTROYED
PTRCHK:: ;ROUTINE TO CHECK BYTE POINTER
TLC A,777777 ;COMPLEMENT AC
TLCN A,777777 ;FIX AC...IS LEFT HALF -1?
RETSKP ;YES SKIP RETURN
TXNE A,<1B12> ;SINGLE WORD BYTE POINTER?
RET ;NO...NON-SKIP RETURN
LDB A,[POINT 6,A,5] ;GET THE P FIELD OF BYTE POINTER
CAIG A,44 ;LOCAL BYTE POINTER?
RETSKP ;YES SO SKIP RETURN
CAIL A,61 ;7-BIT OWGBP?
CAILE A,66 ;7-BIT OWGBP?
RET ;NON SEVEN BIT OWGBP...NON SKIP RETURN
CALL SPCSNZ ;PREVIOUS CONTEXT SECTION NON ZERO?
RET ;PCS IS ZERO...NON SKIP RETURN
RETSKP ;7 BIT OWGBP AND PCS NZ...SKIP RETURN
SUBTTL ACCES JSYS
; CALL TO ACCESS DIRECTORIES
;
; ACCEPTS IN 1/ FLAGS,, N
; 2/ ADDRESS OF ARGUMENT BLOCK
; ARGBLK: DIRECTORY DESIGNATOR
; POINTER TO PASSWORD STRING
; JOB NUMBER (-1 FOR SELF)
.ACCES::MCENT ;MONITOR CONTEXT ENTRY
CALL ACCES0 ;CALL ROUTINE TO DO THE WORK
ITERR ;ILLEGAL INSTRUCTION TRAP
MRETNG ;SUCCESS RETURN (+1)
;ACCES0 - DOES THE WORK FOR .ACCES
;ACCEPTS: SAME AS .ACCES
;RETURNS +1: FAILED, ERROR CODE IN AC 1
; +2: SUCCEEDED
;REGISTER USAGE:
; Q1/ADDRESS OF ARGUMENT BLOCK IN USER'S SPACE
; Q2/DIRECTORY NUMBER
; Q3/STRUCTURE NUMBER (OFFSET IN STRTAB)
; P1/ADDRESS OF START OF MAPPED DIRECTORY
; P2/FLAG INDICATING WHETHER PRIVILEGE IS SUFFICIENT
; P3/JOB NUMBER FOR WHICH CALLED
; P4/OFFSET IN STRUCTURE TABLES IN JSB FOR THIS STRUCTURE
; P5/STRUCTURE UNIQUE CODE
ACCES0: STKVAR<ACCFLG,ACCDRA,<ACCNAM,MAXLW>,ERRFLG>
SETZM ACCFLG ;NO FLAGS LOADED YET
SETZM ERRFLG ;INIT FLAG TO FIRST PASS
SETZM ACCDRA ;NONE HERE YET EITHER
;CHECK FOR ERRORS
ACES0: UMOVE T1,1 ;GET FLAGS,,LENGTH OF ARGUMENT BLOCK
SKIPE ACCFLG ;SEEN FLAGS YET?
HLL T1,ACCFLG ;YES. USE THE SAME FLAGS THEN
TXNN T1,AC%CON!AC%OWN!AC%REM!AC%PWD ;WAS ANY FUNCTION REQUESTED?
RETBAD(ACESX5) ;NO. ERROR
HLLZM T1,ACCFLG ;SAVE FLAGS
HRRZ T2,T1 ;GET LENGTH OF ARGUMENT BLOCK
CAIG T2,.ACJOB ;IS IT LONG ENOUGH FOR ALL ARGUMENTS?
RETBAD (ACESX1) ;NO. RETURN ERROR
MOVE T1,JOBNO ;GET THIS JOB'S NUMBER
HRRZ T2,JOBDIR(T1) ;GET THIS JOB'S DIRECTORY NUMBER
SKIPN T2 ;IS IT LOGGED IN?
RETBAD(CNDIX5) ;NO. ERROR
;GET USER'S LOGGED IN DIRECTORY NAME TO CHECK AGAINST LATER
HRLI T2,USRLH ;MAKE IT A USER NUMBER
MOVEI T1,ACCNAM ;T1/DESTINATION ON STACK
HRLI T1,(POINT 7,0)
DIRST ;CONVERT TO DIRECTORY NAME ON PS:
RETBAD
;GET STRUCTURE UNIQUE CODE, STRUCTURE NUMBER, AND DIRECTORY NUMBER
UMOVE Q1,2 ;GET ADDRESS OF ARGUMENT BLOCK
SKIPE T1,ACCDRA ;ALREADY HAVE DIR INFORMATION?
JRST ACES01 ;YES. USE IT
UMOVE T1,.ACDIR(Q1) ;GET STRUCTURE AND DIRECTORY OR BYTE POINTER
CALL CNVSTD ;GET (STRUCTURE,,DIRECTORY)
RETBAD
MOVEM T1,ACCDRA ;SAVE DIR NUMBER
LDB T1,[POINT 6,T1,17] ;[7.1063]Get structure number
CALL CKSTOF ;[7.1063](T1/T1)Is structure offline?
RETBAD () ;[7.1063]Return "Structure is offline"
MOVE T1,ACCDRA ;[7.1063]Restore T1
ACES01: HRRZ Q2,T1 ;SAVE DIRECTORY NUMBER
HLRZ P5,T1 ;SAVE UNIQUE CODE
CALL SETDIR ;MAP THE DIRECTORY AND GO NOINT
RETBAD ;FAILED
MOVE P1,DIRORA ;POINT TO START OF DIRECTORY
LOAD Q3,CURSTR ;GET STRUCTURE NUMBER FOR MAPPED DIRECTORY
;SEE WHAT JOB THIS IS FOR
UMOVE T1,.ACJOB(Q1) ;GET JOB NUMBER FOR WHICH THIS IS TO BE DONE
CAME T1,[-1] ;DID USER SPECIFY 'THIS JOB'?
CAMN T1,JOBNO ; OR JOB NUMBER SAME AS THE USER'S?
SKIPA ;YES
IFNSK. ;HERE IF USER SPECIFIED ANOTHER JOB
CALL GL2LCL ;SO CONVERT IT FROM GLOBAL TO LOCAL INDEX
JRST [ CALL USTDIR ;UNLOCK THE DIRECTORY
RETBAD ] ;RETURN FAILURE
JRST ACCES7 ;GO DO IT SEPARATELY
ENDIF.
;FOR THIS JOB. SEE IF USER WANTS TO DO UNACCESS
MOVE T2,ACCFLG ;GET INPUT FLAGS
TXNN T2,AC%REM ;UNACCESS REQUESTED?
JRST ACCES1 ;NO.
LOCK JSSTLK ;LOCK THE JSB STORAGE LOCK
SETZ T1, ;T1/OFFSET TO MAPPED JSB (NONE FOR THIS JOB)
CALL UNACC ;DO IT
JRST [ UNLOCK JSSTLK ;UNLOCK THE JSB
CALL USTDIR ;UNLOCK THE DIRECTORY
RETBAD ] ;RETURN FAILURE
UNLOCK JSSTLK ;UNLOCK THE JSB SPACE
CALL USTDIR ;UNLOCK THE DIRECTORY
RETSKP ;SUCCESS
;NOT UNACCESS. SEE IF USER HAS PRIVILEGES OR CORRECT PASSWORD
ACCES1: MOVE T2,ACCFLG ;GET FLAGS AGAIN
TXNE T2,AC%PWD ;JUST CHECK PASSWORD?
JRST ACCESC ;YES, GO DO IT
MOVE T1,CAPENB ;GET ENABLED CAPABILITIES OF THIS FORK
SKIPN ERRFLG ;SECOND PASS (I.E. ACJ APPROVES?)
TXNE T1,SC%WHL!SC%OPR ;WHEEL OR OPERATOR?
JRST [ SETZM P2 ;YES. INDICATE OK TO DO THIS
JRST ACCES2]
UMOVE T2,.ACPSW(Q1) ;GET POINTER TO PASSWORD IN USER'S SPACE
SKIPN T2 ;IS THERE A PASSWORD?
JRST [ MOVX P2,1B0 ;NO. INDICATE NOT OK TO DO THIS
JRST ACCES2]
CALL CHKPSX ;CHECK THE PASSWORD FROM USER'S ADDRESS SPACE
JRST [ MOVX P2,1B1 ;FAILED. INDICATE NOT OK TO DO THIS
JRST ACCES2]
SETZM P2 ;OK. INDICATE ACCESS OK
;CHECK IF USER IS REQUESTING ACCESS TO PUBLIC STRUCTURE OR PREVIOUSLY
;MOUNTED STRUCTURE
ACCES2: MOVE T1,P5 ;GET UNIQUE STR CODE FOR CHKMNT
SETZ T2, ;JSB IS ALREADY MAPPED
LOCK JSSTLK ;LOCK JSB STRUCTURE INFO LOCK
CALL CHKMNT ;CHECK ACCESS TO STRUCTURE
JRST [ UNLOCK JSSTLK ;USER DIDN'T MOUNT STRUCTURE
CALL USTDIR ;UNLOCK DIRECTORY
RETBAD]
;P2 IS NON-ZERO IF HAVEN'T YET PROVED RIGHT TO DO THIS, 0 IF OK TO DO THIS
;IF NOT OK SO FAR, CHECK FOR SPECIAL CASE WHERE USER'S NAME AND THAT OF
;DIRECTORY BEING REQUESTED MATCH, THE OBJECT DIRECTORY IS ON A DOMESTIC
;STRUCTURE, AND THE OWNER FIELD OF THE DIRECTORY PROTECTION ALLOWS CONNECTING
ACCES3: SKIPN P2 ;IS USER ALLOWED TO DO THIS FUNCTION?
JRST ACCES8 ;YES.
MOVE T1,STRTAB(Q3) ;NO. POINT TO SDB FOR THIS STRUCTURE
MOVE T1,SDBSTS(T1) ;GET STATUS OF THIS STRUCTURE
TXNN T1,MS%DOM ;IS IT MOUNTED DOMESTIC?
JRST ACCES8 ;NO. SPECIAL CASE DOESN'T APPLY
MOVE T1,P1 ;POINT TO START OF DIRECTORY
LOAD T1,DRPOW,(T1) ;GET OWNER PROTECTION BITS
TXNN T1,DP%CN ;SEE IF CONNECT IS SET
JRST ACCES8 ;NO. SPECIAL CASE DOESN'T APPLY
MOVEI T1,ACCNAM ;T1/POINTER TO USER'S NAME AS SET
HRLI T1,(POINT 7,0) ; BY DIRST
MOVE Q1,P1 ;POINT TO START OF DIRECTORY
OPSTR <ADD Q1,>,DRNAM,(Q1) ;GET NAME OF DIRECTORY
AOS Q1 ;POINT BEYOND HEADER TO ACTUAL NAME STRING
MOVE T2,[POINT 7,0(Q1)] ;T2/POINTER TO NAME OF REQUESTED DIRECTORY
CALL STRCMP ;SEE IF USER NAME MATCHES REQUESTED DIRECTORY
JRST ACCES8 ;NO. SPECIAL CASE DOESN'T APPLY
SETZ P2, ;YES. INDICATE OK TO DO THIS
;DECIDE WHAT USER WANTS TO DO
ACCES8: MOVE T1,ACCFLG ;GET FLAGS INDICATING WHAT TO DO
TXNN T1,AC%OWN ;GAIN OWNERSHIP (GROUPS)?
JRST ACCES4 ;NO. GO SEE IF CONN
;USER WANTS TO 'ACCESS' THE DIRECTORY - GAIN ITS GROUPS
MOVE T1,P1 ;POINT TO START OF DIRECTORY THAT IS MAPPED
LOAD T1,DRMOD,(T1) ;GET MODE OF DIRECTORY
TXNE T1,MD%FO ;IS IT FILES-ONLY?
JRST [ MOVEI T1,ACESX7 ;YES. CAN'T ACCESS IT
JRST ACCER2]
SKIPE P2 ;NO. DO WE HAVE ACCESS?
JRST [ MOVEI T1,CNDIX1 ;NO. ASSUME INVALID PASSWORD
TXNE P2,1B0 ;DID USER GIVE A PASSWORD?
MOVEI T1,ACESX3 ;NO. SAY PASSWORD IS REQUIRED
JRST ACCER3]
MOVE T1,P5 ;YES. T1/STRUCTURE UNIQUE CODE
CALL GTSTOF ;GET OFFSET IN JSB FOR THIS STRUCTURE
JRST ACCER2 ;NO ROOM FOR AN ENTRY
MOVEM T2,P4 ;SAVE OFFSET
LOAD T1,JSGRP,(P4) ;GET GROUPS PREVIOUSLY SET UP
SKIPE T1 ;WERE THERE ANY?
CALL RELGRP ;YES. RELEASE THE SPACE USED BY THE LIST
; OF GROUPS
CALL CPYUGP ;COPY THE LIST OF USER GROUPS
SETZ T1, ;NONE THERE. CLEAR POINTER
STOR T1,JSGRP,(P4) ;STORE POINTER IN JSB
STOR Q2,JSADN,(P4) ;SAVE 'ACCESSED' DIRECTORY
;SEE IF USER WANTS TO CONNECT
ACCES4: MOVE T1,ACCFLG ;GET FLAGS INDICATING WHAT TO DO
TXNE T1,AC%CON ;CONNECT
JRST ACCES5 ;YES
UNLOCK JSSTLK ;NO. UNLOCK THE JSB STRUCTURE DATA
CALL USTDIR ;UNMAP THE DIRECTORY
RETSKP ;TAKE SUCCESS RETURN
;USER WANTS TO CONNECT
ACCES5: SKIPN P2 ;WAS PASSWORD OK (OR PRIVILEGE SUFFICIENT)?
JRST ACCES6 ;YES. PROCEED
MOVX T2,DC%CN ;T2/CONNECT ACCESS
CALL DIRCHK ;CHECK FOR ABILITY TO CONNECT TO THIS DIRECTORY
JRST [ MOVEI T1,CNDIX1 ;NO. ASSUME INVALID PASSWORD
TXNE P2,1B0 ;DID USER GIVE A PASSWORD?
MOVEI T1,ACESX3 ;NO. SAY PASSWORD IS REQUIRED
JRST ACCER3]
ACCES6: STOR P5,JSUC ;NO. STORE CONNECTED STRUCTURE UNIQUE CODE
STOR Q2,JSDIR ;STORE CONNECTED DIRECTORY NUMBER
CALL CPYCDN ;GO COPY CONNECTED DIR STRING TO JSB
UNLOCK JSSTLK ;UNLOCK THE STRUCTURE INFO LOCK
CALL USTDIR ;UNLOCK THE DIRECTORY (LOCKED BY SETDIR)
; GO GO OKINT
RETSKP ;TAKE SUCCESS RETURN
;USER WANTS TO CONNECT FOR ANOTHER JOB
ACCES7: MOVEM T1,P3 ;SAVE OBJECT JOB NUMBER
CALL USTDIR ;UNLOCK THE DIRECTORY (LOCKED BY SETDIR)
; AND GO OKINT
SKIPN P3 ;VALID JOB #
RETBAD (ARGX07) ;NO. CAN'T DIDDLE JOB 0
MOVE T1,ACCFLG ;SEE WHAT WE WANT TO DO
TXNN T1,AC%CON ;CONNECT?
RETBAD(ACESX4) ;NO. CAN'T DO THIS FOR ANOTHER JOB
MOVE T1,CAPENB ;GET ENABLED CAPABILITIES
TXNN T1,SC%WHL!SC%OPR ;WHEEL OR OPERATOR?
RETBAD(CAPX1) ;NO. REQUIRED FOR THIS FUNCTION
MOVE T1,P3 ;T1/JOB NUMBER
CALL CKJBLI ;SEE IF VALID AND LOGGED IN
RETBAD ;NO. OBJECT JOB MUST BE LOGGED IN
MOVE T1,P3 ;T1/JOB NUMBER FOR WHICH CONNECTING
CALL MAPJSB ;MAP THE OBJECT JOB'S JSB (RETURNS OFFSET IN T1)
RETBAD(ARGX08) ;NO SUCH JOB
MOVEM T1,P1 ;SAVE OFFSETFOR ADDRESSING OBJECT JSB
LOCK JSSTLK(P1) ;LOCK STRUCTURE INFO LOCK
MOVE T2,T1 ;SEND OFFSET TO MAPPED JSB TO CHKMNT
CALL CHKMNT ;CHECK ACCESS TO STRUCTURE
JRST [ UNLOCK JSSTLK(P1) ;USER DID NOT MOUNT STRUCTURE
CALL CLRJSB
RETBAD]
STOR P5,JSUC,(P1) ;STORE CONNECTED STRUCTURE UNIQUE CODE
STOR Q2,JSDIR,(P1) ;STORE CONNECTED DIRECTORY NUMBER
SETZRO JSCDF,(P1) ;MARK THAT THE DIR STRING IN JSB IS NO GOOD
UNLOCK JSSTLK(P1) ;UNLOCK STRUCTURE INFO LOCK
CALL CLRJSB ;UNMAP THE OBJECT JSB
HLRE A,JOBPT(P3) ;GET TTY OF OBJECT JOB
JUMPL A,ACCES9 ;IF DETACHED, SKIP MESSAGE
TXO A,1B18 ;MAKE LINE NUMBER INTO DESIGNATOR
HRROI B,[ASCIZ/
[Connected to /] ;[7.1200]
SETZ C,
SOUT ;TYPE OUT CONNECTED MESSAGE
HRL T2,P5 ;GET STRUCTURE UNIQUE CODE
HRR T2,Q2 ;T2/(STRUCTURE UNIQUE CODE,,DIRECTORY)
DIRST ;PRINT STRUCTURE AND DIRECTORY NAMES
JFCL
HRROI B,[ASCIZ/]
/]
SOUT
ACCES9: RETSKP
;FAILURE
;USER GAVE WRONG PASSWORD
ACCER3: TDZA T2,T2 ;REMEMBER ENTRY
ACCER2: SETOM T2 ;REMEMBER THIS ENTRY
MOVEM T1,Q1 ;SAVE ERROR CODE
ULKDIR ;UNLOCK THE DIRECTORY AND STRUCTURE
UNLOCK JSSTLK ;UNLOCK JSB STRUCTURE INFO LOCK
JUMPE T2,[ UMOVE T1,1 ;IF ACJ TO GET INVOLVED
; GET USER ARG FOR ACJ
HRR T2,Q2 ;DIR NUMBER
HRL T2,P5 ;STRUCTURE CODE
OKINT ;ALLOW INTS
GTOKM (.GOACC,<T1,T2>,[NOINT
JRST .+1])
AOS ERRFLG ;IF SUCCESS, INCREMENT RETRY FLAG
JRST ACES0] ;AND TRY AGAIN
CAIN Q1,CNDIX1 ;IS ERROR THAT PASSWORD WAS BAD?
CALL PASPEN ;YES
MOVE T1,Q1 ;RESTORE ERROR CODE
OKINT ;SETDIR WENT NOINT
RETBAD ;TAKE ERROR RETURN
;ROUTINE TO COPY THE CONNECTED DIRECTORY NAME INTO THE JSB
CPYCDN::SETZRO JSCDF ;[7.1200] Mark the current string is invalid
LOAD T1,JSCDS ;GET THE CURRENT STRING POINTER
JUMPE T1,[MOVEI T2,MAXLW+1 ;IF NONE, GET SPACE FOR ONE
CALL ASGJFR
RET ;IF NO ROOM, DONT BOTHER
STOR T1,JSCDS ;REMEMBER THE STRING POINTER
JRST .+1]
MOVE T4,DIRORA ;NOW GET THE POINTER TO THE DIR NAME
LOAD T2,DRNAM,(T4) ;FROM CURRENT MAPPED DIR
ADD T2,DIRORA ;GET ABSOLUTE ADDRESS
MOVSI T3,(<POINT 7,0(T2),35>)
HRLI T1,(POINT 7,0,35) ;GET BYTE POINTERS TO BOTH STRINGS
CPYCDL: ILDB T4,T3 ;COPY STRING
IDPB T4,T1 ; FROM DIR HEADER TO JSB
JUMPN T4,CPYCDL ;LOOP BACK TIL NULL FOUND
SETONE JSCDF ;MARK THAT THE STRING IS VALID
RET ;AND RETURN
ACCESC: UMOVE T2,.ACPSW(Q1) ;Get pointer to password
SKIPE T2 ;[7428] Password string supplied?
IFSKP. ;[7428] No
MOVEI Q1,ACESX3 ;[7428] Load the proper error code
JRST ACCESE ;[7428] Return bad
ENDIF. ;[7428]
CALL CHKPSX ;[7428] (T2/T1) Check password
IFSKP. ;[7428] If the password matched
CALL USTDIR ;[7428] Unlock directory & structure, go OKINT
RETSKP ;[7428] Return the success
ENDIF. ;[7428]
MOVE T2,CAPENB ;[7428] Bad password, load enabled capabilities
TXNE T2,SC%WHL!SC%OPR ;[7428] Wheel or Operator?
IFSKP. ;[7428] Not prived, so apply penalty
SKIPN T1 ;[7428] Penalty already applied?
CALL PASPEN ;[7428] No, so apply it now
ENDIF. ;[7428]
MOVEI Q1,CNDIX1 ;[7428] Get correct error code
ACCESE: CALL USTDIR ;[7428] Unlock directory & structure, go OKINT
MOVE T1,Q1 ;Error code
RETBAD ;Take error return
;UNACC - UNACCESS A DIRECTORY
;ACCEPTS IN T1/ OFFSET TO JSB (0 FOR THIS JOB)
; JSSTLK MUST BE LOCKED BY THE CALLER OF THIS ROUTINE
;RETURNS +1: FAILS
; +2: SUCCESS
;DIRECTORY MUST BE MAPPED
UNACC::
SAVEQ
MOVEM T1,Q3 ;SAVE OFFSET TO MAPPED JSB
MOVE T1,DIRORA ;POINT TO START OF DIRECTORY
LOAD Q1,DRNUM,(T1) ;GET DIRECTORY NUMBER
LOAD Q2,CURUC ;GET UNIQUE CODE FOR MAPPED DIRECTORY
MOVE T1,Q2 ;GET UNIQUE CODE TO LOOK FOR
MOVE T2,Q3 ;GET OFFSET TO MAPPED JSB
CALL FNDSTM ;GET POINTER TO JSB BLOCK FOR THIS STRUCTURE
RETBAD (ACESX6)
LOAD T1,JSADN,(T2) ;GET ACCESSED DIRECTORY
CAME T1,Q1 ;DID USER ACCESS THIS DIRECTORY?
RETBAD (ACESX6)
SETZRO <JSADN>,(T2) ;YES. CLEAR ACCESSED DIRECTORY NUMBER
OPSTR <SKIPE T1,>,JSGRP,(T2) ;WERE THERE ANY GROUPS?
JRST [ JUMPN Q3,.+1 ;IF ANOTHER JSB, DO NOT FREE GROUP SPACE
SETZRO <JSGRP>,(T2) ;YES. CLEAR THE POINTER
CALL RELGRP ;RELEASE FREE SPACE
JRST .+1]
MOVE T1,Q2 ;T1/STRUCTURE UNIQUE CODE
MOVE T2,Q3 ;GET OFFSET TO JSB
CALL FRJSSO ;REMOVE ENTRY IN JSB FOR THIS STRUCTURE IF POSSIBLE
RETSKP ;SUCCESS
SUBTTL ADBRK JSYS
;JSYS TO SET/CLEAR ADDRESS BREAK
;ACCEPTS:
; 1/ FUNCTION CODE,,PROCESS HANDLE
; 2/ OPTIONAL ARGUMENT BASED ON FUNCTION
; 3/ OPTIONAL ARGUMENT BASED ON FUNCTION
; ADBRK
;RETURNS +1: ALWAYS
;CAUSES ILLEGAL INSTRUCTION TRAP ON ERROR
.ADBRK::MCENT
UMOVE T1,1 ;GET FUN. CODE, FORK HANDLE
HLRZ T2,T1 ;ISOLATE FUNCTION CODE
JUMPL T2,[ITERR (ARGX02)] ;INVALID FUNCTION CODE
CAILE T2,.ABGBR ;IN RANGE?
ITERR (ARGX02) ;NOPE
CALL BRKAVL ;SUPPORTED ON THIS MACHINE?
ITERR (ABRKX1) ;NO
HRRZ P1,T1 ;PRESERVE FORK HANDLE IN P1
CALL @[ IFIW!ABSET
IFIW!ABRED
IFIW!ABCLR
IFIW!ABGAD
IFIW!ABSRG
IFIW!ABRRG
IFIW!ABGBR](T2) ;DISPATCH ON FUNCTION CODE
ITERR ;ERROR RETURN
MRETNG ;GOOD
;.ABSET - SET USER ADDRESS BREAK
;Arguments:
; T2/ address
; T3/ Flags (AB%RED,AB%WRT,AB%XCT)
ABSET: UMOVE P2,2 ;GET ADDRESS
UMOVE P3,3 ; AND FLAGS
LSH P3,-<^D35-^L<AB%SEC>> ;RIGHT-JUSTIFY FLAGS (ASSUMES AB%SEC IS
; RIGHTMOST FLAG BIT)
MOVE P4,P2 ;FORCE UPPER TO BE SAME AS LOWER
JRST ABSRG4 ;GO TO COMMON SETTING
;.ABRED - READ USER ADDRESS BREAK
;RETURNS
; T2/ Address at which break is set
; T3/ flags
ABRED: CALL FLOCK ;LOCK FORK STRUCTURE
MOVE T1,P1 ;GET FORK HANDLE
CALL SETLFK ;MAP PSB
LOAD T2,ABLOW,(T1) ;GET BREAK INFO
LOAD T3,ABFLG,(T1) ;GET FLAGS
LSH T3,<^D35-^L<AB%SEC>> ;PUT BITS IN RIGHT PLACE (ASSUMES AB%SEC
; IS RIGHTMOST FLAG BIT)
IFN KCFLG,<
OPSTR <CAMN T2,>,ABUPP,(T1) ;ARE UPPER AND LOWER THE SAME?
TXNE T3,AB%SEC ;YES. WAS "IGNORE SECTION" REQUESTED?
JRST [ CALL CLRLFK ;ERROR. USER SET BREAK WITH NEW FUNCTION
CALL FUNLK
RETBAD (ABRKX3)]
> ;END OF IFN KCFLG
XCTU [ DMOVEM T2,2] ;RETURN ANSWERS TO USER
CALL CLRLFK ;UNMAP PSB
CALL FUNLK ;UNLOCK
RETSKP
;.ABCLR - CLEAR USER ADDRESS BREAK
ABCLR: CALL FLOCK ;LOCK FORK STRUCTURE
MOVE T1,P1 ;GET FORK HANDLE
IFE STANSW,<
NOSKED ;KEEP HARDWARE AND PSB DATA IN SYNCH
CAIN T1,.FHSLF ;CLEARING OUR OWN BREAKS?
JSP T4,CLRBRK ;YES. CLEAR BREAK CONDITIONS IN HARDWARE
MOVE T1,P1 ;RESTORE THE FORK HANDLE
>;End of IFE STANSW
CALL SETLFX ;Map PSB and check for execute-only
SKIPE ADRBRK(T1) ;IF WE DIDN'T HAVE A BREAK IN THE FIRST PLACE,
; WE CAN'T DECREMENT THE COUNT
JRST [ SOS USERBK ;DECREMENT COUNT OF USER MODE ADDRESS BREAKS
SETZM ADRBRK(T1) ;CLEAR OUT ADDRESS BREAK INFO
JRST .+1]
IFN STANSW,<
CAIN P1,.FHSLF ;CLEARING OUR OWN BREAKS?
JSP T4,CLRBRK ;YES. CLEAR BREAK CONDITIONS IN HARDWARE
MOVE T1,P1 ;RESTORE THE FORK HANDLE
>;End of IFN STANSW
IFE STANSW,<
OKSKED ;BREAK CLEARED IN HARDWARE AND PSB
>;End of IFE STANSW
CALL CLRLFK ;UNMAP PSB
CALL FUNLK
RETSKP
;.ABGAD - READ ADDRESS OF INSTRUCTION WHICH CAUSED LAST ADDRESS BREAK
; (RFSTS GIVES ADDRESS OF NEXT INSTRUCTION TO BE EXECUTED,
; WHICH IS USELESS IF THE ADDRESS BREAK WAS CAUSED BY A
; PC-CHANGING INSTRUCTION)
ABGAD: CALL FLOCK ;LOCK FORK STRUCTURE
MOVE T1,P1 ;GET FORK HANDLE
CALL SETLFK ;MAP ITS PSB
MOVE T2,ADRBK1(T1) ;GET ADDR OF BROKEN INSTRUCTION
UMOVEM T2,2 ;RETURN TO USER
CALL CLRLFK ;UNMAP PSB
CALL FUNLK ;UNLOCK FORK STRUCTURE
RETSKP ;GIVE GOOD RETURN
;.ABSRG - Set address break range
;Arguments:
; T2/ Address of argument block
; BLOCK: Flags,,length of block
; Lower bound address
; Upper bound address
ABSRG: UMOVE P5,T2 ;GET ADDRESS OF ARGUMENT BLOCK
UMOVE P3,.ABHDR(P5) ;GET HEADER WORD
ERJMP R ;FAIL IF CAN'T REFERENCE IT
HRRZ T2,P3 ;COMPUTE LENGTH OF BLOCK
CAIG T2,.ABUPB ;LONG ENOUGH?
RETBAD (ARGX04) ;NO. RETURN ERROR
UMOVE P2,.ABLOB(P5) ;GET LOWER BOUND ADDRESS
ERJMP R
UMOVE P4,.ABUPB(P5) ;GET UPPER BOUND ADDRESS
ERJMP R
IFN KLFLG,<
TXNE P3,AB%SEC ;CAN'T SET THIS ON THE KL
RETBAD (ABRKX4)
CAME P2,P4 ;ADDRESSES MUST BE SAME ON THE KL
RETBAD (ABRKX5)
> ;END OF IFN KLFLG
LSH P3,-<^D35-^L<AB%SEC>> ;PUT BITS IN RIGHT PLACE (ASSUMES AB%SEC
; IS RIGHTMOST FLAG BIT)
;P1/ Fork handle
;P2/ LOWER ADDRESS OR ONLY ADDRESS
;P3/ FLAGS
;P4/ UPPER ADDRESS (USED ON KC ONLY)
ABSRG4: SKIPN P3 ;IF ALL FLAGS ARE ZERO THEN
JRST ABCLR ; TREAT THIS AS A "CLEAR"
CALL FLOCK ;LOCK FORK STRUCTURE
MOVE T1,P1 ;GET FORK HANDLE
CALL SETLFX ;Map process' PSB and check for execute-only
NOSKED ;INTERLOCK USERBK AND EXECBK
SKIPE EXECBK ;IS EXEC MODE BREAK SET?
JRST [ OKSKED ;YES. CAN'T DO THIS THEN
CALL CLRLFK ;UNMAP PSB
CALL FUNLK ;UNLOCK FORK STRUCTURE
RETBAD (ABRKX2)] ;RETURN FAILURE BECAUSE EXEC MODE BREAK IN EFFECT
SKIPN ADRBRK(T1) ;NO. DID WE ALREADY HAVE ADDRESS BREAK?
AOS USERBK ;NO. INCREMENT COUNT OF USER BREAKS
OKSKED ;EXEC MODE BREAK LOCKED OUT
STOR P2,ABLOW,(T1) ;STUFF ADDRESS INTO PSB
STOR P3,ABFLG,(T1) ; AND FLAGS TOO
IFN KCFLG,<
STOR P4,ABUPP ;SAVE UPPER BOUND ON THE KC
> ;END OF IFN KCFLG
CAIN P1,.FHSLF ;SETTING MY OWN BREAK?
JRST [ AOS SKEDF3 ;FORCE RESCHEDULE TO NOTIFY HARDWARE
ISB SCDCHN
JRST .+1]
CALL CLRLFK ;UNMAP PSB
CALL FUNLK ;UNLOCK FORK STRUCTURE
RETSKP ;AND RETURN
;.ABRRG - Read address break range
;Arguments:
; T2/ address of argument block
; BLOCK: Length of block
; Place for flags to be returned
; Place for lower bound address to be returned
; Place for upper bound address to be returned
ABRRG: UMOVE P5,T2 ;GET ADDRESS OF ARGUMENT BLOCK
UMOVE P3,.ABHDR(P5) ;GET HEADER WORD
ERJMP R ;FAIL IF CAN'T REFERENCE IT
HRRZ T2,P3 ;COMPUTE LENGTH OF BLOCK
CAIG T2,.ABUPB ;LONG ENOUGH?
RETBAD (ARGX04)
CALL FLOCK ;LOCK FORK STRUCTURE
MOVE T1,P1 ;GET FORK HANDLE
CALL SETLFK ;MAP PSB
LOAD T2,ABFLG,(T1) ;GET FLAGS
LOAD T3,ABLOW,(T1) ;GET LOWER BOUND ADDRESS
IFN KCFLG,<
LOAD T4,ABUPP,(T1) ;GET UPPER BOUND ADDRESS
> ;END OF IFN KCFLG
IFN KLFLG,<
MOVE T4,T3 ;FORCE UPPER TO BE SAME AS LOWER
> ;END OF IFN KLFLG
CALL CLRLFK ;UNMAP PSB
CALL FUNLK ;UNLOCK
UMOVEM T2,.ABFLG(P5) ;GIVE FLAGS WORD TO THE USER
ERJMP R
UMOVEM T3,.ABLOB(P5) ;GIVE LOWER ADDRESS TO THE USER
ERJMP R
UMOVEM T4,.ABUPB(P5) ;GIVE UPPER ADDRESS TO THE USER
ERJMP R
RETSKP
;.ABGBR - Get address break data
;Arguments:
; T2/ address of argument block
; BLOCK: Length of block
; Place for PC
; Place for address
ABGBR:
UMOVE P5,T2 ;GET ADDRESS OF ARGUMENT BLOCK
UMOVE P3,.ABHDR(P5) ;GET HEADER WORD
ERJMP R
HRRZ T2,P3 ;GET LENGTH OF BLOCK
CAIG T2,.ABBAD ;LONG ENOUGH?
RETBAD (ARGX04)
CALL FLOCK ;LOCK FORK STRUCTURE
MOVE T1,P1 ;GET FORK HANDLE
CALL SETLFK ;MAP PSB
MOVE T2,ADRBK1(T1) ;GET PC WHERE BREAK OCCURRED
MOVE T3,ADRBAD(T1) ;GET ADDRESS THAT WAS REFERENCED
CALL CLRLFK ;UNMAP PSB
CALL FUNLK ;UNLOCK FORK LOCK
UMOVEM T2,.ABBPC(P5) ;RETURN THE PC
ERJMP R
UMOVEM T3,.ABBAD(P5) ;RETURN THE ADDRESS
ERJMP R
RETSKP
SUBTTL ALLOC JSYS
;JSYS TO ALLOCATE DEVICES TO A JOB OR TO THE DEVICE ALLOCATOR POOL
;CALLING SEQUENCE:
;ACCEPTS IN 1/ FUNCTION CODE
; 2/ DEVICE DESIGNATOR
; 3/ JOB NUMBER, -1, OR -2
; ALLOC
;RETURNS +1: ERROR - CODE IN AC 1
; +2: SUCCESSFUL
.ALLOC::MCENT ;ENTER JSYS
UMOVE T1,1 ;GET FUNCTION CODE
CAIE 1,.ALCAL ;IS THIS A LEGAL FUNCTION?
RETERR (ALCX1) ;NO, ILLEGAL FUNCTION CODE
MOVE T1,CAPENB ;THIS FUNCTION REQUIRES PRIVILEGES
TRNN T1,SC%WHL!SC%OPR ;WHEEL OR OPERATOR?
RETERR (ALCX2) ;NO, NOT ENOUGH PRIVILEGES
UMOVE T1,2 ;GET DEVICE DESIGNATOR
CALL CHKDES ;IS THIS A LEGAL DEVICE?
RETERR () ;NO, GIVE USER AN ERROR RETURN
TLNN T3,(DV%AS) ;IS THIS AN ASSIGNABLE TYPE DEVICE?
RETERR (ALCX3) ;NO, MUST BE ASSIGNABLE
CALL LCKDVL ;LOCK UP THE DEVICE LOCK
XCTU [HRRZ T3,3] ;GET ARGUMENT
HLRZ T4,DEVUNT(T2) ;GET OWNER OF THIS DEVICE
CAIN T3,-2 ;REQUESTING DEVICE FOR ALLOC POOL?
JRST ALCAL1 ;YES, GO PERFORM THAT FUNCTION
CAIN T3,-1 ;REQUESTING THAT THIS DEVICE BE FREED?
JRST ALCAL2 ;YES, GO FREE IT UP
EXCH T1,T3 ;PUT GLOBAL JOB NUMBER IN T1 FOR GL2LCL
CALL GL2LCL ;CONVERT GLOBAL JOB NUMBER TO LOCAL INDEX
RETBAD ()
EXCH T1,T3 ;PUT LOCAL JOB INDEX IN T3
CAIGE T3,NJOBS ;LEGAL JOB NUMBER?
SKIPGE JOBRT(T3) ;AND JOB ASSIGNED?
RETERR (ALCX4,<UNLOKK DEVLKK>) ;NO
CAMN T3,T4 ;ALREADY ASSIGNED TO THIS JOB?
JRST ALCAL0 ;YES
CAIE T4,-1 ;IS THIS DEVICE AVAILABLE?
CAIN T4,-2 ;OR IN ALLOCATOR'S POOL?
SKIPA ;YES
RETERR (ALCX5,<UNLOKK DEVLKK>) ;NO
HRLM T3,DEVUNT(T2) ;GIVE THIS DEVICE TO THE JOB SPECIFIED
MOVX T1,DV%ASN
IORM T1,DEVCHR(T2) ;SET DEVICE ASSIGNED TO JOB
ALCAL0: MOVX T1,D1%ALC ;SET THE ALLOCATED FLAG
IORM T1,DEVCH1(T2) ;...
ALCALR: UNLOKK DEVLKK ;RELEASE THE DEVICE LOCK
SMRETN
ALCAL1: MOVX T1,D1%ALC ;SET THE ALLOCATED FLAG
IORM T1,DEVCH1(T2) ;...
CAIE T4,-1 ;IS THE DEVICE FREE?
RETERR (ALCX6,<UNLOKK DEVLKK>) ;NO, TELL CALLER
HRLM T3,DEVUNT(T2) ;YES, GIVE IT TO ALLOCATOR POOL
JRST ALCALR ;GO SET ALLOCATED BIT
ALCAL2: MOVX T1,D1%ALC ;CLEAR THE ALLOCATED FLAG
ANDCAM T1,DEVCH1(T2) ;...
CAIE T4,-2 ;IS DEVICE IN THE POOL NOW?
RETERR (ALCX6,<UNLOKK DEVLKK>) ;NO, TELL CALLER
HRLM T3,DEVUNT(T2) ;YES, PUT IT IN FREE POOL
JRST ALCALR ;GO RETURN
SUBTTL CACCT JSYS
; Change account
.CACCT::MCENT
STKVAR <CACUSR>
MOVE A,JOBNO
MOVE B,JOBDIR(A) ;GET LOGIN DIRECTORY NUMBER
TRNN B,777777
RETERR(CACTX2)
CALL LOGCJM ;[7456] Write usage record on old account
HRLI B,USRLH ;MAKE IT A 36-BIT USER NUMBER
MOVEM B,CACUSR ;SAVE IT
MOVE A,B
CALL CNVDIR ;CONVERT THIS TO A DIR NUMBER
CALL SETDIR ;MAP IN DIRECTORY
RETERR () ;SETDIR FAILURE
UMOVE A,1
MOVE B,CACUSR ;GET BACK USER NUMBER
CALL SETACT
RETERR( ,<CALL USTDIR>)
CALL USTDIR ;[7456] Unlock directory, structure, go OKINT
SMRETN
; INTERNAL ROUTINE TO SET AN ACCOUNT
; CALL: A/ POINTER TO AN ACCOUNT STRING OR 5B2+ACCOUNT NUMBER
; B/ 36-BIT USER NUMBER
; CALL SETACT
; RETURNS: +1 ERROR
; +2 SUCCESS
SETACT::TRVAR <<ACTBUF,MAXLW+1>,ACTLN,PTR,USER,CLSSN> ;[7.1200]
MOVEM B,USER ;SAVE USER NUMBER
MOVEM A,PTR ;SAVE THE POINTER
SETZM ACTBUF
MOVEI A,ACTBUF
HRLS A
AOS A
MOVEI B,ACTBUF
ADDI B,MAXLW
BLT A,0(B) ;CLEAR THE BUFFER
MOVE B,PTR
CAML B,[5B2]
CAMLE B,[6B2-1]
JRST SETAC1 ;NOT A NUMBER
TLZ B,700000 ;NUMBER, CONVERT IT TO A STRING
HRROI A,ACTBUF
AOS A ;STRING STARTS PAST FIRST WORD IN ACTBUF
MOVEI C,12 ;NUMBERS ARE DECIMAL
NOUT ;DO THE CONVERSION
RETBAD () ;FAILED
IBP A ;STEP PAST NULL SO COUNT IS RIGHT
HRRZ B,A ;GET THE LENGTH OF THE STRING
SUBI B,ACTBUF ;IN FULL WORDS ONLY
AOS B ;CORRECT THE COUNT
MOVEM B,ACTLN ;SAVE IT
SOS B
MOVNS B
HRLZ A,B ;MAKE THIS LOOK LIKE A LOOKUP PTR
HRRI A,ACTBUF
JRST SETAC2
SETAC1:
MOVE A,PTR ;GET THE STRING POINTER
CALL PTRCHK ;MAKE SURE IT IS LEGAL
RETBAD (CACTX1) ;NOT LEGAL SO GIVE BAD RETURN
MOVEI A,ACTBUF
CALL CPYFU1 ;COPY ACCOUNT STRING
RETBAD (CACTX1) ;SHOULD NEVER RETURN +1
HLRE B,A
MOVNS B
MOVEM B,ACTLN ;STRING LENGTH IN FULL WORDS
SETAC2: MOVE B,A ;B/ POINTER TO STRING
MOVE A,USER ;GET USER NUMBER
CALL VERACT ;VALIDATE THE ACCOUNT
RETBAD () ;ERROR, RETURN
MOVEM A,PTR ;SAVE INFO RETURNED BY VERACT
MOVEM B,USER ; ...
MOVEM C,CLSSN ;SAVE RETURNED CLASS
TXNE A,AC%MCH ;ACCOUNT MATCH ACCTSR?
RETSKP ;YES, RETURN NOW
MOVE B,ACTLN ;GET BACK STRING LENGTH
SETZM ACCTSR(B) ;MAKE SURE LAST WORD IS ZEROED FOR FULL
; WORD COMPARES IN VACCT
ADDI B,2 ;# FULL WORDS PLUS REMAINDER
MOVEM B,ACCTSL ;SET UP COUNT OF WORDS IN ACCOUNT STRING
HRROI A,ACCTSR
MOVEI B,ACTBUF
HRLI B,(<POINT 7,0,35>) ;POINT TO START OF ACCOUNT TEXT STRING
MOVEI C,MAXLC+1
MOVEI D,.CHNUL ;TERMINATE ON NULL BYTE
SOUT ;COPY VALIDATED STRING TO JSB
ERJMP [RETBAD ()]
MOVE A,USER ;GET THIS ACCOUNT'S EXPIRATION DATE
MOVEM A,ACCTSX ;PUT IT IN JSB
MOVE A,CLSSN ;GET CLASS FROM ACCOUNT ENTRY
CALL SETCLS ;SET IT FOR THE JOB
RETSKP ;GIVE GOOD RETURN
;SPECIAL ROUTINE USED BY LOGIN TO FIND AND USE THE DEFAULT
;ACCOUNT FOR THIS LOGIN. DIRECTORY MUST BE MAPPED AND LOCKED.
SETACL::TRVAR <<ACTBUF,MAXLW+1>,ACTLN,PTR,USER,CLSSN> ;[7.1200]
SETZB D,1+ACTBUF ;INIT COUNTS AND STRING
SETZ A,
MOVEM B,USER ;SAVE USER NUMBER
MOVE C,DIRORA ;GET DIR BASE ADDRESS
LOAD B,DRACT,(C) ;GET DEFAULT ACCOUNT STRING
JUMPE B,SETAL1 ;IF NONE, GO ON
ADD B,DIRORA ;GET POINTER TO BLOCK
HRRZ A,0(B) ;GET SIZE OF BLOCK
SOS A ;COUNT OF WORDS IN ACCOUNT STRING
MOVE D,A ;SAVE COUNT
AOS B ;POINT TO START OF STRING
MOVEI C,1+ACTBUF ;POINT TO WHERE IT WILL GO
CALL XBLTA ;MOVE STRING TO STACK
MOVEI A,-1(D) ;STORE COUNT CONSISTENT WITH COUNT FROM CPYFU1
SETAL1: MOVEM A,ACTLN ;SAVE SIZE OF STRING
MOVNI D,-1(D) ;GET -NWORDS+1
MOVSI A,0(D) ;TO LH OF A
HRRI A,ACTBUF ;FORM LOOKUP POINTER
CALLRET SETAC2 ;AND CONTINUE IN MAIN ROUTINE
SUBTTL CFIBF JSYS
; Clear input buffer
.CFIBF::MCENT
CALL CHKTTR ;IS THIS A TERMINAL?
MRETNG ; NO, THEN THIS IS A NOOP
CALL CHKTTY ;CAN WE GET THE TERMINAL?
ITERR () ; NO, SO RETURN ERROR
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;FAIL IF NOT ACTIVE
CALL TTCIB0
CALL ULKTTY ;ALLOW DEALLOCATION
JRST MRETN
SUBTTL CFOBF JSYS
; Clear file output buffer
.CFOBF::MCENT
CALL CHKTTR ;IS THIS A TERMINAL?
MRETNG ; NO, THEN THIS IS A NOOP
CALL CHKTTY ;CAN WE GET THE TERMINAL?
ITERR () ; NO, SO RETURN ERROR
CALL LCKTTY ;POINT TO DYNAMIC DATA, ALLOW DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;NOT ACTIVE. FAIL
CALL TTCOBF
CALL ULKTTY ;ALLOW DEALLOCATION
JRST MRETN
SUBTTL CNDIR JSYS
; Connect to directory
; Call: 1 ; Directory number
; ;B0 - CHECK PSWD ONLY AND DON'T CONNECT
; ;B1 - DON'T CONNECT
; 2 ; String pointer to password
; CNDIR
; Return
; +1 ; Error
; +2 ; Ok
.CNDIR::MCENT
ITERR (CNDIX7) ;CNDIR WAS REPLACED BY ACCES
SUBTTL CNFIG JSYS
; CONFIGURATION INFORMATION JSYS
;
; USAGE OF REGISTERS
;
; P1 FUNCTION CODE
; Q1 TO BE SETUP IN SUBROUTINES AS ADDESS OF MONITOR BLOCK
; Q2 ADDRESS OF USER BLOCK
; Q3 CONTENTS OF USER ARGUMENT .CFLEN
;
; THEN WE DISPATCH TO FUNCTION CODE HANDLER
.CNFIG::MCENT ;MONITOR CONEXT ENTRY
UMOVE P1,T1 ;P1/ FUNCTION CODE
CAIL P1,.CFINF ;IS IT LOWER THAN LOWEST
CAILE P1,.CFLST ;AND HIGHER THAN HIGHEST
ITERR (CFGBFC) ;YES, OUT OF RANGE, BAD FUNCTION CODE RETURN
UMOVE Q2,T2 ;GET ADDRESS OF ARGUMENT BLOCK
UMOVE Q3,.CFLEN(Q2) ;GET USER ARGUMENT
ERJMP CFGIAA ;HANDLE BAD ADDRESS
CALL @CNFGTB(P1) ;DISPATCH APPROPRIATELY
ITERR () ;FAIL, PASS THE ERROR ALONG
MRETNG ;SUCESS RETURN
; HERE IS THE DISPATCH TABLE
CNFGTB:
DTBDSP (CFINF) ;RETURN PROCESSOR INFORMATION
DTBDSP (CFCIN) ;RETURN CFS INFORMATION
DTBDSP (CFCSE) ;RETURN SERIAL NUMBERS OF CFS HOSTS
DTBDSP (CFCND) ;RETURN NODE NAMES OF CFS HOSTS
DTBDSP (CFHSC) ;Return names of the HSC nodes in cluster
.CFLST==.-CNFGTB-1 ;HIGHEST POSSIBLE FUNCTION CODE
CFGIAA: ITERR (CFGIAB)
; ROUTINES USED FOR PROCESSING .CFLEN.
; ASSUMES
; T1/ MAX # OF WORDS MONITOR WILL RETURN
; Q1/ ADDRESS OF MONITOR BLOCK
; Q2/ USER BLOCK ADDRESS
; Q3/ USER .CFLEN
;
; BOTH CFLNDO AND CFLND2 SETUP .CFLEN AND LEAVES IN Q3
; CFLND2 RETURNS BLOCK TOO SMALL IF USER BLOCK IS NOT .GE. T1
; CFLNDO RETURNS BLOCK TOO SMALL ONLY IF USER BLOCK IS NOT .GE. .CFLEN
CFLND2::LOAD T2,CF%LOB,Q3 ;GET LENGTH OF USER BLOCK
CAMGE T2,T1 ;ARE WE BIG ENOUGH?
ITERR (CFGBTS) ;NO, THIS ROUTINE ITRAP'S
JRST CFLNDO ;YES, CONTINUE WITH NORMAL PROCESSING
CFLNDO::
LOAD T2,CF%LOB,Q3 ;GET LENGTH OF BLOCK
CAIGE T2,.CFLEN+1 ;IS IT AT LEAST BIG ENOUGH FOR .CFLEN
ITERR (CFGBTS) ;NO, ARGUMENT BLOCK TOO SHORT
CAMGE T2,T1 ;IS HIS BLOCK TOO BIG?
IFSKP.
STOR T1,CF%WDP,Q3 ;YES, THEN SAY WE ARE RETURNING MAX.
ELSE.
STOR Q3,CF%WDP,Q3 ;NO, THEN SAY WE ARE RETIURNING SAME AMT.
ENDIF.
MOVEM Q3,.CFLEN(Q1) ;STORE PROPER .CFLEN IN MONITOR BLOCK
RET
; ROUTINE USED TO RETURN STUFF TO USER
; ASSUMES
; Q1/ MONITOR BLOCK ADDRESS
; Q2/ USER BLOCK ADDRESS
; Q3/ WORDS PROCESSED,,LENGTH TO TRANSFER
CFRET::
LOAD T1,CF%WDP,Q3 ;T1/ LENGTH FOR BLTMU
MOVE T2,Q1 ;T2/ COPY FROM
MOVE T3,Q2 ;T3/ COPY TO
CALL BLTMU ;BLT
RET
; RETURN PROCESSOR INFORMATION
DEFSTR UCFIHO,.CFIHO(Q1),5,6
DEFSTR UCACHS,.CFIHO(Q1),7,2
DEFSTR UCFIMO,.CFIMO(Q1),8,9
; P1 SET TO MONITOR BLOCK OF INFORMATION
CFINF: TRVAR <APRWD,PAGWD,<CFINFB,.CFILN>>
XMOVEI Q1,CFINFB ;GET ADDRESS OF MONITOR BLOCK
MOVEI T1,.CFILN
CALL CFLNDO ;PROCESS .CFLEN
MOVEI T1,.CFGKL ;TYPE OF PROCESSOR
MOVEM T1,.CFIPR(Q1)
APRID APRWD ;GET APRID WORD
LOAD T1,APRNM,APRWD ;PROCESSOR SERIAL NUMBER
MOVEM T1,.CFISE(Q1)
LOAD T1,APRMVR,APRWD ;PROCESSOR MICROCODE VERSION
MOVEM T1,.CFIUC(Q1)
SETZ T1, ;FRESH SLATE
CALL SC.PRT ;IS THERE A CI?
TDZA T1,T1 ;NO, ZEROS
MOVX T1,CF%CI ;YES, CF%CI
MOVEM T1,.CFIHO(Q1)
LOAD T1,APRHO,APRWD ;GET APR HARDWARE OPTIONS
STOR T1,UCFIHO
CONI PAG,PAGWD ;GET PAGER CONDITIONS
LOAD T1,PGCLKE+PGCLDE,PAGWD ;CACHE STRATEGY BITS
STOR T1,UCACHS
SETZM .CFIMO(Q1) ;PROCESSOR MICROCODE OPTIONS
LOAD T1,APRMO,APRWD
STOR T1,UCFIMO
MOVE T1,CNFGWD ;SOFTWARE OPTIONS
MOVEM T1,.CFISO(Q1)
MOVE T1,.JBVER
MOVEM T1,.CFIVR(Q1) ;OPERATING SYSTEM VERSION
CALL CFRET ; RETURN ARGUMENTS TO USER BLOCK
RETSKP
ENDTV.
SUBTTL DELDF JSYS
; Delete deleted files
; 1/ DD%DTF (B0) = DELETE ;T FILES ALSO
; 2/ DIRECTORY NUMBER
.DELDF::MCENT
STKVAR <DELDSD> ;DIRECTORY NUMBER SPECIFIED
UMOVE A,2 ;GET THE DIRECTORY NUMBER
MOVEM A,DELDSD ;SAVE THE STRUCTURE/DIRECTORY NUMBER
HLRZS A ;[7351]GET STRUCTURE UNIQUE CODE
CALL CHKMNO ;[7351]DOES USER HAVE IT MOUNTED?
ITERR () ;[7351]NO, RETURN AN ERROR
LDB T1,[POINT 6,DELDSD,17] ;[7.1063]Get structure number
CALL CKSTOF ;[7.1063]Is the structure offline?
ITERR () ;[7.1063]Return "Structure is offline"
MOVE A,DELDSD ;[7351]RESTORE DIRECTORY NUMBER
CALL SETDIR
ITERR(DELDX2) ;NO SUCH USER
MOVX B,DC%CN ;REQUIRES OWNER ACCESS
CALL DIRCHK ;SEE IF USER CAN CONNECT (AND THUS OWN DIRECTORY)
JRST [ ULKDIR ;UNLOCK DIR
ITERR(DELDX1)] ;ERROR
DELDF1: CALL USTDIR
MOVE A,DELDSD ;GET THE DIRECTORY NUMBER
XCTU [HLLZ F,A] ;GET FLAGS
TXZ F,1B17 ;DON'T ALLOW DELETE ALL
CALL DELDEL
ITERR () ;ERROR OCCURED DURING EXPUNGE
JRST MRETN
SUBTTL DEVST JSYS
; Device to string
; Call: 1 ; Destination designator
; 2 ; Device designator
; DEVST
; Return
; +1 ; Ok
.DEVST::MCENT
UMOVE A,2
CALL CHKDEV
JRST [ CAIE A,DEVX2
RETERR()
JRST .+1]
MOVE C,DEVNAM(B)
CALL DEVST0 ;COPY NAME STRING TO USER SPACE
SMRETN
;ROUTINE TO COPY STR NAME TO USER STRING
;ACCEPTS IN C/ SIXBIT STR NAME
DEVST0: SETZ B,
LSHC B,6 ;GET NEXT BYTE
JUMPE B,DEVST1
ADDI B,40
CALL BOUTA
JRST DEVST0
DEVST1: RET
SUBTTL DIBE JSYS
; Dismiss until input buffer is empty
.DIBE:: MCENT
DIBE1: UMOVE T1,1 ;GET DESIGNATOR
CALL CHKTTR
JRST MRETN
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;NOT ACTIVE. FAIL
CALL TTDIBE
JRST DIBE1 ;TRY AGAIN
CALL ULKTTY ;ALLOW DEALLOCATION
JRST MRETN
SUBTTL DIRST JSYS
; Directory number to string conversion
; Call: 1 ; Sink designator
; 2 ; Directory number
; DIRST
; Return
; +1 ; Error
; +2 ; Ok
.DIRST::MCENT
UMOVE A,2 ;GET DIR NUMBER
CALL DIRST0 ;DO THE WORK
RETERR () ;FAILED
SMRETN ;SUCCESSFUL
DIRST0: STKVAR <<DIRSTN,MAXLW>,DIRSTR>
MOVEM A,DIRSTR ;SAVE THE DIRECTORY NUMBER
LDB A,[POINT 6,A,17] ;[7.1063]Get structure number
CALL CKSTOF ;[7.1063](T1/T1)Is structure offline?
RETBAD () ;[7.1063]Return "Structure is offline"
MOVE A,DIRSTR ;[7.1063]Restore T1
CALL GDIRST ;GET POINTER TO NAME STRING INTO A
RETBAD ()
XMOVEI B,1(A) ;COPY NAME STRING TO STACK
XMOVEI C,DIRSTN
LOAD A,NMLEN,(A) ;GET NUMBER OF WORDS
SOS A
CALL XBLTA
LOAD B,CURSTR ;GET CURRENT STR #
MOVE C,DEVNAM+DVXST0(B) ;GET SIXBIT STR DEVICE NAME
CALL USTDIR ;UNLOCK THE DIR
HLRZ A,DIRSTR ;GET DIR NUMBER BACK AGAIN
CAIN A,USRLH ;IS THIS A USER NUMBER?
JRST DIRST1 ;YES, DONT PUT ON THE PUNCTUATION
CALL DEVST0 ;OUTPUT THE STR NAME TO THE USER
MOVEI B,":" ;NOW SOME PUNCTUATION
CALL BOUTA
MOVEI B,"<" ;AND THE DIR DELIMITER
CALL BOUTA
DIRST1: MOVEI A,DIRSTN ;GET POINTER TO STRING
SOS A ;ADR-1
CALL JFNSSD ;NOW OUTPUT THE DIR NAME
MOVEI B,">" ;AND CLOSE WITH CLOSE BRACKET
HLRZ A,DIRSTR ;GET STRUCTURE NUMBER AGAIN
CAIE A,USRLH ;USER NUMBER?
CALL BOUTA ;NO, OUTPUT THE CLOSE BRACKET
RETSKP
SUBTTL DOBE JSYS
; Dismiss until output buffer is empty
.DOBE:: MCENT
DOBE1: UMOVE T1,1 ;GET DESIGNATOR
CALL CHKTTR
JRST MRETN
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;NOT ACTIVE. FAIL
CALL TTDOBE
JRST DOBE1 ;NEED TO RETRY
CALL ULKTTY ;ALLOW DEALLOCATION
JRST MRETN
SUBTTL ERSTR JSYS
; Error number to string
; Call: 1 ; Output designator
; 2 ; Error number
; 3 ; -NCHARS,,CTRL BITS
; ERSTR
.ERSTR::MCENT
CALL FLOCK ;LOCK FORK STRUCTURE
HLRZ 1,2
CALL SETLFK ; Map psb of the fork
UMOVE B,3
HRLZI C,ERRSAV(1)
HRRI C,4
TRNN B,1B19
BLT C,10
XCTU [HRRZ C,2]
CAIN C,777777
MOVE C,LSTERR(1)
CALL [ SAVET ;UNLOCK AND UNMAP PSB HERE
CALL CLRLFK ;BUT PRESERVE ACS
CALLRET FUNLK]
MOVE A,C ;SEE IF THIS IS A LEGAL ERROR CODE
TRZ A,77777 ;MASK OFF LOW ORDER BITS
CAIE A,.ERBAS ;IS THIS LEGAL?
JRST EMRET1 ;NO, MUST HAVE CORRECT BASE ADDRESS
ANDI C,077777 ;FLUSH NON-SIGNIFICANT BITS
JUMPE C,EMRET1 ;ZERO IS ILLEGAL ERROR CODE
; We now have error number in c, parameters in 4-10, bits and count in b
PUSH P,B
IFE NICSW,<
HRROI 2,[ASCIZ /SYSTEM:ERRMES.BIN/]
MOVSI 1,(GJ%OLD!GJ%PHY!GJ%SHT)
>;IFE NICSW
IFN NICSW,<
HRROI 2,[ASCIZ /ERRMES:/]
MOVSI 1,(GJ%OLD!GJ%SHT)
>;IFN NICSW
GTJFN ; Get jfn for error mnemonics
JRST NOFIL
MOVE 2,[XWD 440000,200000]
PUSH P,1
OPENF
JRST [ POP P,1
RLJFN
JFCL
JRST NOFIL]
POP P,1
BIN ;GET FIRST WORD WHICH IS MAX ERR NUM
ERJMP NOFIL2 ;IF END OF FILE, FAIL
CAMLE C,B ;THIS ONE WITHIN RANGE?
JRST NOFIL2 ;NO, FAIL
; ..
;ERSTR...
RIN ; Read byte number of message
ERJMP NOFIL2 ; IF ERROR, FAIL
JUMPE 2,NOFIL2
PUSH P,2
MOVEI 2,7
SFBSZ
RETERR()
POP P,2
SFPTR ; Start reading here
JRST NOFIL2
POP P,C
HLRES C
MOVMS C ;ALLOW + OR - NCHARS
SKIPE C
AOS C
CPYER1: BIN
ERJMP ERSTDN ;IF EOF, THEN DONE
CAIN 2,"@"
JRST ERSTDN
CAIN 2,"_"
JRST EXPND
CALL ERST9
JRST ERSTDS
JRST CPYER1
;ERSTR...
NOFIL: POP P,B
MOVE D,[POINT 7,[ASCIZ /Cannot find error message file/]] ;[7.1200]
NOFILL: ILDB B,D
JUMPE B,EMRET1 ;RETURN AT END OF STRING
CALL ERST9
JRST EMRET1 ;ERROR RETURN PRESERVING LSTERR
JRST NOFILL
EXPND: MOVEI D,0
BIN
ERJMP ERSTDN
CAIN B,"_"
JRST CPYER1
EXPND1: CAIG 2,"9"
CAIGE 2,"0"
JRST EXPNDD
IMULI D,^D10
ADDI D,-60(B)
BIN
ERJMP ERSTDN
JRST EXPND1
;ERSTR...
EXPNDD: CAIN B,"E"
JRST EXPEXP
CAIL D,5
JRST EXPND
CAIN B,"A"
JRST EXPASC
CAIN B,"O"
JRST EXPOCT
CAIN B,"D"
JRST EXPDEC
CAIN B,"H"
JRST EXPHLF
CAIN B,"F"
JRST EXPFLT
CAIN B,"L"
JRST EXPLOC
CAIN B,"N"
JRST EXPJFN
CAIE B,"@"
JRST EXPND
JRST ERSTDN
EXPEXP: JRST EXPND
EXPASC: MOVE B,ERRSAV(D)
CALL ERST9
JRST ERSTD0
JRST EXPND
EXPOCT: MOVE B,ERRSAV(D)
MOVEI D,10
CALL ERNOUT
JRST ERSTD0
JRST EXPND
EXPDEC: MOVE B,ERRSAV(D)
MOVEI D,12
CALL ERNOUT
JRST ERSTD0
JRST EXPND
;ERSTR...
ERNOUT: PUSH P,A
MOVE A,B
CALL ERNOU1
SOS -1(P)
POP P,A
RETSKP
ERNOU1: IDIV A,D
HRLM B,(P)
JUMPE A,.+3
CALL ERNOU1
RET
HLRZ B,(P)
ADDI B,"0"
JRST ERST9
EXPHLF: MOVE D,ERRSAV(D)
PUSH P,D
HLRZ B,D
MOVEI D,10
CALL ERNOUT
JRST ERSTD1
POP P,D
MOVEI B,","
CALL ERST9
JRST ERSTD0
CALL ERST9
JRST ERSTD0
HRRZ B,D
MOVEI D,10
CALL ERNOUT
JRST ERSTD0
JRST EXPND
EXPFLT:
EXPLOC:
EXPJFN: JRST EXPND
ERSTD1: POP P,D
JRST ERSTD0
ERSTDN: AOS -1(P)
ERSTDS: AOS -1(P)
ERSTD0: CLOSF ;CLOSE THE FILE
JFCL
MRETNG ;RETURN OK
NOFIL2: CLOSF ;CLOSE THE FILE
JFCL ;IGNORE ERRORS
JRST EMRET1 ;AND ERROR RETURN PRESERVING LSTERR
SUBTTL GACCT JSYS
; GET ACCOUNT
;
; CALL: 1/ GLOBAL JOB NUMBER OR -1 FOR SELF
; 2/ POINTER TO E TO WHERE TO STORE STRING (IF ANY)
; GACCT
; RETURNS
; +1 ALWAYS, 2/ 5B2+NUMERIC ACCOUNT #, OR
; UPDATED POINTER TO ACCOUNT STRING AT E
.GACCT::MCENT ;MONITOR CODE ENTRY
UMOVE T1,1 ;GET JOB NUMBER
CAMN T1,[-1] ;SELF SPECIFIED ?
IFSKP. ;IF SKIP, JOB NUMBER WAS SPECIFIED
CALL GL2LCL ;TRANSLATE GLOBAL JOB NUMBER INTO LOCAL
ITERR (GACCX1) ;INVALID JOB NUMBER SPECIFIED
ELSE. ;OTHERWISE
MOVE T1,JOBNO ;GET OUR LOCAL INDEX...
ENDIF. ;
; CHECK PRIVILEGES IF NOT THIS JOB
CAMN T1,JOBNO ;THIS JOB ?
JRST GACC10 ;YES, DO NOT CHECK CAPABILITY
MOVE T2,CAPENB ;GET CAPABILITIES
TXNN T2,SC%CNF!SC%WHL!SC%OPR ;HAVE CONFIDENTIAL INFORMATION ACCESS ?
ITERR (GACCX3) ;NO, CONFIDENTIAL INFORMATION ACCESS REQUIRED
; SEE IF REQUESTED JOB EXISTS AND MAP JSB
GACC10: CALL MAPJSB ;GO MAP JSB FOR REQUESTED JOB
ITERR (GACCX2) ;NO SUCH JOB
MOVEM T1,P1 ;SAVE OFFSET TO JSB
; HERE FOR ALPHANUMERIC ACCOUNTS
GACC20: UMOVE T1,2 ;GET POINTER TO USER'S STRING BUFFER
MOVEI T2,ACCTSL(P1) ;POINT TO STRING
CALL CPYTUS ;COPY ACCOUNT STRING TO USER SPACE
; UNMAP JSB AND RETURN
GACC30: CALL CLRJSB ;UNMAP THE JSB
JRST MRETN ;SUCCESS RETURN
SUBTTL GETER JSYS
; Get last error
; Call: 1 ; Fork designator
; GETER
.GETER::MCENT
CALL FLOCK
CALL SETLFK
MOVE B,LSTERR(1)
XCTU [HRL B,1]
UMOVEM B,2
CALL CLRLFK
CALL FUNLK
JRST MRETN
SUBTTL Access Control
; DATA STRUCTURES DEFINITIONS FOR GETOK/GIVOK/RCVOK
;THESE DEFSTRS DESCRIBE A BLOCK OF RESIDENT FREE SPACE. GETOK
;OBTAINS ONE FOR EACH REQUEST AND KEEPS IT UNTIL THE REQUEST IS
;ACCEPTED OR REJECTED. ITS LENGTH IS ENOUGH FOR A FIXED-LENGTH
;HEADER PLUS THE USER'S FUNCTION-DEPENDENT ARGUMENTS.
;*** DO NOT CHANGE THE FOLLOWING TWO DEFSTR'S BECAUSE OF
;THE LINK POINTERS
DEFSTR (GOKFP,0,35,36) ;LINK POINTER
DEFSTR (GOKST,1,35,36) ;REQUEST STATUS
; 0=REQUEST QUEUED
; -1=REQUEST IN PROGRESS
; +1=REQUEST COMPLETE, SUCCESS
; +2=REQUEST COMPLETE, FAILED
DEFSTR (GOKBAD,2,35,36) ;ADDRESS OF SWAP BLOCK CONTAINING ERROR MSG
DEFSTR (GOKPSI,3,35,18) ;PSI (MONITOR) OF THIS REQUEST
DEFSTR (GOKFKN,3,17,18) ;FORK NUMBER
DEFSTR (GIVTMO,4,35,36) ;GIVOK TIMEOUT
DEFSTR (GOKBSZ,5,17,18) ;LENGTH OF FUNCTION-DEPENDENT ARGUMENTS
DEFSTR (GOKTSZ,5,35,18) ;THIS TABLE LENGTH
GOKIDZ==:6 ;SIZE OF HIDDEN DATA
;WARNING: DO NOT REARRANGE THE DEFINITIONS FROM HERE TO THE END OF THIS
;BLOCK! THE BLOCK IS BLT'ED TO THE USER IN RCVOK
DEFSTR (GOKFUN,6,17,18) ;FUNCTION CODE
DEFSTR (GOKJBN,6,35,18) ;JOB NUMBER OF REQUESTOR
DEFSTR (GOKCDR,7,35,36) ;USER NUMBER
DEFSTR (GOKJDR,10,35,36) ;CONNECTED DIRECTORY
DEFSTR (GOKRN,11,35,36) ;REQUEST NUMBER
DEFSTR (GOKURA,12,17,18) ;NUMBER OF ARGS PASSED
DEFSTR (GOKUAN,12,35,18) ;NUMBER OF USER SUPPLIED ARGUMENTS
DEFSTR (GOKUSA,13,35,36) ;ADDRESS OF USER SUPPLIED ARGUMENTS
DEFSTR (GOKCAP,14,35,36) ;CAPABILITIES ENABLED
DEFSTR (GOKETN,14,35,36) ;ERROR NUMBER
DEFSTR (GOKTRM,15,35,36) ;TERMINAL NUMBER
DEFSTR (GOKRJB,16,35,36) ;REQUESTED JOB #
GOKHDL==:^D15 ;COUNT OF ABOVE WORDS
;THE REMAINDER OF THIS BLOCK IS A COPY OF THE USER'S FUNCTION-DEPENDENT
;DATA
DEFSTR (GOKERB,17,35,36) ;ERROR BLOCK POINTER
DEFSTR (GOKFN1,20,35,36) ;FIRST FUNCTION WORD
; DEFINITIONS FOR ERROR BLOCK AS PROVIDED BY THE USER
GOKESZ==0 ;ERROR SIZE
GOKENU==1 ;ERROR NUMBER
GOKEBP==2 ;BYTE POINTER
GOKEZ==3 ;STRING SIZE
GOKMSZ==^D80 ;COUNT OF MAX CHARACTERS FOR ERROR STRING
GOKSFZ==GOKMSZ/5+1 ;SIZE OF BUFFER TO ALLOCATE FOR ERROR STRING
; INCLUDES 1 WORD OF HEADER FOR FREE BLOCK
;DEFINITIONS FOR GTOKPR
GT%ENB==:77B5 ;ENABLES
GT%DEF==77B11 ;DEFAULTS
GT%PRM==777777B35 ;PARAMETERS
DEFSTR (GTENB,0,5,6) ;ENABLES (CURRENTLY USED FUNCTIONS)
DEFSTR (GTDEF,0,11,6) ;DEFAULT (SAVED PARAMETERS)
DEFSTR (GTPRM,0,35,18) ;PARAMETERS
SUBTTL Access Control -- GETOK JSYS
; GETOK JSYS
;
; T1 - FUNCTION CODE
; T2 - ADDRESS OF ARGUMENT BLOCK
; T3 - SIZE OF ARGUMENT BLOCK
; T4 - JOB NUMBER FOR WHICH REQUEST IS MADE
.GETOK::MCENT ;JSYS
SKIPN T1 ;LEGAL?
ITERR (GOKER1) ;NO
TRNE T1,400000 ;USER FUNCTION?
SETZ T1,0 ;YES USE FUNCTION 0
CAIL T1,MXGOKF ;CHECK FOR MAX
ITERR (GOKER1) ;ILLEGAL FUNCTION CODE
SKIPGE Q1,GTOKPR(T1) ;CHECKING ENABLED?
JRST GETOK2 ;OK TO CHECK
TLNE Q1,(SF%DOK) ;NO. IS DEFAULT TO ALLOW IT?
MRETNG ;YES -- ACCEPT
ITERR (GOKER2) ;NO REJECT REQUEST
;HERE IF PROGRAM IS CONTROLLING ACCESS FOR THIS FUNCTION.
;GET A BLOCK OF FREE SPACE TO SAVE THE INFORMATION IN.
GETOK2: UMOVE Q1,T1 ;GET USER'S FUNCTION CODE
MOVE Q2,T2 ;GET USER'S ARGUMENT BLOCK ADDRESS
MOVE Q3,T3 ;GET SIZE OF USER'S ARGUMENT BLOCK
CAILE T3,.GOKMZ ;GET MAX SIZE
ITERR (ARGX05) ;ARGUMENT BLOCK TOO LONG
CALL ALOCRS ;ALLOCATE SOME SPACE
ITERR () ;ITRAP ERROR
UMOVE T2,T4 ;GET REQUESTED FOR JOB #
STOR T2,GOKRJB,(T4) ;SAVE IN BLOCK
MOVE T2,Q2 ;GET ADDRESS OF USER'S ARGUMENT BLOCK (SOURCE)
MOVE Q3,T4 ;SAVE BLOCK ADDRESS
SKIPE T3 ;DON'T BLT IF NO ARGS
CALL BLTUM1 ;COPY DATA FROM USER TO MONITOR BLOCK
SETZM T2 ;NO ROUTINE TO CALL IF BLOCKING
CALL GETOK0 ;DO THE GETOK
ITERR () ;ITRAP ON ERROR
MRETNG ;RETURN OK
;ALOCRS - ALLOCATE RESIDENT FREE SPACE FOR A GETOK REQUEST
;ACCEPTS:
; T3/ LENGTH OF USER'S FUNCTION-DEPENDENT ARGUMENT BLOCK
; Q3/ LENGTH OF USER'S FUNCTION-DEPENDENT ARGUMENT BLOCK
; CALL ALOCRS
;RETURNS +1: FAILURE
; T1/ ERROR CODE
; +2: SUCCESS, NOINT
; T4/ ADDRESS OF BLOCK ACQUIRED
; T3/ POINTS TO PLACE FOR USER ARGS
; Q3/ PRESERVED
;THIS ROUTINE GETS A BLOCK OF FREE SPACE AND INITIALIZES IT
ALOCRS: SKIPGE T3 ;CHECK FOR LEGAL SIZE
RETBAD (ARGX04) ;ILLEGAL SIZE
ADDI T3,GOKHDL ;ADD HEADER LENGTH
NOINT ;DISABLE USER FROM INTERRUPTING US
HRLI T1,.RESP3 ;SET PRIORITY TO LOWEST
HRR T1,T3 ;SET LENGTH
MOVX T2,RS%SE0!.RESGP ;SET GENERAL GROUP, SECTION 0
CALL ASGRES ;ASSIGN RESIDENT SPACE
RETBAD (MONX05,<OKINT>) ;NO RESIDENT FREE SPACE
STOR Q1,GOKFUN,(T1) ;STORE FUNCTION CODE
MOVE T2,TODCLK ;GET THE CURRENT TIME
ADD T2,[GIVTIM] ;GIVOK TIMER
STOR T2,GIVTMO,(T1) ;SET GIVOK TIMER
MOVE T2,Q3 ;GET LENGTH
STOR T2,GOKUAN,(T1) ;STORE LENGTH
ADDI T2,GOKHDL ;SAVE TABLE LENGTH
STOR T2,GOKTSZ,(T1)
AOS T2,GOKNRQ ;UPDATE REQUEST NUMBER
STOR T2,GOKRN,(T1)
MOVE T2,GBLJNO ;SAVE JOB NUMBER OF REQUESTOR
STOR T2,GOKJBN,(T1)
MOVE T2,JOBNO ;Use the job index, not the job number
MOVE T2,JOBDIR(T2) ;GET LOGGED IN DIRECTORY
HRLI T2,USRLH ;MAKE USER NUMBER
STOR T2,GOKCDR,(T1)
HRRZ T2,FORKX ;GET FORK NUMBER OF REQUESTOR
STOR T2,GOKFKN,(T1)
MOVE T2,JSBSDN ;GET CONNECTED DIRECTORY
STOR T2,GOKJDR,(T1)
HLLZ T2,PSIBIP ;GET PRI LEVEL
JFFO T2,.+1 ;RECORD CURRENT LEVEL
STOR T3,GOKPSI,(T1)
MOVE T2,CAPENB ;CAPABILITIES ENABLED
STOR T2,GOKCAP,(T1)
MOVE T2,CTRLTT ;CONTROLLING TTY
STOR T2,GOKTRM,(T1)
SETONE GOKRJB,(T1) ;SAY THAT REQUEST IS FOR THIS JOB
STOR Q3,GOKBSZ,(T1) ;STORE LENGTH
MOVE T4,T1 ;SAVE BLOCK POINTER
ADDI T1,GOKHDL ;ADDI HEADER SO IT POINTS TO USER DATA BLOCK
MOVE T3,T1 ;SET UP TO ADDRESS
STOR T3,GOKUSA,(T4) ;STORE ADDRESS IN DATA BLOCK
MOVE T1,Q3 ;GET LENGTH BACK FOR RETURN
RETSKP ;RETURN
;GETOKM - MONITOR ENTRY POINT FOR GETOK JSYS
; THIS ENTRY POINT IS SUPPOSED TO BE USED INPLACE OF A JSYS ENTRY
; WHEN GETOK IS REQUIRED BY THE MONITOR
; CALLED WITH SAME PARAMETERS AS .GETOK BUT
; IT DOES NOT ITRAP
; T1/ FUNCTION CODE
; T2/ ARGUMENT BLOCK POINTER
; T3/ ARGUMENT BLOCK SIZE
; T4/ ROUTINE TO CALL WHEN BLOCKING (OR 0 IF NONE)
; RETURNS +1 ON FAILURE WITH T1= ERROR CODE
; RETURNS +2 ON SUCCESS
;PRESERVES ALL PERM REGS SO THAT CALLER CAN SET UP BLOCKING COROUTINE
;FROM THE FILE SYSTEM
;NOTE: THE ARGUMENT BLOCK POINTER MUST BE 0 HERE, BECAUSE THE CODE
;(IN GETOK3) THAT COPIES THE ERROR BLOCK BACK TO THE USER USES UMOVEM'S.
;FOR THE MONITOR THIS WILL STORE IN THE WRONG PLACE
GETOKM::SAVEQ ;SAVE REGISTERS
SKIPE Q1,JOBNO ;GET JOB NUMBER
CAMN Q1,ACJJN ;CHECK FOR ACJ JOB ALSO
RETSKP ;RETURN GOOD IF JOB 0 OR ACJ
CAIL T1,MXGOKF ;CHECK FOR MAX FUNCTION
JRST [ BUG.(CHK,ILGOKM,JSYSA,SOFT,<Illegal function for GETOKM call>,<<T1,GOKFCN>>,<
Cause: The GETOKM routine was called with an unknown function code. GETOKM
handles internal GETOK requests from the monitor.
Action: Set this bug dumpable and submit an SPR along with the dump and
instructions on reproducing the problem.
Data: GOKFCN - GETOK function code
>)
RETBAD (GOKER1)]
SKIPGE Q1,GTOKPR(T1) ;CHECKING ENABLED?
JRST GOKMA ;YES PROCEED
GETOKZ: TLNE Q1,(SF%DOK) ;NO. IS DEFAULT TO ALLOW IT?
RETSKP ;YES RETURN GOOD
RETBAD (GOKER2) ;NO REJECT REQUEST
;HERE WHEN ACCESS CONTROL JOB IS CHECKING THIS FUNCTION
GOKMA: STKVAR <BLKADR> ;SAVE ROUTINE TO CALL IF BLOCKING
MOVEM T4,BLKADR ;SAVE BLOCK ADDRESS
DMOVE Q1,T1 ;SAVE ARGUMENTS
MOVE Q3,T3
CALL ALOCRS ;ALLOCATE AND CREATE BLOCK
JRST [ CAIE T1,MONX05 ;CHECK FOR NO RESIDENT FREE SPACE
RETBAD ()
MOVE T1,GTOKPR(Q1) ;GET DEFAULTS
LOAD Q1,GT%DEF,T1 ;GET DEFAULT ARGUMENTS
STOR Q1,GT%ENB,Q1 ;JUSTIFY THEM TO "ENABLED" FIELD
JRST GETOKZ]
MOVE Q3,T4 ;SAVE BLOCK POINTER
MOVE T2,Q2 ;GET FROM ADDRESS
CALL XBLTA ;TRANSFER DEPENDENT DATA
MOVE T2,BLKADR ;GET BLOCK ADDRESS
CALL GETOK0 ;ENTER IN Q AND DO FUNCTION
RETBAD () ;ERROR RETURN ERROR IN T1
RETSKP ;RETURN TO CALLER ALL OK
;GETOK0 - COMMON ROUTINE TO DO GETOK WORK FOR BOTH JSYS AND
;INTERNAL CALL
;ACCEPTS:
; T2/ ROUTINE TO CALL IF NEED TO BLOCK (0 IF NONE)
; Q3/ ADDRESS OF RESIDENT BLOCK DESCRIBING THIS FUNCTION
; CALL GETOK0
;RETURNS +1: REQUEST REJECTED
; T1/ ERROR CODE
; +2: REQUEST ACCEPTED
;CALLER MUST BE NOINT (ALOCRS RETURNS NOINT)
;IF T2 IS NON-ZERO, THIS ROUTINE CALLS 0(T2) WHEN IT NEEDS TO
;WAIT FOR THE ACCESS CONTROL JOB. IT SETS UP A SCHEDULER TEST
;WORD IN T1 BEFORE CALLING THE COROUTINE. IF T2 IS ZERO, THIS
;ROUTINE DISMISSES UNTIL A RESPONSE COMES IN.
;IF THE COROUTINE FAILS, THIS CODE ASSUMES THE SCHEDULER WAIT
;HAS BEEN SATISFIED.
GETOK0: STKVAR <BLKADR> ;SAVE BLOCK ADDRESS HERE
MOVEM T2,BLKADR ;SAVE IT
CSKED ;CRITICAL CODE
LOCK GOKLCK ;STOP EVERYTHING
;If this is to be the first GETOK in the queue, start the RCVOK timer
SKIPN T2,GOKQED ;IS THIS THE FIRST GETOK?
JRST [MOVE T2,TODCLK ;YES, GET CURRENT TIME
ADDI T2,RCVTIM ;ADD THE RCVOK TIMER VALUE
MOVEM T2,RCVTMO ;SET THE TIMEOUT TIME
JRST .+1]
;ADD THIS ENTRY TO THE END OF THE QUEUE
MOVEI T2,GETOKF ;ENTER IN Q
GETOK1: MOVE T3,T2 ;SAVE ADDRESS
SKIPE T2,0(T2) ;LOOK FOR A 0 ENTRY
JRST GETOK1 ;NOPE KEEP TRYING
MOVEM Q3,0(T3) ;FOUND ONE ENTER ON END OF LIST
SETZM 0(Q3) ;MAKE FORWARD POINTER 0
AOS GOKQED ;INDICATE SOMETHING QUEUE'D
UNLOCK GOKLCK ;FREE LOCK
ECSKED ;NO LONGER CRITICAL
OKINT ;CALLER WAS NOINT. ALLOW INTERRUPTS WHILE WAITING
;WAIT FOR A RESPONSE, EITHER HERE OR IN THE COROUTINE
MOVEI T1,1(Q3) ;POINT TO SCHEDULER WORD
HRLI T1,DISOK ;YES. SET UP OUR OWN TEST
MOVSS T1 ;MAKE HALF WORDS PROPER
SKIPN T2,BLKADR ;HAVE SPECIAL BLOCK ADDRESS?
IFSKP.
CALL 0(T2) ;GO DO THE DISMISS
IFNSK.
MOVEM T1,LSTERR ;SAVE ERROR
CALL GETOK3 ;PROCESS BLOCK
NOP ;WHO CARES?
MOVE T1,LSTERR ;RETRIEVE ERROR CODE
RETBAD () ;ERROR
ENDIF.
CALLRET GETOK3 ;AND PROCEED
ENDIF.
MDISMS ;WAIT FOR REQUEST TO COMPLETE
; CALLRET GETOK3 ;DUMMY SUBROUTINE CALL
;GETOK3 - PROCESS A RESPONSE FROM THE ACCESS CONTROL JOB
;THIS IS A SUBROUTINE SINCE IT IS NEEDED TO COMPLETE THE REQUEST
;EVEN IF THE SCHEDULER TEST "FAILS". IN THIS UNLIKELY EVENT,
;THE STATE OF THE GETOK REQUEST IS IMMATERIAL.
;ACCEPTS:
; Q3/ ADDRESS OF DATA BLOCK
; CALL GETOK3
;RETURNS: +1 REQUEST DENIED OR PROCESSING ERROR.
; +2 SUCCESS. ALLOW REQUEST
GETOK3: LOAD T2,GOKBAD,(Q3) ;GET ADDRESS OF ERROR MESSAGE
JUMPE T2,GOKNBS ;NO BUFFER SUPPLIED
LOAD T3,GOKERB,(Q3) ;GET ERROR BLOCK ADDRESS
JUMPE T3,GOKNOB ;NONE
;GIVOK PROVIDED AN ERROR STRING. COPY IT TO THE USER
UMOVE T1,GOKESZ(T3) ;GET BLOCK SIZE
ERJMP GOKNOB ;FAULT IF ERROR
SUBI T1,2 ;CHECK FOR MIN SIZE
JUMPL T1,GOKNOB ;NO BUFFER
LOAD T4,GOKETN,(Q3) ;GET ERROR NUMBER
UMOVEM T4,GOKENU(T3) ;STORE ERROR NUMBER
ERJMP GOKNOB ;QUIT IF WE FAULT
SUBI T1,2 ;CHECK FOR NEXT SET OF ARGS
JUMPL T1,GOKNOB ;NO MORE
UMOVE T1,GOKEZ(T3) ;GET STRING SIZE
ERJMP GOKNOB ;QUIT
JUMPL T1,GOKNOB ;FORGET IT TOO SMALL
CAIL T1,GOKMSZ ;CHECK STRING SIZE
MOVEI T1,GOKMSZ ;SET SIZE
UMOVE T3,GOKEBP(T3) ;GET BYTE POINTER
ERJMP GOKNOB ;QUIT IF ERROR
TLC T3,-1 ;SEE IF LH -1
TLCN T3,-1
HRLI T3,(POINT 7,0) ;SET -1 TO LEGAL POINTER
HRLI T2,(POINT 7,0,35)
GOKMVL: SOJL T1,GOKNOM ;CHECK FOR END OF BUFFER
ILDB T4,T2 ;GET CHARACTER
XCTBU [IDPB T4,T3] ;STORE CHARACTER
ERJMP GOKNOB ;QUIT IF FAULT
SKIPE T4 ;QUIT ON ZERO
JRST GOKMVL ;AND DO NEXT ONE
GOKNOM: LOAD T2,GOKERB,(Q3) ;GET ERROR BLOCK ADDRESS AGAIN
UMOVEM T3,GOKEBP(T2) ;STORE UPDATED STRING
AOS T1 ;UPDATE COUNT TO CORRECT NUMBER
UMOVEM T1,GOKEZ(T2) ;AND BYTE COUNT
;HERE WHEN ERROR STRING HAS BEEN COPIED. RELEASE THE SWAPPABLE FREE
;SPACE THAT HELD THE ERROR STRING
GOKNOB: NOINT ;NOINT UNTIL FREE SPACE IS RETURNED
LOAD T1,GOKBAD,(Q3) ;RELEASE THE MESSAGE BUFFER
MOVEI T2,GOKSFZ ;GOKSFZ WORDS
CALL RELSWP ;RELEASE SPACE
SETZRO GOKBAD,(Q3) ;SAY BUFFER RELEASED
OKINT ;ENABLE INTERRUPTS
;REMOVE THIS ENTRY FROM THE QUEUE AND RETURN THE RESIDENT
;FREE SPACE. RETURN SUCCESS OR FAILURE TO THE USER.
GOKNBS: CALL GOKFR ;FREE ENTRY
CAIE Q1,2 ;WAS THE REQUEST DONE A REFUSAL?
RETSKP ;NO ALL OK
RETBAD (GOKER2) ;YES ITRAP
; DISGOK -ROUTINE TO DISMIS FOR GETOK COMPLETE
; ALSO DOES TIMEOOUT CHECK
RESCD
DISOK:: SKIPLE 0(T1) ;Done?
JRST 1(T4) ;YES CONTINUE
MOVE T2,3(T1) ;GET TIMEOUT TIME
CAML T2,TODCLK ;TIME UP YET?
JRST 0(T4) ;NO CONTINUE WAITING
SKIPN 0(T1) ;FIX QUEUE'D COUNT
SOS GOKQED ;UPDATE COUNTER
SOS T1 ;BACK T1 UP SO IT IS IN A NICE PLACE
LOAD T2,GOKFUN,(T1) ;GET FUNCTION CODE
BUG.(CHK,GIVTMR,JSYSA,SOFT,<GIVOK timeout>,<<T2,FUNC>>,<
Cause: The access control job has not responded with a GIVOK within the
designated time period.
Action: If this consistently happens with the same function code, you
should see if the processing of the function can be made faster.
If there is no obvious function code pattern, you may need to increase
the timeout period or rework the way in which the access control
program operates.
Data: FUNC - the GETOK function code
>,,<DB%NND>) ;[7.1210]
TRZ T2,400000 ;NO USER FUNCTION CODE NEEDED
ADDI T2,GTOKPR ;POINT TO FUNCTION
LOAD T2,GTDEF,(T2) ;GET THE DEFAULT ACTION
MOVEI T3,1 ;ASSUME SUCCESS
TRNN T2,20 ;CHECK FOR OK
AOS T3 ;SET FAILURE
STOR T3,GOKST,(T1) ;SET SUCCESS/FAILURE
JRST 1(T4) ;WAKEUP
SWAPCD
;GOKFR - REMOVE A GETOK ENTRY FROM THE QUEUE AND RETURN ITS
;FREE SPACE TO THE POOL
;ACCEPTS:
; Q3/ ADDRESS OF RESIDENT BLOCK
; CALL GOKFR
;RETURNS +1: ALWAYS
; Q1/ STATUS OF THIS REQUEST
GOKFR: MOVE T1,Q3 ;GET BLOCK ADDRESS
NOINT ;DISABLE INTERRUPTS
CSKED ;DON'T STOP SCHEDULER
LOCK GOKLCK ;LOCK GETOK LIST
MOVEI T2,GETOKF ;GET FORWARD POINTER
GOKREL: MOVE T3,0(T2) ;GET A FORWARD POINTER
CAMN T3,T1 ;IS THIS THE ONE?
JRST GOKFND ;YUP
MOVE T2,T3 ;GET ANOTHER ENTRY
JRST GOKREL ;AND TRY AGAIN
;HERE WHEN BLOCK HAS BEEN FOUND. REMOVE IT FROM THE CHAIN
;AND RETURN IT TO THE FREE POOL.
GOKFND: MOVE T4,0(T3) ;REMOVE IT
MOVEM T4,0(T2)
LOAD Q1,GOKST,(T1) ;GET SUCCESS/FAILURE STATUS
UNLOCK GOKLCK
ECSKED ;END CSKED
CALL RELRES ;RELEASE FREE STORAGE
OKINT ;GAVE IT BACK NOW ENABLE INTERRUPTS
RET ;AND GO TO CALLER
SUBTTL Access Control -- RCVOK JSYS
; RCVOK JSYS
; T1 - POINTER TO BUFFER FOR ARGUMENTS
; T2 - SIZE OF BUFFER
.RCVOK::MCENT ;DO MONITOR STUFF
RCVA1: MOVE T4,CAPENB ;CHECK FOR ENABLED CAPABILITIES
TXNN T4,SC%OPR!SC%WHL ;CHECK FOR WHEEL AND OPR
ITERR (CAPX1) ;NOPE CAN'T DO THIS FUNCTION
MOVE T4,FORKX ;CHECK FOR CORRECT FORK
CAME T4,ACJFN
ITERR (GOKER3) ;ILLEGAL FOR OTHER FORKS
;WAIT HERE IF THERE ARE NO PENDING REQUESTS
CSKED ;BE UNINTERRUPTABLE
LOCK GOKLCK ;LOCK UP THE GETOK STRUCTURE
MOVEI T1,GOKQED ;GO LOOK FOR AN ENTRY TO DO
SKIPN 0(T1) ;CHECK IF ONE ALREADY THERE
JRST [ SETZM RCVTMO ;MAKE SURE TIMER IS OFF
UNLOCK GOKLCK ;FREE LOCK
ECSKED ;BE INTERRUPTABLE
CALL DISN ;WAIT HERE FOR A WHILE
JRST RCVA1] ;AND TRY AGAIN
;AN ENTRY EXISTS. FIND IT AND TURN OFF OR RESTART RCVOK TIMER
SOSN GOKQED ;UPDATE GETOK COUNT, ARE THERE ANY LEFT?
JRST [SETZM RCVTMO ;NO, TURN OFF RCVOK TIMER
JRST RCVA2]
MOVE T2,TODCLK ;YES, GET CURRENT TIME
ADDI T2,RCVTIM ;ADD RCVOK TIMER VALUE
MOVEM T2,RCVTMO ;SET THE TIMEOUT TIME
RCVA2: SKIPA T2,GETOKF ;GET FIRST ENTRY IN Q
RCVGLP: MOVE T2,0(T2) ;GET NEXT ENTRY
JUMPE T2,[SKIPE GOKQED ;SEE IF SOMETHING STRANGE HAPPENED
BUG.(CHK,RCVNOE,JSYSA,SOFT,<RCVOK - No entry found in queue>,,<
Cause: The RCVOK JSYS has detected that the list of unprocessed GETOK requests
is empty, but the count of entries in the list is nonzero. This may
have happened if a GIVTMR BUGCHK has already been issued.
Action: Check the health of the system's access control program. If it is
healthy and this BUGCHK is reproducible, set this bug dumpable and
submit an SPR along with the dump along with instructions on
reproducing the problem.
>) ;QUEUE EMPTY BUT COUNT NOT = 0
SETZM GOKQED ;INSURE COUNT IS 0
UNLOCK GOKLCK ;UNLOCK
ECSKED ;OK TO SCHEDULE
JRST RCVA1] ;AND CONTINUE WAITING
SKIPE 1(T2) ;LOOK FOR AN ENTRY THAT HASN'T BEEN USED YET
JRST RCVGLP ;TRY NEXT ONE
;FOUND AN ENTRY THAT HADN'T BEEN PROCESSED. MARK IT AS BEING
;PROCESSED AND COPY THE ARGUMENT BLOCK AND FUNCTION-DEPENDENT
;DATA TO THE USER. FUNCTION-DEPENDENT DATA ALWAYS GOES IMMEDIATELY
;AFTER THE COMMON DATA
SOS 1(T2) ;MAKE IT LOOK BUSY
LOAD T3,GOKTSZ,(T2) ;GET SIZE OF TABLE
SUBI T3,GOKIDZ ;SUBTRACT INTERNAL DATA SIZE
MOVE T4,T3 ;SAVE SIZE
UMOVE T1,T2 ;GET BUFFER SIZE
SKIPG T1 ;NON NEGATIVE?
ITERR (ARGX17,<UNLOCK GOKLCK ;NO
ECSKED>) ;SCHED NOW OK
CAILE T1,0(T4) ;USE SMALLER SIZE
MOVE T1,T4
SUBI T4,GOKHDL-GOKIDZ ;GET CORRECT SIZE OF NEW ARGS
SKIPG T4 ;SET Z IF NONE
SETZ T4,0
STOR T4,GOKURA,(T2) ;STORE ARGUMENTS PASSED
UMOVE T3,T1 ;GET TO ADDRESS
ADDI T3,GOKHDL-GOKIDZ ;POINT TO USER SUPPLIED WORDS
STOR T3,GOKUSA,(T2)
ADDI T2,GOKIDZ ;POINT PAST INTERNAL DATA (FOR SOURCE)
UMOVE T3,T1 ;GET DESTINATION ADDRESS
CALL BLTMU1 ;SEND TO USER, APPLY PCS IF NECESSARY
UNLOCK GOKLCK ;RELEASE LOCK
ECSKED ;OK TO SCHED
MRETNG ;END IT ALL
;RCVOK TIMEOUT CHECK - CALLED EVERY 20 MS FROM SCHEDULER
RESCD
RCVCH7::
IFN STANSW,<
SKIPN GOKQED ;IS THERE AN ENTRY FOR ACJ TO DO?
SETZM RCVTMO ;NO, IT WENT AWAY. CLEAR TIMER
>;IFN STANSW
SKIPE T1,RCVTMO ;HAS THE TIMER BEEN STARTED?
CAMLE T1,TODCLK ;YES, HAS IT GONE OFF?
RET ;NO
SKIPL GOKLCK ;IS GETOK REQUEST QUEUE LOCKED?
RET ;YES, CAN'T KILL ACJ RIGHT NOW
CALL ACJKI1 ;DON'T ASK THE ACJ ANYMORE
SETZM RCVTMO ;TURN OFF RCVOK TIMER
BUG.(CHK,RCVTMR,JSYSA,SOFT,<RCVOK TIMEOUT - Ignoring access control job>,,<
Cause: The access control job did not do a RCVOK within the designated time
period. A GETOK request was pending.
Action: The access control job should be examined to see if its receiving
requests can be made faster. It is also possible that the ACJ was hung
processing something due to some other system malfunction (a disk going
offline for instance).
>,,<DB%NND>) ;[7.1210]
RET
SUBTTL Access Control -- GIVOK JSYS
; GIVOK JSYS
; T1 - REQUEST NUMBER
; T2 - 0 REQUEST OK
; T2 - 0,,400000+ERROR NUMBER REQUEST FAILED
; T3 - ASCIZ STRING POINTER (OR 0 IF NONE)
SWAPCD
.GIVOK::MCENT ;DO MONITOR STUFF
MOVE T4,CAPENB ;CHECK FOR ENABLED CAPABILITIES
TXNN T4,SC%OPR!SC%WHL ;WHEEL AND OPERATOR ONLY
ITERR (CAPX1) ;NO ILLEGAL FUNCTION
MOVE T4,FORKX ;CHECK FOR CORRECT FORK
CAME T4,ACJFN
ITERR (GOKER3) ;ILLEGAL FOR OTHER FORKS
MOVEI Q1,GETOKF ;GET FRONT OF LIST
NOINT
CSKED ;DON'T STOP
LOCK GOKLCK ;LOCK THE Q
;STEP THROUGH THE QUEUE LOOKING FOR THIS ENTRY
GOKGLP: SKIPN Q1,0(Q1) ;GET NEXT ENTRY
JRST GIVOK1 ;QUIT NOT FOUND (NOT AN ERROR BECAUSE USER CAN QUIT EARLY)
OPSTR <CAME T1,>,GOKRN,(Q1)
JRST GOKGLP ;NOT FOUND TRY ANOTHER
;FOUND THE ENTRY. RECORD THE USER'S RESPONSE TO THIS REQUEST.
MOVEI P6,1 ;SET REQUEST DONE OK
TRNE T2,400000 ;CHECK FOR SUCCESS
AOS P6 ;NO SET FAILURE
STOR T2,GOKETN,(Q1) ;SAVE THE ERROR NUMBER
SETZRO GOKBAD,(Q1) ;ZERO POINTER TO STRING (ASSUME NONE SUPPLIED)
SKIPN T3 ;ONE SUPPLIED?
JRST GIVOK2 ;NO ALL DONE
;USER PROVIDED AN ERROR STRING. COPY IT INTO SWAPPABLE FREE SPACE.
MOVEI T1,GOKSFZ ;YES REQUEST SOME SPACE
CALL ASGSWP ;ASSIGN SWAP SACE
JRST GIVOK2 ;CAN'T GET SPACE FINISH UP
MOVEI T2,GOKMSZ ;MAX 40 CHARACTERS
STOR T1,GOKBAD,(Q1) ;SAVE BUFFER ADDRESS
HRLI T1,(POINT 7,0,35) ;SET UP DESTINATION BYTE POINTER
UMOVE T3,T3 ;GET SOURCE BYTE POINTER
MOVEI T4,440700 ;CONVERT -1,,N TO BYTE POINTER
TLC T3,-1 ; IF NECESSARY
TLCN T3,-1
XCTU [HRLM T4,T3] ;SET BYTEPOINTER TO USER CORRECTLY
GOKBLP: XCTBUU [ILDB Q2,T3] ;GET A CHARACTER
IDPB Q2,T1 ;STORE IN BUFFER
SKIPE Q2 ;QUIT IF NULL
SOJG T2,GOKBLP ;CONTINUE UNTIL COUNT EXCEEDED
GIVOK2: STOR P6,GOKST,(Q1) ;STORE REQUEST DONE
GIVOK1: UNLOCK GOKLCK ;RESTART SKED
ECSKED ;START SCHEDULING AGAIN
OKINT
MRETNG ;RETURN
; GOKFRE -- ROUTINE TO REMOVE GETOK ENTRIES WHEN FORK GOES AWAY OR IS INTERRUPTED
;ACCEPTS:
; T1/ SYSTEM-WIDE FORK HANDLE
; T2/ PRIORITY LEVEL (OR 0 FOR ALL)
; CALL GOKFRE
;RETURNS +1: ALWAYS
;THIS CODE FLUSHES ALL OUTSTANDING GETOK REQUESTS FOR THE
;SPECIFIED FORK. IF PRIORITY LEVEL IS NON-ZERO, IT FLUSHES ONLY
;THOSE REQUESTS THAT WERE MADE AT THE SPECIFIED LEVEL
RESCD ;RESIDENT
GOKFRE::SKIPN GETOKF ;CHECK FOR ANY ENTRIES AT ALL
RET ;NOPE QUIT QUICK
SAVET ;SAVE TEMP'S
STKVAR <GOKBIP,GOKHND,GOKCAD>
MOVEM T2,GOKBIP ;SAVE PRIORITY
MOVEM T1,GOKHND ;SAVE FORK HANDLE
MOVEI T4,GETOKF ;FIND FORWARD POINTER
NOINT ;DISABLE INTERRUPTS
CSKED ;DON'T STOP THIS JOB
LOCK GOKLCK ;LOCK LOCK
;LOOK FOR AN ENTRY FOR THIS FORK
SKIPA
GOKFL1: MOVE T4,GOKCAD ;GET FORWARD POINTER
SKIPN T3,0(T4) ;GET AN ENTRY
JRST GOKFUL ;DONE
MOVEM T3,GOKCAD ;SAVE NEW FORWARD POINTER
LOAD T1,GOKFKN,(T3) ;GET FORK NUMBER
CAME T1,GOKHND ;IS IT THE CORRECT ONE?
JRST GOKFL1 ;NO TRY NEXT ENTRY
;FOUND ONE. SEE IF THE PRIORITIES MATCH UNLESS DOING ALL PRIORITIES
MOVE T1,GOKBIP ;GET THE PRIORITY REQUESTED
JFFO T1,GOKONE ;OTHER THAN 0?
JRST GOKALL ;NO DO ALL
GOKONE: LOAD T1,GOKPSI,(T3) ;GET THE PRIORITY OF THIS ONE
CAMLE T1,T2 ;IS IT ONE TO GET?
JRST GOKFL1 ;NO TRY NEXT ONE
;REMOVE THIS ENTRY FROM THE CHAIN. RELEASE FREE SPACE ASSOCIATED WITH IT.
GOKALL: MOVEM T4,GOKCAD ;SET OLD FORWARD POINTER AS NEW ONE
SKIPN 1(T3) ;IN USE YET?
SOS GOKQED ;NO UPDATE COUNT OF QUEUE'D
LOAD T1,GOKBAD,(T3) ;GET THE ERROR BLOCK ADDRESS
MOVEI T2,GOKSFZ ;SIZE OF BLOCK
PUSH P,T3 ;SAVE T3
SKIPE T1 ;CHECK FOR AN ERROR BLOCK ADDRESS
CALL RELSWP ;RELEASE FREE SPACE
POP P,T3 ;RESTORE
MOVE T4,GOKCAD ;GET THE BLOCK ADDRESS BACK
MOVE T1,0(T3) ;UPDATE POINTERS
MOVEM T1,0(T4)
MOVE T1,T3 ;RELEASE BLOCK
CALL RELRES
JRST GOKFL1
GOKFUL: UNLOCK GOKLCK ;UNLOCK
ECSKED ;NOW WE CAN STOP
OKINT
RET ;QUIT
SUBTTL Access Control -- Delete ACJ Fork (ACJKIL)
;ACJKIL -ROUTINE TO KILL THE ACJ FORK AND CLEANUP
;
;ACJKI1 IS THE SCHEDULER'S ENTRY POINT.
;THE SCHEDULER CHECKS TO MAKE SURE THAT GOKLCK IN NOT LOCKED
;BEFORE CALLING ACJKI1. THE CHECK IS AT RCVCH7.
ACJKIL::SAVET ;SAVE TEMPS
NOINT ;DISABLE INTERRUPTS
CSKED ;CRIT SKED
LOCK GOKLCK ;LOCK UP THE QUEUE
CALL ACJKI1 ;RE-ESTABLISH THE DEFAULT ACTIONS
UNLOCK GOKLCK ;UNLOCK THE QUEUE
ECSKED ;ALLOW SCHEDULING
OKINT ;ALLOW INTERRUPTS
RET
ACJKI1::SETZ T1, ;INIT THE FUNCTION TYPE POINTER
ACJKLP: MOVE T3,T1 ;GET FUNCTION
ADDI T3,GTOKPR
LOAD T2,GTDEF,(T3) ;GET DEFAULT
CAIE T2,77 ;ALREADY SETUP?
STOR T2,GTENB,(T3) ;SET AS NEW ENABLE
SETONE GTDEF,(T3) ;SET NO DEFAULT
AOS T1 ;DO NEXT FUNCTION
CAIGE T1,MXGOKF ;CHECK FOR MAX FUNCTION
JRST ACJKLP ;TRY NEXT ONE
MOVEI T1,GETOKF ;EMPTY THE QUEUE
ACJKL: SKIPN T1,0(T1) ;GET AN ENTRY
JRST ACJDON ;DONE
LOAD T3,GOKFKN,(T1) ;GET FUNCTION
TRZ T3,400000 ;REMOVE USER FUNCTION BITS
SKIPN 1(T1) ;LOOK AT THE PICKED COUNT
SOS GOKQED ;GET THE QUEUE'D COUNT UPDATES
MOVEI T2,1 ;ASSUME ALL OK
MOVEM T2,1(T1) ;SET IN DONE FLAG
MOVSI T2,(SF%DOK) ;CHECK FOR 0K
TDNN T2,GTOKPR(T3)
AOS 1(T1) ;SET FAILURE
JRST ACJKL ;AND TRY NEXT ONE
ACJDON: SETZM ACJFN ;SET NO ACJ FORK
SETZM ACJJN ;SET NO JOB NUMBER
RET ;RETURN
SWAPCD
SUBTTL GTABS JSYS
; Get tab settings
.GTABS::MCENT
CALL CHKTTR
JRST [ XCTU [SETZB A,2]
UMOVEM A,3
UMOVEM A,4
JRST MRETN]
CALL TTGTBS
UMOVEM 1,2
UMOVEM 3,3
UMOVEM 4,4
JRST MRETN
SUBTTL GTAD JSYS
; Read time and date
; Call: RTAD
; Return
; +1
; 1 ; Current date and time or -1 if not set
.GTAD:: MCENT
CALL LGTAD ;DO THE WORK
UMOVEM A,1
JRST MRETN
SUBTTL GTDIR JSYS
; Get directory info
; Call: 1 ; Directory number
; 2 ; Pointer to parameter block
; 3 ; String pointer for password
; GTDIR
.GTDIR::MCENT
UMOVE Q3,2 ;GET POINTER TO PARAMETER BLOCK
XCTU [SKIPG Q2,.CDLEN(Q3)] ;GET LENGTH OF ARGUMENT BLOCK
MOVEI Q2,.CDDGP+1 ;IF NONE SET UP, USE THIS ONE
;MAKE GTDIR RETURN DIR GROUP INFO IF FIRST WORD OF ARG BLOCK = 0
SETZ P1, ;INITIALIZE PRIVILEGE FLAG
UMOVE A,1 ;GET DIRECTORY NUMBER
JUMPE A,GTDIR2 ;IF 0, THEN GO GET DEFAULTS
LDB A,[POINT 6,A,17] ;[7.1063]Get the structure number
CALL CKSTOF ;[7.1063](T1/T1)Is the structure offline?
ITERR () ;[7.1063]Return "Structure is offline"
UMOVE A,1 ;[7.1063]Restore directory number
UMOVE B,C ;PASSWORD POINTER
SKIPE B ;IS IT NON-ZERO?
XCTU [MOVES 0(B)] ;MAKE SURE WE CAN GET AT IT
XCTU [MOVES 0(Q3)] ;TEST TO SEE THAT BLOCK IS WRITEABLE
MOVE B,Q3 ;GO FOR THE LAST WORD IN BLOCK
ADDI B,(Q2) ;POINT TO END..
SOS B ;... of the argument block
XCTU [MOVES 0(B)] ;TEST THIS WORD, TOO
SOS Q2 ;Reflect the largest value to be returned
CAIGE Q2,.CDUGP ;LONG ENOUGH FOR GROUPS?
JRST GTDIR1 ;NO, SKIP REST OF TESTS
UMOVE B,.CDUGP(Q3) ;GET ADDRESS OF THAT STRING
XCTU [MOVES 0(B)] ;AND TEST THAT WORD
CAIGE Q2,.CDDGP ;LONG ENOUGH FOR DIR GROUPS?
JRST GTDIR1 ;NO, SKIP REST OF TESTS
UMOVE B,.CDDGP(Q3) ;GET ADDRESS OF THAT STRING
XCTU [MOVES 0(B)] ;AND TEST THAT WORD
CAIGE Q2,.CDCUG ;LONG ENOUGH FOR INFERIOR GROUPS?
JRST GTDIR1 ;NO, SKIP REST OF TESTS
UMOVE B,.CDCUG(Q3) ;GET ADDRESS OF THAT STRING
XCTU [MOVES 0(B)] ;AND TEST THAT WORD
CAIGE Q2,.CDDAC ;LONG ENOUGH FOR ACCOUNT?
JRST GTDIR1 ;NO, SKIP REST OF TESTS
UMOVE B,.CDDAC(Q3) ;GET ADDRESS OF THAT STRING
XCTU [MOVES 0(B)] ;AND TEST THAT WORD
IFE FTNSPSRV,<
CAIGE Q2,.CDDRN ;long enough for node aliases ?
JRST GTDIR1 ;no, skip rest of tests
UMOVE B,.CDDRN(Q3) ;get address of the sub-argument block
JUMPE B,GTDIR1 ;[7336] Anything here? If no, skip end of block test
XCTU [MOVES 0(B)] ; and test first word
XCTU [ADD B,0(B)] ;get address of the last word and
XCTU [MOVES 0(B)] ; test it
>;END IFE FTNSPSRV
GTDIR1: STKVAR <GTDINO>
MOVEM A,GTDINO ;SAVE DIRECTORY NUMBER
HLRZS A ;GET STRUCTURE UNIQUE CODE IN RIGHT HALF
CALL CHKMNO ;SEE IF OK TO ACCESS THIS STRUCTURE
ITERR () ;NO, MUST INCREMENT MOUNT COUNT FIRST
MOVE A,GTDINO ;GET BACK DIRECTORY NUMBER
MOVX B,DC%CN ;SEE IF USER HAS CONNECT PRIVILEGES
CALL SUPCHK ;SEE IF HAVE ACCESS TO SUPERIOR
JRST GTDIR6 ;FAILED.
MOVE A,GTDINO ;SUCCEEDED. GET DIRECTORY NUMBER
CALL SETDIR ;MAP THE DIRECTORY
ITERR () ;FAILED. RETURN ERROR
JRST GTDIR3 ;GO GET THE INFO
GTDIR6: MOVE A,GTDINO ;A/ DIRECTORY NUMBER
CALL SETDIR ;MAP IN THE DIRECTORY
ITERR() ;FAILED
MOVE B,CAPENB
TRNE B,SC%WHL!SC%OPR
JRST GTDIR3 ; WHEEL OR OPERATOR
MOVX B,DC%CN ;SEE IF USER HAS OWNER ACCESS TO DIR
CALL DIRCHK ;...
IFNSK.
UMOVE B,3 ;SEE IF USER HAS GIVEN THE PASSWORD
CALL CHKPSX
ITERR(GTDIX1,<ULKDIR
MOVE T2,JOBNO ;Get this job's job number
HRRZ T2,JOBDIR(T2) ;Get log-in directory number
SKIPE T2 ;if not logged in
SKIPE T1 ;Or no penalty declared
SKIPA ; Don't extract an ounce of his flesh
CALL PASPEN>) ;Illegal password given and penalty declared
ENDIF.
SETO P1, ;MARK ONLY LIMITED ACCESS
GTDIR3: MOVE A,DIRORA ; GET BASE OF MAPPED DIR AREA
JUMPLE Q2,GTDIR5 ;Run out of argument block yet?
JUMPN P1,GTDIR4 ;IF NOT PRIVILEGED, DONT GIVE PASSWORD
UMOVE C,3
TLC C,-1 ;SEE IF LH = -1
TLCN C,-1
HRLI C,(<POINT 7,0>) ;YES, SET UP BYTE POINTER
LOAD B,DRPSW,(A) ;GET POINTER TO NAME STRING
ADD B,DIRORA ;MAKE IT ABSOLUTE
MOVSI Q1,(POINT 7,0(B),35) ;SET UP STRING POINTER TO NAME STR
UMOVEM C,.CDPSW(Q3) ;SAVE STARTING BYTE POINTER TO PSW
GTDIR0: UMOVEM C,3 ;SAVE UPDATED BYTE POINTER FOR USER
ILDB D,Q1 ;GET NEXT CHARACTER OF PASSWORD
XCTBU [IDPB D,C] ;STORE CHAR IN USER SPACE
JUMPN D,GTDIR0 ;LOOP BACK TIL NULL IS SEEN
GTDIR4: SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD D,DRLIQ,(A) ;GET LOGGED IN QUOTA
UMOVEM D,.CDLIQ(Q3)
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD D,DRPRV,(A) ;GET PRIVILEGE BITS
UMOVEM D,.CDPRV(Q3) ;GIVE PRIVILEGE BITS TO USER
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD D,DRMOD,(A) ;MODE BITS
TXO D,MD%SA ;ALWAYS SET STRING ACCOUNTS ALLOWED BIT
UMOVEM D,.CDMOD(Q3)
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD D,DRLOQ,(A) ;MAX DISK ALLOCATION ALLOWED
UMOVEM D,.CDLOQ(Q3)
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD D,DRNUM,(A) ;DIRECTORY NUMBER
UMOVEM D,.CDNUM(Q3)
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD D,DRDPW,(A) ;DEFAULT FILE PROTECTION WORD
UMOVEM D,.CDFPT(Q3)
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD D,DRPRT,(A) ;DIRECTORY PROTECTION
UMOVEM D,.CDDPT(Q3)
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD D,DRDBK,(A) ;BACKUP SPEC, (# OF GEN'S TO KEEP)
TLZ D,(7B2) ;DONT RETURN THE 5B2 BITS
UMOVEM D,.CDRET(Q3)
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD D,DRDAT,(A) ;TIME AND DATE OF LAST LOGIN
UMOVEM D,.CDLLD(Q3)
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD A,DRUGP,(A) ;USER GROUPS
UMOVE B,.CDUGP(Q3) ;GET POINTER TO BLOCK TO RECEIVE LIST
CALL GTDGRP ;GET BITS FROM LIST
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
MOVE A,DIRORA
LOAD A,DRDGP,(A) ;DIRECTORY GROUPS
UMOVE B,.CDDGP(Q3) ;GET POINTER TO USER BLOCK
CALL GTDGRP ;GET 36 BIT WORD
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
MOVE A,DIRORA ;GET DIR BASE ADDR
LOAD B,DRSDM,(A) ;GET SUBDIR QUOTA
UMOVEM B,.CDSDQ(Q3) ;RETURN TO USER
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD A,DRCUG,(A) ;GET POINTER TO CREATABLE USER GRPS
UMOVE B,.CDCUG(Q3) ;GET POINTER TO USERS BLOCK
CALL GTDGRP ;RETURN GROUPS
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
MOVE B,DIRORA
LOAD B,DRACT,(B) ;NO, GET POINTER TO DEFAULT DIR ACCOUNT
JUMPE B,[MOVEI B,[0]-1 ;RETURN A NULL IF NO DEFAULT ACT SET UP
JRST GTDIR7]
ADD B,DIRORA ;GET ABS ADR OF ACCOUNT IN DIR
GTDIR7: MOVEI C,.CDDAC(Q3) ;PLACE TO PUT USER7'S UPDATED PTR
UMOVE A,.CDDAC(Q3) ;POINTER TO BLOCK TO RECEIVE ACCOUNT
CALL CPYTU1 ;RETURN ACCOUNT TO USER
SOJLE Q2,GTDIR5 ; Run out of arg blk yet?
MOVE A,DIRORA
LOAD B,DRDNE,(A) ; Get default online expiration date/interval
UMOVEM B,.CDDNE(Q3) ; Return to user
SOJLE Q2,GTDIR5 ; Run out of arg blk yet?
LOAD B,DRDFE,(A) ; Get default offline exp date/interval
UMOVEM B,.CDDFE(Q3) ; Return to user
SOJLE Q2,GTDIR5 ;Run out of arg blk yet?
XCTU [SKIPE A,.CDDRN(Q3)] ;no. get address of node alias space, if any.
CALL GTDRNA ;get as many node aliases as will fit.
SOJLE Q2,GTDIR5 ;Out of arg block yet?
MOVE A,DIRORA ;Get the directory origin again
LOAD B,DRPEV,(A) ;Get password encryption version
UMOVEM B,.CDPEV(Q3) ;Return to user
SOJLE Q2,GTDIR5 ;Out of arg block still yet again?
LOAD B,DRPDT,(A) ;Get password encryption date
UMOVEM B,.CDPDT(Q3) ;Return to user
SOJLE Q2,GTDIR5 ;Out of arg block yet?
LOAD B,DRPED,(A) ;Get expiration date of password
UMOVEM B,.CDPED(Q3) ;Return to user
SOJLE Q2,GTDIR5 ;Out of arg block yet?
LOAD B,DRPUD,(A) ;Get cur use count,,max use count of password
UMOVEM B,.CDPMU(Q3) ;Return to user
SOJLE Q2,GTDIR5 ;go if done
LOAD B,DRPPN,(A) ;get PPN
UMOVEM B,.CDPPN(Q3) ;store it for the user
GTDIR5: ULKDIR
JRST MRETN
GTDIR2: MOVE T1,[5B2+.STDFP] ;GET DEFAULT FILE PROTECTION
CAILE Q2,.CDFPT ;SKIP IF LARGER THAN BLOCK SIZE
UMOVEM T1,.CDFPT(Q3) ;RETURN VALUE TO USER BLOCK
MOVE T1,[5B2+.STDDP] ;GET DEFAULT DIR PROTECTION
CAILE Q2,.CDDPT
UMOVEM T1,.CDDPT(Q3)
MOVE T1,[.STDBS] ;GET DEFAULT BACKUP SPECIFICATION
CAILE Q2,.CDRET
UMOVEM T1,.CDRET(Q3)
MOVEI T1,.STDMX ;GET DEFAULT DISK QUOTAS
CAILE Q2,.CDLIQ
UMOVEM T1,.CDLIQ(Q3) ;LOGGED IN QUOTA
CAILE Q2,.CDLOQ
UMOVEM T1,.CDLOQ(Q3) ;LOGGED OUT QUOTA
MOVEI T1,.STDSD ;GET DEFAULT SUBDIR QUOTA
CAILE Q2,.CDSDQ
UMOVEM T1,.CDSDQ(Q3) ;RETURN IT
MOVEI T1,.STDNE ; Default online expiration
CAILE Q2,.CDDNE
UMOVEM T1,.CDDNE(Q3)
SKIPG T1,TPRCYC ;DEFAULT EXP IF SET
MOVEI T1,.STDFE ; Default offline expiration
CAILE Q2,.CDDFE
UMOVEM T1,.CDDFE(Q3)
JRST MRETN ;EXIT
;ROUTINE TO STORE GROUP LIST IN USER SPACE
;ACCEPTS IN A/ RELATIVE ADR OF LIST IN DIRECTORY
; B/ ADDRESS OF USER BLOCK TO RECEIVE LIST
; CALL GTDGRP
;RETURNS +1: ALWAYS
GTDGRP: JUMPE B,R ;DO NOTHING IF USER DOESNT WANT LIST
UMOVE C,0(B) ;GET LENGTH OF LIST AREA
SOJLE C,R ;GET NUMBER OF GROUPS, RETURN IF NONE
JUMPE A,[MOVEI A,1 ;IF NO GROUPS,
UMOVEM A,0(B) ;RETURN CORRECT # IN BLOCK
RET]
SAVEQ
MOVE Q3,B ;SAVE ADDRESS OF LIST AREA
MOVEI Q2,1 ;INIT COUNT TO HEADER COUNT
ADD A,DIRORA ;GET ABS ADR OF LIST IN DIR
LOAD D,BLKTYP,(A) ;CHECK LEGALITY OF BLOCK
CAIE D,.TYGDB ;GROUP DESCRIPTOR BLOCK?
JRST GTDGR4 ;NO, RETURN NOTHING
LOAD D,BLKLEN,(A) ;GET # OF GROUPS IN LIST
GTDGR2: SOJLE D,GTDGR4 ;CHECK IF DONE YET
HLRZ Q1,1(A) ;GET FIRST GROUP NUMBER
JUMPE Q1,GTDGR3 ;IGNORE 0'S
UMOVEM Q1,1(B) ;RETURN IT TO THE USER
AOS Q2 ;COUNT # OF GROUPS
AOS B ;STEP USER LIST
SOJLE C,GTDGR4 ;ANY MORE ROOM IN USER BUFFER?
GTDGR3: HRRZ Q1,1(A) ;GET NEXT GROUP NUMBER
AOS A ;STEP POINTER TO DIR LIST
JUMPE Q1,GTDGR2 ;IGNORE ZEROES
UMOVEM Q1,1(B) ;GIVE IT TO USER
AOS Q2 ;COUNT UP NUMBER OF GROUPS STORED
SOJLE C,GTDGR4 ;IF NO MORE ROOM, RETURN
AOJA B,GTDGR2 ;LOOP BACK FOR REST OF GROUPS
GTDGR4: UMOVEM Q2,0(Q3) ;SAVE COUNT OF GROUPS STORED
RET
;copy node alias list to previous context
;CALL GTDRNA
; T1/ previous context address of node alias space
; the first word of which is the size in words of that space
;returns +1 always, with node alias list in that space, starting at
; the second word. The number of node aliases returned is returned in the
; first word. If not enough space, return as many as possible, no error.
GTDRNA: TRVAR <SIZADR,FIRST,LAST,PRVBLK,MONBLK,REPS>
; SIZADR - address of size field in user's sub-argument block
; FIRST - first free word in user's sub-argument block
; LAST - last free word in user's sub-argument block
; MONBLK - address of current dir. node alias block [absolute]
; PRVBLK - user address of previous node alias block
; REPS - a local variable [loop control]
;the TRVARs - FIRST, LAST, & PRVBLK - are also used in GTDRN1 & GTDRN2
MOVEM T1,SIZADR ;save address of size field
XCTU [HRRZ T2,(T1)] ;get size
MOVEI T3,1 ;initialize used space
XCTU [HRLM T3,(T1)] ; word count
ADD T2,T1 ;get address of
SOS T2 ; last word in space
MOVEM T2,LAST ; and save it
AOS T1 ;get address of first word in space
MOVEM T1,FIRST ; and save it
MOVE T1,DIRORA ;get first node
LOAD T1,DRRNA,(T1) ; alias block address
SKIPN T1 ;are there node aliases ?
RET ;no. done.
ADD T1,DIRORA ;make address absolute
MOVEM T1,MONBLK ;save it
SETZM PRVBLK ;initialize previous user block address
DO. ;for each node alias,
CALL GTDRN1 ;(T1/T1,T2) allocate block in user space.
RET ;failed, just quit.
LOAD T3,RNLEN,(T1) ;get size of block.
SUBI T3,RN.NOD ;get number of strings to copy
MOVEM T3,REPS ;save it
ADDI T1,RN.NOD ;get to first string in monitor block
ADDI T2,.CDNOD ;get to first string in user block
SOSGE REPS ;anything there ?
JRST GTDRNB ;no. go to next block.
CALL GTDRN2 ;(T1,T2/T1,T2) allocate & copy node name
RET ;failed.
AOS T1 ;go to
AOS T2 ; userid
SOSGE REPS ;is there any ?
JRST GTDRNB ;no. go to next block.
CALL GTDRN2 ;(T1,T2/T1,T2) allocate & copy userid
RET ;failed.
ADDI T1,2 ;skip
ADDI T2,2 ; over
SOS REPS ; password
SOSGE REPS ;is there an account ?
JRST GTDRNB ;no. go to next block.
CALL GTDRN2 ;yes. (T1,T2/T1,T2) allocate and copy to user
RET ;failed.
GTDRNB: MOVE T1,MONBLK ;step to
LOAD T1,RNNXT,(T1) ; next block
SKIPN T1 ;is there a next ?
RET ;no. all done
ADD T1,DIRORA ;make address absolute
MOVEM T1,MONBLK ; and save it
LOOP. ;continue
ENDDO. ;end outer loop and routine.
;allocate space for user's remote node alias block
;CALL GTDRN1
; T1/ address of monitor's remote node alias block [absolute]
;returns +2 on success, with
; T1/ address of monitor's block [absolute]
; T2/ address of user's block - user's block initialized and linked to previous
; PRVBLK/ updated to point to this one.
; FIRST/ updated as per allocation
; LAST is referenced
;returns +1 on failure
GTDRN1: LOAD T3,RNTYP,(T1) ;make sure it really is
CAIN T3,.TYRNA ; a node alias block
IFSKP.
MOVE T1,DIRORA ;it isn't
LOAD T1,DRNUM,(T1) ;get directory number
BUG. (CHK,DIRRNA,JSYSA,SOFT,<Remote node alias list inconsistency>,<<T1,DIRNUM>>,<
Cause: GTDRN1 was called to allocate space for the user's remote node alias
block but the pointer to the monitor's remote node alias block provided
by the caller does not contain the correct block type.
Action: There could be a problem with the directory named in the BUGCHK or
there could be a software problem. If no hardware problem is
suspected, and this BUGCHK is reproducible, set this bug dumpable and
submit an SPR along with the dump along with instructions on
reproducing the problem.
Data: DIRNUM - Directory Number
>)
RET ;it isn't.
ENDIF.
LOAD T3,RNLEN,(T1) ;get size
CALL GTDRN4 ;(T3/T2,T3,T4) allocate block in user space
RET ;failed
UMOVEM T3,.CDSIZ(T2) ;initialize user's block - size
;zero out rest of block
AOS T4 ;skip size field
DO.
SOJLE T3,ENDLP.
XCTU [SETZM (T4)]
AOS T4
LOOP.
ENDDO.
SKIPE T3,PRVBLK ;get previous block - is there one ?
UMOVEM T2,.CDNXT(T3) ;yes. link up.
MOVEM T2,PRVBLK ;update PRVBLK
RETSKP ;success return
;allocate and copy string block to user
;CALL GTDRN2
; T1/ address of monitor's entry in node alias block pointing to string block
; T2/ address of user's entry in node alias block pointing to string block
;returns +2 on success with
; T1/ address of monitor's entry
; T2/ address of user's entry
; FIRST/ updated as per allocation
; LAST is referenced
;returns +1 on failure
GTDRN2: STKVAR <MONENT,USRENT>
MOVEM T1,MONENT ;save
MOVEM T2,USRENT ; args
MOVE T1,(T1) ;get monitor string block
JUMPE T1,GTDRN3 ;if null, done
ADD T1,DIRORA ;make it absolute
LOAD T3,NMLEN,(T1) ;get size of string block
SOS T3 ;user doesn't want header
JUMPE T3,GTDRN3 ;if size=0, return now.
AOS T1 ;point to monitor string
CALL GTDRN4 ;(T3/T2,T3,T4) allocate block in user space
RET ;failed.
HRLI T4,(POINT 7,0) ;make it a byte pointer
UMOVEM T4,@USRENT ;stick it in user space
;copy the string
DO.
MOVE T4,(T1) ;get word.
UMOVEM T4,(T2) ;put word.
AOS T1 ;step to
AOS T2 ; next
SOJG T3,TOP. ;continue.
ENDDO.
;restore return args and return success
GTDRN3: MOVE T1,MONENT
MOVE T2,USRENT
RETSKP
ENDSV. ;end STKVAR
;allocate space in user's free space
;CALL GTDRN4
;T3/ size of space to allocate
;returns +1 on failure
;returns +2 on success, with T2 & T4 pointing to user space allocated
;updates TRVAR FIRST
;references TRVAR LAST
;preserves T1 & T3.
GTDRN4: MOVE T2,FIRST ;allocate from top of user space
MOVE T4,T2
ADD T4,T3 ;compute new first
CAMLE T4,LAST ;out of space ?
RET ;yes. failure.
MOVEM T4,FIRST ;no. update FIRST
XCTU [HLRZ T4,@SIZADR] ;update number
ADD T4,T3 ; of words
XCTU [HRLM T4,@SIZADR] ; used in user's free space
MOVE T4,T2
RETSKP
ENDTV. ;end TRVAR from GTDRNA
SUBTTL PLOCK JSYS
;LOCK
;T1/ PHYSICAL PAGE(IF LK%PHY ON) OR -1 TO UNLOCK
;T2/ FKH,,PN ;NOW LIMITED TO .FHSLF
;T3/ FLAGS,,OPTIONAL REPEAT COUNT
; LK%CNT - USE REPEAT COUNT IN RH(3)
; LK%PHY - USE PHYSICAL PAGE IN 1 (IGNORED IF C(1) = -1)
; LK%NCH - UNCACHE PAGES (IF LOCKING)
; LK%AOL - ALLOW LOCKING IN OFFLINE MEMORY (IF LOCKING)
;RETURNS+1(ALWAYS):
; PAGES LOCKED/UNLOCKED AS REQUESTED
;ITRAPS ON ERRORS
DEFSTR (LKOST,0,5,5) ;OLD PAGE STATE
DEFSTR (LKPGN,0,35,23) ;PAGE NUMBER
DEFSTR (LKUSE,0,0,1) ;ENTRY IN USE BIT
;Q1,2,3 ARE COPIES OF THE USERS ARGUMENTS
.PLOCK::MCENT
MOVX T1,SC%WHL!SC%OPR!SC%MNT ;CHECK SPECIAL CAPABILITIES
TDNN T1,CAPENB ; ...
ITERR(CAPX2) ;NOT ENOUGH
UMOVE Q1,1 ;GET ARGUMENTS
UMOVE Q2,2 ; ...
UMOVE Q3,3 ; ...
CALL PLOCK0 ;DO THE WORK
ITERR() ;ERROR, TRAP
JRST MRETN ;SUCCESS, RETURN TO USER
;ENTER HERE WITH:
;Q1/ PHYSICAL PAGE(IF LK%PHY ON) OR -1 TO UNLOCK
;Q2/ FKH,,PN
;Q3/ FLAGS,,OPTIONAL REPEAT COUNT
; LK%CNT - USE REPEAT COUNT IN RH(3)
; LK%PHY - USE PHYSICAL PAGE IN 1 (IGNORED IF C(1) = -1)
; LK%NCH - UNCACHE PAGES (IF LOCKING)
; LK%AOL - ALLOW LOCKING IN OFFLINE MEMORY (IF LOCKING)
; LK%EPN - PAGE NUMBER IS ABSOLUTE NOT SECTION RELATIVE
PLOCK0::SAVEPQ
MOVE T1,Q2 ;GET FN,,PN IN T1
SETZ T2, ;ASSUME NO FLAGS
TXNE Q3,LK%EPN ;EXTENDED PAGE NUMBER SUPPLIED?
TXO T2,PM%EPN ;YES, SAY SO
CALL FKHPTN ;CONVERT FKH,,PN TO SPT,,PN
RETBAD () ;ERROR
MOVE Q2,T1 ;REMEMBER SPT,,PN
TXNN Q3,LK%CNT ;USE USER SUPPLIED COUNT?
HRRI Q3,1 ;NO - USE 1
HRRZ T1,Q3 ;CHANGE OPERATION COUNT INTO
SOSGE T1 ;VERIFY REPEAT COUNT
RETBAD (ILLX04) ;NO
SETZM P4 ;NO FREE SPACE BLOCK YET
JUMPL Q1,LOCK0 ;IF UNMAP, DON'T CHECK PHYSICAL PAGE
TXNN Q3,LK%PHY ;USER GIVE PHYSICAL ADDRESS?
JRST LOCK0 ;NO
ADD T1,Q1 ;YES. COMPUTE LAST PAGE USED THEN
CAMLE T1,NHIPG ;WITHIN BOUNDS?
RETBAD (ILLX04) ;NO. CAN'T HAVE IT THEN
LOCK0: HRRZ T1,Q3 ;REPEAT COUNT AGAIN
ADDI T1,(Q2) ;CHECK END OF GROUP
CAILE T1,PGSIZ ; ...
RETBAD (ILLX04) ;BEYOND PT
NOINT ;NO INTERRUPTIONS FROM NOW ON
; ..
;VERIFIED ALL ARGS. NOW DO LOADING
SKIPL Q1 ;DOING SOME FORM OF LOCKING?
TXNN Q3,LK%PHY ;USER GIVING ADDRESSES?
JRST LOCK2 ;NO. GO ON TO FREE CHOICE
MOVEI T2,1(Q3) ;GET SIZE OF BLOCK NEEDED
CALL ASGJFR ;GET SOME JSB FREE SPACE
RETBAD (MONX02,<OKINT>) ;CAN'T
MOVE P4,T1 ;SAVE BASE ADDRESS HERE
MOVEI P2,1(P4) ;SET UP AT FIRST WORD
;HAVE FREE BLOCK. NOW ACQUIRE EACH PHYSICAL PAGE
MOVE P1,Q1 ;FIRST PHYSCIAL PAGE TO GET
HRRZ P3,Q3 ;COUNT TO GET
LOCK4: MOVE T1,P1 ;PAGE
MOVEI T2,.MCPSO ;GET IT OFF-LINE
CALL SETPST ;DO IT
JRST LCKERR ;CAN'T DO IT
TXNN Q3,LK%AOL ;ALLOWING OFF-LINE?
CAIN T1,.MCPSA ;NO. PAGE WAS ON-LINE?
SKIPA ;YES. OKAY THEN
JRST [ MOVEI T1,LOCKX1 ;NO
JRST LCKERR] ;AND DONE
STOR P1,LKPGN,(P2) ;SAVE PAGE NUMBER
STOR T1,LKOST,(P2) ;SAVE OLD STATE
SETONE LKUSE,(P2) ;SAY IN USE
ADDI P1,1 ;NEXT PHYSICAL ADDRESS
ADDI P2,1 ;NEXT ENTRY IN JSB BLOCK
SOJG P3,LOCK4 ;GET THEM ALL
;ALL REQUESTED PHYSICAL PAGES NOW OFF-LINE. DO THE MAPPING
TXO Q3,LK%AOL ;ALLOW OFF-LINE STORAGE
; ..
LOCK2: HRRZ P1,Q3 ;GET COUNT
SKIPE P2,P4 ;HAVE A FREE BLOCK?
ADDI P2,1 ;YES. USE IT THEN
LOCKLD: JUMPL Q1,[MOVE T1,Q2 ;IF UNMAP. GET I.D.
CALL ULDPAG ;UNLOAD IT IF NECESSARY
JFCL ;WILL GO
JRST LOCKL1] ;AND PROCEED
MOVE T2,Q1 ;GET PHYSICAL PAGE NUMBER
MOVE T1,Q2 ;GET I.D.
HLL T2,Q3 ;COPY FLAGS
SKIPN P2 ;HAVE A BLOCK?
TXOA T3,1B0 ;NO. NO SPECIAL STATE THEN
LOAD T3,LKOST,(P2) ;YES. GET OLD STATE
CALL LODPPS ;LOAD IT
JRST [ PUSH P,T1 ;FAILED. SAVE ERROR CODE
SETOM T1 ;DO UNLOAD
UMOVE T2,2
UMOVE T3,3
PLOCK ;DO IT
POP P,T1 ;GET BACK ERROR CODE
JRST LCKERR] ;AND GO CLEAN UP IF NECESSARY
JUMPN P2,[ADDI Q1,1 ;NEXT PHYSICAL PAGE
SETZM 0(P2) ;DID THAT ENTRY
ADDI P2,1 ;NEXT ENTRY
JRST .+1] ;PROCEED
LOCKL1: ADDI Q2,1 ;NEXT PROCESS PAGE
SOJG P1,LOCKLD ;DO ALL PAGES
MOVEI T1,JSBFRE
SKIPE T2,P4 ;HAVE A BLOCK?
CALL RELFRE ;YES. FREE IT
RETSKP
;ERROR IN LOCKING PAGES.
; T1/ ERROR CODE
LCKERR: SKIPN P3,P4 ;HAVE A BLOCK?
RETBAD (,<OKINT>) ;NO. ALL DONE THEN
PUSH P,T1 ;SAVE ERROR CODE
ADDI P3,1 ;START HERE
HRRZ P2,Q3 ;COUNT
LCKER1: SKIPN 0(P3) ;HAVE ANYTHING HERE?
JRST LCKER2 ;NO
LOAD T2,LKOST,(P3) ;YES. GET PREVIOUS STATE
LOAD T1,LKPGN,(P3) ;GET PAGE NUMBER
CALL SETPST ;PUT IT BACK
JFCL
LCKER2: ADDI P3,1 ;NEXT ENTRY
SOJG P2,LCKER1 ;DO THEM ALL
;ALL PAGES RESTORED. FINISH UP
MOVEI T1,JSBFRE ;POOL NAME
MOVE T2,P4 ;ADDRESS
CALL RELFRE ;RELEASE BLOCK
POP P,T1 ;GET BACK ERROR CODE
RETBAD (,<OKINT>) ;AND DONE
SUBTTL NIN JSYS
; Number input
; Call: 1 ; Source designator
; NIN
; Return
; +1 ; Error
; +2 OK
; 2 NUMBER
.NIN:: MCENT
CAILE 3,1
CAILE 3,^D36
JRST [ MOVEI A,IFIXX1 ; Illegal radix
UMOVEM A,3
JRST EMRET0] ;STORE ERROR CODE AND MRETN
MOVEI C,0
SETZ P1, ;OVERFLOW FLAG
PLIN0: CALL BIN1
JRST NINEOF ;END OF FILE
JUMPE B,NINXX2 ;IF B=0, END OF INPUT
CAIN B,40
JRST PLIN0 ; Skip leading spaces
CAIN B,"-"
JRST MININ
CAIN B,"+"
JRST [ CALL BIN1
JRST NINEOF ;END OF FILE REACHED
JRST .+1]
CALL DIGIN1
JRST NINXX2 ;NO DIGITS SEEN
PLIN: CALL NIN9
PLIN1: UMOVEM C,2
SKIPE P1 ;FOUND AN OVERFLOW?
JRST [ MOVEI A,IFIXX3 ;YES
JRST NINERR]
SMRETN ;DONE
MININ: CALL NIN91
MOVNS C
JRST PLIN1
;NO DIGITS SEEN
NINXX2: MOVEI A,IFIXX2
JRST NINERR
NINEOF: MOVEI A,IOX4 ;EOF SEEN
NINERR: CALL TSTERJ ;ERJMP/ERCAL PRESENT?
UMOVEM A,3 ;NO, RETURN ERROR CODE TO USER IN AC
EMRETN ;GO STORE ERROR IN LSTERR AND TAKE ERROR RETURN
NIN9: XCTU [MUL C,3]
SKIPE C ;GOT SOME LOST BITS?
SETOM P1 ;YES. REMEMBER THE OVERFLOW
LSH C,^D35 ;GET READY TO ADJUST FOR LOSSAGE
ADD D,C ;COMPLETE MULTIPLY
EXCH C,D ;PRODUCT TO PROPER PLACES
ADD D,D ;ADJUST SIGN
JFCL 17,.+1 ;Clear program flags
ADD C,B ;Add in digit
JCRY .+2 ;Number gotten too big?
IFSKP. <SETOM P1> ;Remember the overflow
NIN91: CALL DIGIN
RET
JRST NIN9
DIGIN: CALL BIN1
RET ;EOF REACHED
DIGIN1: SUBI 2,60
JUMPL 2,CPOPJ
CAIG 2,^D9
IFSKP.
CAIL 2,"a"-60 ;HEX NUMBERS CAN ALSO BE IN LOWER CASE
CAILE 2,"z"-60
CAIA ;NOT LOWER CASE
SUBI 2,"a"-"A" ;FOLD THE CASE
CAIL 2,"A"-60
CAILE 2,"Z"-60
RET
SUBI 2,"A"-"9"-1
ENDIF.
XCTU [CAMGE 2,3]
RETSKP
RET
SUBTTL NOUT JSYS
; Fixed point number output
; Call: 1 ; Destination designator
; 2 ; Number to be output
; RH(3) ; Radix
; 3(0) ; 1 to treat number as 36 bit magnitude
; 3(1) ; 1 to always print some kind of sign
; 3(2) ; Right justify the number
; 3(3) ; Print leading zeros if any
; 3(4) ; Print something on errors
; 3(5) ; Print * on errors rather than whole number
; 3(11-17) ; Field width, 0 means large enough to hold all
; NOUT
; Return
; +1 ; Error, bad radix, or number too big for field
; +2 ; Successful
.NOUT:: MCENT
CALL NOUTX
IFSKP.
SMRETN ;SUCCESS
ENDIF.
MOVE A,LSTERR
CALL TSTERJ ;SEE IF ERJMP/ERCAL PRESENT
UMOVEM A,3 ;NO, STORE ERROR CODE
EMRETN ; Take error return
NOUTX:: HRRZ D,C ; Get radix
CAIL D,2
CAILE D,^D10+^D26 ; Must be 2 - 36
JRST [ MOVEI A,NOUTX1
MOVEM A,LSTERR
RET]
HLL D,C ; Save flags in d too
LDB F,[POINT 8,D,17] ; Extract column width
MOVEI Q3,1 ; Initilize digit counter
TLNN D,(1B0) ; Magnitude printout?
CAIL B,0 ; Or positive number?
TLZA D,(1B6) ; Yes, remember not minus sign
TLO D,(1B6+1B1) ; No, remember minus sign
TLNE D,(1B6) ; - sign to be printed?
MOVMS B ; Yes complement number
TLNE D,(1B1) ; A sign of some sort to be printed?
NOUT1: AOS Q3 ; Yes, count as digit
LSHC B,-^D35 ; Make into double
LSH C,-1 ; Length dividend
DIVI B,(D) ; Produce a digit
PUSH P,C ; Save on stack
JUMPN B,NOUT1 ; Repeat until all digits generated
CAIN F,0 ; Zero field width specified?
MOVE F,Q3 ; Yes, make it same as number of digits
TLNE D,(1B2) ; Right justify number?
NOUT2: CAML Q3,F ; And filler needed?
JRST NOUT3 ; No
TLNE D,(1B3) ; Yes. leading 0's?
CALL SGNOUT ; Yes, output sign now
MOVEI B," " ; Get a space
TLNE D,(1B3) ; Unless 0's wanted
MOVEI B,"0" ; Then get a 0
CALL BOUTA ; Call bout so strings will work
SOJA F,NOUT2 ; Decrease remaining width and loop
NOUT3: CAML F,Q3 ; Sufficient room?
JRST NOUT4 ; Yes
MOVEI B,NOUTX2 ; Error
MOVEM B,LSTERR
TLNN D,(1B4) ; Print something anyway?
JRST NOUT7 ; No, go away
TLNN D,(1B5) ; Asterisks?
JRST NOUT4 ; No, print the whole number
MOVEI B,"*" ; Yes,
NOUT6: SOJL F,NOUT7 ; Column filled
CALL BOUTA
JRST NOUT6
NOUT7: TLNE D,(1B1) ; If one position reserved for -,
SOS Q3 ; One less thing on stack
NOUT71: SOJL Q3,CPOPJ
POP P,B
JRST NOUT71
NOUT4: CALL SGNOUT ; Output sign before number
NOUT5: SOJL Q3,NOUT8 ; Any digits left?
POP P,B ; Yes, get one
ADDI B,"0"
CAILE B,"9"
ADDI B,"A"-"9"-1
CALL BOUTA ; Print it
SOJA F,NOUT5 ; Decrease field width
NOUT8: SKIPL F
AOS (P) ; Skip if no error
MOVEI B," "
JRST NOUT6 ; Insert trailing blanks if necessary
SGNOUT: TLZN D,(1B1) ; Sign still needed?
RET ; No, return immediately
MOVEI B,"-"
TLNN D,(1B6)
MOVEI B,"+"
CALL BOUTA
SOS Q3 ; Decrement digit count
SOS F ; Decrement remaining field width
RET
SUBTTL NTINF JSYS
;NTINF - Generic network information jsys
;
; AC1/ address of arg block
;
; NTINF%
;
; Returns +1 always.
;
; Generates illegal instruction trap on failure
; with error code in AC1
;
;
; Arg block format:
;
; 0 .NWABC count of words in arg block
; 1 .NWFNC function code
; 2 .NWxxx function specific arg
; .. .. ..
; .. .. ..
IFE FTNSPSRV,<
.NTINF::MCENT
UMOVE T2,1 ;GET ADDRESS OF ARGUMENT BLOCK FROM USER
UMOVE T1,.NWFNC(T2) ;GET FUNCTION CODE FROM USER
SKIPL T1 ;FUNCTION CODE WITHIN
CAIL T1,NTIMAX ; VALID RANGE ?
ITERR (ARGX02) ;NO, RETURN "INVALID FUNCTION" ERROR
CALL NTIDSP(T1) ;DO THE FUNCTION
ITERR () ;FAILED. RETURN ERROR CODE
MRETNG ;SUCCESS. DONE
;NTINF dispatch table
NTIDSP: IFIW NTIRRH ;.NWRRH - RETURN REMOTE NODE
NTIMAX==.-NTIDSP
;.NWRRH FUNCTION - Return remote host
;
; Given a terminal or job number, returns the originating host
; of a job. Also returns terminal and network type, and node
; number.
;
; T2/ Address of user arg block
;
; Arg block:
;
; 0 .NWABC Argument block count
; 1 .NWFNC .NWRRH
; 2 .NWLIN Tty dev designator, job #, or -1 for self
; 3 .NWNNP Byte pointer to store node name
; 4 .NWTTF Terminal type and flags
; 5 .NWNNU Node number word 1
; 6 .NWNNU+1 Node number word 2
NTIRRH: STKVAR <NTIUAB,NTITDD>
MOVEM T2,NTIUAB ;SAVE USER ARG BLOCK
UMOVE T1,.NWABC(T2) ;GET LENGTH OF ARG BLOCK
CAIGE T1,.NWNNU+2 ;LONG ENOUGH?
RETBAD (ARGX04) ;NO. COMPLAIN
UMOVE T1,.NWLIN(T2) ;GET LINE NUMBER
CAME T1,[-1] ;SELF?
IFSKP.
MOVE T1,JOBNO ;YES - SO GET OUR OWN INDEX
JRST NTRRH1 ;GO CONVERT TO LINE NUMBER
ENDIF. ;
TRZE T1,.TTDES ;TTY DESIGNATOR?
IFNSK. ;IF NO SKIP, TTY WAS SPECIFIED
CAIL T1,0 ;YES, LEGAL LINE NUMBER ?
CAIL T1,NLINES
RETBAD (GTJIX2) ;NO
ELSE. ;OTHERWISE, USER SPECIFIED A JOB NUMBER
CALL GL2LCL ;SO CONVERT IT INTO A JOB INDEX
RETBAD ()
NTRRH1: HLRE T1,JOBPT(T1) ;[7410] Get controlling TTY: for job
SKIPGE T1 ;[7410][7.1046] Is it a detached line?
RETBAD (TTYX04) ;[7410] Yes, return error
ENDIF.
MOVEM T1,NTITDD ;SAVE LINE NUMBER AWAY
UMOVE T1,.NWNNP(T2) ;GET OUTPUT JFN OR DESIGNATOR
MOVE T3,T2 ;PUT ADR OF USER ARG BLOCK IN RIGHT PLACE
MOVE T2,NTITDD ;GET LINE NUMBER
CALL NWTRRH ;GO GET INFORMATION
RETBAD () ;ERROR
RETSKP
ENDSV.
>;END OF IFE FTNSPSRV
SUBTTL PMAP JSYS
; Pmap jsys
; Call: 1 ; Page ident (frk.pn or jfn.pn)
; 2 ; Page ident
; 3 ; Bits 2,3,4 to set page table access
; ;1B0 + COUNT TO DO MULTIPLE PAGES
; PMAP
.PMAP:: MCENT
TRVAR <SRCID,DID,CNT,JF1,PMTS,PMTA,PMTD,PMTL,PMTC>
;***NOTE*** THE ABOVE TRVAR MUST MATCH THE TRVAR'S IN RPACS,
;RMAP AND SPACS. DON'T ADD ANY DEFS BEFORE JF1.
;****
;SRCID - CURRENT SOURCE IDENT ;DID - CURRENT DEST IDENT
;CNT - CURRENT REMAINING COUNT ;JF1 - JFN WHICH HAS STRUCTURE LOCK
;PMTS - INTERLOOP SOURCE ID ;PMTA - INTERLOOP ACCESS
;PMTD - INTERLOOP DEST ID ;PMTL - LOCAL DEST ID
;PMTC - COUNT FOR PMAPCL
SETZM JF1 ;NO LOCK YET
DMOVEM A,SRCID ;SAVE ARGS
SKIPL A ;IS SOURCE A FILE?
JRST PMAP10 ;YES
SKIPGE A,B ;IS DESTINATION A FILE?
JRST PMAP11 ;NO
PMAP10: MOVEM C,CNT ;SAVE ACCESS AND COUNT
HLRZS A ;GET JFN
CAML A,MAXJFN ;reasonable value?
JRST [ MOVEI A,DESX1 ;no, return invalid s/d designator
JRST PMAPER] ; ..
IMULI A,MLJFN ;MAKE IT AN INTERNAL VALUE
MOVE B,FILSTS(A) ;GET JFN STATUS BITS
TXNN B,OPNF ;IS JFN OPEN?
JRST PMPER4 ;NO SO GIVE ERROR
LOAD A,FLUC,(A) ;GET STRUCTURE UNIQUE CODE FOR FILE
TLO A,400000 ;ALLOW FORK-ONLY MOUNT
CALL CHKMNO ;CHECK IF USER HAS MOUNTED STRUCTURE
JRST PMAPER ;NO, FAIL
MOVE C,CNT ;RESTORE COUNT
PMAP11: MOVEI Q2,1 ;ASSUME COUNT IS 1
TXNE C,1B0 ;UNLESS B0 SET
HRRZ Q2,C ;IN WHICH CASE COUNT IS IN 3
JUMPE Q2,MRETN ;REJECT 0 COUNT
CAIN Q2,1 ;ONE PAGE PMAP?
JRST [ CALL PMAP0 ;YES, GET RIGHT TO IT
JRST MRETN]
MOVEM Q2,CNT ;SAVE TOTAL COUNT
;SEE IF SOURCE OR DESTINATION WILL GO OFF END OF PAGE TABLE
;WHILE DOING COUNT. IF SO, DO IN PARTS WHICH INVOLVE ONLY
;ONE PAGE TABLE
PMAPC3: MOVE A,SRCID ;GET SOURCE IDENT
CAMN A,[-1] ;DELETE?
JRST PMAPC4 ;YES
ANDI A,777 ;GET PAGE NUMBER WITHIN PAGE TABLE
MOVN A,A ;COMPUTE 1000-PAGENO TO SEE
ADDI A,1000 ; HOW MANY PAGES CAN BE DONE IN THIS PT
CAMGE A,Q2 ;MORE THAN REQUIRED BY COUNT?
MOVE Q2,A ;NO, REDUCE COUNT
PMAPC4: MOVE A,DID ;GET DESTINATION
ANDI A,777 ;GET PAGE NUMBER WITHIN PAGE TABLE
MOVN A,A ;COMPUTE 1000-PAGENO TO SEE
ADDI A,1000 ; HOW MANY PAGES CAN BE DONE IN THIS PT
CAMGE A,Q2 ;MORE THAN REQUIRED BY COUNT?
MOVE Q2,A ;NO, REDUCE COUNT
CAMN Q2,CNT ;WAS COUNT REDUCED?
JRST [ CALL PMAP0 ;DO ALL OF CNT
JRST MRETN]
CALL PMAP0 ;DO THIS GROUP
MOVE A,SRCID ;GET SOURCE
CAME A,[-1] ;IF DELETE DON'T UPDATE IT
ADDM Q2,SRCID ;UPDATE IDENTIFIERS FOR PAGES JUST DONE
ADDM Q2,DID
MOVN Q2,Q2 ;UPDATE TOTAL COUNT FOR PAGES JUST DONE
ADDB Q2,CNT
JUMPLE Q2,MRETN ;ANY MORE TO DO?
MOVEI A,-1 ;YES. CHECK FOR OVERLFOW OF PAGE NUMBER
TDNE A,SRCID ;DID THIS ONE OVERFLOW?
TDNN A,DID ;NO. HOW ABOUT THIS ONE?
ITERR (ARGX06) ;YES TO ONE OF THEM
JRST PMAPC3 ;NO. GO ON THEN
;PMAP...
;THE FOLLOWING DOES ALL THE WORK, ASSUMING THAT THE COUNT
;DOES NOT CAUSE EITHER IDENTIFIER TO GO OFF THE END OF A PAGE TABLE
PMAP0: CALL FLOCKN ;LOCK FORK LOCK WITH NESTING
SETZM JF1 ;NONE HERE
MOVE A,DID ;GET DESTINATION IDENT
SKIPL B,SRCID ;IS SOURCE IDENT A FILE?
JUMPGE A,[MOVEI A,PMAPX2 ;YES, IF DEST IS A FILE THEN ERROR
JRST PMAPER]
CAMN B,[-1] ;DELETE ONLY?
IFSKP. ;No, not delete only
UMOVE B,3 ;Get user requested access
MOVX C,PM%WT ;Get write access bit
SKIPL A ;Is the destination a file?
IORM C,B ;Yes, grant PM%WT for all sections
ELSE. ;Yes, delete only
UMOVE B,3 ; Get user bits and flags
AND B,[PM%EPN] ; but keep only PM%EPN if set
ENDIF.
CALL CPMAPX ; Convert to ptn.pn and get access
; also check for execute-only
MOVEM D,JF1 ;RETURNS LOCKED JFN
JUMPE A,[MOVE A,SRCID ;IF ZERO COULDN'T GET IT. CHECK FOR DELETE
CAIN D,LNGFX1 ;COULDN'T GET BECAUSE OF NONEX PT?
CAME A,[-1] ;AND DELETING?
JRST PMPER2 ;SOME OTHER ERROR OR NOT DELETING
JRST PMAP51] ;DELETING AND NON-X PT OK. DO NEXT GROUP
TLNN C,(PM%WT)
JRST PMPER1 ; MUST BE ABLE TO WRITE DESTINATION
MOVEM A,PMTD ; Save destination ptn.pn
MOVE A,SRCID ; Get source designator
CAMN A,[-1] ; Delete wanted?
JRST [ SETZB A,C ;YES, 0 IDENT AND ACCESS
JRST PMAP1] ; Then skip the following
UMOVE B,3 ;GET USER REQUESTED ACCESS
CALL CPMAPX ; Convert source and get it's access
; also check for execute-only
IFNSK.
MOVEM D,JF1 ;SAVE LOCKED JFN
TXNN B,READF ;HAVE READ ACCESS TO THE FILE?
JRST PMPER1 ;NO. ERROR
ENDIF.
JUMPE A,PMPER2 ;COULDN'T GET IT
PMAP1: MOVEM C,PMTA ;SAVE ACCESS
MOVEM A,PMTS ;AND PTN.PN
SKIPGE DID ; Is "to" a file?
JRST PMAP2 ; No, ok to do
; ..
; ..
;DESTINATION IS FILE, SO ACCESS OF EACH FILE PAGE TO BE AFFECTED
;MUST BE CHECKED. THE FILE PAGE MUST BE PRIVATE. THIS
;LOOP USES MSCANP WHICH SCANS FOR A NON-0 PAGE AND RETURNS ITS
;ACCESS. THIS MAKES FOR MINIMUM OVERHEAD WHEN MAPPING INTO
;PAGES WHICH ARE ALREADY EMPTY.
MOVE A,PMTD ;GET DESTINATION IDENT
MOVE Q1,Q2 ;GET COUNT FOR LOOP
PMAPC1: MOVEM A,PMTL ;SAVE IDENT
MOVE B,Q1 ;GET REMAINING COUNT FOR CALL
CALL MSCANP ;FIND NON-EMPTY PAGE AND RETURN ACCESS
JUMPE B,PMAPC6 ;NONE
EXCH B,Q1 ;SAVE UPDATED COUNT, GET ORIG COUNT
SUB B,Q1 ;COMPUTE NUMBER OF PAGES SKIPPED
ADDM B,PMTL ;UPDATE IDENT FOR PAGES SKIPPED
TLNN A,(PA%PRV) ; Better be private
JUMPN A,[MOVEI A,PMAPX2; Or empty
JRST PMAPER] ; Else error
MOVE A,PMTL ;RECOVER IDENT
ADDI A,1 ;GO TO NEXT PAGE
SOJG Q1,PMAPC1 ;DO ALL PAGES
;EACH SOURCE PAGE MUST ALSO BE CHECKED. SOURCE PAGE MUST BE
;PRIVATE (I.E. OWNED BY FORK) BECAUSE OWNERSHIP WILL BE TRANSFERRED
;TO FILE.
PMAPC6: MOVE A,PMTS ;GET SOURCE IDENT
JUMPE A,PMAP55 ;IF DELETING, NO FURTHER CHECK NEEDED
MOVE Q1,Q2 ;GET COUNT FOR LOOP
PMAPC5: MOVEM A,PMTL ;SAVE IDENT
MOVE B,Q1 ;GET REMAINING COUNT FOR CALL
CALL MSCANP ;FIND NON-EMPTY PAGE AND RETURN ACCESS
JUMPE B,PMAP55 ;NONE
EXCH B,Q1 ;SAVE UPDATED COUNT, GET ORIG COUNT
SUB B,Q1 ;COMPUTE NUMBER OF PAGES SKIPPED
ADDM B,PMTL ;UPDATE IDENT FOR PAGES SKIPPED
TLNN A,(PA%PRV) ;PRIVATE?
JUMPN A,[MOVEI A,PMAPX2 ;GET ERROR CODE
JRST PMAPER]
MOVE A,PMTL ;RECOVER IDENT
ADDI A,1 ;GO TO NEXT PAGE
SOJG Q1,PMAPC5 ;DO ALL PAGES
PMAP55: JRST PMAP5
;DESTINATION IS FORK. PRESENT CONTENTS OF EACH PAGE WILL BE
;REMOVED, SO IT IS NECESSARY TO UPDATE MAP COUNT FOR FILES WHOSE
;PAGES ARE UNMAPPED. FOR EFFICIENCY IN THE CASE WHERE FORK MAP
;IS EMPTY, MSCANP IS USED TO SCAN FOR NON-EMPTY PAGES.
PMAP2: SKIPGE A,SRCID ;IS FROM A FILE?
JRST PMAP4 ; No.
HLRZS A ; Yes, get jfn
IMULI A,MLJFN ; CONVERT TO INTERNAL INDEX
MOVSI B,0(Q2) ;UPDATE MAP COUNT BY NUMBER OF PAGES
ASH B,1 ; IN REQUEST
ADDM B,FILLFW(A) ; Increment count of reasons for opening
UNLOCK FILLCK(A) ;FREE THIS TO PREVENT LOCK-UP IN OFNJXL
PMAP4: MOVE Q1,Q2 ;GET COUNT FOR PAGE SCAN LOOP
SETZM PMTC ;INIT PMAPCL COUNT
MOVE A,PMTD ;GET DESTINATION IDENT
PMAPC2: MOVEM A,PMTL ;SAVE IDENT
MOVE B,Q1 ;GET REMAINING COUNT FOR CALL
SETZ Q3, ;INIT COUNTER
CALL MSCANP ;FIND NON-0 PAGE AND GET ACCESS
JUMPE B,PMAP56 ;NONE
EXCH B,Q1 ;SAVE UPDATED COUNT
SUB B,Q1 ;COMPUTE NUMBER OF PAGES SKIPPED
ADDM B,PMTL ;UPDATE IDENT FOR PAGES SKIPPED
JUMPE A,PMAP33 ; Jump if empty
TLNE A,(PA%PRV)
JRST PMAP33 ; Or if private
MOVE A,PMTL ; Is indirect or share
PMAP99: CALL MRPT ; Get it's id
JRST [ JUMPN Q3,PMAPC8 ;IF HAVE SOME, GO TO IT
JRST PMAP33] ;NONE TO DO
JUMPE Q3,[HLRZ Q3,A ;SAVE OFN
JRST PMAP88] ;GO INCREMENT AND PROCEED
HLRZ B,A ;GET OFN
CAIE B,0(Q3) ;SAME AS LAST?
JRST PMAPC8 ;NO. GO DO IT THEN
PMAP88: ADD Q3,[1B16] ;INCREMENT COUNT
AOS A,PMTL ;NEXT ONE
SOJG Q1,PMAP99 ;OF MORE, DO IT
PMAPC8: HRLZ A,Q3 ;GET OFN TO FIND
CALL OFNJXL ; Convert to jfn
JRST PMAP3 ;NONE. FORGET IT THEN
PMAP6: HLRZ C,FILLFW(A) ;GET JFN SHARE COUNT
HLRZ B,Q3 ;GET COUNT
SUBI C,0(B) ;DO DECREMENT
JUMPE C,[MOVE B,PMTD ; COUNT NOW 0. GET DEST IDENT
CALL PMAPCL ;MUST REMOVE PAGES BEFORE COUNT GOES
MOVX B,FRKF ; TO 0. UNRESTRICT JFN SO NEXT CLZFF
ANDCAM B,FILSTS(A) ; GETS IT
JRST .+1] ;NOW OK TO REDUCE COUNT
HRLM C,FILLFW(A) ;SET REDUCED COUNT
CALL LUNLKF ;FREE JFN AND STRUCTURE
OKINT ;AND UNDO THE NOINT FROM THE LOCK
PMAP3: MOVE T1,PMTL ;WHERE TO START THIS SCAN
JUMPG Q1,PMAPC2 ;DO ALL PAGES
; ..
; ..
;NOW CALL KERNAL ROUTINE TO CHANGE THE ACTUAL MAPS
PMAP56:
PMAP5: MOVE A,PMTS
MOVE C,PMTA
MOVE B,PMTD
TXO C,PM%IND+PM%CPY+PM%ABT ;RETAIN CERTAIN BITS
XCTU [AND C,3]
SKIPGE SRCID ;SOURCE A FORK?
TXO C,PM%IND ;YES, INSIST ON INDIRECT
MOVE 4,Q2 ;GET COUNT
CALL MSETPT ;DO MULTIPLE PT SET
JRST PMAP77 ;ERROR SO HANDLE IT
PMAP51: CALL FUNLK ;RELEASE FORK LOCK
MOVE A,PMTD ;GET IDENTIFIER FOR DESTINAITION
SKIPL DID ;DESTINATION MUST BE A PROCESS
JRST PMAP7 ;IF NOT, CAN'T PRELOAD PAGES
MOVE B,Q2 ;GET REPEAT COUNT
UMOVE C,C ;GET USER'S FLAGS
TXNE C,PM%PLD ;WANT TO PRELOAD ALL OF THESE PAGES?
CALL PREPG ;YES. REQUEST SWAP IN THEN
JFCL ;DON'T CARE
SKIPGE SRCID ;SOURCE A FILE?
IFSKP.
MOVE A,JF1 ;YES. GET JFN
LOCK FILLCK(A) ;LOCK IT UP
ENDIF.
PMAP7: CALL PMAPRL ;RELEASE FILE LOCKS
RET
;HERE IF PMAPC2 LOOP FOUND NO PAGES TO DO
PMAP33: AOS T1,PMTL ;NEXT PAGE
SOJG Q1,PMAPC2 ;DO MORE IF MORE TO DO
JRST PMAP56 ;NONE TO DO. FINISHED DELETES
PMAP77: ;HERE WHEN MSETPT HAS FAILED
SKIPL SRCID ;WAS THE SOURCE ID A JFN?
CALL PMAP78 ;SRCID WAS A JFN...SO CLEAN IT UP
CALL FUNLK ;UNLOCK FORK STRUCTURE
CALL PMAPRL ;RELEASE FILE LOCKS
MOVE T1,LSTERR ;GET THE LAST ERROR
CAIE T1,IOX11 ;QUOTA EXCEEDED?
ITERR ;NO SO GENERATE ILLEGAL INST FOR CALLER
MOVEI T1,.ICQTA ;GET QUOTA EXCEEDED INTERRUPT CHANNEL
CALL PSIRQ0 ;QUEUE UP THE INTERRUPT
CHKINT ;MAKE SURE IT GETS NOTICED
JRST MRETN ;AND RETURN TO CALLER
PMAP78: ;HERE TO CLEAN UP WHEN SRCID WAS A JFN
SAVEAC <T1,T2> ;
MOVE T1,JF1 ;YES. GET JFN
LOCK FILLCK(T1) ;LOCK IT UP
MOVNI T2,(Q2) ;GET NEGATIVE PAGE COUNT
HRLZS T2 ;IN LEFT HALF
ASH T2,1 ;MULTIPLY BY TWO
ADDM T2,FILLFW(T1) ;FIX THE COUNT
RET ;RETURN TO CALLER
;ERROR RETURN FROM PMAP
PMPER4: MOVEI A,DESX5 ;GET ERROR CODE
JRST PMAPER ;AND JOIN REGULAR ERROR CODE
PMPER2: SKIPN A,D ;GET ERROR CODE
PMPER1: MOVEI A,PMAPX1 ;CONVENIENT ERROR PLACE
PMAPER: MOVEM A,LSTERR
MOVEM B,ERRSAV
PMPER3: CALL PMAPRL ;GO RELEASE ANY FILE LOCKS
CALL FUNLKI ;UNLOCK FORK LOCK IF WE HAVE IT
ITERX ;GENERATE ITRAP
;ROUTINE TO RELEASE ANY ACCUMULATED FILE LOCKS
PMAPRL: SKIPN A,JF1 ;HAVE ONE HERE?
RET ;NO. ALL DONE THEN
CALL LUNLKF ;YES. UNLOCK IT THEN
OKINT ;AND UNDO THE EXTRA NOINT
RET ;DONE
;ACCEPTS: A/PROCESS HANDLE OR JFN
; B/0 IF PT SHOULDN'T BE CREATED IF IT DOESN'T EXIST
; B/TYPE OF ACCESS REQUESTED
;RETURNS: +1,IF THE PAGE IS IN A FILE
; +2,IF THE PAGE IS IN A PROCESS
;GET IDENT AND ACCESS
; CPMAP - normal entry
; CPMAPX - disallow execute-only processes if process ident
CPMAPX: JUMPL A,FRKMPX ;If B0 set, then must be process handle
CPMAP: JUMPL A,FRKMAP
CALL CPJFNV ;VERIFY JFN ARG
JRST PMAPER ;ERROR
JUMPN A,R
RETSKP
FRKMPX: CALL FKHPTX ;Convert FRK.PN to PTN.PN
; and check for execute-only
JRST FRKMP2 ;Error-- Release any locks and give error
JRST FRKMP1 ;Continue below . . .
FRKMAP: CALL FKHPTN
JRST FRKMP2 ;Error-- Release any locks and give error
FRKMP1: RETSKP ;SAY IS A FORK HANDLE
FRKMP2: JUMPE B,PMAPER ;NO CREATES IF B IS ZERO
CAME B,[PM%EPN] ;JUST THIS BIT IS THE SAME AS ZERO
CAIE A,ARGX06 ;AND WAS THE FAILURE DUE TO AN ILLEGAL PAGE?
JRST PMAPER ;Error-- Release any locks and give error
SETZ A, ;CREATE A PRIVATE SECTION
MOVEI C,1 ;CREATE ONE SECTION
HLL C,B ;USER SPECIFIED ACCESS BITS
HRRZ B,DID ;GET DESTINATION PAGE NUMBER
LSH B,-PGSFT ;CONVERT TO SECTION NUMBER
HLL B,DID ;DESTINATION HANDLE
SMAP% ;GET A PAGE MAP
ERJMP PMPER3 ;ERROR
MOVE A,DID ;RESTORE DESTINATION ID
SETZ B, ;MAKE SURE NO LOOP
JRST FRKMPX ;NOW GET PTN.PN
;REMOVE PAGES FROM PAGE TABLE AS FAR AS IT HAS BEEN SCANNED.
;DONE BECAUSE CANNOT WAIT UNTIL END OF SCAN WHEN JFN COUNT GOES
;TO 0.
; B/ DEST IDENT
; Q2/ ORIGINAL PAGE COUNT
; Q1/ CURRENT PAGE COUNT (PAGES LEFT TO SCAN)
; CALL PMAPCL
; RETURN +1, PRESERVED ALL AC'S.
PMAPCL: SAVET
MOVEI A,0 ;SAY CLEAR MAP
ADD B,PMTC ;UPDATE ID BY NUMBER ALREADY CLEARED
MOVEI D,(Q2) ;COMPUTE NUMBER OF PAGES SCANNED
SUB D,Q1
SUB D,PMTC ;LESS THOSE ALREADY DONE
ADDM D,PMTC ;UPDATE RUNNING COUNT
MOVX C,PM%ABT ;ALLOW ONLY ABORT BIT
XCTU [AND C,3] ; IF SPECIFIED BY CALLER
CALL MSETPT ;CLEAR THEM
ITERR ()
RET
SUBTTL PPNST JSYS
;JSYS TO CONVERT PPN (TOPS10) TO STRING
;ACCEPTS IN T1/ OUTPUT DESIGNATOR
; T2/ PPN (MUST BE 4,,#)
; T3/ POINTER TO DEVICE/STR NAME
; PPNST
;RETURNS +1 ALWAYS T3/ UPDATED POINTER
.PPNST::MCENT
UMOVE T1,3 ;GET STRING PNTR
CALL STDEV0 ;CONVERT TO DEVICE DESIGNATOR
ITERR () ;RETURN ERROR
HLRZ T2,T1 ;CHECK DEVICE TYPE
CAIE T2,.DVDES+.DVDSK ;GRNTEE DISK!
ITERR (PPNX2) ;VALID FOR DISK/STR ONLY
HRRZS T1 ;STR UNIQUE CODE ONLY
CAIN T1,-1 ;WAS IT DSK:
LOAD T1,JSUC ;YES - GET CONNECTED STR
HRLZS T1 ;NOW MAKE INTO 36-BIT DIR #
UMOVE T2,2 ;GET USER SUPPLIED PPN
JUMPE T2,PPNST3 ;ZERO IS AN ILLEGAL PPN
HRR T1,T2 ;POSSIBLE DIRECTORY NUMBER
HLRZS T2 ;PROJECT NUMBER
CAIN T2,PPNLH ;OLD STYLE PPN?
JRST PPNST1 ;YES - GO CONVERT THAT
MOVE Q1,T1 ;SAVE UNIQUE STR CODE
HLRZS T1 ;STR CODE TO RH
CALL CNVSTR ;GET INDEX INTO STRTAB
ITERR () ;LOOSE
PUSH P,T1 ;SAVE T1
CALL ULKSTR ;(T1)UNLOCK STRLK. CNVSTR SET IT.
POP P,T1 ;RESTORE T1
MOVE T2,STRTAB(T1) ;ADDRESS OF STB
LOAD T2,STRIDX,(T2) ;OFN OF IDXTAB
MOVE T1,MXDIRN ;MAXIMUM NUMBER OF DIRECTORIES
LSH T1,-PGSFT+1 ;PAGE NUMBER OF PPN EXTENSION
HRL T1,T2 ;OFN,,PAGE NUMBER OF FIRST PAGE OF PPN EXTENSION
CALL MRPACS ;PPN EXTENSION EXIST?
JUMPE T1,PPNST3 ;JUMP IF NO
TLNN T1,(1B5) ;THIS PAGE IN THE FILE?
JRST PPNST3 ;NO
MOVE T1,Q1 ;RESTORE STR CODE
HRRI T1,ROOTDN ;TO GET IN IDXTAB AND PPN EXTENSION
CALL SETDIR ;IDXTAB
ITERR () ;RETURN ERROR CODE
UMOVE T1,2 ;USER SUPPLIED PPN
CALL FNDPPN ;SEARCH FOR PPN, GET DIR #
JRST PPNST2 ;NOT FOUND
CALL USTDIR ;UNLOCK DIRECTORY
HLL T1,Q1 ;UNIQUE STR CODE
PPNST1: CALL DIRST0 ;CONVERT TO STRING
ITERR () ;PROBLEM WITH DIR?
JRST MRETN ;GIVE RETURN
PPNST2: CALL USTDIR ;UNLOCK DIRECTORY
PPNST3: ITERR (PPNX1) ;UNKNOWN PPN
SUBTTL PMCTL JSYS
;JSYS TO PERFORM VARIOUS CONTROL/STATUS OPERATIONS ON PHYSICAL MEMORY
;1/ FLAGS(FUTURE),,FUNCTION CODE
;2/ +ARGLIST LENGTH
;3/ ARGLIST ADDRESS
; PMCTL
;RETURNS+1:
; FUNCTION PERFORMED/INFORMATION RETURNED
;ITRAPS ON ASSORTED ERRORS
;AC USAGE WITHIN PMCTL:
;Q1/ FUNCTION CODE
;Q2/ ARGLIST LENGTH
;Q3/ ARGLIST
;THE VALUES IN Q1-3 ARE VALIDATED IN THE ENTRY SEQUENCE
.PMCTL::MCENT
MOVE T1,CAPENB ;GET ENABLED SPECIAL CAPABILITIES
TXNN T1,SC%WHL!SC%OPR!SC%MNT ;APPROPRIATE CAPABILITIES?
ITERR (CAPX2) ;NO
UMOVE Q1,1 ;GET FUNCTION CODE
JUMPL Q1,PMCILF ;CHECK IF VALID
CAILE Q1,PMCMXF ; ...
PMCILF: ITERR (ARGX02) ;INVALID FUNCTION
UMOVE Q2,2 ;GET ARGLIST LENGTH
HLRZ T1,PMCDSP(Q1) ;GET MINIMUM REQUIRED
CAMLE T1,Q2 ;GREATER THAN REQUIRED?
ITERR (ARGX04) ;NO - TOO SMALL
UMOVE Q3,3 ;GET ARGUMENT LIST ADDRESS
HRRZ T1,PMCDSP(Q1) ;GET FUNCTION DISPATCH
JRST (T1) ;AND DO IT
;FUNCTION TABLE - ENTRIES ARE XWD MIN ARGLIST,FUNCTION
PMCDSP: XWD 1,PMCRCE ;READ CACHE ENABLE
XWD 1,PMCSCE ;SET CACHE ENABLE
XWD 2,PMCRPS ;READ SPECIAL PAGE STATUS
XWD 2,PMCSPS ;SET SPECIAL PAGE STATUS
XWD 12,PMCRME ;READ MEMORY ERROR INFORMATION
PMCMXF==.-PMCDSP-1 ;MAXIMUM FUNCTION CODE
;HERE TO RETURN THE STATE OF THE CACHE ENABLES
PMCRCE: SKIPE T1,CASHF ;ZERO IF OFF
MOVX T1,MC%CEN ;NONZERO IF ON
UMOVEM T1,.MCCST(Q3) ;STORE RESULT
MRETNG
;HERE TO SET THE CACHE ENABLES. IF THE CURRENT STATE IS THE SAME AS
;THE REQUESTED STATE, NOTHING IS DONE (PREVENTING USELESS UNLOADS)
PMCSCE: UMOVE T1,.MCCST(Q3) ;GET USERS REQUESTED STATE
TXNN T1,MC%CEN ;WANT CACHE ON?
JRST PMCSC1 ;NO.
SKIPN CASHF ;YES - IS IT ALREADY ON?
CALL CASHON ;MUST TURN IT ON NOW
MRETNG
PMCSC1: SKIPE CASHF ;WANT CACHE OFF, IS IT?
CALL CASHOF ;NO - DO IT NOW
MRETNG
;HERE TO READ THE SPECIAL PAGE STATUS OF A PHYSICAL PAGE
PMCRPS: UMOVE T1,.MCPPN(Q3) ;GET USER'S ARGS
HLRE T2,T1 ;GET REPEAT COUNT OF PAGES
MOVMS T2 ;GET COUNT GIVEN BY USER
CAIGE Q2,1(T2) ;ENOUGH ROOM FOR ARGS?
ITERR (ARGX04) ;NO. GIVE ERROR THEN
MOVE Q2,T1 ;YES. PROCEED
MOVE P1,Q3 ;COPY ARG
PMCRP1: HRRZ T1,Q2 ;GET PAGE NUMBER
CALL GETPST ;CALL KERNAL ROUTINE
ITERR(ARGX06,<UMOVEM Q2,.MCPPN(Q3)>) ;INVALID PAGE NUMBER
UMOVEM T2,.MCPST(P1) ;STORE RESULT
ADDI P1,1 ;NEXT OFFSET
AOBJN Q2,PMCRP1 ;DO ALL REQUESTED PAGES
MRETNG
;HERE TO SET THE SPECIAL PAGE STATUS OF A PHYSICAL PAGE
PMCSPS: UMOVE T1,.MCPPN(Q3) ;GET USERS PAGE NUMBER
UMOVE T2,.MCPST(Q3) ;GET NEW SPECIAL PAGE STATE
CALL SETPST ;CALL KERNAL ROUTINE
ITERR () ;ERROR CODE IN T1
MRETNG ;SUCCESS
;HERE TO READ INFORMATION ABOUT SYSTEM MEMORY ERRORS
PMCRME: SETZM P1 ;NO ENTRIES FOUND YET
PMCRM1: MOVEI T1,.PMMER ;GET A MEMORY ERROR ENTRY
CALL DEQERR ;GET IT
JRST [ JUMPN P1,PMCRM0 ;IF FOUND SOME, NOW DONE
ITERR (PMCLX4)] ;OTHERSWISE, ERROR
LOAD T2,SBSCN,(T1) ;GET CONTROLLER
HRLI T2,<.PMMER_^D9>+12 ;TYPE AND COUNT
UMOVEM T2,.PMMTP(Q3) ;STORE IN USER SPACE
MOVE T2,SBSERA(T1) ;GET ERG
UMOVEM T2,.PMMRG(Q3) ;STORE IT
LOAD T2,SBSSY,(T1) ;SYNDROME
UMOVEM T2,.PMMSY(Q3)
LOAD T2,SBSBN,(T1) ;BLOCK NUMBER
UMOVEM T2,.PMMBN(Q3)
LOAD T2,SBSSB,(T1) ;SPARE BIT NUMBER
UMOVEM T2,.PMMSB(Q3)
MOVE T2,SBSEAD(T1) ;ERROR ADDRESS
UMOVEM T2,.PMMEA(Q3)
PUSH P,T1 ;SAVE BLOCK NUMBER
XMOVEI T2,SBSSER(T1) ;FIRST SERIAL NUMBER
MOVEI T3,.PMMSN(Q3) ;USER ADDRESS
MOVEI T4,.PMMNS ;REPEAT COUNT
PMCRM2: LDB T1,[POINT ^D32,0(T2),31] ;GET SERIAL NUMBER
UMOVEM T1,0(T3) ;STORE IN USER SPACE
ADDI T3,1 ;NEXT USER ADDRESS
ADDI T2,1 ;NEXT SERIAL NUMBER
SOJG T4,PMCRM2 ;DO ALL SERIAL NUMBER
POP P,T1 ;BLOCK ADDRESS
CALL RELRES ;FREE IT
SUBI Q2,12 ;USED THIS MANY WORDS
ADDI Q3,12 ;AND NOW POINT HERE
CAIL Q2,12 ;ROOM FOR ANOTHER?
AOJA P1,PMCRM1 ;YES. GET IT
PMCRM0: UMOVEM Q2,2 ;UPDATED COUNT
UMOVEM Q3,3 ;UPDATED POINTER
MRETNG ;DONE
SUBTTL PRARG JSYS
;JSYS TO SET AND READ ARGUMENTS FOR A PROCESS
;ACCEPTS IN 1/ FUNCTION CODE ,, FORK HANDLE
; 2/ ADR OF ARG BLOCK
; 3/ LENGTH OF ARG BLOCK
; PRARG
;RETURNS +1: ALWAYS
; 3/ COUNT OF WORDS IN ARGUMENT BLOCK
.PRARG::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
UMOVE Q2,2 ;GET ADR OF ARG BLOCK
XCTU [HRRZ Q3,3] ;GET LENGTH OF BLOCK
XCTU [HRRZ T1,1] ;GET FORK HANDLE
CALL SETLFK ;MAP IN PSB OF THIS FORK
MOVE Q1,T1 ;SAVE INDEX FOR LATER
XCTU [HLRZ T1,1] ;GET FUNCTION CODE
CAIN T1,.PRARD ;READ?
JRST PRARGR ;YES, GO RETURN BLOCK
CAIE T1,.PRAST ;SET?
ITERR (PRAX1,<CALL CLRLFK
CALL FUNLK>) ;NO, GIVE ERROR RETURN
MOVE T2,PRARGP(Q1) ;IS THERE AN EXISTING BLOCK?
JUMPE T2,PRARG1 ;NO IF ZERO
SETZM PRARGP(Q1) ;ZERO THE OLD POINTER
CALL PRARGF ;RELEASE OLD SPACE
PRARG1: JUMPE Q3,PRARGC ;JUST CLEARING THE ARG BLOCK?
MOVE T2,Q3 ;NO, GET SOME SPACE FOR NEW BLOCK
CAILE T2,PRAMAX ;IS THIS A LEGAL SIZE?
ITERR (PRAX3,<CALL CLRLFK
CALL FUNLK>) ;NO, PRARG BLOCK TOO LARGE
AOS T2 ;ADD ONE FOR HEADER
CALL ASGJFR ;GET SPACE IN JSB
ITERR (PRAX2,<CALL CLRLFK
CALL FUNLK>) ;NOT ENOUGH ROOM FOR THIS SIZE BLK
MOVEM T1,PRARGP(Q1) ;STORE ADR OF BLOCK IN PSB
PRARSL: UMOVE T3,0(Q2) ;GET FIRST WORD OF BLOCK
AOS T1 ;STEP POINTER TO FREE BLOCK
AOS Q2 ;AND POINTER TO USER BLOCK
MOVEM T3,0(T1) ;STORE WORD IN BLOCK
SOJG Q3,PRARSL ;LOOP UNTIL ALL WORDS STORED
PRARGC: CALL CLRLFK ;UNMAP PSB
CALL FUNLK
JRST MRETN ;AND EXIT
;RELEASE PRARG'S JSB BLOCK (CALLER MUST BE NOINT)
;
; 2/ POINTER TO THE BLOCK
PRARGF::MOVEI T1,JSBFRE ;GET FREE SPACE HEADER
CALLRET RELFRE ;RELEASE THE SPACE
;READ ARGUMENT BLOCK
PRARGR: XCTU [SETZM 3] ;ASSUME NO DATA AVAILABLE
SKIPN T1,PRARGP(Q1) ;GET POINTER TO BLOCK IF ANY
JRST PRARRD ;NONE, GO RETURN 0
HRRZ T2,0(T1) ;GET LENGTH OF BLOCK
SOJLE T2,PRARRD ;SKIP HEADER WORD
UMOVEM T2,3 ;STORE COUNT OF WORDS AVAILABLE
PRARRL: SOJL Q3,PRARRD ;ANY MORE TO DO?
MOVE T3,1(T1) ;YES, GET NEXT WORD
UMOVEM T3,0(Q2) ;STORE WORD IN USER BLOCK
AOS T1 ;STEP POINTER TO JSB BLOCK
SOSLE T2 ;ANY MORE WORDS IN BLOCK?
AOJA Q2,PRARRL ;YES, GO STORE THEM
PRARRD: CALL CLRLFK ;UNMAP PSB
CALL FUNLK
JRST MRETN ;AND RETURN
SUBTTL QUEUE% JSYS
;QUEUE% JSYS
;
; T1/ LENGTH of argument block
; T2/ ADDRESS of argument block
;
; QUEUE%
;
; RETURN +1: ALWAYS
; FAILURE: ITRAP, error code is LSTERR
; SUCCESS: Component response in Response block (if requested)
;General definitions for IPCF args, etc.
TIM2WT==1000 ;Time to wait for process to respond
ACKME==400000,,0 ;bit for "I want an answer"
ODDBIT==1B35 ;If bit is on, number is odd
IMMLEN==1 ;Length of an immediate argument
MU1LEN==3 ;Length of 1st MUTIL% arg block
MU2LEN==2 ;Length of 2nd MUTIL% arg block
SENLEN==4 ;Length of MSEND% packet desc. block
RECLEN==7 ;Length of MRECV% PDB
HDRLEN==5 ;Length of IPCF message-header
QABLEN==2 ;Length of the sub-arg-blocks
QIMLEN==IMMLEN+1 ;Length of an IPCF message immed-arg-sub-block
QMINLN==4 ;Length of the minimum size QUEUE% arg block
;Offsets into the QUEUE packet passed to Galaxy
.QJLTY==0 ;Length,,type word
.QJMB1==1 ;Ack, ack msg, suffix ;Only ACK bit is set by QUVERF
.QJJOB==2 ;Job number
.QJMB2==3 ;Flag word ;Set to zero by QUVERF
.QJMBC==4 ;Message block count
.QJ1SB==5 ;1st Sub-Block begins here
SWAPCD
.QUEUE::MCENT ;Enter here
TRVAR <QJERR,QUMSG,ARGLEN,BLKCNT,<ARGBLK,7>>
SETZ F, ;Zero my flags word
MOVEI Q2,ARGBLK ;Get address of my local IPCF arg block
CAIL T1,QMINLN ;Length of argument block has minimum length...
IFSKP. ;Not long enough,
ITERR (QUEUX7) ;Argument block too short
ENDIF. ;ELSE Length is valid...
MOVEM T1,ARGLEN ;Store length of agr block away
MOVEM T2,P2 ;Loc of arg block too
UMOVE T1,.QUFNC(P2) ;get flags-resp-length,,function code
MOVE F,T1 ;Copy into flags AC
TXZ T1,QF%FLG ;Zero out the flags
CAML T1,[PGSIZ,,-1] ;Is response length more than 1 page?
IFNSK. ;Yes...error
ITERR (QUEUX6) ;Illegal Response Length
ENDIF. ;OK...
HRRZS T1 ;Want just function code
SKIPLE T1 ;It'd better be positive
CAIL T1,QHIFUN ;is it in the range of function codes?
JRST QUE02 ;Nope...
;Get a pid for the component desired from system pid table. FUNBLK,
;indexed by function code, has halfword offsets into pid table, rh
;contains normal values, lh has debugging values.
;Function is illegal if 0
TXNE F,QU%DBG ;Is he debugging?
IFSKP. ;No...
HRRZ T2,FUNBLK(T1) ;Get RH, which contains normal entry
ELSE.
HLRZ T2,FUNBLK(T1) ;Get LH, which contains debug entry
ENDIF. ;Got PID table offset, 0 is illegal
SKIPE T2
IFSKP. ;Offset is 0, error
QUE02: ITERR (QUEUX2) ;Get error code (Illegal Function)
ENDIF. ;Non-0 offset
MOVEM T2,.IPCFS(Q2) ;Offset into system PID table goes in argblk
MOVX T2,.MURSP ;Want to Read System PID for this component
MOVEM T2,.IPCFL(Q2) ;Put it into arg block
CALL QUVERF ;Move and verify user arguments
IFNSK. ;Something bad in arg list
MOVEM T1,QJERR ;Hang on to the error
JRST QUERR ;Process error return
ENDIF. ;Else OK...
MOVEI T1,MU1LEN ;Length of argument block
MOVE T2,Q2 ;Addr of argument block
MUTIL% ;Get PID for component
IFNSK. ;Jsys error
MOVEM T1,QJERR ;Put error code into safekeeping
JRST QUERR ;To error routine
ENDIF. ;Else success
MOVE P3,.IPCFR(Q2) ;Pid returned for component
; ..
; ..
;Now set up the IPCF packet to send to component. Set up the packet to
;create a PID, for me, process-wide, page mode, don't allow anyone else
;to use it, and this is for QUEUE%.
MOVX T1,<IP%CPD!IP%NOA!IP%CFV!<FLD(.IPCCG,IP%CFC)>>
MOVE T2,KIMUFL ;GET THE PC FLAGS OF THE JSYS
TXNN T2,PCU ;CHECK PREVIOUS CONTEXT USER BIT
TXO T1,IP%MON ;IF MONITOR JSYS, SET PACKET BY MONITOR
MOVEM T1,.IPCFL(Q2) ;Flags go here
SETZM .IPCFS(Q2) ;To be filled in by MSEND% (my PID)
;.IPCFR(Q2) already set up (PID of recvr)
MOVEI T1,PGSIZ ;Sending a page
HRLM T1,.IPCFP(Q2) ;LH gets the length of message
MOVE T1,QUMSG ;Load the addr of the IPCF page
LSH T1,-11 ;Make it a page #
HRRM T1,.IPCFP(Q2) ;RH gets the addr of the msg start
MOVEI T1,SENLEN ;Length of PDB for MSEND%
MOVE T2,Q2 ;Address
MSEND% ;Send the message
IFNSK.
MOVEM T1,QJERR ;Error in JSYS...save error code
JRST QUERR ;To error routine
ENDIF. ;Else OK, go on...
;Get next PDB from IPCF queue...
MOVE Q3,.IPCFS(Q2) ;Save MY PID (filled in by the MSEND%)
TXNN F,QU%NRS ;Do we want to wait for response?
CALL QURSP ;Yes, go wait for it.
MOVE T1,QUMSG ;Get address of message page (all done with it)
CALL RELPGS ;Release the free space
MOVE T1,Q3 ;Get PID #
CALL QRLPID ;(T1) Release it
MRETNG ;return to user, good
;QUVERF -- QUeue% argument VERiFication routine. Takes user-supplied
;arguments from the argument-sub-block and puts them into an IPCF
;message-argument-block. JSB free storage is used for this message.
;
; P2/ Address of user supplied header and arg blocks
;
; CALL QUVERF
;
; RETURN +1: FAILURE, error code in T1...illegal arg list
; or system resources unavailable
; RETURN +2: SUCCESS, arguments in block pointed at by QUMSG, P1 has
; length
QUVERF: MOVE T1,ARGLEN ;get length of user arg block
TXNE T1,ODDBIT ;Is length even? (args come in 2 word blocks)
ITERR (QUEUX1) ;No, Error, get error code
SUBI T1,.QUARG ;Subtract header len to get len of arg block
LSH T1,-1 ;Div by 2 to get # of arg blocks, 2 words/arg
MOVE P1,T1 ;Message contains at least [T1] words
MOVEM T1,BLKCNT ;Message block count goes here
MOVNS T1 ;negate message-block-count
HRLZS Q3,T1 ;into LH for AOBJN...(also into Q3 for later)
;Now figure out how long the IPCF message to the component is
ADDI P1,HDRLEN ;Add length of the mess header to total length
MOVE T4,P2 ;get pointer to the user args
;Now ready to loop thru args to get # of words needed for message...
QUE03: ADDI T4,QABLEN ;get to the next arg blk
UMOVE P4,.QATYP(T4) ;Get Arg type record (has length field...)
TXNE P4,QA%IMM ;Is the next word an immediate arg?
IFSKP. ;No...
HLRZ T2,P4 ;Get length of this sub-block
ADD P1,T2 ;Add length of this block to running count
ELSE. ;Yes...
ADDI P1,IMMLEN ;1 word argument...
ENDIF. ;OK, if more sub-blocks
AOBJN T1,QUE03 ;do it again
;Now get a page of JSB free space if message size is OK
CAILE P1,PGSIZ ;Maximum message length is 1 page
ITERR (QUEUX1) ;Block is too long...error, Invalid arg list
CALL ASGPGS ;OK...Ask for the storage, goes away on a RESET
ITERR (QUEUX5) ;Error code System Resources Unavailable
MOVEM T1,QUMSG ;Got 1 page of JSB space, Save address
;Begin to set up the message header
MOVSS P1 ;Length in LH
XCTU [HRR P1,.QUFNC(P2)] ;Get function code (print, batch...)
MOVEM P1,.QJLTY(T1) ;LH of message(0) is the length
HRRZS P1 ;Save only the function code
SETZ T2, ;No Flags by default
TXNN F,QU%NRS ;User want a response ?
MOVX T2,ACKME ;yes, we want a ack from galaxy
CAIN P1,.QUWTR ;Is it a write-to-opr with reply ?
TXZ T2,ACKME ;yes, don't ack
MOVEM T2,.QJMB1(T1) ;into this word of message
MOVE T2,GBLJNO ;get the job #
MOVEM T2,.QJJOB(T1) ;save it away
SETZM .QJMB2(T1) ;clear this word of hdr
MOVE T2,BLKCNT ;get # of blocks for this message
MOVEM T2,.QJMBC(T1) ;into message header
;...
;Now get ready to loop thru arg sub-blocks again, this time
;copying arguments into IPCF message. Q3 has AOBJN counter already...
MOVEI T1,.QJ1SB(T1) ;get addr of 1st message-sub-block
MOVE T4,P2 ;loc of user-arg-block
QUE04: ADDI T4,QABLEN ;get to the next arg blk
UMOVE P4,.QATYP(T4) ;Get flags/length,,block-type word
TXNE P4,QA%IMM ;this an immediate arg?
IFNSK. ;yes...
HRRZS P4 ;This is the type of sub block
HRLI P4,QIMLEN ;length in LH of message-sub-block-header
MOVEM P4,(T1) ;store in message
AOS T1 ;point at next word in message
UMOVE T2,.QADAT(T4) ;get immediate value
MOVEM T2,(T1) ;put into message
AOS T1 ;increment message-position-pointer
ELSE. ;.QADAT is a pointer to data
;Length-of-block-in-message= (length-of-block-in-args + 1) to include hdr word.
XCTU [MOVS T2,.QATYP(T4)] ;Get arg-sub-block (swapped)
HRRZ T3,T2 ;Get length field for looping thru data
AOS T2 ;Bump it to account for header word
MOVSM T2,(T1) ;header goes into message (swapped back)
SKIPG T3 ;data length must be at least 1
IFNSK. ;Error
MOVEI T1,QUEUX1 ;Illegal Argument List
RET ;Take care of it, release free space
ENDIF. ;Else were OK
MOVNS T3 ;set up for AOBJN loop to xfer data
HRLZS T3 ; " " " "
UMOVE P5,.QADAT(T4) ;P5 gets pointer to arg-sub-block data
QUE05: AOS T1 ;Point at next word in message-arg-block
UMOVE T2,(P5) ;Get data from arg-sub-blk
MOVEM T2,(T1) ;into msg-arg-blk
AOS P5 ;point at next word of arg-sub-blk
AOBJN T3,QUE05 ;while there's still more data to get, get it
AOS T1 ;point at next msg word to fill
ENDIF. ;this arg-block is done...
AOBJN Q3,QUE04 ;if more, do another
RETSKP ;all done...
;Here to wait for a response back from galaxy
QURSP: MOVX T1,.MUQRY ;Function code to return next PDB
MOVEM T1,(Q2) ;Put it into arg block
MOVEI T1,RECLEN ;Length of arg block
MOVEI T2,ARGBLK ;Loc of arg block
QUCHK: MUTIL% ;Get the PDB into ARGBLK
IFNSK. ;Error in JSYS, error code in T1
CAIE T1,IPCFX2 ;Is it "No message for this PID" error
IFSKP. ;Yes, wait then try again
MOVEI T1,TIM2WT ;Wait for 2 seconds
DISMS% ;Spin wheels
MOVEI T1,RECLEN ;Restore argument to T1 for MUTIL% call
JRST QUCHK ;Check it again
ENDIF. ;Else fatal error
;Note: there is no 'time-out' feature incorpoated here because a
; job using QUEUE% may not get runtime within a predictable,
; discrete amount of time. (ie. - running in the Dregs queue)
MOVEM T1,QJERR ;Save error code to return to user
JRST QUERR ;To error routine
ENDIF. ;Else it's a good one
;For the .MUQRY function, the PDB is returned at ARGBLK + 1
CAME P3,.IPCFS+1(Q2) ;See if the PID of the sender is what I expect
JRST QUCHK ;Nope, Ignore it and get another
MOVE T1,.IPCFL+1(Q2) ;Get the flags word
TXOE T1,IP%CFV ;Is the message a page?
IFSKP. ;Nope...
SETZM .IPCFL(Q2) ;Zero the Flags word of the Args
ELSE. ;Yes, Message is a page
MOVEM T1,.IPCFL(Q2) ;Put flags into the arg block for MRECV%
ENDIF. ;Now set up for the rest of the receive...
MOVEM Q3,.IPCFR(Q2) ;Want messages for me
SETZM .IPCFS(Q2) ;Senders PID, filled in by MRECV%
MOVE T1,QUMSG ;Get the location to store response
HRRM T1,.IPCFP(Q2) ;into the PDB (LH already has length)
MOVEI T1,RECLEN ;get the length of the MRECV% PDB
MOVE T2,Q2 ;T2 points to the arg block
MRECV% ;Block until we receive a message
IFNSK. ;+1 return, Something went wrong, don't recover
MOVEM T1,QJERR ;Jsys error...save error code
JRST QUERR ;To error routine
ENDIF. ;Else OK...Got message
; ..
; ..
;Now we have a message...Is their an error from component?
;Any text? If so, move message into users response space
MOVE T2,QUMSG ;Get the address of the returned message
MOVE T1,.QRFLG(T2) ;Want flags...Any set?
TXNE T1,QU%NTB ;Any text response?
IFSKP. ;Yes
UMOVE T1,.QUFNC(P2) ;Get response-length,,function word
TXZ T1,QF%FLG ;Zero out the Flags
HLRZS T1 ;and put the response-len in the RH
IFG. T1 ;If user wants a reply at all
HLRZ T3,.QRLEN(T2) ;Find out how much we got back
CAMG T3,T1 ;Does user want less than what's there?
MOVE T1,T3 ;No, give him all we got
UMOVE T3,.QURSP(P2) ;Get location to put response
ADDI T2,.QRTXT ;Get location of beginning of response text
CALL BLTMU1 ;(T1,T2,T3) BLT the text back to the users space
ENDIF. ;User doesn't want response
ENDIF. ;Or component didn't give us one
MOVE T2,QUMSG ;[7470]Get the address of the returned message
MOVE T1,.QRFLG(T2) ;[7470]Want flags...Any set?
TXNN T1,QU%CFE ;[7470]Is it "COMPONENT FATAL ERROR"?
RET ;[7470]No, return OK
MOVEI T1,QUEUX3 ;[7470]Yes, get error code
MOVEM T1,QJERR ;[7470]And save it...
JRST QUERR ;[7470]Go release free space and ITRAP user
;QRLPID -- Routine releases PID
;T1/ # of PID to be released
;
; CALL QRLPID ;(T1) RELEASE PID IN T1
;RETURN +1: ALWAYS, PID released if it existed
; Trashes T1-T4
QRLPID: MOVEI T3,.MUDES ;Delete a PID
MOVEM T1,T4 ;PID to delete
MOVEI T1,2 ;Length of arg block
MOVEI T2,T3 ;Arg block consists of T3 and T4
MUTIL% ;Delete it
ERJMP .+1 ;Don't care about errors
RET ;And return
;Here with fatal error...
;Release free space, ITERR.....
QUERR: MOVE T1,QUMSG ;get pointer to beginning...
CALL RELPGS ;(T1) Release free space
MOVE T1,Q3 ;PID to delete
CALL QRLPID ;(T1) Delete PID
MOVE T1,QJERR ;Get error code to send back
ITERR ()
;FUNction BLocK -- table of PIDs corresponding to function supplied
;QUEUE% retrieves PIDs by indexing into table by function code. A
;value of 0 means this code is illegal.
FUNBLK::Z ;Function code 0 is illegal
.SDQSR,,.SPQSR ;system PID for QUASAR
.SDQSR,,.SPQSR ;
.SDQSR,,.SPQSR ;
.SDQSR,,.SPQSR ;
.SDQSR,,.SPQSR ;
Z ;Illegal
Z ; "
.SDQSR,,.SPQSR ;Quasar...
.SDQSR,,.SPQSR ;
.SDOPR,,.SPOPR ;system PID for ORION
.SDOPR,,.SPOPR ;
Z ;Illegal
Z ;Illegal
.SDCUS,,.SPCUS ;system PID for a custom application
QHIFUN==.-FUNBLK ;highest valid function code
SUBTTL RELD JSYS
; Release device
; 1/ DEVICE DESIGNATOR, OR -1 TO RELEASE ALL DEVICES
; RELD
; Returns
; +1 ; Error, bad designator or not assigned to this job
; +2 ; Ok.
.RELD:: MCENT
STKVAR <RELDSV,RELDIX>
MOVEM T1,RELDSV ;SAVE DEVICE DESIGNATOR
RELD1: CALL LCKDVL ;LOCK DEVICE LOCK, GO NOINT
CAMN 1,[-1] ;ALL ASSIGNED DEVICES?
JRST RELDAL ;YES. GO DO THEM
CALL CHKDEV ;DO WE HAVE ACCESS TO THIS DEVICE?
RETERR(,<UNLOKK DEVLKK>) ;NO.
MOVEM T2,RELDIX ;SAVE INDEX TO DEVICE TABLES
HLRZ T1,DEVUNT(T2) ;GET OWNING JOB
CAIN T1,-1 ;IS THERE ONE?
JRST RELD2 ;NO. DON'T BOTHER TO DEASSIGN IT
CALL RELDEV ;GO RELEASE THIS DEVICE
JRST RELDWT ;FAILED
HRRZ P3,P4 ;DEVICE ONLY
MOVE T2,RELDIX ;T2/ INDEX TO DEVICE TABLES
CALL DSMNT0 ;AND DISMOUNT DEVICE
JFCL
RELD2: UNLOKK DEVLKK
OKINT
SMRETN
;RELEASING ALL DEVICES ASSIGNED TO THIS JOB
RELDAL:
MOVSI Q1,-NDEV ;SET UP AOBJN POINTER
RELDA3: MOVE B,Q1 ;SET UP FOR CALL TO RELDEV
HLRZ A,DEVUNT(B) ;GET OWNING JOB
CAME A,JOBNO ;THIS JOB?
JRST RELDA4 ;NO. ON TO NEXT DEVICE
CALL RELDEV ;(B/A) YES. RELEASE IT
JRST RELDWT ;FAILED. GO WAIT UNTIL IT CAN SUCCEED
HRRZ P3,P4 ;ADDRESS ONLY
CALL DSMNT0 ;(B/) AND DISMOUNT DEVICE
JFCL
RELDA4: AOBJN Q1,RELDA3
JRST RELD2 ;GO UNLOCK AND EXIT
;FAILED TO RELEASE THE DEVICE. WAIT IF NECESSARY
RELDWT: TXZN T1,1B0 ;NEED TO WAIT?
RETERR (,<UNLOKK DEVLKK
OKINT>) ;NO. FAIL
UNLOKK DEVLKK ;YES. UNLOCK DEVICE TABLES
OKINT ;LET USER CTRL/C OUT
HRL T1,T2 ;T1/ (LINE NUMBER,,ADDRESS)
MDISMS ;WAIT UNTIL IT'S POSSIBLE
MOVE T1,RELDSV ;RESTORE DEVICE DESIGNATOR
JRST RELD1 ;GO TRY AGAIN
;RELDEV - RELEASE DEVICE AND SEND MESSAGE TO ALLOCATOR IF NECESSARY
;ACCEPTS:
; T2/ INDEX TO DEVICE TABLES
; CALL RELDEV
;RETURNS +1: FAILED
; T1/ ERROR CODE
; OR
; 1B0 + ADDRESS OF SCHEDULER ROUTINE FOR DISMS
; +2: SUCCEEDED
;
;PRESERVES B
;
RELDEV::STKVAR <RELDIX>
LDB D,[POINT 9,DEVCHR(B),17] ;GET DEVICE TYPE NUMBER
MOVX C,DV%OPN
TDNE C,DEVCHR(B) ;IS DEVICE OPENED?
RETBAD (DEVX6) ;TCO 4.2022 YES, RETURN ERROR
HRRZ C,DEVUNT(B) ;GET THE UNIT NUMBER
ANDI C,DV%UNT ;MASK UNIT
CAIN C,DV%UNT ;CHECK FOR -1
MOVEI C,-1 ;SET -1
CAIN D,.DVTTY ;IS THIS A TTY?
JRST RELDD3 ;YES. GO DO SPECIAL PROCESSING
RELDD0: HRRZ C,DEVDSP(B) ;GET TYPE OF THIS DEVICE
CAIN C,MTDTB ;IS THIS AN MT DEVICE?
CALL RELDMT ;YES. DO PROPER CLEAN UP THEN
MOVX C,DV%ASN ;INDICATE NO LONGER ASSIGNED
ANDCAM C,DEVCHR(B)
MOVE D,DEVCH1(B) ;GET CHARACTERISTICS WORD
MOVEI C,-1 ;SET UP TO RETURN DEVICE TO FREE POOL
TLNE D,(D1%ALC) ;IS THIS DEVICE AN ALLOCATED DEVICE
MOVEI C,-2 ;YES, RETURN IT TO ALLOCATOR
HRLM C,DEVUNT(B) ;MARK THAT DEVICE IS FREE
TLNN D,(D1%ALC) ;ALLOCATED DEVICE?
JRST RELDD1 ;NO, DONT PUT IN MESSAGE
MOVE A,DEVCHR(B) ;SET UP DEVICE DESIGNATOR
TLZ A,777000
TLO A,.DVDES
HRR A,DEVUNT(B) ;GET UNIT NUMBER
MOVEM B,RELDIX ;[7148] PRESERVE B. ALCMES WILL TRASH IT
CALL ALCMES ;[7148] (T1/)
JFCL ;[7148]
MOVE B,RELDIX ;[7148] RESTORE THE DEVICE INDEX
RELDD1: RETSKP
RELDD3: LOAD A,FRKTTY,+0 ;GET TOP FORK'S CTY
CAIE A,.TTDES(C) ;IS THIS IT?
CAMN C,CTRLTT ;YES. IS IT THIS JOB'S CONTROLLING TTY?
RETSKP ;YES. DON'T DEASSIGN IT
MOVEM B,RELDIX ;SAVE INDEX TO DEVICE TABLES
MOVE B,C ;B/ TERMINAL NUMBER
CALL GTTOPF ;GET SCTTY GROUP
IFSKP.
CAIE T3,-1 ;OWNED?
ANNSK.
TMNN LOGIOB,JOBBIT ;YES. IN LOGOUT?
SKIPA T1,[DEVX6] ;NO. ERROR
MOVX T1,<1B0+CTWAIT> ;YES. HAVE TO WAIT
RETBAD() ;DO IT
ENDIF.
CALL TTYDEA ;DEALLOCATE ITS DYNAMIC DATA
RETBAD ;FAILED. RETURN FAILURE
RELDD4: MOVE B,RELDIX ;RESTORE INDEX TO DEVICE TABLES
JRST RELDD0 ;FINISH PROCESSING
;Scheduler test to wait for TTY to be released as a sub-CTY
RESCD
CTWAIT: MOVE T2,T1 ;TTY NUMBER
CALL GTTOPF ;GET TOP OF THE LINE
JRST 1(4) ;AWAKE IF NOT ASSIGNED
CAIE T3,-1 ;STILL IN USE?
JRST 0(4) ;YES
JRST 1(4)
SWAPCD
SUBTTL RESET JSYS
; Reset jsys
; Call: RESET
; Closes all files, resets tty status etc
.RESET::MCENT
MOVNI A,4
KFORK ; Kill all inferior forks
MOVE A,FORKX ; GET FORK NUMBER OF THIS FORK
CALL PIDRFK ; GO DELETE TEMPORARY PIDS OF THIS FORK
MOVE A,FORKX
CALL ENQFKR ; DEQ ALL ENQ'D REQUESTS FOR THIS FORK
SKIPE SNPPGS ; THIS FORK HAVE ANY BREAK POINTS IN?
CALL SNPREL ; YES, GO RELEASE THEM
SKIPGE CTRLTT
JRST RSTFK ; Skip tty reset if not ctrltt
MOVEI A,101
MOVE B,NORMTF ; Normal modes
SFMOD
ERJMP .+1 ;Don't care about errors
RSTFK: MOVEI A,400000
CIS
DIR
SETZB T2,T3 ;ZERO BOTH INTERRUPT AND DEFERRED WORD MASK
STIW
MOVNI 2,1
DIC
CALL CLRTRP ;CLEAR TRAP FUNCTION WORDS AND LUUO BLOCK
CALL EVRKIL ;CHECK FOR DECNET EVENT READER
IFE FTNSPSRV,<
CALL LLMRFK## ;[7173] Release any LLMOP resources
>
MOVE T1,FORKX
TMNE FKNTC,(T1) ;ARE WE ENABLED FOR NET TOPO CHANGE INTERRUPTS?
CALL NTCOFF ;YES, DISABLE THEM
NOP ;STUPID ROUTINE DOESN'T HAVE RETS, ONLY RETSKPs
CALL NIJKFK## ;Reset stuff for the NI% JSYS
MOVE 1,[CZ%ABT+400000] ;SAY DELETE NONX FILES
CLZFF
RWSET ;RELEASE WORKING SET
SKIPGE PATADR ;FORCED NON-COMPATIBILITY?
JRST RSTFK2
HLLZS PATADR ;NO, CLEAR ENTRY VECTOR, BUT KEEP SECTION #
SETZM PATLEV ;AND COMPAT EVEC LENGTH
RSTFK2: MOVNI A,1 ;SET UP TO RELEASE ALL HANDLES
RFRKH ;FREE FORK HANDLES
JFCL ;?
SETZM JTTRW ;CLEAR JSYS TRAP WORD
MOVEI T1,77 ;UNASSIGNED CHANNEL
STOR T1,JTMCN ;TO JSYS TRAP PSI CHANNEL
SETOM JTLCK ;CLEAR JSYS TRAP LOCK
CALL DAPRST ;CLEAR DIM CONNECTION DATA
JRST MRETN
SUBTTL RFCOC JSYS
; Read control character output control
.RFCOC::MCENT
CALL CHKTTR
JRST RFCOC1
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;NOT ACTIVE. FAIL
CALL TTRCOC
UMOVEM 1,2
UMOVEM 3,3
CALL ULKTTY ;ALLOW DEALLOCATION
JRST MRETN
RFCOC1: MOVE A,[BYTE (2)2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2]
UMOVEM A,2
UMOVEM A,3
JRST MRETN
SUBTTL RFMOD JSYS
;RFMOD JSYS - Read TERMINAL mode
;ACCEPTS:
; T1/ SOURCE DESIGNATOR
; RFMOD
;RETURNS +1: ALWAYS,
; T2/ JFN MODE WORD
;NOTE: IF T1 POINTS TO A NON-TERMINAL, CERTAIN DEFAULTS ARE RETURNED
;IN PARTICULAR, WHEN CHKTTR FAILS, AC 'STS' HAS, IN BITS 32-35
;THE MODE BITS FROM THE OPENF. SINCE STS=P1, THIS CODE RETURNS BITS 32-35 IN P1
.RFMOD::MCENT
SETZ P1, ;INITIALIZE P1 TO 0
CALL CHKTTR
JRST RFMOD1
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;NOT ACTIVE. FAILED
CALL TTRMOD
UMOVEM 1,2
CALL ULKTTY ;ALLOW DEALLOCATION
JRST MRETN
RFMOD1: MOVE A,P1
ANDI A,17
ADD A,[^D66B10+^D72B17+^D7B3]
UMOVEM A,2
JRST MRETN
SUBTTL RFPOS JSYS
; Read file position
.RFPOS::MCENT
CALL CHKTTR
JRST [ XCTU [SETZM 2]
JRST MRETN]
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;NOT ACTIVE. FAILED
CALL TTRPOS
CALL ULKTTY ;ALLOW DEALLOCATION
UMOVEM 1,2
JRST MRETN
SUBTTL RMAP JSYS
; Read map
; Call: LH(1) ; Fork handle
; RH(1) ; Page number
; RMAP
; Retrn
; +1
; LH(1) ; Jfn
; RH(1) ; Page number
; 2 ; Access read, write,execute,nonexistent in bits 2-5
.RMAP:: MCENT
CALL FLOCKN ; LOCK THE FORK LOCK
MOVEI B,0 ; Convert arg to PC section. Old programs
; running in non-zero sections want it this way
; New programs written to run in non-zero sections don't
CALL FKHPTN ; Convert frk.pn to ptn.pn
ITERR (,<CALL FUNLK>) ;could be non-existent section, return error
PUSH P,C ;SAVE SECTION ACCESS BITS
CALL RMAP ; Call map routine
ITERR (,<CALL FUNLK>)
ANDM B,(P) ;ACCESS IS SECTION ACCESS & PAGE ACCESS
POP P,B
UMOVEM A,1
UMOVEM B,2
CALL FUNLK ;FREE THE FORK LOCK
JRST MRETN
;ROUTINE RMAP
;CALL WITH
; A/ PTN,,PN
; B/ USERS BITS (PM%EPN)
;RETURNS
; .+1 ERROR A = ERROR CODE
; .+2
; A = FKH,,PN IF FORK
; = JFN,,PN IF FILE
; B = PAGE ACCESS
RMAP: CALL MRPT ;GET MAP INFO
JRST RMAP3 ;A FORK PAGE
PUSH P,B ;A FILE PAGE
CALL OFNJFN ;GET THE JFN
RMAP1: SETO A, ;UNIDENTIFABLE
RMAP2: POP P,B ;RESTORE ACCESS
RETSKP ;GIVE GOOD RETURN
RMAP3: PUSH P,B ;SAVE PAGE ACCESS BITS
JUMPE A,RMAP1
CALL PTNFKH
RET
JRST RMAP2
;XRMAP
; 1/ FORK HANDLE,,0
; 2/ ADDRESS OF DATA BLOCK
; XRMAP%
;WHERE DATA BLOCK IS
; NUMBER OF WORDS IN DATA BLOCK (INCLUDING THIS ONE)
;REPEAT <NUMBER OF WORDS IN DATA BLOCK - 1>/3,<
; PAGE COUNT
; STARTING FORK PAGE NUMBER
; WHERE TO STORE THE ANSWER>
;
.XRMAP::MCENT
DMOVE Q1,T1 ;SAVE ARGUMENTS
UMOVE P1,(Q2) ;GET NUMBER OF WORDS IN DATA BLOCK
HRRES P1 ;MUST BE .GT. 0
JUMPLE P1,[ITERR (ARGX17)]
SUBI P1,1 ;COUNT INCLUDES COUNT WORD
IDIVI P1,3 ;ARGUMENTS ARE TRIPLETS
JUMPN P2,[ITERR (ARGX17)]
CALL FLOCKN ;LOCK FORK STRUCTURE
XRMAP1: UMOVE P2,1(Q2) ;PAGE COUNT
UMOVE P3,2(Q2) ;STARTING PAGE NUMBER
UMOVE P4,3(Q2) ;WHERE TO STORE THE ANSWERS
XRMAP2: MOVE T1,Q1 ;FORK HANDLE
HRR T1,P3 ;PAGE NUMBER, NOT RIGHT IF MORE THAN 512 SECTIONS
MOVX T2,PM%EPN ;DON'T SUBSTITUTE PC SECTION (SHOULD THIS BE AN OPTION?)
CALL FKHPTN ;GET PTN.PN
ITERR (,<CALL FUNLK>) ;NO SUCH
MOVE P3,T1 ;SAVE PTN
PUSH P,T3 ;SAVE SECTION ACCESS BITS
XRMAP3: SOJL P2,XRMAP4 ;JUMP IF CURRENT PAGE COUNT EXHAUSTED
MOVE T1,P3 ;PAGE TABLE NUMBER,,PAGE NUMBER
CALL RMAP ;GET MAP INFO
ITERR (,<CALL FUNLK>) ;NON-EXISTENT SECTION?
AND T2,(P) ;PAGE + SECTION ACCESS BITS
UMOVEM T1,(P4) ;FORK OR JFN
UMOVEM T2,1(P4) ;ACCESS BITS
ADDI P4,2 ;POINT AT NEXT ANSWER PLACE
ADDI P3,1 ;NEXT PAGE
TRNE P3,777 ;CROSSING A SECTION BOUNDARY?
JRST XRMAP3 ;NO, GET INFO ON NEXT PAGE
XRMAP4: POP P,(P) ;YES, STRAIGHTEN OUT STACK
JUMPG P2,XRMAP2 ;AND FIND THE NEXT PAGE TABLE
ADDI Q2,3 ;POINT AT NEXT TRIPLET
SOJG P1,XRMAP1 ;LOOP OVER THE ENTIRE ARGUMENT LIST
CALL FUNLK ;UNLOCK
JRST MRETN ;AND RETURN TO THE USER
SUBTTL RPACS JSYS
; Read accessiblity of page
; Call: LH(A) ; Fork or file handle
; RH(A) ; Page number
; RPACS
.RPACS::MCENT
TRNE T1,777000 ;DOES THE PAGE NUMBER SAY "LONG FILE"?
SKIPGE T1 ;IS THIS A FORK HANDLE?
JRST RPACS1 ;YES - THEN SHORT FILE IS ASSUMED
HLRZS T1 ;NO - USER ASKING FOR LONG FILE
CAML T1,MAXJFN ;COULD IT BE A GOOD JFN?
ITERR (DESX3) ;NO WAY
IMULI T1,MLJFN ;CONVERT TO INTERNAL INDEX
MOVE T1,FILSTS(T1)
TXNN T1,LONGF ;IS FILE LONG?
RPACS0: JRST [ XCTU [SETZM 2] ;NO - File not long
JRST MRETN]
UMOVE 1,1 ;YES - RESTORE USER AC1
RPACS1: TRVAR <<DUMMY,3>,JF1> ;MUST MATCH TRVAR IN PMAP
SETZM JF1 ;NO STR LOCK YET
SETZ B, ;NO PT CREATES PLEASE
REPEAT 0,< ;DON'T USE THIS NOW
JUMPL T1,[CALL CHKADR ;CHECK ON THE ADDRESS
ITERR (ARGX06) ;NOT WITHIN RANGE
CALL FKHPTA ;GET I.D. OF PAGE
JRST RPACS0 ;NON-EX SECTION
JRST RPACS2] ;PROCEED
> ;END OF REPEAT 0
CALL CPMAP ;GET PAGE IDENT AND ACCESS
MOVEM D,JF1 ;PAGE IN DISK FILE - MUST RELEASE THIS STR LOCK
RPACS2: SKIPE T1 ;FOUND A MATCH?
CALL MRPACS ;READ THE PAGE ACCESSIBILITY
UMOVEM 1,2
SKIPE A,JF1 ;SEE IF A STR LOCK TO RELEASE
CALL LUNLKF ;YES. GO DO IT
JRST MRETN
;LOCAL ROUTINE TO CHECK VALIDITY OF PROCESS PAGE
; T1/ FH.PTN
CHKADR: LDB T2,[POINT 9,T1,26] ;GET PAGE NUMBER
CAILE T2,(VSECNO) ;A VALID SECTION?
RET ;NO
RETSKP ;YES
SUBTTL RSMAP JSYS
; Read section map
; Call: LH(1) ; Fork handle
; RH(1) ; Section number
; RSMAP
; Return
; +1
; 1/ map information simular to SMAP source argument
; -1 = no current mapping
; 0 = private section
; fork handle,,section # = mapping to a fork section
; JFN,,section # = mapping to a file section
; 2/ access information
.RSMAP::MCENT
STKVAR <SAVPTR>
CALL CKXADR ;EXTENDED ADDRESSING?
ITERR () ;NO
HRRZ T2,T1 ;SECTION NUMBER
CAILE T2,MXSECN ;LEGAL?
ITERR (ARGX23) ;NO
MOVE Q1,T1 ;SAVE USER'S ARGUMENT
HLRZS T1 ;FORK HANDLE
CALL FLOCKN ;LOCK FORK STRUCTURE WITH NESTING
CALL STJFKR ;GET JOB-WIDE HANDLE
ITERR (,<CALL FUNLK>) ;ERROR IF UNKNOWN
HRRZ T1,SYSFK(T1) ;GET SYSTEM-WIDE HANDLE
LOAD T1,FKPS%,(T1) ;GET SPT INDEX FOR PSB
HRL Q1,T1 ;COMBINE WITH SECTION NUMBER
MOVE T1,Q1 ;..
CALL CHKMAP ;SEE IF MAPPED SECTION, GET SECTION POINTER
JRST [ MOVEM T1,SAVPTR ;SAVE SECTION POINTER
SKIPE T1 ;CURRENTLY MAPPED?
TDZA T1,T1 ;YES, PRIVATE
SETO T1, ;NO, INDICATE NO CURRENT MAPPING
JRST RSMAP3] ;CONTINUE
MOVEM T1,SAVPTR ;SAVE SECTION POINTER
MOVE T1,Q1 ;PSB,,SECN
CALL SECJFN ;A FILE?
CAIA ;NO, A FORK
JRST RSMAP2 ;YES
LOAD T2,PTRCOD,T1 ;GET POINTER TYPE
CAIE T2,INDCOD ;INDIRECT?
JRST [ HRLZS T1 ;NO, A SHARE POINTER. GET SPTN
JRST RSMAP1] ;GET FORK HANDLE
LOAD T2,SPTX,T1 ;YES, GET SPTN OF PSB IT POINTS TO
HRRZ T2,SPTH(T2) ;SYSTEM WIDE FORK HANDLE OF OWNING FORK
LOAD T1,IPPGN,T1 ;SECTION TABLE INDEX
SUBI T1,USECTO ;SECTION NUMBER
LSH T1,PGSFT ;CONVERT TO A "PAGE NUMBER"
LOAD T3,FKUP%,(T2) ;GET SPTN OF PAGE TABLE
HRL T1,T3 ;COMBINE WITH PAGE NUMBER
RSMAP1: PUSHJ P,PTNFKH ;GET FORK HANDLE
ITERR (,<CALL FUNLK>) ;ERROR IF UNKNOWN?
CAMN T1,[-1] ;OWNING FORK FOUND?
JRST RSMAP3 ;CONFUSION? (PROBABLY A SYSTEM ERROR)
MOVE T2,T1 ;FORK HANDLE,,PAGE NUMBER
RSMAP2: HRRZ T1,T2 ;PAGE NUMBER WITHIN FORK OR FILE
LSH T1,-PGSFT ;SECTION NUMBER
HLL T1,T2 ;JFN OR FORK HANDLE,,SECN
RSMAP3: UMOVEM T1,1 ;STORE THAT FOR THE USER
MOVE T1,SAVPTR ;RESTORE SECTION POINTER
;WORRY ABOUT INDIRECT HERE AND IF NECESSARY IN CHKMAP???
CALL GPAC ;GET ACCESS INFORMATION
UMOVEM T1,2 ;STORE THAT FOR THE USER
CALL FUNLK ;UNLOCK FORK STRUCTURE
JRST MRETN ;GOOD RETURN TO THE USER
SUBTTL SETER JSYS
; Set last error
; Accepts 1: Flags,,fork designator
; 2: Error code
; 4-10: For ERRSAV if B0 of 1 is on
; Returns
; +1 Always
.SETER::MCENT
CALL FLOCK ; Lock things down
MOVE P1,T1 ; Flags,,fork
MOVE P2,T2 ; Error code
HRRZS T1 ; Just fork handle
CALL STJFKR ; Get job fork index
ITERR FRKHX1,<CALL FUNLK> ; Bad handle
CALL SKIIF ; Must be self or lower
ITERR FRKHX2,<CALL FUNLK>
CALL CHKNXS ; Make sure not execute-only unless SELF
MOVE P3,T1 ; Save fork's job index
CALL SETLF1 ; Map PSB
MOVE Q1,T1 ; Save offset to PSB of fork
TLNE P1,(1B0) ; Not setting ERRSAV?
CAMN P3,FORKN ; Or me?
JRST SETE1 ; Yes
MOVES PSBPGA(Q1) ; Touch it, going NOSKED
NOSKED
HRRZ 7,SYSFK(P3) ; Get FORKX (7 is Q3 or FX)
CALL CHKWT ; Must not be running
JRST SETE3 ; Which he is
SETE1: MOVEM P2,LSTERR(Q1) ; Save into PSB
TLNN P1,(1B0) ; Doing ERRSAV?
JRST SETE2 ; No
MOVEI T1,10-4 ; # of words to copy
MOVEI T2,4 ; From user acs
MOVEI T3,ERRSAV(Q1)
CALL BLTUM
CAMN P3,FORKN ; Me?
JRST SETE2 ; Yes
OKSKED
SETE2: CALL CLRLFK ; Unmap PSB
CALL FUNLK
MRETNG
SETE3: OKSKED
CALL CLRLFK
ITERR FRKHX4,<CALL FUNLK> ; Moving violation
SUBTTL SETJB JSYS
; SET JOB PARAMETERS
;ACCEPTS IN 1/ JOB NUMBER
; 2/ FUNCTION CODE
; 3/ VALUE OR POINTER TO ARG BLOCK
; SETJB
;RETURNS +1: ALWAYS
SJ%OWN==:1B0 ;IF SET, THEN SETTING PARAMETERS IN OWN JOB
.SETJB::MCENT
SETZ T4, ;LOCAL FLAG AC
UMOVE T1,1 ;GET JOB NUMBER
CAMN T1,[-1] ;SELF?
IFSKP. ;IF SKIP, USER SPECIFIED A GLOBAL JOB NUMBER
CALL GL2LCL ;SO TRANSLATE IT INTO A LOCAL JOB INDEX
ITERR(SJBX4) ;ILLEGAL JOB NUMBER
ELSE. ;OTHERWISE, USER SPECIFIED 'SELF' (-1)
MOVE T1,JOBNO ;GET OUR LOCAL INDEX
ENDIF. ;
SKIPGE JOBRT(T1) ;JOB LOGGED IN?
ITERR (SJBX5) ;NO, JOB NOT LOGGED IN
CAME T1,JOBNO ;OUR OWN JOB?
JRST [ MOVE T2,CAPENB ;NO, CHECK FOR PROPER PRIVILEGES
TXNN T2,SC%WHL!SC%OPR
ITERR (SJBX6) ;NOT PRIVILEGED
JRST STJB1] ;OK
TXO T4,SJ%OWN ;SETTING PARAMETERS IN OUR OWN JOB
STJB1: CALL MAPJSB ;MAP IN JSB OF JOB
RETBAD(SJBX5)
MOVEM T1,P1 ;SAVE JSB OFFSET
XCTU [HRRZ T2,2] ;GET FUNCTION CODE
UMOVE T3,3 ;GET VALUE
CAIL T2,MAXSJF ;LEGAL FUNCTION CODE?
ITERR (SJBX1,<CALL CLRJSB>) ;ILLEGAL FUNCTION CODE
TXNN T4,SJ%OWN ;OUR OWN JOB?
CALL SJBCHK ;NO, SEE IF JOB CAN DO THIS FUNCTION
XCT SJBTAB(T2) ;PERFORM THE FUNCTION
CALL CLRJSB ;UNMAP JSB
JRST MRETN ;SUCCESSFUL
SJBCHK: SKIPN SJBTBF(T2) ;CAN THE JOB PERFORM THIS FUNCTION?
ITERR (SJBX8,<CALL CLRJSB>) ;NO
RET ;YES, GO DO IT
;MACROS TO DEFINE PARALLEL FLAG AND FUNCTION TABLES FOR SETJB
; FLAG TABLE (SJBTBF) VALUES:
; 1 - MEANS ANY JOB CAN SET THE PARAMETER
; 0 - MEANS ONLY THE OWNER JOB CAN SET THE PARAMETER
DEFINE SJTBL <
SJTB1 (1,<CALL SJBDEN>) ;;0 - SET DEFAULT MAGTAPE DENSITY
SJTB1 (1,<STOR T3,JSMTP,(T1)>) ;;1 - SET MAGTAPE DEFAULT PARITY
SJTB1 (1,<CALL SJBDM>) ;;2 - SET MAGTAPE DEFAULT DATA MODE
SJTB1 (1,<STOR T3,JSMTR,(T1)>) ;;3 - SET MAGTAPE DEFAULT RECORD SIZE
SJTB1 (1,<STOR T3,JSDFS,(T1)>) ;;4 - SET DEFERRED SPOOLING
SJTB1 (0,<CALL SJBSRM>) ;;5 - SET SESSION REMARK
SJTB1 (0,<CALL SJBT20>) ;;6 - SET TOPS20 COMMAND LEVEL
SJTB1 (1,<MOVEM T3,ARDFRT>) ;;7 - Set default retrieval mode
SJTB1 (1,<CALL SJBBAT>) ;;10 - SET BATCH STREAM AND FLAGS
SJTB1 (1,<CALL SJBLL>) ;;11 - SET LOGICAL LOCATION
SJTB1 (1,<CALL SJBBSN>) ;;[7259]12 - Set batch sequence number
SJTB1 (1,<CALL SJBBJN>) ;;[7259]13 - Set batch job name
SJTB1 (1,<CALL SJBBID>) ;;[7259]14 - Set batch request ID
>
DEFINE SJTB1 (FLG,INSTR) <
EXP FLG>
SJBTBF: SJTBL ;GENERATE FLAG TABLE
DEFINE SJTB1 (FLG,INSTR) <
INSTR>
SJBTAB: SJTBL ;GENERATE FUNCTION TABLE
MAXSJF==.-SJBTAB ;MAXIMUM SETJB FUNCTION CODE
SJBDEN: SKIPL T3 ;NEGATIVE VALUE IS ILLEGAL
CAILE T3,MTMXDN ;LEGAL DENSITY?
ITERR (SJBX2,<CALL CLRJSB>) ;ILLEGAL DENSITY
STOR T3,JSMTD,(T1) ;STORE DENSITY
RET
;SET TOPS20 COMMAND LEVEL
SJBT20: JUMPE T3,SJBT1 ;IF 0, IT'S O.K.
CAME T3,[-1] ;IF -1, IT'S O.K.
ITERR (SJBX1) ;OTHERWISE "INVALID FUNCTION"
SJBT1: STOR T3,JBT20,(T1) ;STORE NEW VALUE
RET
SJBDM: SKIPL T3 ;DONT ALLOW NEGATIVE VALUES
CAILE T3,MTMXDM ;LEGAL DATA MODE?
ITERR (SJBX3,<CALL CLRJSB>) ;ILLEGAL DATA MODE
STOR T3,JSMTM,(T1) ;YES, SAVE DATA MODE
RET
;SET JOB LOGICAL LOCATION
SJBLL: STKVAR <<SJNAM,WPN>,UNP>
MOVEM C,UNP ;REMEMBER USER POINTER TO NODE NAME
MOVE A,C ;GET USER POINTER TO NAME
MOVEI B,SJNAM ;WE'LL READ PARSED NODE NAME INTO THIS BUFFER
CALL PARNDU ;VERIFY THAT NAME IS KOSHER
ITERR ;IT'S NOT, GIVE REASON TO CALLER
UMOVEM A,C ;GIVE USER UPDATED POINTER
MOVEI A,WPN ;TRANSFER MAXIMUM WORDS ALLOWED PER NODE NAME
MOVEI B,SJNAM ;TRANSFER FROM OUR BUFFER
MOVEI C,LLSR(P1) ;TO APPROPRIATE JOB'S BUFFER IN JSB
CALLRET XBLTA ;TRANSFER THE DATA
; SET JOB SESSION REMARK
SJBSRM: MOVE T1,T3 ;USER'S POINTER TO STRING
CALL CPYFUS ;GET THE STRING
ITERR (MONX02,<CALL CLRJSB>)
CALL LOGCJM ;[7456] Write ses rec before string changes
UMOVEM T3,3 ;RETURN USER'S UPDATED POINTER
HRRZ T2,T1 ;POINTER TO STRING
MOVE T4,T1 ;SAVE IT IN T4 FOR NOW
MOVEI T1,MAXLW+1 ;STRING LENGTH
MOVEI T3,JSSRM(P1) ;SAY WHERE TO PUT REMARK
CALL XBLTA ;PUT STRING IN THE JSB
MOVEI T1,JSBFRE
MOVE T2,T4 ;FREE UP JSB FREE SPACE FOR STRING
CALL RELFRE
OKINT ;CPYFUS WENT NOINT
RET
; SET JOB BATCH STREAM NUMBER AND FLAGS
SJBBAT: CALL CHKPRI ;[7259]Wheel or OPR pris
ITERR (SJBX6) ;[7259]Not enough privs
MOVEM T3,BATSTF(P1) ;[7259]Save new flags
RET ;[7259]Return ok
; Set job batch sequence number
SJBBSN: CALL CHKPRI ;[7259]Wheel or OPR privs
ITERR (SJBX6) ;[7259]Not enough privs
MOVEM T3,JBBSEQ(P1) ;[7259]Save batch sequence number
RET ;[7259]Return ok
; Set BATCH job name
SJBBJN: CALL CHKPRI ;[7259]Wheel or OPR privs
ITERR (SJBX6) ;[7259]Not enough privs
MOVEM T3,JBBNAM(P1) ;[7259]Save batch job name (SIXBIT)
RET ;[7259]Return ok
SJBBID: CALL CHKPRI ;[7259]Wheel or OPR privs
ITERR (SJBX6) ;[7259]Not enough privs
MOVEM T3,BATRID(P1) ;[7259]Save Batch request ID
RET ;[7259]Return ok
; CHKPRI - Checks to see if caller has WHEEL or OPR privileges
; returns +1 Not enough privs
; +2 Has privs
CHKPRI: MOVX T1,SC%OPR!SC%WHL ;[7259]Wheel or OPR only
TDNN T1,CAPENB
RET ;[7259]No, bad return
RETSKP ;[7259]Yes, good return
SUBTTL SFCOC JSYS
; Set control character output control
.SFCOC::MCENT
CALL CHKTTR ;IS THIS A TERMINAL?
MRETNG ; NO, THEN THIS IS A NOOP
CALL CHKTTY ;CAN WE ACCESS THE TERMINAL?
ITERR (DESX2) ;No, return proper error code
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;NOT ACTIVE. FAIL
UMOVE 1,2
UMOVE 3,3
CALL TTSCOC
CALL ULKTTY ;ALLOW DEALLOCATION
JRST MRETN
SUBTTL SFMOD JSYS
; Set file modes
.SFMOD::MCENT
CALL CHKTTR ;IS THIS A TERMINAL?
MRETNG ; NO, THEN THIS IS A NOOP
CALL CHKTTY ;CAN WE ACCESS THE TERMINAL?
EMRETN () ; NO, SO RETURN ERROR
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;NOT ACTIVE. FAIL
UMOVE 1,2
CALL TTSMOD
CALL ULKTTY ;ALLOW DEALLOCATION
JRST MRETN
SUBTTL SFPOS JSYS
; Set file position
.SFPOS::MCENT
CALL CHKTTR ;IS THIS A TERMINAL?
MRETNG ; NO, THEN THIS IS A NOOP
CALL CHKTTY ;CAN WE ACCESS THE TERMINAL?
EMRETN () ; NO, SO RETURN ERROR
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;NOT ACTIVE. FAIL
UMOVE 1,2
CALL TTSPOS
CALL ULKTTY ;ALLOW DEALLOCATION
JRST MRETN
SUBTTL SMAP JSYS
;SMAP JSYS - SET USER SECTION MAP
;ACCEPTS:
; T1/ SOURCE I.D.
; (FORK HANDLE,,SECTION NUMBER) TO MAP A FORK'S SECTION
; (JFN,,SECTION NUMBER) TO MAP A FILE'S SECTION
; 0 TO CREATE A PRIVATE SECTION
; -1 TO DELETE A SECTION
; T2/ FORK HANDLE,,SECN OF DESTINATION
; T3/ ACCESS,,COUNT
; SMAP
;RETURNS +1: ALWAYS
;ILLEGAL INSTRUCTION TRAP ON ERROR
;RIGHT HALF OF T2 MUST BE NON-ZERO
;THIS CODE CLEARS THE MAP BEFORE CHECKING THE NEW SOURCE. THEREFORE
;ONE MAY GET AN ERROR AND HAVE THE MAP CLEARED
;USE OF AC'S:
; P3/ NUMBER OF SECTIONS (DECREMENTED IN LOOP)
; P4/ DESTINATION (SPT INDEX OF PSB,,SECTION NO) (INCREMENTED IN LOOP)
; P5/ (JFN,,OFN) OR 0
; Q1/ SECTION NUMBER FOR SOURCE
; Q2/ DESTINATION ID (SPT INDEX OF PSB,,SECTION NO.)
; Q3/ ACCESS,,COUNT FROM USER'S AC 3
.SMAP:: MCENT
CALL CKXADR ;EXT ADDRESSING SUPPORTED?
ITERR () ;no - return error to user
TRVAR <DSTFRK> ;DESTINATION FORKX
DMOVE Q2,T2 ;SAVE DESTINATION AND ACCESS
HRRZ Q1,T1 ;SAVE SECTION # OF SOURCE
;CHECK ARGUMENTS
HRRZS T2 ;GET SECTION # ONLY
SKIPG T2 ;NON-ZERO SECTION?
ITERR (ARGX23) ;NO. ILLEGAL THEN
TRNN T3,-1 ;NON-ZERO COUNT?
ITERR (ARGX24) ;NO. CAN'T DO IT THEN
ADDI T2,-1(T3) ;COMPUTE LAST SECTION USED
CAILE T2,MXSECN ;VALID?
ITERR (ARGX23) ;NO.
UMOVE T1,T1 ;GET THE SOURCE ID
CAMN T1,[-1] ;ARE WE DELETING A SECTIONS?
JRST SMAP0 ;YES
JUMPG T1,SMAP0 ;IF A JFN DONT CHECK SECTION
HRRZS T1 ;ZERO THE LEFT HALF
ADDI T1,-1(T3) ;DETERMINE THE HIGHEST SECTION NUMBER
CAILE T1,MXSECN ;IS IT LEGAL
ITERR (ARGX23) ;NO
;VERIFY DESTINATION PROCESS AND GET SPT INDEX FOR PSB
SMAP0: HLRZ T1,Q2 ;GET FORK HANDLE FOR DESTINATION
CALL FLOCKN ;LOCK THE FORK STRUCTURE, ALLOW NESTING
CALL CSMAPX ;GET SYSTEM-WIDE HANDLE, CHECK EXECUTE ONLY
ITERR (,<CALL FUNLK>) ;ERROR
MOVEM T1,DSTFRK ;SAVE IT FOR SECMAP
LOAD T1,FKPS%,(T1) ;GET SPT INDEX FOR PSB
HRL Q2,T1 ;COMBINE WITH SECTION NUMBER
;..
;DELETE THE CURRENT ENTRIES FOR THESE SECTIONS (IF ANY)
; Q2/ SPT INDEX FOR PSB,,SECTION NUMBER
; Q3/ ACCESS,,COUNT
;..
HRRZ P3,Q3 ;ISOLATE COUNT
MOVE P4,Q2 ;GET PSB,,SECTION NO.
SMAP1: SETZM P5 ;INIT FILE REG
MOVE T1,P4 ;GET PSB,,SEC
CALL CHKMAP ;SEE IF A PRIVATE SECTION
IFNSK.
JUMPE T1,SMAP3 ;IF NO ENTRY, JUMP OFF
SETOM T1 ;PRIVATE SECTION. INDICATE UNMAP
HRRZ T2,P4 ;GET SECTION NUMBER
LSH T2,PGSFT ;MAKE IT PAGE 0 OF THIS SECTION
XCTU [HLL T2,T2] ;GET FORK HANDLE AGAIN
MOVE T3,[PM%CNT+1000] ;THE WHOLE SECTION
PMAP ;CLEAR THE MAP
ERJMP .+1 ;CLEAR THE SECTION POINTER ANYWAY
ENDIF.
MOVE T1,P4 ;GET BACK ARG AGAIN
CALL SECJFN ;SEE IF A JFN
JRST SMAP2 ;NOT
MOVE P5,T1 ;SAVE OFN
HLL P5,T2 ;SAVE JFN
;SECTION IS MAPPED TO ANOTHER PROCESS OR A FILE
;P5/ (JFN,,OFN) OR 0 IF NOT A FILE
SMAP2: SETZM T1 ;SAY DELETE
MOVE T2,P4 ;GET (PSB INDEX,,SECTION NO.)
CALL SECMAP ;CLEAR SECTION
ITERR (,<CALL FUNLK>) ;STILL SHARED
JUMPE P5,SMAP3 ;A FILE?
HLRZ T1,P5 ;GET JFN
MOVX T2,<-2>B17 ;GET DECREMENTER
IMULI T1,MLJFN ;GET INDEX INTO JSB
ADDM T2,FILLFW(T1) ;DISCOUNT THIS MAPPING
SMAP3: ADDI P4,1 ;NEXT I.D.
SOJG P3,SMAP1 ;DO ALL SECTION
;..
;ALL SECTIONS CLEAR. DO NEW MAPPING
;..
UMOVE T1,1 ;GET USER'S SOURCE ARGUMENT
CAMN T1,[-1] ;DELETE ONLY?
JRST SMAP5 ;DONE. SUCCESS
;NOT A DELETE. SEE WHAT WE ARE TRYING TO SMAP TO
HRRZ P3,Q3 ;ISOLATE COUNT
IFL. T1
HLRZS T1 ;GET SOURCE HANDLE
CALL CSMAPX ;CONVERT TO SYSTEM-WIDE HANDLE, CHECK XO
ITERR (,<CALL FUNLK>) ;ERROR
LOAD T2,FKPS%,(T1) ;GET SPT OFFSET FOR PSB
HRL T1,T2 ; INTO LEFT HALF
HRR T1,Q1 ;SOURCE SECTION NUMBER
DMOVE T2,Q2 ;DESTINATION,,DESTINATION SECTION NUMBER
HLLZS T3 ;ACCESS
HRRZ T4,P3 ;COUNT
CALL MSETST ;SETUP THE DESTINATION SECTION TABLE
ITERR (,<CALL FUNLK>)
JRST SMAP5 ;DONE
ENDIF.
TXZ Q3,<<-1B17>^!<PM%RD!PM%WT>> ;ONLY ALLOW READ AND WRITE
IFG. T1
CALL SMFILE ;IF FILE. GO DO IT
ITERR (,<CALL FUNLK>) ;ERROR
JRST SMAP5 ;DONE
ENDIF.
SMAP4: SETOM T1 ;INDICATE PRIVATE SECTION
DMOVE T2,Q2 ;GET ARGUMENTS
TXO T3,PA%WT ;MUST HAVE WRITE
HRR T3,DSTFRK ;DESTINATION FORK
CALL SECMAP ;CREATE PRIVATE SECTION
ITERR (,<CALL FUNLK>)
ADDI Q2,1 ;NEXT SECTION
SOJG P3,SMAP4 ;DO ALL SECTIONS
SMAP5: CALL FUNLK ;DID IT
MRETNG ;AND RETURN
ENDTV.
;ROUTINE TO GET SYSTEM-WIDE HANDLE AND CHECK IF A FORK IS EXECUTE ONLY
;
;ACCEPTS:
; T1/ FORK HANDLE
;
; CALL CSMAPX
;
;RETURNS +1: FORK IS EXECUTE ONLY OR BAD FORK HANDLE
; +2: T1/ SYSTEM-WIDE FORK HANDLE
CSMAPX: HRLZS T1 ;FKH.0
MOVX T2,PM%EPN ;ALWAYS ASKING ABOUT SECTION 0, DON'T CHANGE TO PC SECTION
CALL FKHPTX ;VERIFY FORK HANDLE AND CHECK EXECUTE ONLY
RETBAD () ;BAD FORK HANDLE OR EXECUTE ONLY FORK
HLRZS T1 ;SECTION 0 PAGE TABLE INDEX
HRRZ T1,SPTH(T1) ;SYSTEM WIDE FORK HANDLE OF OWNING FORK
RETSKP ;GOOD RETURN
SUBTTL SMON JSYS
; Set fact switch
;ACCEPTS IN 1/ FUNCTION CODE
; 2/ NEW SETTING
; SMON
; Traps if process hasn't wheel/operator privilege
.SMON:: MCENT
EA.ENT ;[7.1076] Ensure section 1
MOVE C,CAPENB
TXNN C,SC%WHL!SC%OPR
ITERR (SMONX1)
UMOVE T1,1 ;GET FLAG TO BE SET
CAIN T1,.SFRMT ;SETTING REMOTE LOGIN STATUS?
CALL [ SAVET ;YES
XCTU [SKIPE 2] ;DOING ENABLE?
CALLRET DTRMEN ;YES. TELL FE
CALLRET DTRMDS] ;NO. TELL FE
JUMPL T1,SMONER ;FUNCTION CODE MUST BE POSITIVE
CAIL T1,^D36 ;IS IT A BIT IN FACTSW?
JRST SMON2 ;NO, GO CHECK FUNCTION CODE
CAIE T1,.SFNVT ; yes, setting ARPANET logins allowed?
JRST SMON1 ; no, skip this
SETZ T1, ; yes, try ARPA-only JSYS
GTHST ; ..
ERJMP MRETN ; failed, must be non-ARPA monitor
MOVEI T1,.SFNVT ; restore function code
SMON1: IDIVI T1,^D36 ;GET BIT POSITION
MOVX T1,1B0 ;SET UP TO BUILD MASK
MOVNS T2
LSH T1,0(T2) ;GET MASK
XCTU [SKIPE 2] ;SETTING THE BIT?
JRST [ IORM T1,FACTSW ;YES, DO SO
JRST MRETN]
ANDCAM T1,FACTSW ;NO, CLEAR IT
JRST MRETN
SMON2: CAILE T1,^D35+NSMON2 ;IS IT TOO BIG A CODE?
SMONER: ITERR(SMONX2) ;YES, RETURN FAILURE
SUBI T1,^D36 ;SHIFT CODE DOWN BY 36 FOR TABLE
LSH T1,1 ;DOUBLE THE CODE
UMOVE T2,2 ;GET USER'S VALUE FOR THE FUNCTION
SKIPE T2 ;IF ZERO, DO EVEN DISPATCH
TRO T1,1 ;IF NONZERO, DO ODD DISPATCH
XCT SMON2T(T1) ;DO THE FUNCTION
JRST MRETN
;TABLE FOR SMON FUNCTION CODES .GE. 36
SMON2T: JFCL ;CODE 44, VALUE 0
JFCL ;CODE 44, VALUE NON-ZERO
JFCL ;CODE 45, VALUE ZERO
JFCL ;CODE 45, VALUE NON-ZERO
JFCL ;CODE 46, VALUE ZERO
CALL HSTINJ ;CODE 46, VALUE NON-ZERO
MOVEM T2,TIMZON ;CODE 47, VALUE ZERO
MOVEM T2,TIMZON ;CODE 47, VALUE NON-ZERO
JFCL ;CODE 50, VALUE ZERO
JFCL ;CODE 50, VALUE NON-ZERO
SETZM AVALON ;CODE 51, VALUE ZERO
SETOM AVALON ;CODE 51, VALUE NON-ZERO
CALL UNGEN ;CODE 52, ZERO. TURN OFF STATUS REPROTING
CALL GENGEN ;CODE 52, NON-ZERO. ENABLE REPORTING
CALL SGTOK ;CODE 53, VALUE ZERO
CALL SGTOK ;CODE 53, VALUE NON-ZERO
MOVEM T2,TPRCYC ;Code 54, set tape recycle period
MOVEM T2,TPRCYC
MOVEM T2,DIRRDU ;CODE 55, VALUE ZERO SET DIR READ MASK
MOVEM T2,DIRRDU ;CODE 55, NON-ZERO. SET DIR READ MASK
MOVEM T2,ARRCYC ;Code 56, set archive tape recycle period
MOVEM T2,ARRCYC
SETZM NRTWTS ;Code 57, Retrieval waits ok (val 0)
SETOM NRTWTS ;Code 57, no retrieval waits (val non-0)
MOVEM T2,TPMTDF ;CODE 60, SET TAPE-MOUNT DEFAULTS
MOVEM T2,TPMTDF
SETZM PRELDF ;CODE 61, WORKING SET PRELOADING: OFF, ON
SETOM PRELDF
SETZM DSTFLG ;code 62, use automatic DST routines
CALL DSTSET ;code 62, set DST on/off permanently
JFCL ;CODE 63 IS UNUSED AND UNASSIGNED
JFCL ; " " " " " "
JFCL ;CODE 64 VALUE ZERO
CALL MSSMRK ;CODE 64 DO/DON'T SERVICE MSCP REQUESTS
CALL SETSPR ;code 65, value 0 and...
CALL SETSPR ;code 65, value <> 0, set spear entry count
CALL SCOFTI ;CODE 66, SET CARRIER OFF TIME
CALL SCOFTI ; " "
CALL SHNG0F ;CODE 67, SET HANGUP ACTION NOT LOGGED IN
CALL SHNG0F ; " "
CALL SHNG1F ;CODE 70, SET HANGUP ACTION LOGGED IN
CALL SHNG1F ; " "
;SMON2T continues...
MOVEM T2,XECFLG ;CODE 71, SET EXEC FLAGS
MOVEM T2,XECFLG ; " "
CALL SETNIA## ;CODE 72, SET NI ADDRESS
CALL SETNIA## ; " "
CALL DCUNIT ;CODE 73, DON'T CARE UNIT
CALL DCUNIT ;CODE 73, DON'T CARE UNIT
IFN LAHFLG <
CALL SMFLTS ;[8974] (T2/) Code 74, set LAT state
CALL SMFLTS ;[8974] (T2/) Code 74, set LAT state
>;end of IFN LAHFLG
IFE LAHFLG < ;[7.1063]If no LAT
ITERR (ARGX02) ;[7.1063]Return "Invalid function"
ITERR (ARGX02) ;[7.1063]...
>;End if IFE LAHFLG ;[7.1063]
CALLX (XCDSEC,CLRCLU) ;[7.1076] Code 75, enable CLUDGR SYSAP 0=off
CALLX (XCDSEC,SETCLU) ;[7.1076] Code 75, disable CLUDGR SYSAP -1=on
CALLX (XCDSEC,CLRTMG) ;[7.1076] Code 76, enable cluster sendalls 0=off
CALLX (XCDSEC,SETTMG) ;[7.1076] Code 76, disable cluster sendalls -1=on
SETZM TMRINT ;[7.1063]Code 77, offline structures disabled
CALL SETTMR ;[7.1063]Code 77, set structure timer
SETZM LGSFLG ;[7.1112]Code 100, disable Login Structure
SETOM LGSFLG ;[7.1112]Code 100, enable Login Structure
SETZM MINPAS ;[7.1231]Code 101, Disable min password length
CALL SETMPW ;[7.1231]Code 101, Enable min password length
NSMON2==<.-SMON2T>/2 ;MAXIMUM CODE VALUE LESS 36
;[7.1231]
;SETMPW - Routine to set MINPAS, the minimum password length. Only
;non-negative, less than 39 characters are allowed.
;
; Called with:
; T2/ Min password length
; CALL SETMPW
;
; Returns:
; +1 - Always
SETMPW: CAIL T2,1 ;Are we at least 1?
CAILE T2,MAXLC ;How about under the absolute MAX?
ITERR (SMONX4) ;Bad length, return error
MOVEM T2,MINPAS ;Legal value, so stash it
RET ;Done
HSTINJ: CALL HSTINI ;JACKET ROUTINE FOR HSTINI
JFCL ; WHICH HAS A SKIP RETURN
RET
SETZON: MOVEM T2,TIMZON ;STORE VALUE (OR 0)
CALLRET DTTIME ;SEND NEW INFO TO FE
SGTOK: HRRZ T1,T2 ;GET FUNCTION CODE
SKIPN T1 ;CHECK FOR LEGAL
ITERR (SMONX2) ;ILLEGAL FUNCTION
CAIN T1,400000 ;CHECK FOR USER FUNCTION
SETZ T1,0 ;FORCE FUNCTION 0
CAIL T1,MXGOKF ;CHECK FOR LEGAL FUNCTION
ITERR (SMONX2) ;FATAL ERROR ILLEGAL FUNCTION
JUMPGE T2,SGTDIS ;CHECK FOR DISABLE
SKIPN T3,ACJFN ;CHECK FOR ACJ FORK
JRST [ MOVE T3,JOBNO ;SAVE JOB NUMBER
MOVEM T3,ACJJN
MOVE T3,FORKX ;SAVE FORK NUMBER
MOVEM T3,ACJFN
CALL SETACJ ;SET ACJ'S SCHEDULING PRIORITY
JRST SGSET]
CAME T3,FORKX ;THIS THE CORRECT FORK?
ITERR (GOKER3) ;NO YOU CAN'T DO THIS
SGSET: NOINT ;DISABLE INTERRUPTS
LOAD T3,GT%ENB,T2 ;GET THE ENABLES
ADDI T1,GTOKPR
LOAD T4,GTDEF,(T1) ;CHECK FOR ALREADY SETUP
CAIE T4,77
ITERR (SMONX2) ;ILLEGAL FUNCTION
STOR T3,GTENB,(T1)
ANDI T3,37 ;SET DISABLE DEFAULT
STOR T3,GTDEF,(T1)
OKINT
RET ;QUIT
SETACJ: SAVEAC <T1,T2> ;PRESERVE T1,T2
MOVEI T1,.FHSLF ;THE ACJ FORK
MOVEI T2,MFRKWD ;GET THE PRIORITY
SPRIW ;SET IT
RET
SGTDIS: SKIPN T3,ACJFN ;CHECK FOR ACJ FORK
JRST SGNOAC ;NO ACJ FORK ALL OK
CAME T3,FORKX ;CHECK FOR MATCHING FORK
ITERR (GOKER3) ;ILLEGAL FUNCTION
SGNOAC: NOINT ;THEN WE MUST CLEAN QUEUE
CSKED ;DON'T RESCHED
LOCK GOKLCK ;LOCK THE Q
MOVE T3,T1 ;SAVE FUNCTION
ADDI T3,GTOKPR
LOAD T4,GT%ENB,T2 ;GET DISABLES
STOR T4,GTENB,(T3) ;SET NEW DEFAULT
SETONE GTDEF,(T3) ;SET DISABLED DEFAULT
SGTDAB: MOVEI T4,GETOKF ;POINTER TO BEGINNING OF LIST
SGOKL: SKIPN T4,0(T4) ;GET AN ENTRY
JRST SGOKD ;DONE
LOAD T3,GOKFKN,(T4) ;CHECK FUNCTION
TRZ T3,400000 ;REMOVE USER BITS
CAME T3,T1 ;IS IT THIS ONE?
JRST SGOKL ;NO TRY NEXT ONE
SKIPN 1(T4) ;LOOK AT THE PICKED COUNT
SOS GOKQED ;GET QUEUE'D COUNT
MOVEI T3,1 ;ASSUME ALL OK
MOVEM T3,1(T4) ;SET IN DONE FLAG
TLNN T2,(SF%DOK) ;WAS REQUEST OK?
AOS 1(T4) ;NO MAKE IT A FAILURE
JRST SGOKL ;AND TRY NEXT ENTRY
SGOKD: SETZ T1,0 ;START WITH FUNCTION 0
SGOKDL: SKIPGE GTOKPR(T1) ;ANY ENABLED?
JRST SGOKDN
AOS T1
CAIGE T1,MXGOKF ;CHECK FOR MAX FUNCTION
JRST SGOKDL ;NOT DONE YET
SETZM ACJFN ;SET NO ACJ FORK
SETZM ACJJN ;SET NO ACJ JOB NUMBER
SGOKDN: UNLOCK GOKLCK ;UNLOCK THE LOCK
ECSKED ;ALLOW SCHEDULING
OKINT ;ENABLE INTERRUPTS
RET ;AND RETURN
NR (TPMTDF,1) ;TAPE-MOUNT CONTROLS WORD
DSTSET: CAIL T2,.DSTAU
CAILE T2,.DSTAL ;in range?
ITERR (SMONX2) ;no, issue error
MOVEM T2,DSTFLG ;save it.
RET ;return
; SETSPR - CALLED BY SMON% FUNCTION 63 (.SFSPR)
; SHOULD ONLY BE CALLED BY SETSPD AT SYSTEM START-UP, TO REINITIALIZE
; SPRCNT, THE RUNNING COUNT OF SPEAR ENTRIES OUTPUT.
;
; SETSPD READS THE VALUE OF .SPCNT FROM DUMP.EXE AND SMON%'S IT TO HERE,
; WHERE IT IS STORED AS THE COUNT OF SPEAR EVENTS UP TO THIS POINT.
;
; CALL SETSPR
; T2/ WHERE T2 = NEW VALUE OF SPRCNT TO
SETSPR: MOVEM T2,SPRCNT ;STORE NEW VALUE INTO SPRCNT
JUMPN T2,R ;RET IF NON-ZERO
BUG.(INF,SPRZRO,JSYSA,SOFT,<SETSPR - SPRCNT was set to zero>,,<
Cause: SMON% function .SFSPR (Set count of SPEAR entries output) was called
with a value of 0. This indicates that the monitor could not get the
running count of the number of SPEAR entries output from either the
dump file or ERROR.SYS.
SPRCNT is a cell which should contain the running number of SPEAR
entries made in the ERROR.SYS file over the life of the system.
>,,<DB%NND>) ;[7.1210]
RET
;SET NEW TIME OF LOGOUT AFTER CARRIER OFF
SCOFTI: MOVEM T2,COFTIM ;SET NEW HANGUP/LOGOUT TIME
RET
;SET NEW VALUES FOR HANGUP ON LOGOUT
SHNG0F: MOVEM T2,HNGU0F
RET
SHNG1F: MOVEM T2,HNGU1F
RET
;[7.1063]
; SETTMR - Set the offline structures timer value
;
; Accepts in T2: Timer value in seconds
; CALL SETTMR
;
; Returns +1: Success
; Generates an illegal instruction trap if the timer
; value is out of range
MAXTMR==^D900 ;Maximum timer value allowed
SETTMR: SKIPLE T2 ;If less than one second
CAILE T2,MAXTMR ;Or more than MAXTMR
ITERR (SMONX3) ;Then return "out of range"
IMULI T2,^D1000 ;Convert to milliseconds
MOVEM T2,TMRINT ;And save in TMRINT
RET ;Done
SUBTTL SNOOP JSYS
; SNOOP JSYS
;ACCEPTS IN AC1/ FUNCTION CODE
; AC2-AC4/ FUNCTION DEPENDENT ARGUMENTS
; SNOOP
;RETURNS +1: ERROR - ERROR CODE IN T1
; +2: SUCCESSFUL
;SNOOP DATA BASE
REPEAT 0,<
SNPBPP:
+--------------------+--------------------+
!SNPBN: !SNPBL: !
! BREAK POINT # ! LINK TO NEXT BP !
+--------------------+--------------------+
!SNPBTI: !
! INSTRUCTION TO TRANSFER TO BP ROUTINE !
+-----------------------------------------+
!SNPBRI: !
! REPLACED INSTRUCTION FROM MONITOR !
+-----------------------------------------+
!SNPB1: !
! JRST MONADR+1 !
+-----------------------------------------+
!SNPB2: !
! JRST MONADR+2 !
+-----------------------------------------+
!SNPADR: !
! 30 BIT ADDRESS OF BREAKPOINT !
+-----------------------------------------+
+--------------------+--------------------+
SNPPGS: !SNPPC: !SNPPA: !
! # OF PAGES LOCKED ! ADR OF FIRST PAGE !
+--------------------+--------------------+
+--------------------+--------------------+
SNPLST: !SNPFLG: !SNPLNK: !
! BREAK POINT FLAGS ! LINK TO FIRST BP !
+--------------------+--------------------+
>
;SNOOP DATA STRUCTURE DEFINITIONS
DEFSTR (SNPBN,0,17,18) ;BREAK POINT NUMBER
DEFSTR (SNPBL,0,35,18) ;LINK TO NEXT BREAK POINT OF FORK
SNPBP==1 ;WHERE TO JUMP TO ON A BREAK POINT
SNPBII==SNPBP+1 ;INDEX OF REPLACED INSTRUCTION
DEFSTR (SNPBTI,SNPBP,35,36) ;TRANSFER INSTRUCTION TO BP ROUTINE
DEFSTR (SNPBRI,SNPBP+1,35,36) ;REPLACED INSTRUCTION
DEFSTR (SNPB1,SNPBP+2,35,36) ;JRST MONADR+1
MONAD1==SNPBP+2 ;[7.1165] Offset for this word
DEFSTR (SNPB2,SNPBP+3,35,36) ;JRST MONADR+2
MONAD2==SNPBP+3 ;[7.1165] Offset for this word
DEFSTR (SNPADR,SNPBP+4,35,36) ;[7.1165] Address of breakpoint
MONADR==SNPBP+4 ;[7.1165] Offset for this word
SNPBSZ==6 ;LENGTH OF A BREAK POINT BLOCK
DEFSTR (SNPPC,SNPPGS,17,18) ;COUNT OF SNOOP PAGES LOCKED DOWN
DEFSTR (SNPPA,SNPPGS,35,18) ;ADDRESS OF FIRST PAGE LOCKED DOWN
DEFSTR (SNPFLG,SNPLST,17,18) ;BREAK POINT FLAGS FOR THIS FORK
DEFSTR (SNPLNK,SNPLST,35,18) ;LINK TO FIRST BREAK POINT FOR FORK
;BREAK POINT FLAGS IN SNPFLG
SN.BRK==1 ;BREAK POINTS HAVE BEEN INSERTED
SN.SML==2 ;SWAPPABLE MONITOR IS LOCKED DOWN
NR (SNPFTB,1) ;FREE PAGES TABLE *** UP TO 36. PAGES ONLY!
NR (SNPBPC,1) ;COUNT OF USERS USING SNOOP FACILITY
NR (SNPLOK,1) ;LOCK FOR SNOOP DATA BASE
NR (SNPFRE,1) ;FREE LIST FOR BREAK POINTS
RS (SNPCNT,1) ;# OF BREAK POINTS CURRENTLY INSERTED
;SNOOP JSYS DISPATCH ROUTINE
.SNOOP::MCENT ;ENTER THE JSYS
MOVE T2,CAPENB ;GET ENABLED CAPABILITIES
XCTU [HRRZ T1,1] ;GET FUNCTION CODE
CAIN T1,.SNPSY ;IS THIS A SYMBOL LOOKUP?
JRST SNPFN6 ;YES, DONT LOCK UP DATA BASE
CAIN T1,.SNPAD ;IS THIS AN ADDRESS LOOKUP?
JRST SNPFN7 ;YES, GO LOOK IT UP
TRNN T2,SC%WHL!SC%OPR ;IS THE USER PROPERLY PRIVILEGED?
RETERR (SNOPX1) ;NO, GIVE ERROR RETURN
CAIL T1,SNPDTL ;IS THIS A LEGAL FUNCTION
RETERR (SNOPX2) ;NO, GIVE ERROR RETURN
SKIPN SNPPGS ;PAGES ALREADY LOCKED DOWN?
SKIPL SNPDTB(T1) ;NO, SHOULD THEY BE LOCKED DOWN?
SKIPA ;ALL OK
RETERR (SNOPX3) ;PAGES NOT LOCKED AND SHOULD BE!
HRRZ T1,SNPDTB(T1) ;FIND TRANSFER ADDRESS
NOINT ;LOCK UP THE DATA BASE
LOCK SNPLOK ;...
CALL (T1) ;GO DO THE FUNCTION
JRST [ UNLOCK SNPLOK ;ERROR DURING FUNCTION
OKINT ;UNLOCK LOCKS
RETERR ()] ;AND GIVE ERROR RETURN TO USER
UNLOCK SNPLOK ;OK RETURN
OKINT ;UNLOCK
SMRETN ;GIVE USER THE SKIP RETURN
SNPDTB: SNPFN0 ;DECLARE CODE AND LOCK INTO MONITOR
400000,,SNPFN1 ;LOCK DOWN SWAPPABLE MONITOR
400000,,SNPFN2 ;DEFINE A BREAK POINT
400000,,SNPFN3 ;INSERT ALL BREAK POINTS
400000,,SNPFN4 ;REMOVE ALL BREAK POINTS
SNPFN5 ;REMOVE ALL BP'S AND UNLOCK EVERYTHING
SNPDTL==.-SNPDTB
;SNOOP JSYS FUNCTION 0 - DECLARE CODE AND LOCK INTO MONITOR VIRT MEMORY
SNPFN0: STKVAR <SNPF0C,SNPF0S,SNPF0D>
SKIPE SNPPGS ;USER ALREADY LOCKED DOWN SOME PAGES?
RETBAD (SNOPX4) ;YES, THEN THIS IS ILLEGAL
MOVE T1,FORKX ;GET OUR FORK NUMBER
LOAD T1,FKUP%,(T1) ;GET SPT INDEX OF SECTION 0 MAP
HRLZS T1 ; INTO LEFT HALF
XCTU [HRR T1,3] ;GET PAGE NUMBER OF DATA
TRNE T1,777000 ;IS THIS A LEGAL PAGE #?
RETBAD (SNOPX5) ;NO
MOVEM T1,SNPF0S ;SAVE SOURCE IDENTIFIER
XCTU [HRRZ T2,2] ;GET COUNT OF PAGES TO BE LOCKED
JUMPE T2,[RETBAD (SNOPX6)] ;ZERO PAGES IS NOT ALLOWED
MOVEM T2,SNPF0C ;SAVE IT FOR LATER
CALL VALPAG ;VALIDATE THAT PAGES ARE PRIVATE
RET ;ILLEGAL PAGE ACCESS
MOVE T1,SNPF0C ;GET COUNT OF PAGES DESIRED
CALL SNPFFP ;FIND A CONSEQUTIVE BLOCK OF FREE PAGES
RET ;NOT ENOUGH FREE PAGES
STOR T1,SNPPA ;STORE START ADR OF LOCKED PAGES
MOVE T2,SNPF0C ;GET NUMBER OF PAGES TO BE LOCKED
STOR T2,SNPPC ;REMEMBER HOW MANY WERE LOCKED
CALL SNPASP ;ASSIGN THESE PAGES FOR US
LOAD T2,SNPPA ;GET MONITOR VIRTUAL PAGE NUMBER AGAIN
MOVEM T2,SNPF0D ;SAVE DESTINATION IDENTIFIER
MOVE T1,SNPF0S ;GET SOURCE IDENTIFIER
XCTU [HRRZM T2,2] ;RETURN MONITOR ADDRESS TO USER
SNPF0A: TRZ T1,777000 ;GUARANTEE A LEGAL PAGE #
LSH T2,PGSFT ;GET ADDRESS FROM PAGE #
HRLI T2,(PM%RD!PM%WT!PM%EX)
CALL SETIOP ;LOCK IT INTO MONITOR
BUG.(CHK,SNPLKF,JSYSA,SOFT,<SNPFN0 - Cannot lock down page into monitor>,,<
Cause: The .SNPLC function of the SNOOP JSYS was trying to lock pages from the
user address space into the monitor address space. It called the
SETIOP routine in PAGEM to do this, and SETIOP returned +1 indicating
failure.
Action: If this BUGCHK is reproducible, set this bug dumpable and submit an SPR
along with the dump along with instructions on reproducing the problem.
>)
AOS T1,SNPF0S ;GET NEXT SOURCE IDENTIFIER
AOS T2,SNPF0D ;GET NEXT DESTINATION IDENTIFIER
SOSLE SNPF0C ;ANY MORE TO BE DONE?
JRST SNPF0A ;YES, GO LOCK OTHER PAGES
AOSE SNPBPC ;IS BREAK POINT PAGE LOCKED DOWN YET?
RETSKP ;YES, DONT LOCK AGAIN
MOVEI T1,SNPBPP ;GET PAGE ADDRESS OF BREAK POINT PAGE
LSH T1,-PGSFT ;GET PAGE NUMBER
HRL T1,MMSPTN ;SET UP PTN,,PN FOR LOCKING
CALL MLKPG ;LOCK DOWN BREAK POINT PAGE
RETSKP ;GIVE OK RETURN TO USER
;ROUTINE TO VALIDATE THAT ALL PAGES TO BE LOCKED ARE PRIVATE OR CPW
;ACCEPTS IN T1/ IDENTIFIER FOR USER PAGES
; T2/ COUNT OF PAGES
; CALL VALPAG
;RETURNS +1: ILLEGAL PAGE TYPE
; +2: OK
VALPAG: STKVAR <VALPGI,VALPGC>
MOVEM T1,VALPGI ;SAVE IDENTIFIER
MOVEM T2,VALPGC ;AND COUNT
VALPG1: MOVE T1,VALPGI ;GET IDENTIFIER OF NEXT PAGE
CALL MRPACS ;GET PAGE ACCESS BITS
TLNN T1,(1B9!1B10) ;PRIVATE OR COPY ON WRITE?
RETBAD (SNOP18) ;NO, GIVE ERROR RETURN TO USER
HRRZ T1,VALPGI ;GET ADDRESS OF PAGE
HRRI T2,1(T1) ;STEP TO NEXT PAGE
HRRM T2,VALPGI ;...
LSH T1,PGSFT ;MAKE PAGE # INTO ADDRESS
XCTU [MOVES 0(T1)] ;WRITE INTO PAGE TO MAKE IT PRIVATE
SOSLE VALPGC ;ANY MORE TO BE DONE?
JRST VALPG1 ;YES, GO TEST OTHER PAGES
RETSKP ;NO, ALL DONE
;SNOOP JSYS FUNCTION 1 - LOCK DOWN THE SWAPPABLE MONITOR
SNPFN1: LOAD T1,SNPFLG ;GET FLAGS FOR THIS FORK
TROE T1,SN.SML ;IS IT ALREADY LOCKED DOWN?
RETSKP ;YES, DONT DO IT AGAIN
STOR T1,SNPFLG ;NO, STORE UPDATED FLAGS
CALL SWPMLK ;LOCK DOWN SWAPPABLE MONITOR
RETSKP ;GIVE OK RETURN
;SNOOP JSYS FUNCTION 2 - DEFINE A BREAK POINT
SNPFN2: STKVAR <SNPF2N,SNPF2I,SNPF2A>
LOAD T1,SNPFLG ;GET SNOOP FLAGS FOR THIS FORK
TRNE T1,SN.BRK ;ARE THE BREAK POINTS INSERTED?
RETBAD (SNOPX7) ;YES, GIVE ERROR RETURN
UMOVE T1,2 ;GET BREAK POINT NUMBER
MOVEM T1,SNPF2N ;SAVE BREAK POINT NUMBER
CALL SNPBPR ;RELEASE THIS BREAK POINT
UMOVE T4,4 ;GET TRANSFER INSTRUCTION FROM USER
JUMPE T4,RSKP ;IF NO INST, THEN EXIT
MOVEM T4,SNPF2I ;SAVE INSTRUCTION FOR LATER
UMOVE T4,3 ;GET ADDRESS IN MONITOR
MOVEM T4,SNPF2A ;SAVE ADDRESS FOR LATER ALSO
MOVE T1,0(T4) ;GET INSTRUCTION
MOVE T2,1(T4) ;AND INSTRUCTION+1
TLNE T1,777000 ;IS THIS INST 0?
TLNN T2,777000 ;OR THIS ONE?
RETBAD (SNOPX8) ;YES, THIS IS NOT LEGAL PLACE FOR BP
MOVEI T1,SNPBPP ;NOW CHECK IF A BP ALREADY ON THIS LOC
MOVEI T2,SNPBPS/SNPBSZ ;GET # OF POSSIBLE BP'S
SNPF2L: LOAD T3,SNPADR,(T1) ;[7.1165] Get address of BP
JUMPE T3,SNPF2D ;IF 0, THEN NO BP DEFINED HERE
CAMN T3,T4 ;[7.1165] Same as one being defined?
RETBAD (SNOP17) ;YES, 2 BP'S ON SAME ADR IS ILLEGAL
SNPF2D: MOVEI T1,SNPBSZ(T1) ;STEP TO NEXT BP
SOJG T2,SNPF2L ;LOOP BACK UNTIL ALL BP'S ARE CHECKED
HRRZ T1,SNPFRE ;GET POINTER TO FIRST FREE BP
JUMPE T1,[RETBAD (SNOPX9)] ;IF 0, THEN NONE LEFT
LOAD T2,SNPBL,(T1) ;GET POINTER TO SECOND FREE BP
HRRM T2,SNPFRE ;MAKE FREE LIST POINT TO 2ND BP
MOVE T3,SNPF2N ;GET BREAK POINT NUMBER
STOR T3,SNPBN,(T1) ;SAVE BREAK POINT NUMBER
LOAD T3,SNPLNK ;GET POINTER TO USER'S 1ST BP
STOR T3,SNPBL,(T1) ;PUT NEW BP AT START OF LIST
STOR T1,SNPLNK ;...
MOVE T2,SNPF2A ;GET ADDRESS TO BE PATCHED AGAIN
MOVE T3,0(T2) ;GET INSTRUCTION BEING REPLACED
STOR T3,SNPBRI,(T1) ;AND REPLACED INSTRUCTION
MOVE T4,SNPF2I ;GET BACK INSTRUCTION FROM USER
STOR T4,SNPBTI,(T1) ;STORE TRANSFER INSTRUCTION
STOR T2,SNPADR,(T1) ;[7.1165] Save breakpoint address
AOS T2 ;[7.1165] Go back at BP+1
STOR T2,SNPB1,(T1) ;[7.1165] Store transfer address
AOS T2 ;[7.1165] Get address of next instruction
STOR T2,SNPB2,(T1) ;[7.1165] And put it in breakpoint block
;[7.1165]
;Nota bene - The breakpoint block only contains the 30 bit address of
;where we should jump to after we execute breakpoint instructions. The
;following overwrites the section number of the address to jump back
;to with a "JRST". This is OK as breakpoints are hit from any section
;and JRSTs use 18 bit addresses. This can be done from sections 0, 1,
;or 6 as they have breakpoints mapped through each section.
MOVSI T3,(JRST) ;[7.1165] Make legal instruction in BP
HLLM T3,MONAD1(T1) ;[7.1165] Put OP code in breakpoint
HLLM T3,MONAD2(T1) ;[7.1165] Don't forget second instruction
RETSKP ;GIVE OK RETURN
;ROUTINE TO RETURN A BREAK POINT TO FREE POOL
;ACCEPTS IN T1/ BREAK POINT NUMBER OR -1 FOR ALL BREAK POINTS
; CALL SNPBPR
;RETURNS +1: ALWAYS
SNPBPR: MOVEI T2,SNPLST ;SET UP TO GET FIRST BP ON LIST
SNPBR1: MOVE T4,T2 ;SAVE LAST POINTER
LOAD T2,SNPBL,(T2) ;GET NEXT BP ON LIST
JUMPE T2,R ;IF 0, BP WAS NOT FOUND
LOAD T3,SNPBN,(T2) ;GET NUMBER OF THIS BP
CAME T1,T3 ;A MATCH?
JUMPG T1,SNPBR1 ;NO, LOOP BACK TIL ONE FOUND
LOAD T3,SNPBL,(T2) ;GET FORWARD POINTER
STOR T3,SNPBL,(T4) ;PUT IT IN LAST BP FORWARD POINTER
HRRZ T3,SNPFRE ;GET FIRST FREE BP
HRRM T2,SNPFRE ;PUT THIS BP ON FREE LIST
STOR T3,SNPBL,(T2) ;MAKE THIS BP POINT TO OTHER FREE BP'S
MOVEI T3,0 ;CLEAR OUT JRST A+1 WORD
STOR T3,SNPB1,(T2) ; TO FLAG THAT BP IS ON FREE LIST
JRST SNPBPR ;LOOP BACK UNTIL ALL BP'S SCANNED
;SNOOP JSYS FUNCTION 3 - INSERT BREAK POINTS
SNPFN3: LOAD T1,SNPFLG ;GET FLAGS
TROE T1,SN.BRK ;BREAK POINTS INSERTED YET?
RETBAD (SNOP10) ;YES, ERROR
STOR T1,SNPFLG ;NO, STORE UPDATED FLAGS
CALL SWPMWE ;WRITE ENABLE THE SWAPPABLE MONITOR
LOAD T1,SNPLNK ;GET POINTER TO FIRST BP OF USER
SNPF3A: JUMPE T1,SNPF3B ;0 MEANS AT END OF BP LIST
LOAD T2,SNPADR,(T1) ;[7.1165] Get address of where to put BP
MOVE T3,(T2) ;[7.1165] Get instruction being replaced
CAME T3,SNPBII(T1) ;IS IT SAME AS ORIGINAL
BUG.(INF,SNPIC,JSYSA,SOFT,<SNPFN3 - Instruction being replaced has changed>,,<
Cause: The instruction being replaced by a SNOOP% breakpoint via SNOOP%
function .SNPIB is not the same instruction that was at that location
when the SNOOP% breakpoint was defined by function .SNPDB.
Action: No action is required. The new instruction is being replaced.
>)
MOVSI T3,(JRST) ;SET UP JRST BP INSTRUCTION
HRRI T3,SNPBP(T1) ;GET ADDRESS OF BP CODE
MOVEM T3,(T2) ;[7.1165] Insert the breakpoint
AOS SNPCNT ;COUNT UP # OF BP'S INSERTED
LOAD T1,SNPBL,(T1) ;GET POINTER TO NEXT BP
JRST SNPF3A ;LOOP BACK TIL ALL BP'S ARE INSERTED
SNPF3B: CALL SWPMWP ;WRITE PROTECT THE SWAPPABLE MONITOR
RETSKP ;GIVE OK RETURN
;SNOOP JSYS FUNCTION 4 - REMOVE ALL BREAK POINTS
SNPFN4: LOAD T1,SNPFLG ;GET FLAGS
TRZN T1,SN.BRK ;WERE BP'S INSERTED
RETBAD (SNOP11) ;NO, GIVE ERROR RETURN
STOR T1,SNPFLG ;STORE UPDATED FLAGS
CALL SWPMWE ;WRITE ENABLE SWAPPABLE MONITOR
LOAD T1,SNPLNK ;GET LINK TO FIRST BP
SNPF4A: JUMPE T1,SNPF4B ;0 MEANS END OF LIST
LOAD T2,SNPBRI,(T1) ;GET REPLACED INSTRUCTION
LOAD T3,SNPADR,(T1) ;[7.1165] Get address of replaced instruction
MOVEM T2,(T3) ;[7.1165] Put back instruction
SETZM MONADR(T1) ;[7.1165] Indicate breakpoint is gone
SOSGE SNPCNT ;COUNT DOWN # OF BP'S INSERTED
JRST SNPF4C ;OVERLY DECREMENTED
SNPF4D: LOAD T1,SNPBL,(T1) ;GET POINTER TO NEXT BP IN LIST
JRST SNPF4A ;LOOP BACK TIL ALL BP'S ARE REMOVED
SNPF4B: CALL SWPMWP ;WRITE PROTECT THE SWAPPABLE MON AGAIN
RETSKP ;AND EXIT
SNPF4C: BUG.(CHK,SNPODB,JSYSA,SOFT,<SNPF4C - Count of inserted break points overly decremented>,,<
Cause: The .SNPRB function of the SNOOP JSYS was removing breakpoints, and the
number of breakpoints in the linked list was greater than the
breakpoint count.
Action: If this BUGCHK is reproducible, set this bug dumpable and submit an SPR
along with the dump along with instructions on reproducing the problem.
>)
SETZM SNPCNT ;FIX UP COUNT
JRST SNPF4D ;AND CONTINUE ON
;SNOOP JSYS FUNCTION 5 - RELEASE ALL STORAGE
SNPFN5: STKVAR <SNPF5C,SNPF5D>
SKIPN SNPPGS ;PAGES LOCKED DOWN?
RETSKP ;NO, THEN NOTHING TO DO
LOAD T1,SNPFLG ;GET FLAGS
TRNE T1,SN.BRK ;BREAK POINTS IN?
CALL SNPFN4 ;YES, REMOVE THEM
JFCL
SETO T1, ;RELEASE ALL BREAK POINTS
CALL SNPBPR ; BACK TO FREE POOL
LOAD T1,SNPPC ;GET NUMBER OF PAGES TO UNLOCK
MOVEM T1,SNPF5C ;SAVE COUNT
LOAD T2,SNPPA ;GET MONITOR VIRTUAL PAGE NUMBER
MOVEM T2,SNPF5D ;SAVE DESTINATION IDENTIFIER
JUMPLE T1,SNPF5B ;IF NONE LOCKED, DONT UNLOCK ANY
SNPF5A: MOVEI T1,0 ;0 MEANS UNLOCK
LSH T2,PGSFT ;CREATE AN ADDRESS FROM THE PAGE #
HRLI T2,(PM%RD!PM%WT!PM%EX)
CALL SETIOP ;UNLOCK PAGES
BUG.(CHK,SNPUNL,JSYSA,SOFT,<SNPF5A - Cannot unlock SNOOP page>,,<
Cause: The .SNPUL function of the SNOOP JSYS received a failure return from
the SETIOP routine in PAGEM while trying to unlock a page that was
locked with the .SNPLC function.
Action: If this BUGCHK is reproducible, set this bug dumpable and submit an SPR
along with the dump along with instructions on reproducing the problem.
>)
AOS T2,SNPF5D ;UPDATE DESTINATION
SOSLE SNPF5C ;ANY MORE PAGES TO BE DONE?
JRST SNPF5A ;LOOP BACK FOR ALL PAGES
LOAD T1,SNPPA ;NOW RELEASE SNOOP DATA PAGES
LOAD T2,SNPPC
CALL SNPRLP ;FOR OTHERS TO USE
SNPF5B: SETZM SNPPGS ;FLAG THAT NO PAGES ARE LOCKED
LOAD T1,SNPFLG ;GET FLAGS BACK
TRNE T1,SN.SML ;DID THIS USER LOCK SWAPPABLE MONITOR?
CALL SWPMUL ;YES, UNLOCK IT
SOSL SNPBPC ;ANY OTHER USERS OF SNOOP?
RETSKP ;NO
MOVEI T1,SNPBPP ;GET ADR OF SNOOP BP PAGE
LSH T1,-PGSFT ;MAKE IT A PAGE NUMBER
HRL T1,MMSPTN ;GET PTN OF MONITOR MAP
CALL MULKPG ;UNLOCK THE BP PAGE
RETSKP ;AND EXIT
;SNOOP JSYS FUNCTIONS 6 AND 7 - SYMBOL TABLE LOOKUPS. AC USAGE:
; Q1 - VALUE OF A SYMBOL THAT SEARCH FOUND
; Q2 - NUMBER-1 OF MATCHES FOUND
; Q3 - QUANTITY TO SEARCH FOR (SYMBOL OR VALUE)
; P1 - VALUE OF A SYMBOL RETURNED BY NXTSYM
; P2 - FLAG FOR WHAT WE ARE SEARCHING FOR
; P3 - SYMBOL WHOSE VALUE IS IN Q1
SNPFN7: TDZA P2,P2 ;REMEMBER WE ARE TO FIND SYMBOL FOR VALUE
SNPFN6: MOVEI P2,1 ;REMEMBER WE ARE TO FIND VALUE OF SYMBOL
TRNN T2,SC%WHL!SC%OPR!SC%MNT ;HAVE PRIVILEGES?
RETERR (SNOPX1) ;NO, LOSE
IFN FTNSPSRV <
MOVE P3,.JBSYM ;SYMTAB PTR
SKIPL P3 ;MAKE SURE IT LOOKS REASONABLE
RETERR (SNOP14) ;NO, SAY NO SUCH SYMBOL
>
IFE FTNSPSRV < ;[6.1]
MOVE P3,PDVSYM ;Point to defined symbols symbol block
>
TRVAR <SYMLOC,SYMCNT> ;ALLOCATE STORAGE
SETO Q2, ;INITIALIZE COUNT OF MATCHES
UMOVE Q3,2 ;GET USER'S ARGUMENT
IFN FTNSPSRV <
HLRO T1,P3 ;GET LENGTH OF SYMBOL TABLE
MOVMS T2,T1 ;MAKE POSITIVE IN BOTH ACS
>
IFE FTNSPSRV <
LDB T1,[POINTR .STLEN(P3),SY%LEN] ;Get length of table
MOVE T2,T1 ;Move to T2 as well
>
LSH T1,-1 ;CONVERT TO NUMBER OF SYMBOLS
MOVEM T1,SYMCNT ;SET COUNT
IFN FTNSPSRV <
HRRZ T1,P3 ;GET FIRST LOCATION OF SYMBOLS
ADD T1,T2 ;ADD TO GET LAST SYMBOL ADDRESS + 1
HLL T1,MONEDV+.EDSEC ;INCLUDE SYMTAB SECTION
>
IFE FTNSPSRV <
MOVE T1,.STPTR(P3) ;Get start address of symbols
ADD T1,T2 ; and add to get last symbol address + 1
>
MOVEM T1,SYMLOC ;INITIALIZE SYMLOC
XCTU [SKIPE Q1,3] ;DID HE SUPPLY A PROGRAM NAME?
CALL NAMSRC ;YES, RESET STUFF TO ONLY LOOK THERE
CALL @[ IFIW FNDSYM ;CALL RETURN A SYMBOL ROUTINE
IFIW FNDVAL](P2) ;OR CALL RETURN A VALUE ROUTINE
SMRETN ;SKIP RETURN
;HERE TO SEARCH FOR THE RIGHT MODULE NAME, AND RESTRICT OUR SEARCH
;TO ONLY THAT MODULE. NAME IS IN AC Q1.
NAMSRC: TLNE Q1,740000 ;MAKE SURE THIS IS A MODULE NAME
RETERR(SNOP12) ;ERROR IF NOT
NAMSRL: CALL NXTSYM ;GET NEXT SYMBOL PAIR
RETERR (SNOP13) ;NO MORE, PROGRAM NAME NOT FOUND
TLNE T1,740000 ;IS THIS A PROGRAM NAME?
JRST NAMSRL ;NO, SOMEBODY IS CONFUSED, KEEP GOING
HLRE T2,P1 ;GET NEGATIVE LENGTH OF THIS SYMBOL MODULE
CAMN T1,Q1 ;HAVE WE FOUND THE RIGHT NAME YET?
JRST NAMSDN ;YES, GO FINISH UP
JUMPE T2,NAMSRL ;IF NO LENGTH KEEP LOOKING
ADDI T2,2 ;ACCOUNT FOR MODULE NAME ENTRY
ADDM T2,SYMLOC ;DECREMENT ADDRESS BY SIZE OF MODULE
ASH T2,-1 ;GET HOW MANY SYMBOLS THAT IS
ADDM T2,SYMCNT ;UPDATE NUMBER OF SYMBOLS LEFT
JRST NAMSRL ;LOOK AT NEXT PROGRAM NAME
NAMSDN: JUMPE T2,R ;IF LAST MODULE SEARCH REST OF TABLE
ADDI T2,2 ;ACCOUNT FOR MODULE NAME
MOVM T2,T2 ;GET POSITIVE SIZE OF MODULE
LSH T2,-1 ;CONVERT TO NUMBER OF SYMBOLS
CAMGE T2,SYMCNT ;FEWER SYMBOLS THAN REST OF SYMBOL TABLE?
MOVEM T2,SYMCNT ;YES, ONLY SEARCH THE MODULE
RET ;RETURN
;HERE TO DO THE WORK OF SEARCHING FOR A SYMBOL, AND RETURNING ITS VALUE.
FNDVAL: TLZ Q3,740000 ;CLEAR TYPE BITS FROM SYMBOL
FNDVLL: CALL NXTSYM ;READ NEXT SYMBOL PAIR
JRST FNDVDN ;NO MORE SYMBOLS
TLZE T1,740000 ;SEE IF PROGRAM NAME AND CLEAR TYPE BITS
CAME T1,Q3 ;THE SYMBOL WE ARE LOOKING FOR?
JRST FNDVLL ;NO, LOOK SOME MORE
EXCH P1,Q1 ;SAVE VALUE
AOJE Q2,FNDVLL ;IF FIRST MATCH, LOOK SOME MORE
CAME P1,Q1 ;ANOTHER MATCH, SAME VALUE?
RETERR (SNOP16) ;NO, MULTIPLY DEFINED SYMBOL
JRST FNDVLL ;SAME VALUE, THAT IS OK
FNDVDN: SKIPGE Q2 ;FIND THE SYMBOL?
RETERR (SNOP14) ;NOT FOUND
UMOVEM Q1,2 ;YES, RETURN THE VALUE
RET ;RETURN
;HERE TO DO THE WORK OF SEARCHING FOR A VALUE, AND RETURNING A SYMBOL.
FNDSYM: MOVSI Q1,400000 ;INITIALIZE TO MOST NEGATIVE NUMBER
FNDSYL: CALL NXTSYM ;READ NEXT SYMBOL PAIR
JRST FNDSDN ;NO MORE
CAMG P1,Q3 ;IS SYMBOL VALUE LESS THAN GIVEN ONE?
CAMGE P1,Q1 ;AND CLOSER THAN OLD BEST?
JRST FNDSYL ;NO, KEEP LOOKING
TLNE T1,740000 ;IS THIS A PROGRAM NAME?
TLNE T1,(1B0) ;OR IS THE SYMBOL SUPPRESSED?
JRST FNDSYL ;YES, DON'T CONSIDER IT
MOVE P3,T1 ;SAVE BETTER SYMBOL
MOVE Q1,P1 ;AND ITS VALUE
AOJA Q2,FNDSYL ;KEEP LOOKING
FNDSDN: SKIPGE Q2 ;FIND ANY SYMBOL?
RETERR (SNOP14) ;NONE FOUND
UMOVEM P3,2 ;YES, GIVE USER THE SYMBOL NAME
SUB Q3,Q1 ;GET DIFFERENCE FROM GIVEN VALUE
UMOVEM Q3,3 ;STORE OFFSET TOO
RET ;RETURN
;ROUTINE TO RETURN THE NEXT SYMBOL PAIR FROM THE SYMBOL TABLE.
;RETURNS +1: NO MORE SYMBOLS
; +2: SYMBOL IN T1, VALUE IN P1
NXTSYM: SOSGE SYMCNT ;MORE SYMBOLS?
RET ;NO, NON-SKIP RETURN
SOS T1,SYMLOC ;DECREMENT ADDRES
MOVE P1,(T1) ;GET VALUE OF SYMBOL
SOS T1,SYMLOC ;DECREMENT AGAIN
MOVE T1,(T1) ;GET SYMBOL NAME
RETSKP ;AND SKIP
;SNOOP JSYS UTILITY ROUTINES
;ROUTINE TO RELEASE ALL SNOOP RESOURCES ON A RESET JSYS
; CALL SNPREL
;RETURNS +1 ALWAYS
SNPREL::NOINT ;LOCK UP THE LOCKS
LOCK SNPLOK ;...
CALL SNPFN5 ;GO RELEASE ALL RESOURCES
JFCL
UNLOCK SNPLOK ;UNLOCK THE DATA BASE
OKINT
RET ;AND RETURN
;ROUTINE TO FIND CONSECUTIVE FREE PAGES FOR USER CODE TO BE LOCKED INTO
;ACCEPTS IN T1/ COUNT OF PAGES DESIRED
; CALL SNPFFP
;RETURNS +1: NO FREE SPACE LEFT, ERROR CODE IN T1
; +2: SUCCESSFUL - PAGE # OF FIRST PAGE IN T1
SNPFFP: STKVAR <SNPFFC,SNPFFM>
MOVEM T1,SNPFFC ;SAVE COUNT
CAILE T1,SNPDPC ;IS THIS REQUEST REASONABLE?
JRST SNPFF4 ;NO, NOT ENOUGH SNOOP PAGES
MOVEI T1,SNPDAT ;GET START OF DATA AREA
LSH T1,-PGSFT ;TURN IT INTO A PAGE NUMBER
MOVEI T2,SNPDPC(T1) ;GET END OF DATA AREA+1
SUB T2,SNPFFC ;CALCULATE END OF SEARCH VALUE
MOVEM T2,SNPFFM ;SAVE CUT OFF POINT
SETZB T3,T4 ;INITIALIZE ACS FOR SEARCH
MOVSI T2,400000 ;START AT BIT 0 OF FIRST WORD IN TABLE
SNPFF1: AOS T4 ;KEEP TRACK OF PAGES SCANNED
TDNN T2,SNPFTB(T3) ;IS THIS PAGE AVAILABLE?
JRST SNPFF3 ;NO, GO INIT COUNTERS
CAML T4,SNPFFC ;SEEN ENOUGH FREE PAGES YET?
RETSKP ;YES, RETURN TO CALLER
SNPFF2: ROT T2,-1 ;SHIFT BIT TO NEXT POSITION
JUMPG T2,SNPFF1 ;LOOP BACK FOR REST OF COUNT
AOJA T3,SNPFF1 ;JUST MOVED TO NEXT WORD, INC INDEX
SNPFF3: ADD T1,T4 ;UPDATE POINTER TO FIRST FREE PAGE
SETZ T4, ;START COUNTER OVER AT 0
CAMG T1,SNPFFM ;IS THE SEARCH FINISHED?
JRST SNPFF2 ;NO, GO SEARCH SOME MORE
SNPFF4: RETBAD (SNOP15) ;YES, NO ROOM TO LOCK PAGES INTO
;ROUTINE TO ASSIGN AND RELEASE PAGES IN SNOOP POOL
;ACCEPTS IN T1/ PAGE NUMBER OF FIRST PAGE IN GROUP
; T2/ NUMBER OF PAGES IN GROUP
; CALL SNPASP OR SNPRLP
;RETURNS +1: ALWAYS
SNPASP: SKIPA T4,[ANDCAM T3,SNPFTB(T1)]
SNPRLP: MOVE T4,[IORM T3,SNPFTB(T1)]
STKVAR <SNPARC>
MOVEM T2,SNPARC ;SAVE NUMBER OF PAGES IN GROUP
MOVEI T2,SNPDAT ;GET START OF DATA AREA
LSH T2,-PGSFT ;TURN IT INTO A PAGE NUMBER
SUB T1,T2 ;GET A RELATIVE PAGE NUMBER
IDIVI T1,^D36 ;GET INDEX INTO TABLE
MOVNS T2 ;GET NEGATIVE BIT POSITION FOR SHIFT
MOVSI T3,400000 ;START AT BIT 0
LSH T3,0(T2) ;GET FIRST BIT TO BE SET OR CLEARED
SNPAR1: XCT T4 ;SET OR CLEAR THE BIT
ROT T3,-1 ;MOVE TO NEXT BIT
SKIPG T3 ;TIME TO INCREMENT INDEX?
AOS T1 ;YES
SOSLE SNPARC ;DECREMENT COUNT
JRST SNPAR1 ;LOOP BACK FOR ALL BITS
RET ;ALL DONE
;ROUTINE TO INITIALIZE THE SNOOP FUNCTION AND DATA BASE
; CALL SNPINI
;RETURNS +1 ALWAYS
SNPINI::SETZM SNPBPP ;ZERO BREAK POINT PAGE
MOVE T1,[SNPBPP,,SNPBPP+1]
BLT T1,SNPBPP+SNPBPS-1
MOVEI T1,SNPBPP ;GET POINTER TO FIRST BP BLOCK
MOVEM T1,SNPFRE ;SET UP FREE LIST
MOVEI T2,SNPBPS/SNPBSZ ;GET MAX NUMBER OF BREAK POINTS
SNPIN1: MOVEI T3,SNPBSZ(T1) ;GET ADDRESS OF NEXT BREAK POINT
MOVEM T3,0(T1) ;MAKE THIS BP POINT TO NEXT BP
MOVE T1,T3 ;STEP TO NEXT BP
SOJG T2,SNPIN1 ;LOOP TIL ALL BP'S LINKED
SETZM -SNPBSZ(T1) ;PUT A ZERO AT END OF LIST
SETOM SNPFTB ;NOW INIT FREE PAGES TABLE
MOVE T1,[SNPFTB,,SNPFTB+1]
MOVEI T2,<<SNPDPC+^D35>/^D36>
CAILE T2,1 ;ONLY ONE WORD TABLE?
BLT T1,SNPFTB-1+<<SNPDPC+^D35>/^D36>
SETOM SNPBPC ;INIT COUNT OF SNOOP USERS
SETZM SNPCNT ;INITIALIZE COUNT OF INSERTED BP'S
SETOM SNPLOK ;INIT SNOOP DATA BASE LOCK
RET ;AND EXIT
SUBTTL SOBE JSYS
;SOBE - Skip if output buffer is empty
;ACCEPTS:
; DEVICE DESIGNATOR
; SOBE
;RETURNS +1: OUTPUT BUFFER IS NOT EMPTY
; T2/ NUMBER OF BYTES IN BUFFER
; +2: OUTPUT BUFFER IS EMPTY OR ERROR
; T2/ 0 IF EMPTY, OR ERROR CODE
; ERJMP/ERCAL IS RECOGNIZED.
.SOBE:: MCENT
CALL CHKTTR
JRST SOBE1
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
JRST [ CALL ULKTTY ;NOT ACTIVE. ALLOW DEALLOCATION
MOVEI A,TTYX01 ;SET ERROR TO 'LINE IS NOT ACTIVE'
JRST SOBE1] ;GO RETURN ERROR CODE
CALL TTSOBE
JRST [ UMOVEM A,2 ;STORE COUNT OF CHARS IN BUFFER
CALL ULKTTY ;ALLOW DEALLOCATION
MRETNG]
CALL ULKTTY ;ALLOW DEALLOCATION
XCTU [SETZM 2] ;INDICATE NO CHARS IN BUFFER
SMRETN ;SKIP RETURN
;HARD ERROR
SOBE1: MOVEM T1,LSTERR ;SAVE ERRORS IN LSTERR
CALL TSTERJ ;ERJMP/ERCAL PRESENT?
UMOVEM T1,B ;NO, RETURN ERROR CODE
SMRETN
SUBTTL SOBF JSYS
; Skip if output buffer full
;ACCEPTS:
; DEVICE DESIGNATOR
; SOBF
;RETURNS +1: OUTPUT BUFFER IS NOT FULL OR ERROR
; T2/ NUMBER OF BYTES IN BUFFER
; OR
; 0 IF ERROR
; +2: ERROR OR OUTPUT BUFFER IS FULL
; T2/ COUNT IF NO ERROR
.SOBF:: MCENT
CALL CHKTTR
JRST [ SETZ A, ;NOT A TERMINAL. RETURN COUNT OF 0
JRST SOBF1]
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
JRST [ CALL ULKTTY ;NOT ACTIVE. ALLOW DEALLOCATION
SETZ A, ;SET COUNT TO 0
JRST SOBF1]
CALL TTSOBF ;GO TEST BUFFER COUNT
JRST [ CALL ULKTTY ;NOT FULL. ALLOW DEALLOCATION
JRST SOBF1] ;RETURN +1 WITH COUNT
UMOVEM 1,2 ;FULL. Return count of bytes in buffer
CALL ULKTTY ;ALLOW DEALLOCATION
SMRETN
SOBF1: UMOVEM 1,2 ; Return count of bytes in buffer
JRST MRETN
SUBTTL SPACS JSYS
; Set accessibility of a page
; Call: LH(A) ; Fork or file handle
; RH(A) ; Page number
; SPACS
.SPACS::MCENT
TRVAR <<DUMMY,3>,JFHDL> ;MUST MATCH TRVAR IN PMAP
SETZM JFHDL ;ASSUME NO STR LOCK TO RELEASE
SETZ B, ;NO PT CREATES
CALL CPMAPX ; Convert to ptn.pn
MOVEM D,JFHDL ;REMEMBER STR LOCK
JUMPE A,SPACER ;IF NO MATCH,ERROR
XCTU [SKIPGE 1] ;FORK HANDLE?
JRST SPACFK ;YES
TXNN B,WRTF ; MUST BE ABLE TO WRITE
SPACER: JRST [ MOVEI A,SPACX1
MOVEM A,LSTERR
SKIPE A,JFHDL ;LOCKED A STR?
CALL LUNLKF ;YES. UNLOCK IT
ITERX] ;GENERATE ITRAP
MOVSI C,160000
JRST SPAC1
;FORK HANDLE WAS SPECIFIED
SPACFK: PUSH P,A ; Save page handle
CALL MRPACS ; Get access of page
TLNN A,(1B5)
JRST SPACER ; Non-existent page
TLNE A,(1B10)
JRST SPACPR ; Private page
PUSH P,A ; Save access
MOVE A,-1(P) ; Get back the page handle
CALL MRPT ; Get map contents
JRST SPACP1 ; Indirect or shared to fork
CALL OFNJFN ; Convert to jfn.pn
JRST SPACCF ; Closed file
SETZ B, ;NO PT CREATES
CALL CPMAPX ; Get allowable access
MOVEM D,JFHDL ;REMEMBER STR LOCK
ADJSP P,-1 ;FIX UP STACK
JRST SPAC2
SPACCF: POP P,C
AND C,[XWD 160000,0]
JRST SPAC2
SPACP1: ADJSP P,-1 ;FIX UP STACK
SPACPR: MOVSI C,160000
SPAC2: TLO C,1400
POP P,A
SPAC1: UMOVE B,2
AND B,C
CALL MSPACS
SKIPE A,JFHDL ;HAVE A STR LOCK TO RELEASE?
CALL LUNLKF ;YES. FREE IT
JRST MRETN
SUBTTL SPOOL JSYS
;SPOOL JSYS
;ACCEPTS IN 1/ LENGTH ,, FUNCTION CODE
; 2/ LOCATION OF ARGUMENT BLOCK
; SPOOL
;RETURNS +1: ERROR - ERROR CODE IN AC 1
; +2: SUCCESSFUL
.SPOOL::MCENT ;ENTER JSYS
XCTU [HRRZ T1,1] ;GET FUNCTION CODE
CAILE T1,.SPLRD ;LEGAL FUNCTION?
RETERR (SPLX1) ;NO
XCTU [HLRZ T2,1] ;GET LENGTH
HLRZ T3,SPLTAB(T1) ;GET DESIRED LENGTH
CAMGE T2,T3 ;USER SUPPLY ENOUGH ARGS?
RETERR (SPLX2) ;NO, ILLEGAL LENGTH
UMOVE Q1,2 ;GET ADDRESS OF ARG BLOCK
HRRZ T1,SPLTAB(T1) ;GET ADDRESS OF ROUTINE TO CALL
JRST 0(T1) ;DISPATCH
SPLTAB: 3,,SPOOL0 ;(0) DEFINE INPUT SPOOLING SET
2,,SPOOL1 ;(1) SET SPOOL DIRECTORY FOR A DEVICE
2,,SPOOL2 ;(2) READ SPOOL DIRECTORY FOR A DEVICE
SPOOL0: UMOVE T1,0(Q1) ;GET DEVICE DESIGNATOR
CAME T1,[600000+.DVCDR,,-1]
RETERR (SPLX3) ;ILLEGAL DEVICE DESIGNATOR
MOVEI T1,JSBFRE ;PREPARE TO RELEASE OLD STRING IF ANY
HRRZ T2,JSCDR ;GET OLD STRING POINTER
JUMPN T2,[NOINT ;WAS THERE AN OLD STRING?
CALL RELFRE ;YES, RELEASE IT
OKINT
JRST .+1]
UMOVE T1,1(Q1) ;GET STRING POINTER
CALL CPYFU0 ;COPY STRING INTO JSB
RETERR () ;ERROR
HRRZM T1,JSCDR ;STORE STRING ADDRESS
XCTU [HRRZ T1,2(Q1)] ;GET VERSION NUMBER OF FIRST FILE
JUMPE T1,[RETERR (SPLX5)] ;0 IS ILLEGAL
SOS T1 ;IT GET INCREMENTED BEFORE BEING USED
HRLM T1,JSCDR ;STORE IT IN JSB
SMRETN ;GIVE OK RETURN
SPOOL1: MOVE T1,CAPENB ;CHANGING DIR # IS PRIVILEGED
TRNN T1,SC%WHL!SC%OPR ;WHEEL OR OPER?
RETERR (SPLX4) ;NO, MUST BE PRIVILEGED
UMOVE T1,0(Q1) ;GET DEVICE DESIGNATOR
CALL CHKDES ;CHECK THIS DESIGNATOR
RETERR ;NO, ILLEGAL DESIGNATOR
UMOVE T4,1(Q1) ;GET DIR NUMBER
HLL T1,DEVCHR(T2) ;SET UP DESIGNATOR
TLZ T1,777000 ;...
MOVSI T2,-NDEV ;SET UP TO LOOP THRU DEVICES
SPOL1L: HLL T3,DEVCHR(T2) ;SET UP DESIGNATOR
TLZ T3,777000 ;...
HRR T3,DEVUNT(T2) ;GET UNIT NUMBER
ANDI T3,DV%UNT ;MASK TO UNIT NUMBER
CAIN T3,DV%UNT ;CHECK FOR -1
MOVEI T3,-1 ;SET -1
CAMN T1,T3 ;IS THIS THE CORRECT DEVICE?
MOVEM T4,DEVCH2(T2) ;YES, STORE NEW DIR #
AOBJN T2,SPOL1L ;LOOP FOR ALL DEVICES
SMRETN ;AND EXIT
SPOOL2: UMOVE T1,0(Q1) ;GET DEVICE DESIGNATOR
CALL CHKDES ;CHECK ITS LEGALITY
RETERR ;BAD DESIGNATOR
MOVE T3,DEVCH2(T2) ;GET DIR NUMBER
JUMPN T3,SPOL2A ;IF SET, RETURN VALUE
MOVX T1,RC%EMO ;EXACT MATCH ONLY
HRROI T2,[ASCIZ/SPOOL:/] ;[7.1112]GET DEFAULT VALUE
RCDIR ;GET THE DIRECTORY NUMBER
TXNE T1,RC%NOM!RC%AMB ;NO MATCH OR AMBIGUOUS?
RETERR (SPLX6) ;YES
SPOL2A: UMOVEM T3,1(Q1) ;STORE ANSWER
SMRETN
SUBTTL STABS JSYS
; Set tab stops
.STABS::MCENT
CALL CHKTTY
JRST MRETN
UMOVE 1,2
UMOVE 3,3
UMOVE 4,4
CALL TTSTBS
JRST MRETN
SUBTTL STAD JSYS
; Set time and date
; Call: 1 ; Date and time in standard format
; STAD
; Return
; +1 ; Can't set because not wheel or opr
; +2 ; Ok
.STAD:: MCENT
MOVE B,CAPENB
TRNN B,SC%WHL!SC%OPR
SKIPGE TADIDT
JRST STAD1
MOVEI A,STADX1
RETERR()
STAD1: CALL LGTAD ;GET CURRENT DATE/TIME
MOVEM A,CKPDTL ;SAVE AS LAST DATE/TIME
UMOVE A,1 ;RE-FETCH USER ARG
MOVE B,TODPWL ;JIFFIES SINCE STARTUP (BY POWERLINE)
MUL B,[1B17] ;SHIFT BINARY POINT
DIV B,JFDAY ;COMPUTE DAYS AND FRACTION SINCE STARTUP
CAML C,JFDAY2 ;ROUND
AOS B
SUB A,B ;COMPUTE ACTUAL SYSTEM STARTUP TAD
MOVEM A,TADIDT ;SAVE IT
CALL TIMZDT ;CAUSE TIMER QUEUE TO BE RESCHEDULED
CALL NXTASC ;Recompute next automatic accounting shift change
SKIPN JOBNO ;IS THIS OTHER THAN JOB 0?
SMRETN
CALL DTTIME ;YES. SEND TIME TO ALL 11'S
; IFN CFSCOD,<
CALL CFTADB ;If CFS, send to all systems
; > ;IFN CFSCOD
MOVEI T1,.USENT ;WRITE ENTRY FUNCTION
MOVEI T2,TADLST ;ARG LIST
USAGE ;LOG THIS FACT
SMRETN
TADLST: USENT. (.UTTAD,1,1) ;DATE-TIME CHANGE
USDTL. (CKPDTL) ;OLD DATE/TIME
0 ;END OF LIST
SUBTTL STDEV JSYS
; String to device
; Call: 1 ; Device designator
; STDEV
; Return
; +1 ; Error
; +2 ; Ok
; 2 ; Device designator
.STDEV::MCENT
UMOVE A,1
CALL STDEV0 ;DO THE WORK
IFNSK. ;If not OK
UMOVEM A,2 ;Stash the error code
EMRETN () ;GIVE ERROR RETURN
ENDIF.
UMOVEM A,2 ;RETURN DEVICE DESIGNATOR
JRST SKMRTN ;GIVE SKIP RETURN
STDEV0: CALL CPYFUS
RETBAD (GJFX22) ;JSB FULL
MOVEI D,0 ;SEE IF TERMINATED WITH A COLON
MOVE B,A ;GET POINTER TO STRING
HRLI B,(POINT 7,0,34) ;MAKE IT INTO A BYTE POINTER
STDEV1: ILDB C,B ;SCAN FOR A COLON
CAIE C,":" ;FOUND THE END OF THE DEVICE STRING?
CAIN C," " ;EITHER COLON OR SPACE IS A TERMINATOR
SKIPA ;YES, FOUND A TERMINATOR
JUMPN C,STDEV1 ;NO, AT END OF STRING?
DPB D,B ;YES, PUT A NULL IN ON TOP OF COLON
PUSH P,A
SETZ B, ;INDICATE NO DIRECTORY SEARCH
CALL CHKLND ; GO CHECK FOR A LOGICAL NAME FIRST
CALL STDEVP ; GO SEE ABOUT A PHYSICAL DEVICE
JRST STDEV2 ; ERROR CODE IN A
HLRZ B,A ;GET DEVICE DESIGNATOR
HRRZ C,A ;GET UNIT NUMBER
CAIE C,-1 ;IS IT SPECIAL?
CAIE B,.DVDES+.DVDSK ;NO, IS IT A STRUCTURE?
JRST [ AOS -1(P) ;NO, GIVE SKIP RETURN
JRST STDEV2]
LDB B,[POINT STRNS,A,35] ;GET STRUCTURE INDEX
MOVE B,STRTAB(B) ;GET SDB ADDRESS
LOAD B,STRJB,(B) ;GET FORK INIT'ING STRUCTURE
SKIPE B ;SKIP IF NOT BEING INIT'ED
JRST [ CAMN B,FORKX ;Are we the fork doing it?
JRST .+1 ;Yes, so that's ok
MOVEI T1,STDVX1 ;No, say "No such device",
JRST STDEV2] ;and give error return
AOS -1(P) ;YES, GIVE SKIP RETURN
STDEV2: EXCH A,0(P) ;SAVE ANSWER, RESTORE PNTR
MOVE B,A ; TO B
MOVEI A,JSBFRE ;SAY JSB FREE SPACE
CALL RELFRE ;RELEASE IT
POP P,A ;RESTORE ANSWER (OR ERROR)
RET ;RETURN
;ROUTINE TO GET PHYSICAL DEVICE DESIGNATOR
;ACCEPTS IN A/ STRING POINTER TO DEVICE NAME
; CALL STDEVP
;RETURNS +1: ERROR - ERROR CODE IN A
; +2: OK, DEVICE DESIGNATOR IN A
STDEVP::CALL DEVLUX ; Look up the device name
JRST [ CAIE A,GJFX16
JRST .+1
MOVEI A,STDVX1
RET] ; NO SUCH DEVICE
HRRZ A,DEVUNT(B)
ANDI A,DV%UNT ;MASK TO UNIT
CAIN A,DV%UNT ;CHECK FOR -1
MOVEI A,-1 ;YES SET IT -1
HLRZ D,DEVCHR(B) ;GET DEVICE TYPE
TRZ D,777000 ;...
CAIE A,-1 ;SPECIAL CASE OF UNIT #
CAIE D,.DVDSK ;CHECK FOR DISK (STR)
JRST STDVP1 ;NOT STRUCTURE - GO ON
HRRZ A,C ;GET UNIQUE CODE
HRLI A,.DVDES+.DVDSK ;RETURN STR DESIGNATOR
RETSKP
STDVP1: HRRZ A,DEVUNT(B) ;GET DEVICE AGAIN
HRL A,D ;SET DEVICE TYPE
TLO A,.DVDES ; SET DEVICE DESIGNATOR CODE
RETSKP
SUBTTL STI JSYS
; Simulate teletype input
; A/ DESIGNATOR (SHOULD BE TTY)
; B/ CHARACTER
.STI:: MCENT
CALL CHKTTR ;MAKE SURE WE'RE DEALING WITH A TERMINAL
ITERR (TTYX1) ;NOT A TERMINAL OR NO SUCH TERMINAL
MOVE T3,CAPENB ;WHEEL OR OPERATOR CAN DO IT
TXNE T3,SC%WHL!SC%OPR
JRST STI2
MOVEM T2,Q1 ;SAVE LINE NUMBER
NOSKED ;GO NOSKED WHILE LOOKING AT LINE DATA
CALL STADYN ;POINT TO DYNAMIC DATA
ITERR (TTYX01,<OKSKED>) ;NOT ACTIVE. ONLY PRIVILEGED CAN SEND TO IT
CALL TTCKAD ;ACCEPTING ADVICE?
IFNSK.
CALL CHKTTY ;DO WE HAVE ACCESS?
ITERR (DESX2,<OKSKED>) ;NO. RETURN ERROR
ENDIF.
OKSKED
MOVE T2,Q1 ;GET LINE NUMBER
STI2: UMOVE T1,T2 ;GET CHARACTER
CALL TTSTI ;PUT CHARACTER IN INPUT BUFFER
ITERR ()
JRST MRETN
SUBTTL TMON JSYS
; Read fact switch
;ACCEPTS IN 1/ FUNCTION TO BE TESTED
; TMON
;RETURNS +1: ALWAYS - VALUE IN AC 2
.TMON:: MCENT
UMOVE T1,1
JUMPL T1,TMONER ;CODE MUST BE POSITIVE
CAIL T1,^D36 ;DOES IT FIT IN FLAG WORD?
JRST TMON2 ;NO, SEE IF OTHER CODE IS VALID
MOVNS T1 ;GET MASK
MOVX T2,1B0
LSH T2,0(T1)
TDNN T2,FACTSW ;TEST BIT
TMONZ: TDZA T1,T1 ;BIT NOT SET
TMONO: MOVEI T1,1 ;BIT IS SET
TMONV: UMOVEM T1,2 ;RETURN VALUE
JRST MRETN ;RETURN TO USER
TMON2: CAIL T1,^D36+NTMON2 ;LEGAL CODE FOR TMON?
TMONER: ITERR (TMONX1) ;NO
XCT TMON2T-^D36(T1) ;YES, GET THE VALUE
JRST TMONV ;NON-SKIP RETURNS A VALUE
JUMPE T1,TMONZ ;SKIPS RETURN 0 OR 1 ONLY
JRST TMONO ;RETURN A ONE
;TABLE OF TMON FUNCTIONS
TMON2T: JRST TMONER ;44 - IS NETWORK ON?
JRST TMONER ;45 IS WRITE-ONLY
JRST TMONER ;46 IS WRITE-ONLY
MOVE T1,TIMZON ;47-RETURN LOCAL TIME ZONE
MOVE T1,NLHOST ;50-RETURN LOCAL ARPANET HOST NUMBER
MOVE T1,AVALON ;51-RETURN ACCOUNT VALIDATION STATUS
MOVE T1,STSBLK ;52-RETURN VALUE OF STATUS REPORTING
CALL TGTOK ;53-RETURN STATE OF THIS GETOK FUNCTION
MOVE T1,TPRCYC ;54-RETURN TAPE RECYCLE TIME
MOVE T1,DIRRDU ;55-RETURN VALUE OF DIR READ MASK
MOVE T1,ARRCYC ;56-RETURN ARCHIVE TAPE RECYCLE TIME
SKIPA T1,NRTWTS ;57-WAIT FOR RETRIEVALS?
MOVE T1,TPMTDF ;60-TAPE MOUNT CONTROLS
SKIPA T1,PRELDF ;61-WORKING SET PRELOADING
CALL GTDSTF ;62-get DST method type
NOP ;63-UNUSED AND UNNASSIGNED
CALL MSSRED ;64-MSCP SERVER DISKS
MOVE T1,SPRCNT ;65-GET RUNNING COUNT OF SPEAR ENTRIES
MOVE T1,COFTIM ;66 - CARRIER OFF TIME
MOVE T1,HNGU0F ;67 - HUNGUP ACTION NOT LOGGED IN
MOVE T1,HNGU1F ;70 - HANGUP ACTION LOGGED IN
MOVE T1,XECFLG ;71 - READ EXEC FLAGS WORD
JRST GETNIA ;[8850] 72 - Get ethernet address
ITERR (TMONX1) ;[7.1063]73 - Not defined
IFN LAHFLG < ;[8850] If LAT code assembled in
CALL TMFLTS ;[8974](/T1) 74 - Get LAT state
>;End of IFN LAHFLG ;[8850]
IFE LAHFLG < ;[8850] If no LAT code
ITERR (TMONX1) ;[8850] 74 - Not defined if no LAT
>;End if IFE LAHFLG ;[8850]
MOVE T1,CLUSET ;[7.1076]75 - Get CLUDGR SYSYAP status
MOVE T1,CLUTMG ;[7.1076]76 - Get cluster sendall status
CALL RETTMR ;[7.1063]77 - Offline structures timer value
MOVN T1,LGSIDX ;[7.1124]100 - Login Structure state
MOVE T1,MINPAS ;[7.1231]101 - Get min password length
NTMON2==.-TMON2T ;NUMBER OF LEGAL CODES OVER 35
TGTOK: TRNE T2,400000 ;CHECK FOR USER FUNCTION CODE
TDZA T1,T1 ;FORCE FOR USER FUNCTION
SKIPE T1,T2 ;GET FUNCTION CODE
CAIL T1,MXGOKF ;CHECK FOR LEGAL FUNCTION
ITERR (TMONX1)
HLL T1,GTOKPR(T1) ;GET FLAGS
HRR T1,T2 ;PUT THE ORIGINAL VALUE BACK IN RH
RET ;RETURN FLAGS,,FUNCTION TO USER
GTDSTF: CALL DSTCHK ;check if DST method type is valid
UMOVEM T1,T2 ;return it to user
RET ;return
;[7.1063]
;
; RETTMR - Return the offline structures timer interval
;
; CALL RETTMR
;
; Returns +1: Always, timer value in T1
;
RETTMR: MOVE T1,TMRINT ;Get the timer interval
IDIVI T1,^D1000 ;Convert to seconds
RET ;Done
;[8850]
;GETNIA - Routine to pass on to the user the 6 ethernet bytes.
;
; Called with:
;
; User T3/ Byte pointer to put ethernet address
; XCT TMON2T(.SFSEA)
;
; Returns:
;
; To user - Always with updated byte pointer in user space
MAXCH==^D17 ;Number of characters in the ethernet address string
GETNIA: XCTU [SKIPE T2] ;User give us channel 0 (the only channel)?
ITERR (NIENSC) ;No, bad channel number
SAVEQ ;These get used
STKVAR <USERBP,<STRING,4>,COUNT> ;Temp storage
UMOVE T1,T3 ;Get user's byte pointer
TLC T1,-1 ;Check source pointer
TLCN T1,-1 ;Was a -1 in left half?
HRLI T1,(POINT 7,) ;Yes, make the usual byte pointer
MOVEM T1,USERBP ;Save for later useage
DMOVE Q2,ETHADR ;Get our ethernet address
HRRI T1,STRING ;Set up T1 with our byte pointer
HRLI T1,(POINT 7,) ;Make 7-bit byte pointer
SETZM COUNT ;Start at 0
DO. ;Loop to get each character
AOS T3,COUNT ;Our character number
CAILE T3,MAXCH ;Have we reached our max?
EXIT. ;Yes we have
SETZ Q1, ;Character is going to go here
IDIVI T3,3 ;Every third character is a separator
IFE. T4 ;Are we on the third character?
IFE NICSW,<
MOVEI Q1,.CHDAS ;If third character, then we want a dash
>
IFN NICSW,<
MOVEI Q1,"-" ;If third character, then we want a dash
>
ELSE. ;Else, we get a real byte from ethernet address
LSHC Q1,4 ;Get a byte in the right AC
LSHC Q2,4 ;Move other bytes into useful position
CAIGE Q1,^D10 ;Are we in character range?
IFSKP. ;If so,
ADDI Q1,71 ;Make it the right character
ELSE. ;Else,
ADDI Q1,60 ;Make it a number
ENDIF.
ENDIF.
IDPB Q1,T1 ;Save character in our holding cell
LOOP. ;Go back for more characters
OD. ;Have put in all of the characters
MOVEI Q1,.CHNUL ;End string with a null
IDPB Q1,T1 ;And make sure it gets in there
MOVE T1,USERBP ;Get user byte pointer
MOVEI T2,STRING ;String starts here in monitor space
SOS T2 ;And of course, CPYTU1 wants this 1 less
MOVEI T3,3 ;Put updated pointer into user's AC 3
CALL CPYTU1 ;(T1,T2,T3/) Now give the string to the user
MRETNG ;And done
SUBTTL UTEST JSYS
;THE UTEST JSYS - BASIC UNIT TESTING FACILITY
;ACCEPTS IN 1/ FUNCTION CODE ,, LENGTH OF ARGUMENT BLOCK
; 2/ ADDRESS OF ARGUMENT BLOCK
;FUNCTION 0 = START TESTING
; 1 = STOP TESTING
;ARGUMENT BLOCK:
;LOC 0/ ADDRESS OF MONITOR ROUTINE TO TEST
;LOC 1/ NUMBER OF WORDS TO BE TESTED
;LOC 2/ START OF BIT TABLE OF ADDRESSES TO BE TESTED
; BIT = 0 MEANS DO NOT TEST THE CORRESPONDING LOCATION
; BIT = 1 MEANS TEST THIS LOCATION
;ON THE STOP TESTING FUNCTION THE BIT TABLE IS MODIFIED TO CONTAIN:
; BIT = 0 MEANS THIS LOCATION WAS EXECTUTED DURING THE TESTING
; BIT = 1 MEANS THAT THIS LOCATION WAS NOT EXECUTED
.UTEST::MCENT
NOINT ;DO NOT ALLOW INTERRUPTS
MOVE T1,CAPENB ;SEE IF THE CALLER IS PRIVILEGED
TXNN T1,SC%WHL ;MUST BE A WHEEL
ITERR (CAPX3) ;NOT A WHEEL, THIS JSYS IS NOT LEGAL
XCTU [HLRZ T3,1] ;GET THE FUNCTION CODE
CAIL T3,UTABLN ;IS THIS A LEGAL FUNCTION
ITERR (UTSTX1) ;NO, GIVE ERROR
XCTU [HRRZ T4,1] ;GET LENGTH OF ARG BLOCK
UMOVE T1,2 ;GET ADDRESS OF ARG BLOCK
SUBI T4,2 ;GET NUMBER OF WORDS TO TEST
IMULI T4,^D36 ;ONE BIT FOR EACH WORD
SKIPG T4 ;IS THERE AN ARG BLOCK?
TDZA T2,T2 ;NO
UMOVE T2,1(T2) ;GET THE NUMBER OF WORDS FROM ARG BLOCK
CAMG T4,T2 ;TAKE THE SMALLER VALUE
MOVE T2,T4 ;...
MOVE T3,UTAB(T3) ;GET DISPATCH ADDRESS
CALL 0(T3) ;DO THIS FUNCTION
ITERR() ;FAILED
MRETNG ;SUCCESS
UTAB: UTEST0 ;FUNCTION 0 - START TESTING
UTEST1 ;FUNCTION 1 - STOP TESTING
UTABLN==.-UTAB
;ROUTINE TO INSERT THE TEST INSTRUCTION INTO THE ROUTINE TO BE TESTED
;ACCEPTS IN T1/ ADR OF ARG BLOCK
; T2/ # OF BITS IN BIT TABLE
UTEST0: CAIL T2,UTNPG*PGSIZ ;TOO LARGE A REQUEST?
RETBAD (UTSTX2) ;YES, CANNOT DO THIS REQUEST
NOSKED ;NOW SECURE THE INTERLOCK
SKIPL UTLOCK ;IS THIS FEATURE AVAILABLE?
RETBAD (UTSTX3,<OKSKED>) ;NO, ALREADY IN USE
MOVE T3,FORKX ;YES, PUT OUR FORK NUMBER IN UTLOCK
MOVEM T3,UTLOCK ;WE NOW OWN THE FACILITY
OKSKED
MOVSI P3,(<POINT 1,0(P2)>) ;SET UP TO SCAN BIT TABLE
XCTU [HRRZ P1,0(T1)] ;GET ADDRESS OF MONITOR ROUTINE
MOVEM P1,UTBASE ;SAVE FOR EXIT
MOVEI P2,2(T1) ;GET START OF BIT TABLE
MOVE P4,T2 ;GET COUNT OF WORDS TO TEST
MOVEM T2,UTLEN ;SAVE COUNT FOR EXIT
MOVEI Q1,777(T2) ;LOCK DOWN THE BUFFER AREA
LSH Q1,-PGSFT ;GET # OF PAGES NEEDED FOR BUFFER AREA
SETZ Q2,
UT0L1: MOVEI T1,UTPGS(Q2) ;GET ADR OF NEXT PAGE TO LOCK
CALL MLKMA ;LOCK IT DOWN
ADDI Q2,PGSIZ ;STEP TO NEXT PAGE
SOJG Q1,UT0L1 ;LOOP BACK TIL ALL PAGES LOCKED
CALL SWPMWE ;WRITE ENABLE THE MONITOR
MOVE T3,[CALL UTREP] ;GET THE INSTRUCTION TO BE INSERTED
MOVEI T4,UTPGS ;GET START OF BUFFER AREA
UT0L2: XCTBMU [ILDB T1,P3] ;GET NEXT BIT FROM USER BIT TABLE
MOVE T2,(P1) ;GET NEXT INSTRUCTION FROM ROUTINE
MOVEM T2,(T4) ;STORE IT IN THE BUFFER
AOS T4 ;STEP TO NEXT LOCATION IN BUFFER
AND T2,[777000,,0] ;GET INSTRUCTION OPCODE
CAMN T2,[JUMP] ;IS THIS AN ERJMP OR ERCAL STYLE INSTRUCTION?
SETZ T1, ;YES, DO NOT TEST THIS LOCATION
TLCE T2,777000 ;IS THE OPCODE = 0?
TLCN T2,777000 ;OR 777?
SETZ T1, ;YES, DO NOT CHANGE THIS LOCATION
SKIPE T1 ;SHOULD THIS LOCATION BE CHANGED?
MOVEM T3,(P1) ;YES, PUT "CALL REP" IN ITS PLACE
AOS P1 ;STEP TO NEXT WORD IN ROUTINE
SOJG P4,UT0L2 ;LOOP BACK TIL ALL WORDS SET UP
RETSKP ;DONE
;ROUTINE TO REMOVE THE TEST INSTRUCTION AND REPORT RESULTS
;ACCEPTS IN T1/ ADR OF ARG BLOCK
; T2/ # OF BITS IN BIT TABLE
UTEST1: MOVE T3,UTLOCK ;SEE IF WE OWN THIS FACILITY
CAME T3,FORKX ;...
RETBAD (UTSTX3) ;WE DO NOT, SO DO NOT ALLOW THIS
MOVE P1,UTBASE ;GET START ADR OF ROUTINE BEING TESTED
MOVSI P3,(<POINT 1,0(P2)>) ;SET UP BYTE POINTER
MOVEI P2,2(T1) ;GET POINTER TO THE START OF BIT MASK
MOVE P4,T2 ;GET # OF WORDS TO STORE BACK
MOVE P5,UTLEN ;GET # OF WORDS IN ORIGINAL TEST CALL
MOVEI T4,UTPGS ;GET START OF BUFFER
UT1L: MOVE T2,(P1) ;GET INSTRUCTION FROM ROUTINE
MOVE T3,(T4) ;GET ORIGINAL INSTRUCTION FROM BUFFER
MOVEI T1,1 ;START OFF WITH "UNEXECUTED" RESPONSE
CAME T2,[CALL UTREP] ;DID THIS INST GET EXECUTED?
TDZA T1,T1 ;YES, RETURN 0 TO USER
MOVEM T3,(P1) ;STORE ORIGINAL INSTRUCTION BACK
SOSL P4 ;USER WANT ANY MORE?
XCTBMU [IDPB T1,P3] ;YES, STORE THE ANSWER
AOS T4 ;STEP TO NEXT WORD IN BUFFER
AOS P1 ;STEP TO NEXT WORD IN MONITOR
SOJG P5,UT1L ;LOOP TIL ALL INSTRUCTIONS ARE RESTORED
MOVEI P1,777-UTPGS(T4) ;NOW UNLOCK THE PAGES
LSH P1,-PGSFT ;GET COUNT OF PAGES TO BE DONE
UT1LL: MOVEI T1,<UTPGS_-PGSFT>-1(P1) ;GET PAGE #
HRL T1,MMSPTN ;GET PTN OF MONITOR MAP
CALL MULKPG ;UNLOCK THE PAGE
SOJG P1,UT1LL ;LOOP TIL ALL PAGES UNLOCKED
CALL SWPMWP ;WRITE PROTECT THE MONITOR AGAIN
SETOM UTLOCK ;GIVE UP THE FACILITY
RETSKP ;AND EXIT
;ROUTINE TO RELEASE THE UTEST RESOURCES ON A FORK KILL
UTREL:: SETZB T1,T2 ;DO NOT GET ANY RESULTS BACK
CALL UTEST1 ;GO RELEASE THIS FACILITY
JFCL ;IF IT FAILS, WE CAN DO NOTHING
RET ;DONE
;ROUTINE TO RETURN THE ORIGINAL VALUES TO THE TESTED ROUTINE
RESCD
UTREP:: PUSH P,T1 ;SAVE AN AC FOR SCRATCH
SOS -1(P) ;GET ADDRESS OF CALLING INSTRUCTION
HRRZ T1,-1(P) ;...
SUB T1,UTBASE ;GET OFFSET INTO BUFFER
MOVE T1,UTPGS(T1) ;GET THE ORIGINAL INSTRUCTION
MOVEM T1,@-1(P) ;RESTORE THE LOC TO ITS ORIGINAL STATE
POP P,T1 ;RESTORE THE SCRATCH AC
UTREPE::RET ;AND GO DO THE ACTUAL INSTRUCTION
SWAPCD
SUBTTL VACCT JSYS
; VALIDATE ACCOUNT
; CALL: T1/ 36-BIT USER # OR DIRECTORY #
; T2/ POINTER TO ACCOUNT STRING
; VACCT
; RETURNS: +1 ALWAYS
.VACCT::MCENT
STKVAR <VERNO,VERPTR>
UMOVE T1,1 ;GET USER OR DIR #
CAME T1,[-1] ;IS THIS FOR CURRENT USER?
JRST VACCT0 ;NO
MOVE T1,JOBNO ;YES,
MOVE T1,JOBDIR(T1) ;GET LOGGED-IN DIRECTORY
HRLI T1,USRLH ;MAKE IT A USER NUMBER
VACCT0: MOVEM T1,VERNO ;SAVE FOR NOW
HLRZS T1
CAIN T1,USRLH ;IS IT A USER NUMBER?
JRST [ MOVE T1,VERNO ;YES, GET WHOLE NUMBER
CALL CNVDIR ;CONVERT IT TO A DIRECTORY NUMBER
JRST VACCT1] ;AND CONTINUE
MOVE T1,VERNO ;GET DIRECTORY NUMBER
VACCT1: CALL SETDIR ;MAP IN THE DIRECTORY
ITERR () ;ERROR, TELL USER
UMOVE T1,2 ;GET POINTER TO ACCOUNT STRING
CALL CPYFUS ;DRAG IN THE ACCOUNT
ITERR (MONX02) ;ERROR, JSB FULL
MOVEM T1,VERPTR ;SAVE LOOKUP POINTER TO ACCT STRING
UMOVEM T3,2 ;RETURN UPDATED POINTER TO USER
MOVE T1,VERNO ;USER OR DIR #
MOVE T2,VERPTR ;LOOKUP POINTER TO ACCOUNT STRING
CALL VERACJ ;GO VALIDATE THE ACOUNT
JRST VACCTX
VACCT2: MOVEI T1,JSBFRE ;RELEASE CPYFUS'ED STRING
MOVE T2,VERPTR
CALL RELFRE
CALL USTDIR ;UNMAP DIR
OKINT ;CPYFUS WENT NOINT
MRETNG ;SUCCESS RETURN
; CALL TO VERACT FAILED
VACCTX: MOVEM T1,LSTERR ;SAVE ERROR CODE
REPEAT 0,<
MOVE T1,JOBNO
MOVE T1,JOBDIR(T1) ;GET THIS JOB'S LOGIN DIR NO
CAIN T1,OPERDN ;VALIDATING FOR OPERATOR?
JRST VACTX2 ;YES, CHECK FOR SPECIAL OPER ACCOUNT
> ;END OF REPEAT 0
VACTX1: MOVEI T1,JSBFRE ;RELEASE SPACE FOR CPYFUS'ED STRING
MOVE T2,VERPTR
CALL RELFRE
CALL USTDIR ;UNMAP DIRECTORY
OKINT ;CPYFUS WENT NOINT
ITERX ;GENERATE ITRAP
REPEAT 0,<
VACTX2: MOVE T2,VERPTR
AOS T2 ;POINT TO ACCOUNT TO VALIDATE
MOVE T1,[-2,,[ASCIZ/OPERATOR/]]
VACTX3: MOVE T3,0(T1) ;GET NEXT WORD IN ACCT STRING
CAME T3,0(T2) ;ACCOUNTS THE SAME SO FAR?
JRST VACTX1 ;NO, CLEAN UP AND RETURN ERROR
AOS T2
AOBJN T1,VACTX3 ;SCAN SOME MORE
JRST VACCT2 ;USING SPECIAL ACCOUNT, GIVE OK RETURN
> ;END OF REPEAT 0
; INTERNAL ROUTINE TO VALIDATE AN ACCOUNT
; CALL: T1/ 36-BIT USER OR DIRECTORY NUMBER
; T2/ LOOKUP POINTER TO AN ACCOUNT STRING
; CALL VERACT
; RETURNS: +1 FAILED, ERROR CODE IN T1
; +2 SUCCESS, T1/ AC%MCH => ACCOUNT MATCHES ACCTSR
; T2/ ACCOUNT EXPIRATION DATE
; T3/ DEFAULT CLASS FOR ACCOUNT
; -1=> NO DEFAULT CLASS
VR%USR==:1B0 ;MEANS VALIDATING FOR A USER NUMBER
;USED INTERNALLY BY VERACT IN FLAG AC Q1
VERACJ: TDZA T3,T3 ;INDICATE VERACJ ENTRY
VERACT::SETO T3,0 ;INDICATE VERACT ENTRY
SKIPN AVALON ;ACCOUNT VALIDATION RUNNING?
JRST [ SETZB T1,T2 ;NO, GIVE GOOD RETURN IMMEDIATELY
SETZ T3,0 ;CLASS 0
RETSKP]
SAVEQ
TRVAR <TFL,STRINX,VERABJ,VERHDR,VERLOC,VERLUK,VERNUM,<VERTMP,2>,VERCLS,VEREPT>
MOVEM T3,TFL ;SAVE ENTRY FLAG
SETZ Q1, ;INITIALIZE FLAG AC
MOVEM T2,VERLUK ;SAVE LOOKUP PTR TO ACCT STRING
MOVEM T1,VERNUM ;SAVE USER OR DIR #
MOVEM T3,VEREPT ;SAVE ENTRY TYPE
HLRZS T1
CAIN T1,USRLH ;IS IT A USER NUMBER?
JRST [ TXO Q1,VR%USR ;NOTE THAT A USER NUMBER WAS PASSED
JRST VERAC1] ;AND CONTINUE
CALL CNVSTR ;IS THIS A DIRECTORY #?
RETBAD ( ) ;ERROR, RETURN
MOVEM T1,STRINX ;SAVE STR: INDEX INTO STRTAB
; ARGUMENTS PASSED TO VERACT ARE OK
; HASH ACCOUNT STRING AND GO SCAN DATABASE
VERAC1: MOVE T1,VERLUK ;LOOKUP PTR TO ACCOUNT STRING
AOJ T1, ;MAKE IT POINT TO START OF ACCT STRING
HLRZ T2,T1
SOJ T2,
HRLM T2,T1 ;T1/ AOBJN PTR TO ACCT STRING
MOVEM T1,VERABJ ;SAVE IT
LOCK ACTLCK ;PREVENT OTHER TWEAKING OF ACCT PAGES
CALL CHKASR ;ACCOUNT MATCH ACCTSR?
JRST VERAC6 ;NO, CONTINUE
TRNE T1,-1 ;MATCH - ACCOUNT EXPIRED?
JRST BADRTE ;YES, GIVE INVALID RETURN
JRST OKRET ;NO, GIVE GOOD RETURN
VERAC6: CALL CHKCSH ;ACCOUNT MATCH CACHED ACCT IN JSB?
JRST VERAC0 ;NO, GO SCAN DATA BASE
TRNE T1,-1 ;ACCOUNT EXPIRED?
JRST BADRTE ;YES, GIVE INVALID RETURN
JRST OKRET ;NO, GIVE GOOD RETURN
; HASH ACCOUNT AND GO SCAN DATA BASE
VERAC0: MOVE T1,VERABJ ;AOBJN POINTER TO ACCOUNT
CALL HSHNAM ;HASH ACCOUNT STRING
CAILE T1,HASHLN ;VALID HASH VALUE?
JRST [BUG.(CHK,HSHERR,JSYSA,HARD,<VERACT - Hash value out of range>,,<
Cause: An account string was being hashed by routine HSHNAM in JSYSA in a
effort to validate an account. This BUG. indicates that HSHNAM returned
a hash value that is illegal.
Action: If this BUGCHK is reproducible, set this bug dumpable and submit an SPR
along with the dump along with instructions on reproducing the problem.
>)
RETBAD (VACCX0)]
MOVEI T2,HSHPG+1 ;START OF HASH VALUES ON HSHPG
ADD T2,T1 ;HASH VALUE IS INDEX INTO TABLE
MOVE T2,0(T2) ;GET HASH TABLE ENTRY
JUMPE T2,BADRET ;IF NO ENTRY THERE, ACCOUNT IS INVALID
VERAC2: IDIVI T2,PGSIZ ;PAGE # WHERE THE ACCT BLK RESIDES IN THE DATA FILE
MOVEM T3,VERLOC ;RELATIVE LOC ON PG WHERE ACCT BLK BEGINS
CAMN T2,ACTPGN ;IS THIS PAGE ALREADY MAPPED IN?
JRST VERAC3 ;YES, JUST CONTINUE
MOVEM T2,T3
SKIPGE ACTPGN ;ANYTHING MAPPED INTO ACTPG YET?
JRST VERAC5 ;NO, JUST GO MAP IN NEW PAGE
SETZ T1, ;UNMAP CURRENT WINDOW PAGE
HRRZI T2,ACTPG ;START OF ACCOUNT WINDOW PAGE
CALL SETMPG
VERAC5: MOVEM T3,ACTPGN ;SAVE NEW PAGE # MAPPED IN
HRRZ T1,T3
HRL T1,ACTOFN ;T1/ OFN,,NEW PAGE #
MOVX T2,PM%RD ;READ ACCESS TO WINDOW PAGE
HRRI T2,ACTPG ;START ADDRESS OF WINDOW
CALL SETMPG ;MAP IN PG CONTAINING ACCT BLOCK
VERAC3: MOVEI T1,ACTPG
ADD T1,VERLOC ;ADDRESS WHERE ACCOUNT BLOCK LIVES
; NOW HAVE PAGE W/ HASHED ACCT BLK MAPPED INTO ACTPG
; SEE IF ACCT STRINGS ARE THE SAME
; IF YES, CONTINUE - IF NO, GET NEXT CHAINED ACCOUNT
MOVEM T1,VERHDR ;SAVE LOC WHERE HEADER BEGINS
LOAD T3,ACCLS,(T1) ;[7251]GET CLASS OF ACCOUNT
MOVEM T3,VERCLS ;[7251]SAVE IT IN VERCLS
HLRO T2,VERABJ ;LENGTH OF ACCT NAME IN WORDS
MOVNS T2 ;MAKE IT POSITIVE
LOAD T3,BKLEN,(T1) ;LENGTH OF THIS ACCOUNT BLOCK
SUBI T3,4 ;LENGTH OF THIS ACCT NAME
CAMN T2,T3 ;LENGTHS THE SAME?
JRST VERAC7 ;YES, SEE IF THIS IS THE DESIRED ACCOUNT
VERAC4: MOVE T1,VERHDR ;GET ADR OF HEADER
LOAD T2,ACPTR,(T1) ;PTR TO NEXT CHAINED ACCT BLK
JUMPE T2,BADRET ;IF NO MORE ACCT BLKS, GIVE LOSING RETURN
JRST VERAC2 ;GO CHECK NEXT ACCOUNT BLOCK
; SEE IF THIS IS THE DESIRED ACCOUNT BLOCK
; IF YES, AND THE USER IS WHOPER, ACCEPT IT AS A VALID ACCOUNT
; IF USER ISN'T WHOPER, GO SCAN DATA BASE TO VALIDATE THE ACCOUNT
VERAC7: MOVE T1,VERABJ ;SEE IF THIS IS THE DESIRED ACCT
MOVE T2,VERHDR
ADDI T2,4 ;POINT TO THIS ACCOUNT NAME
CALL CHKSAM ;IS THIS THE DESIRED ACCOUNT?
JRST VERAC4 ;NO, GO LOOK AT THE NEXT CHAINED ONE
MOVE T2,VERHDR ;THIS IS THE ACCOUNT
CALL CHKEXP ;HAS IT EXPIRED?
JRST BADRTE ;YES, ACCOUNT IS INVALID
MOVE T1,CAPENB ;GET ENABLED CAPABILITIES
TXNN T1,SC%WHL!SC%OPR ;IS USER WHOPER?
JRST VERAC8 ;NO, GO SCAN DATA BASE
MOVE T1,JOBNO
SKIPN VEREPT ;CHECK FOR VACCT JSYS
JRST VERAC8 ;NO, GO SCAN DATA BASE
MOVE T2,VERHDR ;YES, GET EXP DATE OF ACCOUNT
LOAD T3,ACCLS,(T2) ;GET CLASS OF ACCOUNT
LOAD T2,XPDAT,(T2)
CALL CPYCSH ;SAVE ACCOUNT AND EXP DATE IN JSB CACHE
SETZ T1, ;SAY ACCOUNT DOESN'T MATCH ACCTSR
MOVE T2,VERHDR
LOAD T3,ACCLS,(T2) ;GET CLASS AGAIN
LOAD T2,XPDAT,(T2) ;GET EXPIRATION DATE AGAIN
JRST OKRET ;AND GIVE GOOD RETURN
VERAC8: CALL SCNACT ;GO SCAN DATA BASE
JRST BADRT0 ;ACCOUNT INVALID OR EXPIRED
MOVE Q2,T2 ;ACCOUNT VALID, SAVE EXP DATE
MOVE T3,VERCLS ;[8821] Restore class
CALL CPYCSH ;SAVE ACCT AND EXP DATE IN JSB CACHE
MOVE T2,Q2 ;GET BACK EXPIRATION DATE
MOVE T3,VERCLS ;RESTORE CLASS
SETZ T1, ;ACCOUNT DOESN'T MATCH ACCTSR
JRST OKRET ;GIVE GOOD RETURN
; SEE IF AN ACCOUNT HAS EXPIRED
; CALL: T2/ ADDRESS OF ACCOUNT DATA BLOCK
; CALL CHKEXP
; RETURNS: +1 ENTRY EXPIRED
; +2 ENTRY NOT EXPIRED
CHKEXP: LOAD T2,XPDAT,(T2) ;GET EXPIRATION DATE
CHKEX0: JUMPE T2,RSKP ;IF 0, ENTRY NEVER EXPIRES
PUSH P,T2 ;Save T2 since LGTAD destroys it
CALL LGTAD ;GET CURRENT TIME AND DATE
POP P,T2 ;Restore T2
CAMG T2,T1 ;HAS THE ENTRY EXPIRED?
RETBAD (VACCX2) ;YES
RETSKP ;NO, ENTRY STILL VALID
; SEE IF ACCOUNT MATCHES ACCTSR
; CALL CHKASR
; RETURNS: +1 NO MATCH
; +2 MATCH, T1/ AC%MCH => MATCHES ACCTSR
; RH(T1)/ 0 => ACCOUNT NOT EXPIRED
; 1 => ACCOUNT EXPIRED
; T2/ ACCOUNT EXPIRATION DATE
; CLOBBERS T1 THROUGH T4
CHKASR: MOVE T1,JOBNO
SKIPN T4,JOBDIR(T1) ;IS THIS JOB LOGGED IN?
RET ;NO, DON'T CHECK THE JSB
HRRZ T3,VERNUM ;GET USER FOR WHOM ACCOUNT BEING VALIDATED
CAMN T3,T4 ;VALIDATING FOR SELF ?
JRST CHKAS2 ;YES, CONTINUE ON
SKIPN VEREPT ;SETTING ACCOUNT ON A FILE?
RET ;NO, THEN DO NOT USE ACCOUNT IN THE JSB
CHKAS2: MOVE T1,VERABJ ;AOBJN POINTER TO ACCOUNT
HRRZI T2,ACCTSR ;ADDRESS OF ACCOUNT IN JSB
CALL CHKSAM ;ACCOUNTS THE SAME?
RET ;NO, JUST RETURN
MOVE T2,ACCTSX ;SAME - GET EXPIRATION DATE
CALL CHKEX0 ;ACCTSR EXPIRED?
JRST CHKAS1 ;YES
MOVX T1,AC%MCH
RETSKP
CHKAS1: HRRZI T1,1 ;NOTE THAT ACCTSR HAS EXPIRED
TXO T1,AC%MCH
RETSKP ;AND RETURN
; SEE IF ACCOUNT MATCHES CACHED ACCOUNT (CSHACT)
; CALL CHKCSH
; RETURNS: +1 NO MATCH
; +2 MATCH, RH(T1)/ 0 => ACCOUNT NOT EXPIRED
; 1 => ACCOUNT EXPIRED
; T2/ ACCOUNT EXPIRATION DATE
; CLOBBERS T1 THROUGH T4
CHKCSH: MOVE T1,JOBNO
SKIPN JOBDIR(T1) ;JOB LOGGED IN?
RET ;NO, DON'T CHECK THE JSB
MOVE T1,VERNUM ;GET USER NUMBER BEING VERIFIED
CAME T1,CSHUSR ;SAME AS LAST TIME ?
RET ;NO, INVALID ACCOUNT
MOVE T1,VERABJ ;AOBJN POINTER TO ACCOUNT
HRRZI T2,CSHACT ;ADDRESS OF CACHED ACCOUNT
CALL CHKSAM ;ACCOUNTS THE SAME?
RET ;NO, JUST RETURN
MOVE T2,CSHACX ;SAME - GET EXPIRATION DATE
CALL CHKEX0 ;CSHACT EXPIRED?
JRST CHKCS1 ;YES
MOVE T3,CSHCLS ;GET CLASS OF ACCOUNT
SETZ T1, ;NO, SAY ACCOUNT NOT EXPIRED
RETSKP ;AND GIVE GOOD RETURN
CHKCS1: HRRZI T1,1 ;SAY CSHACT EXPIRED
RETSKP ;AND RETURN
; COPY VALID ACCOUNT TO CACHED ACCOUNT SLOT IN JSB
; THE CACHED ACCOUNT IS CURRENTLY USED ONLY BY VERACT
; TO REMEMBER THE MOST RECENTLY VALIDATED ACCOUNT
;
; CALL: T2/ ACCOUNT EXPIRATION DATE
; T3/ CLASS OF ACCOUNT
; CALL CPYCSH
;
; RETURNS: +1 ALWAYS
; CLOBBERS T1, T2, T3
CPYCSH: MOVEM T2,CSHACX ;SAVE EXP DATE OF CACHED ACCOUNT
MOVEM T3,CSHCLS ;SAVE CLASS IN CACHE
MOVE T4,VERNUM ;GET USER FOR WHOM VALIDATION WAS DONE
MOVEM T4,CSHUSR ;SAVE USER FOR WHOM VALIDATION WAS DONE
HLRE T1,VERABJ
MOVNS T1 ;LENGTH OF ACCOUNT
HRRZ T2,VERABJ ;ADDRESS OF VALID ACCOUNT
MOVEI T3,CSHACT ;COPY ACCOUNT TO JSB
CALL XBLTA
RET ;AND RETURN
; SEE IF TWO STRINGS ARE THE SAME
; CALL: T1/ AOBJN POINTER TO A STRING
; T2/ ADDRESS OF ANOTHER STRING IN ACCOUNT WINDOW PAGE
; CALL CHKSAM
; RETURNS: +1 NOT THE SAME
; +2 ACCOUNT STRINGS ARE THE SAME
CHKSAM: MOVE T3,0(T2) ;GET NEXT WORD IN THE STRING
XOR T3,(T1) ;ARE THEY THE SAME SO FAR?
TRZ T3,1B35 ;IGNORE BIT 35
JUMPN T3,R ;NO, RETURN NOW
AOJ T2, ;POINT TO NEXT WORD IN THE STRING
AOBJN T1,CHKSAM ;CONTINUE COMPARING STRINGS
RETSKP ;ALL DONE, STRINGS ARE THE SAME
; HASH AN ACCOUNT STRING
; CALL: T1/ AOBJN POINTER TO ACCOUNT STRING
; CALL HSHNAM
; RETURNS: +1 ALWAYS, T1/ HASH VALUE
HSHNAM: ASUBR <HSH1,HSH2,HSH3,HSH4>
STKVAR <HSHTMP>
HLRZ T4,T1 ;GET STRING LENGTH
CAIN T4,-1 ;IS THE ACCOUNT ONE WORD LONG?
JRST [ MOVE T3,0(T1) ;YES, GET THE STRING
MOVEM T3,HSHTMP
JRST HSHNM2] ;AND CONTINUE
MOVE T3,0(T1) ;GET FIRST WORD OF STRING
MOVEM T3,HSHTMP ;SAVE IT
ADD T1,[1,,1] ;POINT TO NEXT WORD IN STRING
HSHNM1: MOVE T3,0(T1)
XORM T3,HSHTMP
AOBJP T1,HSHNM2
JRST HSHNM1 ;CONTINUE XOR'ING WORDS IN THE STRING
HSHNM2: MOVE T1,HSHTMP ;GET FINAL VALUE
TRZ T1,1B35 ;MAKE HASHING INDEPENDENT OF BIT 35
XOR T1,RANDOM
MUL T1,RANDOM
MOVMS T1
IDIVI T1,HASHLN ;DIVIDE BY # OF POSSIBLE HASH VALUES
MOVE T1,T2 ;REMAINDER IS HASH VALUE
DMOVE T2,HSH2 ;RESTORE ORIGINAL VALUES
MOVE T4,HSH4
RET ;AND RETURN
RANDOM: 5*5*5*5*5*5*5*5*5*5*5*5*5*5*5
; ACCOUNT IS INVALID - CLEAN UP AND RETURN ERROR
BADRET: SKIPA T1,[VACCX0] ;INVALID ACCOUNT
BADRTE: MOVEI T1,VACCX2 ;ACCOUNT HAS EXPIRED
BADRT0: MOVE Q2,T1 ;SAVE THE ERROR CODE FOR LATER
HRRZ T1,VERNUM
CAIN T1,OPERDN ;VALIDATING FOR THE OPERATOR?
JRST BADRT2 ;YES, CHECK FOR SPECIAL OPERATOR ACCOUNT
MOVE T2,JOBNO ;SEE IF JOB IS LOGGED IN
SKIPN JOBDIR(T2) ;IS IT LOGGED IN?
CAIE T1,SYSTDN ;NO, IS THIS FOR DIRECTORY <SYSTEM>
SKIPA ;NO
JRST BADRT2 ;YES, GO ALLOW THE USE OF "OPERATOR"
MOVE T3,CAPENB ;GET ENABLED CAPABILITIES
TXNE T3,SC%WHL!SC%OPR ;WHEEL OR OPERATOR ?
SKIPN JOBDIR(T2) ;AND NOT LOGGED IN ?
SKIPA ;YES
JRST BADRT2 ;GO CHECK FOR ACCOUNT "OPERATOR"
BADRT3: TXNE Q1,VR%USR ;VALIDATING FOR A USER NUMBER?
JRST BADRT1 ;YES, PROCEED
MOVE T1,STRINX
CALL ULKSTR ;UNLOCK THE STRUCTURE
BADRT1: UNLOCK ACTLCK ;UNLOCK HASH PAGE AND WINDOW PAGE
MOVE T1,Q2 ;GET BACK THE ERROR CODE
RETBAD ;GIVE FAILURE RETURN
BADRT2: SKIPN VEREPT ;IF VACCT JSYS THEN ERROR
JRST BADRT3
MOVE T2,VERLUK
AOS T2 ;START OF ACCOUNT TO VALIDATE
MOVE T1,[-2,,[ASCIZ/OPERATOR/]]
BADRT4: MOVE T3,0(T1) ;GET NEXT WORD IN STRING
CAME T3,0(T2) ;ACCOUNTS THE SAME SO FAR?
JRST BADRT3 ;NO, CLEAN UP AND RETURN ERROR
AOS T2
AOBJN T1,BADRT4 ;SCAN SOME MORE
SETZB T2,T3 ;OPERATOR ACCOUNT NEVER EXPIRES
CALL CPYCSH ;COPY OPERATOR ACCOUNT AND EXP DATE TO JSB
SETZB T1,T2 ;ACCOUNT MATCHES NOTHING IN THE JSB
; AND OPERATOR ACCOUNT NEVER EXPIRES
JRST OKRET ;USING SPECIAL ACCOUNT, GIVE OK RETURN
; ACCOUNT IS VALID - GIVE GOOD RETURN
OKRET: TXNE Q1,VR%USR ;VALIDATING FOR A USER NO?
JRST OKRT1 ;YES, PROCEED
DMOVEM T1,VERTMP ;SAVE THE ANSWER REGISTERS
MOVE T1,STRINX
CALL ULKSTR ;UNLOCK THE STRUCTURE
DMOVE T1,VERTMP ;RESTORE ANSWER
MOVE T3,VERCLS ;RESTORE CLASS
OKRT1: UNLOCK ACTLCK
SOJA T3,RSKP ;SUCCESSFUL RETURN WITH CLASS
VERACX: BUG.(CHK,CRSPAG,JSYSA,HARD,<VERACT - Account data block crosses a page boundary>,,<
Cause: The monitor's account data base illegally crossed a page boundary.
This indicates a problem with the account data base.
Action: There is a problem with the accounts data base. A new accounts data
base should be installed with ACTGEN. If this BUGCHK is reproducible,
set this bug dumpable and submit an SPR along with the dump along with
instructions on reproducing the problem.
>,,<DB%NND>) ;[7.1210]
RETBAD (VACCX0)
VERAX1: BUG.(CHK,BADTAB,JSYSA,HARD,<VERACT - Spurious hash table encountered>,,<
Cause: This BUG indicates that a block has been found in the monitor's account
data base that is not an account block. The account data base is
corrupted.
Action: There is a problem with the accounts data base. A new accounts data
base should be installed with ACTGEN. If this BUGCHK is reproducible,
set this bug dumpable and submit an SPR along with the dump along with
instructions on reproducing the problem.
>)
RETBAD (VACCX0)
; SCAN DATA BASE FILE FOR A VALID USE OF AN ACCOUNT
; CALL SCNACT
; RETURNS: +1 ACCOUNT NOT VALID FOR THIS USE
; +2 ACCOUNT VALID, T2/ EXPIRATION DATE
; AC USE: Q2/ ADDRESS OF DATA BLOCK CURRENTLY BEING SCANNED
SCNACT: STKVAR <NXTPG,TOTLEN,SCNACE>
SETZM SCNACE ;ASSUME NO VALID ACCOUNTS
MOVEI T1,ACTPG ;START OF ACCOUNT WINDOW PAGE
ADDI T1,PGSIZ
MOVEM T1,NXTPG ;IF DATA BLOCK CONTAINS THIS ADDRESS, BAD ERROR!
MOVE Q2,VERHDR ;ADDRESS OF ACCOUNT HEADER
LOAD T1,DATASZ,(Q2) ;GET LENGTH OF ALL DATA FOR THE ACCOUNT
MOVEM T1,TOTLEN ;SAVE IT
SCNAC0: LOAD T1,BKLEN,(Q2) ;LENGTH OF THIS BLOCK
MOVEM T1,T2
SOJ T1,
ADD T1,Q2 ;ADDRESS OF LAST WORD IN BLOCK
CAML T1,NXTPG ;DOES BLOCK CROSS A PAGE BOUNDARY?
JRST VERACX ;YES, GO BUGCHK
ADD Q2,T2 ;GET START OF NEXT DATA BLOCK
MOVE T1,TOTLEN
SUB T1,T2
MOVEM T1,TOTLEN
SKIPG TOTLEN ;DONE SCANNING ALL BLOCKS?
JRST SCNAC2 ;YES, ACCOUNT NOT VALID FOR THIS USE
CAML Q2,NXTPG ;IS THIS BLOCK ON THE NEXT PAGE?
JRST [ CALL SCNMAP ;YES, MAP IN NEW WINDOW PAGE
MOVEI Q2,ACTPG ;MAKE Q2 POINT TO TOP OF NEW PAGE
JRST .+1] ;AND CONTINUE
SCNAC3: LOAD T1,BKTYP,(Q2) ;GET BLOCK TYPE
CAIN T1,.TYNUL ;IS THIS A NULL BLOCK?
JRST [ LOAD T2,BKLEN,(Q2) ;YES
MOVE T1,TOTLEN
SUB T1,T2
MOVEM T1,TOTLEN ;ADJUST COUNT OF WORDS SCANNED
CALL SCNMAP ;MAP IN NEXT PAGE
MOVEI Q2,ACTPG ;MAKE Q2 POINT TO FIRST BLOCK ON PAGE
JRST SCNAC3] ; and check next block
LOAD T1,BKTYP,(Q2) ;
CAIN T1,.TYWUS ;WILDCARD USER?
JRST SCNUSR ;YES, GO SCAN THE BLOCK
CAILE T1,.TYALU ;SOME KIND OF USER DATA BLOCK?
JRST SCNDIR ;NO, GO SCAN DIRECTORY BLOCKS
CAILE T1,.TYACC ;REALLY A USER BLOCK?
JRST SCNUSR ;YES, GO SCAN IT
CAIE T1,.TYACC ;IS IT AN ACCOUNT BLOCK?
JRST VERAX1 ;NO, BAD BLOCK
SKIPLE TOTLEN ;ALL BLOCKS SCANNED?
JRST SCNAC0 ;NO, GO LOOK AT NEXT BLOCK
SCNAC2: MOVEI T1,VACCX0 ;NO VALID ACCOUNTS
SKIPE SCNACE ;WAS AN EXPIRED ONE FOUND?
MOVEI T1,VACCX2 ;YES, RETURN THIS ERROR CODE
RETBAD
; SCANNING A USER BLOCK FOR A MATCH
SCNUSR: CALL SCNUNO ;GO DO THE WORK
JRST SCNAC1 ;NO MATCH OR ACCOUNT EXPIRED, GO LOOK AT NEXT BLOCK
RETSKP ;MATCH, NOT EXPIRED, OK RETURN
; SCANNING A DIRECTORY BLOCK FOR A MATCH
SCNDIR: TXNE Q1,VR%USR ;USER NUMBER GIVEN?
SKIPA T1,[VACCX0] ;YES. NO MATCH THEN
CALL SCNDNO ;GO DO THE WORK
JRST SCNAC1 ;NO MATCH OR ACOUNT EXPIRED, GO LOOK AT NEXT BLOCK
RETSKP ;MATCH, NOT EXPIRED,GIVE GOOD RETURN
SCNAC1: CAIN T1,VACCX2 ;DID THE ACCOUNT EXPIRE?
SETOM SCNACE ;YES, REMEMBER THAT
JRST SCNAC0 ;LOOP BACK TO SEE IF A VALID ONE EXISTS
; SCANNING USER BLOCKS
; CALL: Q2/ ADDRESS OF DATA BLOCK CURRENTLY BEING SCANNED
; CALL SCNUNO
; RETURNS: +1 NO MATCH OR ACCOUNT EXPIRED
; +2 MATCH, T2/ 0 => ACCOUNT NEVER EXPIRES
; OR T2/ EXPIRATION DATE
SCNUNO:LOAD T1,BKTYP,(Q2) ;GET THIS BLOCK TYPE
CAIN T1,.TYALU ;"ALL USERS" BLOCK?
JRST SCNUN0 ;YES, SEE IF IT HAS EXPIRED
CAIN T1,.TYUGP ;USER GROUP BLOCK?
JRST SCNUN1 ;YES, GO SCAN IT
SKIPN TFL ;IF VERACJ ENTRY
JRST SCN2 ;GO USUAL WAY
MOVE T2,JOBNO
HRRZ T2,JOBDIR(T2)
SKIPE T2 ;is the user logged in ?
JRST [ MOVEI T2,USRNAM+1 ;[3138] YES USE USER NAME IN JSB
JRST SCN1] ;[3138] GO CHECK USER NAME
SCN2:
MOVE T2,DIRORA ;ADDRESS OF MAPPED-IN DIR
LOAD T2,DRNAM,(T2) ;START OF LOGGED-IN DIRECTORY NAME
ADD T2,DIRORA ;ADDRESS OF DRNAM BLOCK
AOS T2 ;POINT PAST BLOCK HEADER
SCN1:
CAIN T1,.TYWUS ;WILD CARD STRING?
JRST SCNUN2 ;YES, GO HANDLE IT SPECIALLY
LOAD T1,BKLEN,(Q2) ;BLOCK LENGTH
SUBI T1,2 ;GET USER NAME LENGTH TO COMPARE
MOVNS T1 ;MAKE IT NEGATIVE
HRLZS T1
MOVE T3,Q2
ADDI T3,2 ;ADDRESS OF START OF USER NAME
HRR T1,T3 ;NOW HAVE AOBJN POINTER TO NAME
CALL CHKSAM ;USER NAMES THE SAME?
RETBAD (VACCX0) ;NO
; ...
; ...
SCNUN0: MOVE T2,Q2 ;A MATCH WAS FOUND
CALL CHKEXP ;SEE IF ACCOUNT HAS EXPIRED FOR THIS USE
RETBAD (VACCX2) ;EXPIRED
LOAD T2,XPDAT,(Q2) ;NOT EXPIRED, GET EXP DATE
SETZ T1, ;ACCOUNT DOESN'T MATCH ONE IN THE JSB
RETSKP ;GIVE MATCH RETURN
; TRY TO MATCH A USER GROUP NUMBER
SCNUN1: LOAD T1,USRGP,(Q2) ;GET GROUP NUMBER
CALL CHKUGP ;CHECK AGAINST GROUP #'S IN DIRECTORY
RETBAD (VACCX0) ;NO MATCH
JRST SCNUN0 ;MATCH, SEE IF ACCOUNT HAS EXPIRED
;WILD CARD USER NAME STRING
SCNUN2: MOVSI T1,(POINT 7,0(T4)) ;SET UP BYTE POINTER TO NAME STRING
MOVE T4,T2 ;GET POINTER TO FIRST BYTE OF USER NAME
MOVSI T2,(POINT 7,0) ;NOW SET UP A POINTER TO THE MASK STRING
HRRI T2,2(Q2) ;GET ADR OF FIRST WORD OF MASK STRING
CALL CHKWLD ;NOW COMPARE THE STRINGS FOR A MATCH
RETBAD (VACCX0) ;NO MATCH
JRST SCNUN0 ;MATCHED, GO SEE IF EXPIRED
; SCANNING DIRECTORY BLOCKS
; CALL: Q2/ ADDRESS OF DATA BLOCK CURRENTLY BEING SCANNED
; CALL SCNDNO
; RETURNS: +1 NO MATCH OR ACCOUNT EXPIRED
; +2 MATCH, T2/ 0 => ACCOUNT NEVER EXPIRES
; OR T2/ EXPIRATION DATE
SCNDNO: LOAD T1,SXSTR,(Q2) ;GET BLOCK'S STRUCTURE NAME
CAMN T1,[-1] ;ALL STRUCTURES VALID?
JRST SCNDN2 ;YES, PROCEED
MOVE T2,STRINX ;GET STRUCTURE NUMBER
ADDI T2,DVXST0 ;ADD OFFSET TO STR PART OF DEVICE TABLES
CAME T1,DEVNAM(T2) ;STRUCTURE NAME MATCH ALIAS?
RETBAD (VACCX0) ;NO, RETURN IMMEDIATELY
SCNDN2: LOAD T1,BKTYP,(Q2) ;GET BLOCK TYPE
CAIN T1,.TYDGP ;DIRECTORY GROUP BLOCK?
JRST SCNDN1 ;YES, GO CHECK DIRECTORY GROUPS
MOVE T2,DIRORA ;START OF MAPPED-IN DIRECTORY
LOAD T2,DRNAM,(T2)
ADD T2,DIRORA ;ADDRESS OF BLOCK WHERE DRNAM LIVES
AOJ T2, ;POINT PAST BLOCK HEADER
LOAD T1,BKLEN,(Q2) ;GET THIS BLOCK'S LENGTH
SUBI T1,3 ;LENGTH OF DIRECTORY NAME IN WORDS
MOVNS T1 ;MAKE IT NEGATIVE
HRLZS T1
MOVE T3,Q2
ADDI T3,3 ;ADDRESS OF START OF DIRECTORY NAME
MOVE T4,0(T3) ;GET FIRST WORD OF DIR NAME
CAMN T4,[-1] ;ALL DIRECTORIES VALID?
JRST SCNDN0 ;YES, PROCEED
HRR T1,T3 ;NOW HAVE AOBJN PTR TO DIRECTORY NAME
CALL CHKSAM ;DIRECTORY NAMES THE SAME?
RETBAD (VACCX0) ;NO
SCNDN0: CALLRET SCNUN0 ;GET DATA AND RETURN
; TRY TO MATCH A DIRECTORY GROUP NUMBER
SCNDN1: LOAD T1,DIRGP,(Q2) ;GET GROUP NUMBER
CALL CHKDGP ;GROUP NUMBER MATCH ONE IN DIR LIST?
RETBAD (VACCX0) ;NO MATCH
JRST SCNDN0 ;MATCH, CONTINUE
; UNMAP CURRENT ACCOUNT WINDOW PAGE AND MAP IN NEXT SEQUENTIAL PAGE
; CALL SCNMAP
; CLOBBERS T1, T2, T3
SCNMAP: SETZ T1,
HRRZI T2,ACTPG ;ADDRESS OF WINDOW PAGE IN CORE
CALL SETMPG ;UNMAP IT
AOS ACTPGN ;GET SET TO MAP IN NEXT PAGE
HRRZ T1,ACTPGN
HRL T1,ACTOFN ;T1/ OFN,,NEW PAGE NUMBER
MOVX T2,PM%RD ;READ ACCESS TO WINDOW
HRRI T2,ACTPG
CALL SETMPG ;MAP IN THE NEXT PAGE
RET ;AND RETURN
SUBTTL End of JSYSA
TNXEND
END