Google
 

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