Google
 

Trailing-Edge - PDP-10 Archives - BB-Y393H-SM - monitor-sources/jsysa.mac
There are 53 other files named jsysa.mac in the archive. Click here to see a list.
;Edit 6732 to JSYSA.MAC by LEACHE on Thu 27-Jun-85, for SPR #17832
;		Fix disk-allocation count problem at ENAC0

;Edit 6729 to JSYSA.MAC by SANTIAGO on Tue 18-Jun-85
;		Prevent user getting password through address break
;;		Fix originally by GLINDELL
;Edit 3188 to JSYSA.MAC by EVANS on Wed 12-Dec-84, for SPR #20023
;		Remove edit 1866 - 3185 supersedes it.
;Edit 3182 to JSYSA.MAC by EVANS on Wed 14-Nov-84
;		Call to LOGCJM caused writing of 2 session remarks (records)
;;		Remove for now until better fix.
;Edit 3174 to JSYSA.MAC by LOMARTIRE on Fri 12-Oct-84, for SPR #18546
;		Grant PM%WT in process to file PMAP% to allow section creates
;Edit 3173 to JSYSA.MAC by SHTIL on Fri 12-Oct-84 - REMOVE EDIT 3128
;Edit 3166 to JSYSA.MAC by GLINDELL on Mon 17-Sep-84, for SPR #17637
;		ACJKIL must be resident since it is called from the sched cycle
;Edit 3153 to JSYSA.MAC by SHTIL on Mon 27-Aug-84 - Final fix for SPR# 20138
;Edit 3143 to JSYSA.MAC by EVANS on Mon 30-Jul-84, for SPR #20141
;		Do not skip over first user account block on a page - this user
;;		could never log in; the system never "saw" the account.
;Edit 3138 to JSYSA.MAC by SHTIL on Wed 18-Jul-84 - Final fix for 3137
;Edit 3137 to JSYSA.MAC by SHTIL on Mon 16-Jul-84 - CANCEL EDIT 3128
;Edit 3128 to JSYSA.MAC by SHTIL on Thu 21-Jun-84, for SPR #20108
;		Let a user to set a file account regardless whether he is
;;		WHEEL  or OPR and what account he is presently running
;Edit 3127 to JSYSA.MAC by TBOYLE on Wed 20-Jun-84, for SPR #18961
;		Fix session start and end times and checkpointed values
;Edit 3110 to JSYSA.MAC by EVANS on Fri 18-May-84
;		ELIMINATE GARBAGE IN ACCOUNTING RECORDS BY GETTING NODE NAME FROM LLSR, NOT LLSR(P1)
;Edit 3078 to JSYSA.MAC by EVANS on Mon 5-Mar-84, for SPR #19898
;		Make Attach, Detach, & Set Session Remark write USAGE records.
;Edit 3064 to JSYSA.MAC by CJOHNSON on Tue 3-Jan-84, for SPR #19853
;		Make NIN return error if 2**35 or greater is input
;Edit 3041 to JSYSA.MAC by TSANG on Tue 8-Nov-83, for SPR #19555
;		Modify Edit #3036
;Edit 3040 to JSYSA.MAC by CJOHNSON on Tue 8-Nov-83, for SPR #18631
;		Return DESX2 error if SFCOC tried on another assigned tty
;Edit 3036 to JSYSA.MAC by TSANG on Thur 3-Nov-83, for SPR #19555
;     		Set the node name in Entry Header Record.
;Edit 3003 to JSYSA.MAC by TBOYLE on Mon 29-Aug-83, for SPR #19182
;		Make TMON% leave RH unchnaged with .SFSOK function.
;Edit 3001 to JSYSA.MAC by TBOYLE on Mon 22-Aug-83, for SPR #17558
;		Make RESET% cleat ARTHTR (Arithmetic traps)
;EDIT 2923 - PREVENT ILMNRF
; UPD ID= 285, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.13,  13-Jan-83 16:19:48 by MOSER
;EDIT 2899 - ALLOW PMAP DELETE OF PAGES IN NONEXISTANT FILE SECTION
; UPD ID= 271, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.12,  27-Dec-82 16:32:46 by WEETON
;EDIT 2890 - Check privs before doing .USCKI function of USAGE JSYS
; UPD ID= 241, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.11,  11-Nov-82 16:56:15 by MOSER
;EDIT 2858 - PREVENT ILPPT3 FROM RCVOK
; UPD ID= 211, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.10,  14-Oct-82 15:29:18 by MOSER
;EDIT 2836 - PREVENT PTNON0 WHEN USER LOGS IN - ACTLCK TRASHED
; UPD ID= 201, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.9,   6-Oct-82 14:38:42 by MOSER
;EDIT 2831 - PREVENT SPURIOUS RCVTMR BUGCHKS
; UPD ID= 173, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.8,  27-Sep-82 14:22:29 by MOSER
;EDIT 2816 - FIX DISPOSITION FOR REQUESTS AFTER GIVTMR, RCVTMR
; UPD ID= 168, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.7,  14-Sep-82 13:24:26 by MOSER
;EDIT 2814 - USE TPRCYC FOR OFFLINE EXPIRATION IN GTDIR
; UPD ID= 166, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.6,  14-Sep-82 11:42:07 by MOSER
;EDIT 2813 - RCVOK - RETURN -1 AS TERMINAL NUMBER IF DETACHED JOB
; UPD ID= 108, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.5,  27-Jul-82 15:54:42 by MOSER
;EDIT 2635 - INCLUDE NODE NAME IN USAGE RECORDS.
; UPD ID= 44, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.4,   3-Apr-82 17:52:42 by ZIMA
;Edit 2607 - Change ACVAR to use v5 MACSYM.
; UPD ID= 21, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.3,  21-Mar-82 15:55:10 by ZIMA
;Edit 2007 - Reset ARPANET connections in RESET JSYS.
; UPD ID= 14, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.2,  17-Mar-82 15:56:11 by ZIMA
;Edit 2003 - Fix NULQTA BUGHLTs from PMAP with non-open JFN.
;<4-1-FIELD-IMAGE.MONITOR>JSYSA.MAC.2, 25-Feb-82 20:24:56, EDIT BY DONAHUE
;UPDATE COPYRIGHT DATE
; UPD ID= 937, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.15,   6-Jan-82 14:08:02 by MOSER
;EDIT 1971 - More of edit 1970.
; UPD ID= 930, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.14,  14-Dec-81 16:28:13 by MOSER
;EDIT 1970 - ADD ACTBBD BUGCHK FOR BAD ACCOUNT FILE.
; UPD ID= 799, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.13,  15-Sep-81 14:18:46 by SCHMITT
;Edit 1942 - add monitor uptime in UFRSTT record
; UPD ID= 735, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.12,  21-Aug-81 09:31:12 by ZIMA
;Edit 1927 - put edit 1907 in standard form.  No code changes.
; UPD ID= 714, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.11,  18-Aug-81 16:37:26 by ZIMA
;Edit 1924 - put edit 1825 in standard form.  No code changes.
;Edit 1924 - put edit 1823 in standard form.  No code changes.
; UPD ID= 651, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.10,   9-Jul-81 11:51:24 by MOSER
;EDIT 1907 - Subtract 1 from arg block length before using it as a group
; counter in GTDGRP.
; UPD ID= 528, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.9,  12-May-81 17:37:41 by SCHMITT
;Edit 1872 - Lock ACTLCK before reference into HSHPG
; UPD ID= 513, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.8,   5-May-81 17:18:30 by SCHMITT
;Edit 1866 - Check for mounted structure at .DELDF
; UPD ID= 445, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.7,  14-Apr-81 17:23:23 by ZIMA
;Edit 1844 - Fix CFIBF, CFOBF, SFCOC, SFMOD, SFPOS, SOBE for noop conditions
; and LSTERR setting on errors.
; UPD ID= 398, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.6,  13-Feb-81 09:11:52 by DONAHUE
;Edit 1831 - Fix bug which prevented fork from clearing address break for self
; UPD ID= 358, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.5,   6-Jan-81 12:33:12 by SCHMITT
;Edit 1825 - Change call to FRKMAP in RMAP to FKHPTN and add ITERR return
; UPD ID= 347, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.3,  29-Dec-80 16:47:31 by SCHMITT
;Edit 1823 - Change .CACCT to perform USAGE login and logout rather than
;	     session end
; UPD ID= 311, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.3,   6-Dec-80 17:53:43 by ZIMA
;Edit 1812 - Fix ERSTR to recognize ERJMP/ERCAL better on errors.
; UPD ID= 215, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.2,  24-Sep-80 13:17:06 by ZIMA
;Edit 1787 - Fix USAGE JSYS .USRAS function to return values.
; UPD ID= 188, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.6,   4-Sep-80 11:45:34 by ZIMA
;Edit 1779 - Fix wild addressing problem in RPACS causing system crashes.
; UPD ID= 176, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.5,   2-Sep-80 13:56:34 by ZIMA
; UPD ID= 148, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.4,  26-Aug-80 16:16:34 by ZIMA
;Edit 1766 - fix RMAP to lock fork structure before touching PSBs.
; UPD ID= 138, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.3,   4-Aug-80 12:51:00 by SCHMITT
; UPD ID= 26, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.2,   4-Jun-80 11:11:45 by ZIMA
;EDIT 1724 - Fix wrong value for disk quota +infinity near ENAC0:
; UPD ID= 219, SNARK:<4.MONITOR>JSYSA.MAC.254,  24-Jan-80 09:45:52 by GRANT
;TCO 4.2598 - MAKE THE RELEASING OF PRARG'S JSB SPACE A SUBROUTINE (PRARGF)
;<4.MONITOR>JSYSA.MAC.253,  3-Jan-80 08:09:05, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
; UPD ID= 49, SNARK:<4.MONITOR>JSYSA.MAC.252,  29-Nov-79 09:14:40 by GRANT
;TCO 4.2583 - Make GETOK return an error status block
;TCO 4.2584 - Make GETOK correctly store a user-defined function code
;<4.MONITOR>JSYSA.MAC.251, 20-Nov-79 16:19:51, Edit by KONEN
;Allow indexed addresses for USAGE JSYS temporarily
;<4.MONITOR>JSYSA.MAC.250,  3-Nov-79 16:33:49, EDIT BY R.ACE
;BUG DOCUMENTATION
;<4.MONITOR>JSYSA.MAC.249,  3-Nov-79 11:19:35, EDIT BY R.ACE
;SMAP - CHANGE LK%CNT TO PM%CNT
;<4.MONITOR>JSYSA.MAC.248,  1-Nov-79 14:10:29, EDIT BY GRANT
;FIX SAVEAC ARGUMENTS IN SETACJ
;<4.MONITOR>JSYSA.MAC.247, 29-Oct-79 10:16:23, EDIT BY R.ACE
;REMOVE CPYUF1 BUGCHK
;<4.MONITOR>JSYSA.MAC.246, 24-Oct-79 18:13:02, EDIT BY MURPHY
;HANDLE SKIP/NOSKIP FROM SECMAP
;<4.MONITOR>JSYSA.MAC.245, 24-Oct-79 12:52:59, EDIT BY GRANT
;TCO 4.2543 - ADD RCVOK TIMER
;<4.MONITOR>JSYSA.MAC.244,  2-Oct-79 16:37:24, EDIT BY HALL
;SMAP - ALLOW ONLY PRIVATE SECTIONS
;<4.MONITOR>JSYSA.MAC.243,  2-Oct-79 16:33:55, EDIT BY MILLER
;FIX QUEUE HANDLING IN RCVOK TO BE RACE FREE
;<4.MONITOR>JSYSA.MAC.242,  2-Oct-79 09:41:49, Edit by KONEN
;MAKE SCNDNO CHECK ALIAS, RATHER THAN STR NAME
;MAKE CHKSAM AND HSHNAM IGNORE BIT 35
;IMPLEMENT -1 ARGUMENT AS CURRENT USER TO .VACCT
;<4.MONITOR>JSYSA.MAC.241,  1-Oct-79 15:40:21, EDIT BY MILLER
;MAKE SURE IF ACJ CALLED FOR ACCESS THAT SECOND PASS USES SAME FLAGS
; AND TARGET DIRECTORY NUMBER
;<4.MONITOR>JSYSA.MAC.240, 26-Sep-79 16:16:35, EDIT BY HALL
;UFNRAS - CALL BLTMU1 INSTEAD OF BLTMU FOR EXTENDED ADDRESSING
;<4.MONITOR>JSYSA.MAC.239, 26-Sep-79 15:49:46, EDIT BY HALL
;UFNSAS - CALL BLTUM1 INSTEAD OF BLTUM FOR EXTENDED ADDRESSING
;<4.MONITOR>JSYSA.MAC.238, 20-Sep-79 16:26:19, EDIT BY MURPHY
;HANDLE FAILURE OF TTSTI IN .STI
;<4.MONITOR>JSYSA.MAC.237, 20-Sep-79 15:41:54, EDIT BY HALL
;CRJOB,GETOK - CALL BLTUM1 INSTEAD OF BLTUM IN ORDER TO APPLY PCS IF NECESSARY
;RCVOK - CALL BLTMU1 INSTEAD OF BLTMU IN ORDER TO APPLY PCS IF NECESSARY
;<4.MONITOR>JSYSA.MAC.236, 18-Sep-79 16:12:06, EDIT BY HALL
;UFWFET - GET DATA ITEM USING INDEXED REFERENCE INSTEAD OF INDIRECT
;SO THAT ZERO SECTION IS DEFAULTED TO PCS
;<4.MONITOR>JSYSA.MAC.235, 14-Sep-79 15:43:27, EDIT BY MILLER
;TCO 4.2469. ADD .GOACC ACJ FUNCTION
;<4.MONITOR>JSYSA.MAC.234, 12-Sep-79 16:42:12, EDIT BY DBELL
;TCO 4.2462 - RESTORE TRASHED DIRECTORY NUMBER IN GTDIR
;<OSMAN.MON>JSYSA.MAC.1, 10-Sep-79 15:37:42, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>JSYSA.MAC.232, 27-Aug-79 13:51:32, Edit by KONEN
;REMOVE SETTING JOB ENABLED DURING LOGIN
;<4.MONITOR>JSYSA.MAC.231, 23-Aug-79 11:29:41, Edit by KONEN
;TCO 4.2417 - Correct check for "DSK*" for accounts file
;<4.MONITOR>JSYSA.MAC.230, 20-Aug-79 10:27:31, Edit by KONEN
;Allow account on file, if it is current account of user
;<4.MONITOR>JSYSA.MAC.229, 17-Aug-79 10:49:07, EDIT BY HALL
;MAKE RMAP HANDLE FAILURE FROM PTNFKH
;SMAP - HANDLE FAILURE FROM PMAP
;<4.MONITOR>JSYSA.MAC.228, 16-Aug-79 16:55:01, Edit by KONEN
;MAKE SURE LAST WORD OF ACCOUNT IN JSB IS ZEROED AFTER FINAL CHARACTER
; TO CORRECT INVALID ACCOUNT STRINGS WHEN DEFAULTING ACCOUNTS
;<4.MONITOR>JSYSA.MAC.227, 15-Aug-79 13:18:48, EDIT BY R.ACE
;CHANGE CALL TO CK2060 TO CKXADR
;<4.MONITOR>JSYSA.MAC.226, 14-Aug-79 15:05:04, EDIT BY HALL
;SMAP - MOVE PAGING STUFF FROM HERE TO PAGEM, FIX BUGS
;<4.MONITOR>JSYSA.MAC.225, 11-Aug-79 08:23:49, EDIT BY HALL
;SMAP - ALLOW DELETION OF PRIVATE SECTION
;<4.MONITOR>JSYSA.MAC.224,  6-Aug-79 10:34:40, Edit by KONEN
;FIX GETTING 'INVALID ACCOUNT STRING' WHEN RUNNING WITHOUT ACCOUNT
;VALIDATION
;<4.MONITOR>JSYSA.MAC.222, 26-Jul-79 15:37:14, EDIT BY OSMAN
;tco 4.2349 - Put NOINT in UFNSAS to avoid ASGINT
;<4.MONITOR>JSYSA.MAC.221, 26-Jul-79 13:54:28, EDIT BY TOMCZAK
;STDEV - return an error code when checking for initing fork.
;<4.MONITOR>JSYSA.MAC.220, 23-Jul-79 17:01:55, EDIT BY ZIMA
;TCO 4.2337 - Make extra check for possible batch job in USAGE JSYS
;<4.MONITOR>JSYSA.MAC.219, 23-Jul-79 15:40:13, EDIT BY HALL
;ALOCRS - INDEX JOBDIR BY JOB NUMBER
;<4.MONITOR>JSYSA.MAC.218, 13-Jul-79 16:29:41, EDIT BY HALL
;DISOK - LOAD DEFAULT ACTION IN T2 BEFORE TESTING IT
;<4.MONITOR>JSYSA.MAC.217, 13-Jul-79 16:17:31, EDIT BY HALL
;SMAP - CREATE PRIVATE SECTION
;<4.MONITOR>JSYSA.MAC.216, 11-Jul-79 15:22:04, Edit by MCLEAN
;FIX GOKFRE TO USE GOKPSI NOT GOKBIP
;<4.MONITOR>JSYSA.MAC.215,  9-Jul-79 16:39:06, EDIT BY R.ACE
;FIX BAD EDIT TO GETOKM TO GIVE DEFAULT ON RESOURCES-EXHAUSTED
;<4.MONITOR>JSYSA.MAC.214,  3-Jul-79 06:31:54, EDIT BY R.ACE
;FIX RELINT BUGCHKS
;<4.MONITOR>JSYSA.MAC.213, 29-Jun-79 13:57:27, Edit by MCLEAN
;ADD CODE TO MAKE GETOKM NOT FAIL ON RESOURCES FAILURE. MAKE IT TAKE THE DEFAULT PATH
;<4.MONITOR>JSYSA.MAC.212, 15-Jun-79 21:19:51, EDIT BY DBELL
;CHANGE RETBAD IN .GTDIR TO ITERR
;<4.MONITOR>JSYSA.MAC.211, 13-Jun-79 12:38:04, EDIT BY KIRSCHEN
;FIX SETUP OF ACCTSL ON LOGIN
;<4.MONITOR>JSYSA.MAC.210,  7-Jun-79 14:39:51, Edit by KONEN
;REQUIRE REGULATED STRUCTURE TO BE MOUNTED FOR .GTDIR
;<4.MONITOR>JSYSA.MAC.209,  3-Jun-79 13:04:41, EDIT BY KIRSCHEN
;FIX VERIFICATION OF ACCOUNTS USING ACCTSR OR CSHACT IN JSB
; USE ACCSTR ONLY IF VERIFYING ACCOUNT FOR SELF
; USE CSHACT ONLY IF VERIFYING FOR SAME USER AS LAST TIME
;<4.MONITOR>JSYSA.MAC.208, 20-May-79 21:09:32, Edit by LCAMPBELL
; Check JFN for reasonableness at PMAP10 (prevents SECNX BUGHLTs)
;<4.MONITOR>JSYSA.MAC.207, 18-May-79 16:28:02, EDIT BY DBELL
;TCO 4.2253 - FIX VALIDATION OF DIRECTORY GROUP NUMBERS AT SCNDN1
;<4.MONITOR>JSYSA.MAC.206, 28-Apr-79 20:35:39, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.205, 28-Apr-79 20:18:58, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.204, 28-Apr-79 19:35:07, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.203, 28-Apr-79 19:31:21, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.202, 27-Apr-79 13:48:59, Edit by LCAMPBELL
; If non-ARPA monitor, ignore SMON to allow ARPA logins
;<4.MONITOR>JSYSA.MAC.202, 26-Apr-79 23:25:58, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.201, 26-Apr-79 14:17:58, Edit by MCLEAN
;CHANGE GOKMSZ TO BE 80 CHARACTERS
;<4.MONITOR>JSYSA.MAC.200, 23-Apr-79 16:42:57, Edit by KONEN
;<4.MONITOR>JSYSA.MAC.199, 23-Apr-79 12:51:45, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.198, 22-Apr-79 21:32:39, Edit by KONEN
;CHANGE DEVLCK CODE IN STDEV TO CHECKING FOR STR BEING INIT'ED
;<4.MONITOR>JSYSA.MAC.197, 22-Apr-79 13:55:27, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.196, 22-Apr-79 13:41:01, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.195, 22-Apr-79 13:34:31, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.194, 19-Apr-79 16:11:35, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.193, 19-Apr-79 16:05:49, Edit by MCLEAN
;SHORTEN CHECK FOR ACJ JOB/JOB 0
;<4.MONITOR>JSYSA.MAC.192, 18-Apr-79 14:48:32, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.191, 16-Apr-79 23:27:51, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.190, 16-Apr-79 23:18:12, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.189, 16-Apr-79 22:56:11, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.188, 16-Apr-79 22:43:34, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.187, 16-Apr-79 17:21:08, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.186, 16-Apr-79 16:58:02, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.185, 16-Apr-79 16:44:13, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.184, 16-Apr-79 15:53:07, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.183, 15-Apr-79 22:39:55, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.182, 15-Apr-79 22:35:55, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.181, 15-Apr-79 22:13:34, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.180, 15-Apr-79 22:04:10, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.179, 15-Apr-79 22:00:51, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.178, 14-Apr-79 22:44:26, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.177, 14-Apr-79 22:33:50, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.176, 14-Apr-79 21:54:46, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.175, 14-Apr-79 21:51:07, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.174, 14-Apr-79 21:46:17, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.173, 13-Apr-79 10:54:38, EDIT BY MILLER
;REMOVE TCO 4.2224. IT BROKE FILE PAGE DELETING
;<4.MONITOR>JSYSA.MAC.172, 11-Apr-79 13:34:29, Edit by MCLEAN
;ADD NEW GETOK CODE SOME FOR TIMEOUT
;<4.MONITOR>JSYSA.MAC.171, 10-Apr-79 16:35:40, Edit by MCLEAN
;ADD DEFINITONS FOR GTOKPR
;<4.MONITOR>JSYSA.MAC.170, 10-Apr-79 13:21:39, Edit by MCLEAN
;FIX IT SO GETOKM DOES NOT DO GETOK FOR JOB 0 ALSO ADD NEW ARG FOR RCVOK OF NUMBER PASSED
;<4.MONITOR>JSYSA.MAC.169,  9-Apr-79 14:07:00, Edit by MCLEAN
;MAKE GIVOK SUCCEED IF NO SWAP SPACE
;<4.MONITOR>JSYSA.MAC.168,  6-Apr-79 10:35:15, Edit by KONEN
;ADD ELAPSED USE TIME FOR STRUCTURE AND TAPE ACCOUNTING
;<4.MONITOR>JSYSA.MAC.167,  5-Apr-79 16:36:23, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.166,  5-Apr-79 11:11:40, Edit by MCLEAN
;REMOVE 1 ARG FROM GTOKM
;<4.MONITOR>JSYSA.MAC.165,  4-Apr-79 14:27:35, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.164,  4-Apr-79 13:03:41, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.163,  4-Apr-79 12:55:28, Edit by MCLEAN
;FIX GTOKM MACROS FOR RETERR INSTEAD OF RETBAD
;<4.MONITOR>JSYSA.MAC.162,  2-Apr-79 22:34:49, EDIT BY ZIMA
;TCO 4.2225 - Make NOUT recognize following ERJMP/ERCAL on error.
;Also preserve the BOUT error in the ITERR in BOUTA
;<4.MONITOR>JSYSA.MAC.161,  2-Apr-79 21:58:57, EDIT BY ZIMA
;TCO 4.2224 - Prevent PMAP file writes if PM%WR not specified
;<4.MONITOR>JSYSA.MAC.160,  2-Apr-79 16:17:40, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.159,  2-Apr-79 16:02:36, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.158,  2-Apr-79 09:35:20, EDIT BY R.ACE
;ALLOC JSYS - SET DV%ASN FOR DEVICE WHEN GIVING TO USER JOB
;<4.MONITOR>JSYSA.MAC.157, 30-Mar-79 15:56:26, Edit by KONEN
;CORRECT USAGE ENTRIES
;<4.MONITOR>JSYSA.MAC.156, 29-Mar-79 13:40:53, Edit by KONEN
;CORRECT PMAP FOR POSSIBLY UNLOCKING A WRONG JFN
;<4.MONITOR>JSYSA.MAC.155, 27-Mar-79 17:14:37, EDIT BY HALL
;MORE COMMENTS
;<4.MONITOR>JSYSA.MAC.154, 26-Mar-79 17:39:34, EDIT BY HALL
;TYPO
;<4.MONITOR>JSYSA.MAC.153, 26-Mar-79 16:56:22, EDIT BY HALL
;ADD SOME MORE COMMENTS TO GETOK
;<4.MONITOR>JSYSA.MAC.152, 26-Mar-79 13:00:22, EDIT BY MILLER
;FIX UP GETOK0 SO THAT IF SCHEDULER TEST FAILS, REQUEST IS
; PROPERLY TERMINATED.
;<4.MONITOR>JSYSA.MAC.151, 23-Mar-79 17:19:26, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.150, 23-Mar-79 10:01:48, EDIT BY HALL
;MORE COMMENTS
;<4.MONITOR>JSYSA.MAC.149, 23-Mar-79 09:52:32, EDIT BY HALL
;ADD SOME COMMENTS TO GETOK
;<4.MONITOR>JSYSA.MAC.148, 22-Mar-79 21:42:07, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.147, 22-Mar-79 21:36:50, Edit by MCLEAN
;MAKE GETOKM SET REQUESTED FOR TO -1
;<4.MONITOR>JSYSA.MAC.146, 22-Mar-79 17:53:33, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.145, 22-Mar-79 17:41:16, Edit by MCLEAN
;FIX IT SO GETOK DOESN'T USE FIRST WORD OF FREE SPACE
;<4.MONITOR>JSYSA.MAC.144, 22-Mar-79 15:01:33, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.143, 22-Mar-79 14:03:57, Edit by MCLEAN
;FIX IT SO USER FUNCTIONS ALWAYS FAIL IF CHECKING NOT ENABLED
;<4.MONITOR>JSYSA.MAC.142, 21-Mar-79 14:34:42, Edit by MCLEAN
;FIX GOKNOB TO BE NOINT
;<4.MONITOR>JSYSA.MAC.141, 21-Mar-79 10:42:18, EDIT BY BOSACK
;FIX RACE IN OFFUSQ BY MAKING RELSWP CALL NOINT
;<4.MONITOR>JSYSA.MAC.140, 20-Mar-79 14:32:45, Edit by MCLEAN
;FIX STRING ERROR RETURNS IN GETOK
;<4.MONITOR>JSYSA.MAC.139, 20-Mar-79 12:58:44, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.138, 19-Mar-79 10:07:25, EDIT BY KIRSCHEN
;Change [] to () when setting up byte pointer in GIVOK
;<4.MONITOR>JSYSA.MAC.137, 19-Mar-79 10:05:17, EDIT BY KIRSCHEN
;DO NOT CLOBBER BLOCK HEADER IN GOVOK
;<4.MONITOR>JSYSA.MAC.136, 13-Mar-79 17:39:09, Edit by MCLEAN
;FIX DPB TO BE IDPB IN GIVOK
;<4.MONITOR>JSYSA.MAC.135, 13-Mar-79 06:35:27, EDIT BY R.ACE
;TAKE OUT VALIDATION OF .SFTDF WORD IN SMON
;<4.MONITOR>JSYSA.MAC.134, 12-Mar-79 16:19:05, Edit by MCLEAN
;MORE .VACCT FIXES
;<4.MONITOR>JSYSA.MAC.133,  7-Mar-79 19:13:26, Edit by KONEN
;<4.MONITOR>JSYSA.MAC.132,  7-Mar-79 13:25:48, Edit by KONEN
;PREVENT DISMIS WHILE NOSKED
;<4.MONITOR>JSYSA.MAC.131,  7-Mar-79 02:58:12, Edit by MCLEAN
;MAKE GIVOK DO ITERR
;<4.MONITOR>JSYSA.MAC.130,  7-Mar-79 02:40:46, Edit by MCLEAN
;FIX COMMENTS IN GETOK AND FIX ALLOCATION FAILURE LEAVING NOINT
;<4.MONITOR>JSYSA.MAC.129,  5-Mar-79 16:29:05, Edit by MCLEAN
;FIX REGISTER USAGE IN SGOKL
;<4.MONITOR>JSYSA.MAC.128,  5-Mar-79 15:15:42, Edit by MCLEAN
;MORE VACC JSYS FIXES
;<4.MONITOR>JSYSA.MAC.127,  4-Mar-79 17:37:13, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>JSYSA.MAC.126,  2-Mar-79 15:25:20, Edit by MCLEAN
;FIX GETOKM MACROS
;<4.MONITOR>JSYSA.MAC.125, 23-Feb-79 16:53:07, Edit by KONEN
;LOCK DEVICE TABLES DEEPER IN CODE TO AVOID GETTING DEVICE WHILE BEING CHANGED
;<4.MONITOR>JSYSA.MAC.124, 21-Feb-79 11:18:40, EDIT BY MURPHY
;ADD WORKING SET PRELOAD CONTROL TO SMON, TMON - DLM
;<4.MONITOR>JSYSA.MAC.123, 20-Feb-79 15:53:42, Edit by KONEN
;LOCK DEVICE TABLES FOR STDEV TO AVOID GETTING DEVICE WHILE BEING CHANGED
;<4.MONITOR>JSYSA.MAC.122,  9-Feb-79 22:36:18, EDIT BY ZIMA
;TCO 4.2164 - Fix handling of user-defined USAGE entries
;<4.MONITOR>JSYSA.MAC.121,  7-Feb-79 21:19:12, EDIT BY KIRSCHEN
;check for 2060 in smap jsys
;<4.MONITOR>JSYSA.MAC.120,  2-Feb-79 16:31:57, Edit by MCLEAN
;FIX VERACT AND VACCT TO DO CORRECT VALIDATION OF OPERATOR ACCOUNT
;<4.MONITOR>JSYSA.MAC.119, 29-Jan-79 03:55:45, EDIT BY DBELL
;CHANGE REFERENCES TO HSYPAG TO HSYBLK
;<4.MONITOR>JSYSA.MAC.118, 24-Jan-79 13:54:44, Edit by MCLEAN
;FIX BATCH FLAGS FOR OTHER JOBS
;<4.MONITOR>JSYSA.MAC.117, 11-Jan-79 17:29:51, EDIT BY MILLER
;REMOVE CHECK FOR OPERATOR IN VACCT JSYS
;<4.MONITOR>JSYSA.MAC.116,  8-Jan-79 12:29:30, EDIT BY DBELL
;DO OKINT IN NEW SYMBOL TABLE UNMAPPING ROUTINE
;<4.MONITOR>JSYSA.MAC.115,  8-Jan-79 06:47:31, EDIT BY DBELL
;TCO 4.2155 - Implement hidden symbol tables:
;	Make the symbol table lookup functions of SNOOP% understand
;	hidden symbol tables.
;<4.MONITOR>JSYSA.MAC.114, 29-Dec-78 17:51:35, Edit by MCLEAN
;FIX GOKREL TO DO EVERY ENTRY
;<4.MONITOR>JSYSA.MAC.113, 28-Dec-78 15:33:37, Edit by MCLEAN
;PUT SOME CSKEDS IN GETOK CODE SO LOCK DOESN'T HANG EVERYONE
;<4.MONITOR>JSYSA.MAC.112, 22-Dec-78 15:09:04, Edit by OPERATOR
;MAKE SURE STRING ENTRIES IN USAGE TABLES PRECEED OTHER TYPES
;<4.MONITOR>JSYSA.MAC.111, 21-Dec-78 10:36:02, Edit by KONEN
;ADD TAPE AND STRUCTURE MOUNT TABLES FOR USAGE JSYS
;PREVENT PMAP FROM/TO FILE IF MOUNTED ONLY BY ANOTHER FORK OF JOB
;<4.MONITOR>JSYSA.MAC.110, 20-Dec-78 14:44:33, EDIT BY HURLEY.CALVIN
; Add USAGE entries and table for ARCHIVE/VIRTUAL disk account entries
;<4.MONITOR>JSYSA.MAC.109, 19-Dec-78 09:58:06, EDIT BY OSMAN
;ALLOW .SJLLO FROM REMOTE JOB
;<4.MONITOR>JSYSA.MAC.108, 12-Dec-78 15:39:54, Edit by MCLEAN
;MAKE IT SO SMON FOR GETOK CLEANS UP THE QUEUE ON DISABLE
;<4.MONITOR>JSYSA.MAC.107, 11-Dec-78 14:17:52, Edit by MCLEAN
;DON'T ZERO GOKQED IF COUNT POSITIVE
;<4.MONITOR>JSYSA.MAC.106, 11-Dec-78 14:14:00, Edit by MCLEAN
;FIX GOKQED WHEN ^C IS DONE
;<4.MONITOR>JSYSA.MAC.105, 29-Nov-78 19:56:31, EDIT BY ZIMA
;TCO 4.2101 - SET CONTROLLING TERMINAL TO ACCEPT SYS MESSAGES ON LOGIN
;<4.MONITOR>JSYSA.MAC.105, 29-Nov-78 19:48:41, EDIT BY ZIMA
;TCO 4.2100 - FIX CRJOB WITH CJ%NAM ZERO
;<4.MONITOR>JSYSA.MAC.104, 29-Nov-78 08:24:58, EDIT BY R.ACE
;TCO 4.2088 - ADD TAPE-MOUNT DEFAULTS TO SMON/TMON
;FIX MIXUP IN TMON FUNCTION VECTOR
;<4.MONITOR>JSYSA.MAC.103, 13-Nov-78 11:40:25, EDIT BY MILLER
;MAKE SURE TAPE IS INFORMED WHENEVER AN MT IS DEASSIGNED
;<4.MONITOR>JSYSA.MAC.102, 31-Oct-78 16:08:11, Edit by KONEN
;Teach GTDIR when getting defaults to look at user-requested block size
;<4.MONITOR>JSYSA.MAC.99, 24-Oct-78 16:20:00, EDIT BY OSMAN
;TC0 4.2060 - ADD .SJLLO
;<4.MONITOR>JSYSA.MAC.98, 23-Oct-78 21:09:32, Edit by MCLEAN
;TCO 4.2063 ADD BATCH STREAM NUMBER AND FLAGS TO SETJB
;<KONEN>JSYSA.MAC.8, 23-Jun-78 17:44:17, Edit by KONEN
;ADD CODE TO ACCES JSYS TO REQUIRE PRIOR MOUNT INCREMENT FOR NON-PS STR.
;<CALVIN>JSYSA.MAC.1, 22-Aug-78 06:52:33, EDIT BY CALVIN
; Add code to GTDIR to return default online and offline expirations
;<CALVIN>JSYSA.MAC.1, 17-Aug-78 07:38:24, EDIT BY CALVIN
; Implement SMON & TMON functions for archive/virtual disk system
;[BBN-TENEXD]<3-EONEIL>JSYSA.MAC.2,  1-Jun-78 10:59:59, Ed: EONEIL
; SETJB change for archive system (default retrieval mode)
;<4.MONITOR>JSYSA.MAC.95, 19-Oct-78 08:11:53, EDIT BY MILLER
;<4.MONITOR>JSYSA.MAC.94, 17-Oct-78 14:06:15, Edit by MCLEAN
;ADD COMMENTS TO GETOK AND ADD CHANGES FOR LOGIMS CALLING SEQUENCE
;<4.MONITOR>JSYSA.MAC.93, 17-Oct-78 14:00:32, EDIT BY MILLER
;MOD;<4.MONITOR>JSYSA.MAC.92,  2-Oct-78 10:58:54, EDIT BY MILLER
;FIX BYTE POINTER AT PMCRM2
;<4.MONITOR>JSYSA.MAC.91,  2-Oct-78 10:04:55, EDIT BY R.ACE
;TCO 4.2028 - FIX BUG IN RELD - LOST MESSAGES TO DEVICE ALLOCATOR
;<4.MONITOR>JSYSA.MAC.90, 26-Sep-78 08:45:36, EDIT BY R.ACE
;TCO 4.2022 - MAKE RELD RETURN DEVX6 IF DEVICE IS OPEN
;<4.MONITOR>JSYSA.MAC.89, 21-Sep-78 20:28:22, Edit by MCLEAN
;FIX SOME SPECIAL CASES FOR JOB CLASS IN VERACT AND FIX GTOKM MACROS
;<4.MONITOR>JSYSA.MAC.88, 21-Sep-78 14:13:01, EDIT BY MILLER
;MAKE TRVARS IN RPACS,RMAP AND SPACS MATCH THE ONE IN PMAP
; FIX RPACS TO GIVE SPECIAL ERROR ON NON-EX SECTION
;<4.MONITOR>JSYSA.MAC.87, 16-Sep-78 15:59:09, EDIT BY MILLER
;<4.MONITOR>JSYSA.MAC.86, 16-Sep-78 15:10:58, EDIT BY MILLER
;ADD CALL SKDLOG TO LOGIN CODE
;<4.MONITOR>JSYSA.MAC.85, 16-Sep-78 13:54:57, Edit by MCLEAN
;FIX RCVOK ARGUMENTS
;<4.MONITOR>JSYSA.MAC.84,  8-Sep-78 14:47:48, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.83,  7-Sep-78 00:28:29, Edit by MCLEAN
;FIX STDVP1 FOR NEW DEVICE CHARACTERISTICS
;<2MCLEAN>JSYSA.MAC.79,  5-Sep-78 12:55:38, Edit by MCLEAN
;<2MCLEAN>JSYSA.MAC.78,  5-Sep-78 00:12:40, Edit by MCLEAN
;<2MCLEAN>JSYSA.MAC.1, 27-Aug-78 21:52:33, Edit by MCLEAN
;MAKE DEVUNT BE 15 BITS
;<4.MONITOR>JSYSA.MAC.81,  3-Sep-78 23:45:28, Edit by MCLEAN
;FIX RCVOK AND GETOK DATA BASE
;<4.MONITOR>JSYSA.MAC.80,  2-Sep-78 16:37:34, EDIT BY JBORCHEK
;FIX TYPO AT SETACL WHEN CLSSN WAS ADDED
;<4.MONITOR>JSYSA.MAC.79,  2-Sep-78 02:16:08, Edit by MCLEAN
;FIX SGTOK FOR FUNCTION CODE CHECK
;<4.MONITOR>JSYSA.MAC.78,  1-Sep-78 22:52:34, Edit by MCLEAN
;ADD CLSSN TO SETACL TOO...
;<4.MONITOR>JSYSA.MAC.77, 28-Aug-78 08:15:27, EDIT BY MILLER
;CALL FKHPTA FROM RPACS
;<4.MONITOR>JSYSA.MAC.76, 25-Aug-78 14:17:28, EDIT BY MILLER
;MAKE RPACS RETURN A ZERO IF NON-EX SECTION GIVEN
;<4.MONITOR>JSYSA.MAC.75, 24-Aug-78 14:47:03, EDIT BY MILLER
;FIX SCNUNO AND SCNDNO TO RETURN CLASS CORRECTLY
;<4.MONITOR>JSYSA.MAC.74, 24-Aug-78 13:11:37, EDIT BY MILLER
;MAKE SETACT SET PROPER CLASS FOR JOB ON CACCT AND LOGIN
;<4.MONITOR>JSYSA.MAC.73, 24-Aug-78 11:48:25, EDIT BY MILLER
;<4.MONITOR>JSYSA.MAC.72, 24-Aug-78 09:12:13, EDIT BY MILLER
;PROCESS CLASS NUMBER IN ACCOUNTING DATA BASE
;<4.MONITOR>JSYSA.MAC.71, 22-Aug-78 17:48:28, EDIT BY R.ACE
;TCO 1991 - REMOVE SMON/TMON FUNCTION FOR DEFAULT TAPE LABEL TYPE
;<4.MONITOR>JSYSA.MAC.70, 22-Aug-78 15:31:09, EDIT BY JBORCHEK
;MAKE SMON FOR LOCAL HOST CALL STHSTJ (USES NEW FORMAT HOST NUMBER)
;<4.MONITOR>JSYSA.MAC.69, 19-Aug-78 10:46:55, EDIT BY ENGEL
;ADD COMMENTS TO CPMAP:
;<4.MONITOR>JSYSA.MAC.68, 19-Aug-78 10:41:06, EDIT BY ENGEL
;ADD SOME COMMENTS TO .RPACS
;<4.MONITOR>JSYSA.MAC.67, 18-Aug-78 12:50:06, EDIT BY MILLER
;ALLOW SMAP OF FILE SECTION AGAIN. FORK CODE NOW CORRECT
;<4.MONITOR>JSYSA.MAC.66, 17-Aug-78 09:42:09, EDIT BY MILLER
;MORE SMAP CLEAN UP. RETURN BETTER ERROR MESSAGED
;<4.MONITOR>JSYSA.MAC.65, 17-Aug-78 09:39:34, EDIT BY MILLER
;ALLOW ONLY FORK TO FORK MAP FOR SMAP
;<4.MONITOR>JSYSA.MAC.64, 13-Aug-78 12:23:42, EDIT BY MILLER
;RETURN PROPER ERROR CODE IF PMAP VIOALATION IS LNGFX1
;<4.MONITOR>JSYSA.MAC.63,  3-Aug-78 14:12:58, EDIT BY MILLER
;PUT ERJMP AFTER BOUT IN BOUTA
;<4.MONITOR>JSYSA.MAC.62, 31-Jul-78 13:57:50, EDIT BY MILLER
;ALLOW PM%IND IF PMAP DONE FROM MONITOR MODE
;<4.MONITOR>JSYSA.MAC.61, 20-Jul-78 08:28:37, Edit by ENGEL
;CHANGE HRRI AT CRJB5Y: TO A XMOVEI
;<4.MONITOR>JSYSA.MAC.60, 19-Jul-78 00:46:07, Edit by MCLEAN
;FIX GETOK JSYS ARGUMENTS PER SPEC
;<4.MONITOR>JSYSA.MAC.59, 18-Jul-78 14:03:30, Edit by HALL
;<4.MONITOR>JSYSA.MAC.58, 17-Jul-78 13:08:13, Edit by MCLEAN
;GETOK ARGUMENTS CHANGE
;<2MCLEAN>JSYSA.MAC.56, 16-Jul-78 00:10:07, Edit by MCLEAN
;<2MCLEAN>JSYSA.MAC.55, 15-Jul-78 23:50:06, Edit by MCLEAN
;GETOK FOR LOGIN AND CRJOB
;<4.MONITOR>JSYSA.MAC.56, 16-Jul-78 01:06:58, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.55, 16-Jul-78 00:45:20, Edit by MCLEAN
;TCO 1946 AND TCO 1941 NEW SMON/TMON JSYS FOR MAGTAPE LABELS
;AND READ TIME UPDATE MASK
;<4.MONITOR>JSYSA.MAC.54, 15-Jul-78 22:04:59, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.53, 15-Jul-78 21:53:15, Edit by MCLEAN
;FIX GETOKM SO IT DOESN'T ITRAP UNLESS REQUESTED TO.
;<4.MONITOR>JSYSA.MAC.52, 13-Jul-78 01:04:26, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.51, 12-Jul-78 23:57:02, Edit by MCLEAN
;MORE GETOK STUFF
;<3A.MONITOR>JSYSA.MAC.24, 11-Jul-78 13:40:55, Edit by PORCHER
;TCO 1896 - ADD CODE TO HANDLE ABRBITRARY USAGE ENTRIES 5000-9999
;<4.MONITOR>JSYSA.MAC.49,  8-Jul-78 14:37:28, EDIT BY MILLER
;TCP 1934. ALLOW "ABORT" PMAP
;<4.MONITOR>JSYSA.MAC.47, 29-Jun-78 14:30:09, Edit by MCLEAN
;MORE GETOK
;<4.MONITOR>JSYSA.MAC.46, 28-Jun-78 11:31:10, EDIT BY OSMAN
;ADD SJT20 FUNCTION OF SETJB - TCO # 1927
;<4.MONITOR>JSYSA.MAC.45, 27-Jun-78 21:44:01, EDIT BY JBORCHEK
;FIX TYPO. MOVE CHANGED TO LOAD AT GETOK1+19
;<4.MONITOR>JSYSA.MAC.44, 27-Jun-78 15:59:44, Edit by MCLEAN
;MORE GETOK STUFF
;<4.MONITOR>JSYSA.MAC.43, 27-Jun-78 15:57:27, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.42, 27-Jun-78 15:19:04, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.41, 23-Jun-78 14:29:41, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.40, 23-Jun-78 14:15:44, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.39, 23-Jun-78 07:54:46, EDIT BY MILLER
;FIX PLOCK0 NOT TO CALL FKHPTN
;<4.MONITOR>JSYSA.MAC.38, 21-Jun-78 00:25:28, Edit by MCLEAN
;MORE GETOK
;<4.MONITOR>JSYSA.MAC.37, 20-Jun-78 15:53:28, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.36, 20-Jun-78 15:04:39, Edit by MCLEAN
;<1BOSACK>JSYSA.MAC.1000,  5-Jun-78 18:49:44, EDIT BY BOSACK
;<4.MONITOR>JSYSA.MAC.34, 19-Jun-78 13:44:56, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.33, 19-Jun-78 13:43:56, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.32, 19-Jun-78 13:16:02, Edit by HELLIWELL
;ADD SAVEPQ AT PLOCK0
;<4.MONITOR>JSYSA.MAC.31, 19-Jun-78 13:06:07, Edit by MCLEAN
;INSERT GETOK JSYS STUFF
;<4.MONITOR>JSYSA.MAC.30, 14-Jun-78 00:55:37, Edit by MCLEAN
;<2MCLEAN>JSYSA.MAC.19, 14-Jun-78 00:50:38, Edit by MCLEAN
;<2MCLEAN>JSYSA.MAC.17, 10-May-78 01:18:11, Edit by MCLEAN
;TCO 1908 MAKE GETOK CHANGES FOR SMON AND TMON
;<4.MONITOR>JSYSA.MAC.28, 11-Jun-78 17:18:39, Edit by HELLIWELL
;INCREMENT P2 IN LOOP AT LOCK4 IN PLOCK JSYS
;<3A.MONITOR>JSYSA.MAC.18,  9-Jun-78 14:18:38, EDIT BY MILLER
;FIX UP PMCRPS TO ONLY UPDATE COUNT ON ERROR
;<3A.MONITOR>JSYSA.MAC.17,  8-Jun-78 17:08:35, EDIT BY MILLER
;MORE FIXES FOR NEW PMCTL CODE
;<3A.MONITOR>JSYSA.MAC.16,  8-Jun-78 16:07:10, EDIT BY MILLER
;TCO 1893. ENCHANCE PMCTL FUNCTION TO READ PAGE STATE
;<4.MONITOR>JSYSA.MAC.24,  3-Jun-78 20:25:54, Edit by JBORCHEK
;MOVE SNOOP STORAGE TO STG
;<3A.MONITOR>JSYSA.MAC.15, 26-May-78 16:03:52, Edit by HELLIWELL
;MAKE PLOCK0 SUBR RETURN OKINT ON ERRORS
;<4.MONITOR>JSYSA.MAC.22, 25-May-78 13:43:38, Edit by HELLIWELL
;MAKE PLOCK0 GLOBAL
;<3A.MONITOR>JSYSA.MAC.13, 25-May-78 13:39:55, Edit by HELLIWELL
;MAKE PLOCK0 SUBROUTINE SO VB10 CODE CAN LOCK PAGES
;<4.MONITOR>JSYSA.MAC.20, 23-May-78 13:45:54, EDIT BY MILLER
;CHANGE CALL LODPPG TO CALL LODPPS
;<3A.MONITOR>JSYSA.MAC.11, 23-May-78 11:14:51, EDIT BY MILLER
;MORE FIXES TO PLOCK
;<3A.MONITOR>JSYSA.MAC.10, 23-May-78 10:30:12, EDIT BY MILLER
;FIX TYPEOS
;<3A.MONITOR>JSYSA.MAC.9, 23-May-78 10:25:02, EDIT BY MILLER
;FIX PLOCK TO ALLOW LOCKING OF MULTIPLE PHYSICAL PAGES
;<3A.MONITOR>JSYSA.MAC.8, 18-May-78 12:45:59, EDIT BY MILLER
;TCO 1189. ADD NEW SMON AND TMON FUNCTIONS FOR STATUS REPROTING
;<4.MONITOR>JSYSA.MAC.16, 26-Apr-78 16:39:40, EDIT BY MILLER
;DON'T SCAN DIR BLOCKS IF USER NUMBER GIVEN TO VERACT
;<4.MONITOR>JSYSA.MAC.15,  2-Mar-78 17:50:24, EDIT BY MILLER
;ACCOUNT FOR NEW SKIP RETURN FROM TTDIBE
;<3A.MONITOR>JSYSA.MAC.5,  2-Mar-78 17:02:41, EDIT BY MILLER
;CHANGE CALL TO TTDOBE
;<4.MONITOR>JSYSA.MAC.13,  1-Mar-78 10:52:45, Edit by PORCHER
;Isolate .USSAS and .USRAS functions from USAGE JSYS
;<4.MONITOR>JSYSA.MAC.12, 28-Feb-78 17:13:37, Edit by PORCHER
;Make STAD call NXTASC to recompute next accounting shift change
;<4.MONITOR>JSYSA.MAC.11, 28-Feb-78 13:10:49, Edit by PORCHER
;Add USAGE functions .USCAS,.USSAS,.USRAS for accounting shift changes
;<4.MONITOR>JSYSA.MAC.10, 17-Feb-78 09:02:49, EDIT BY MILLER
;FIX ERROR CODE FOR PMAP TO APPEND FILE
;<4.MONITOR>JSYSA.MAC.9, 16-Feb-78 17:39:28, EDIT BY MILLER
;FIX UP ERROR CODES FOR SMAP JSYS
;<4.MONITOR>JSYSA.MAC.8, 16-Feb-78 17:30:07, EDIT BY MILLER
;ADD SMAP JSYS
;<4.MONITOR>JSYSA.MAC.7, 16-Feb-78 09:22:28, Edit by PORCHER
;<3A.MONITOR>JSYSA.MAC.3, 15-Feb-78 08:12:31, EDIT BY MILLER
;USE SYMBOLIC OFFSETS IN PMCTL ERROR FUNCTION
;<3A.MONITOR>JSYSA.MAC.2,  3-Feb-78 11:31:57, EDIT BY MILLER
;FIXES TO "READ ERROR" FUNCTION OF PMCTL
;<4.MONITOR>JSYSA.MAC.4, 28-Jan-78 15:56:05, Edit by PORCHER
;<4.MONITOR>JSYSA.MAC.3, 28-Jan-78 15:34:19, EDIT BY PORCHER
;Add execute-only checks to ADBRK, PMAP, SPACS and SETER
;<4.MONITOR>JSYSA.MAC.2, 24-Jan-78 10:19:50, EDIT BY MILLER
;MERGE IN 3A CHANGES
;<3A.MONITOR>JSYSA.MAC.1, 23-Jan-78 20:47:32, EDIT BY MILLER
;ADD PLOCK JSYS CODE. FINISH PMCTL- ADD READ ERROR FUNCTION
;<4.MONITOR>JSYSA.MAC.1, 12-Dec-77 11:32:25, EDIT BY CROSSLAND
;FIX TO SET TIME AND DATE ROUTINE FOR REORGANIZATION OF TIMER QUEUES

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH PROLOG,ACTSYM
	TTITLE JSYSA
	SWAPCD

;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 FJSYS.

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
;**;[3036]	Add one line		YKT	NOV-03-83
EXTN <ASZSIX>			;[3036] IN MEXEC

RS(FACTSW)			; Fact switches

RS TADIDT,1			;INITIAL DAY AND TIME

PPNLH==:4			;SYSTEM DEFINED PPN LHS

;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
	>

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

SJ%OWN==:1B0			;IF SET, THEN SETTING PARAMETERS IN OWN JOB


;BIT FOR SETACT (SET ACCOUNT) AND VERACT (VERIFY ACCOUNT)

AC%MCH==:1B1			;ACCOUNT MATCHES ACCTSR
;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

;**;[1763] REWRITE BIN1 ROUTINE   RAS   4-AUG-80
;LOCAL BIN

;RETURNS +1:	ERROR OR EOF
;	 +2:	BYTE IN B
;
; This routine will return a byte from the users address space using
; the contents of the users AC1 as the source designator.  CR are eaten
; if they are followed by LFs. Otherwise, the CR is returned.

BIN1::	SAVEAC <T1>		;SAVE THIS AC
	UMOVE A,1		;GET USERS SOURCE DESIGNATOR
	CALL BIN2		;GET ONE BYTE FROM DESIGNATOR
	 RET			;ERROR OR EOF, RETURN FACT TO CALLER
	CAIE T2,.CHCRT		;IS THE BYTE A CARRIAGE RETURN?
	 RETSKP			;NO, RETURN THE BYTE TO CALLER
	CALL BIN2		;IT IS A CARRIAGE RETURN, GET NEXT BYTE
	 RETSKP			;ERROR OR EOF, RETURN THE LAST BYTE
	CAIN T2,.CHLFD		;IS THIS BYTE A LF?
	 RETSKP			;YES, RETURN IT AS BYTE
	BKJFN			;BYTE IS NOT A LF, PUT IT BACK
	 SKIPA			;STRANGE ERROR, DON'T UPDATE USERS DESIGNATOR
	UMOVEM T1,T1		;UPDATE USER'S SOURCE DESIGNATOR
	MOVEI T2,.CHCRT		;GET BACK THE CARRIAGE RETURN
	RETSKP			;AND GIVE THIS BACK TO THE CALLER

;Routine to input one byte from designator in T1.  Will return any byte

BIN2:	TLNN A,777777		;DO WE HAVE A STRING POINTER
	JRST [	BIN		;NOT STRING PTR, DO REGULAR BIN
		 ERJMP [RET]	;ERROR OR EOF
		RETSKP]		;RETURN BYTE
	TLC A,777777		;DO WE HAVE A -1 IN LH?
	TLCN A,777777		;...
	HRLI A,440700		;YES, MAKE IT A STANDARD BYTE POINTER
	XCTBU [ILDB B,A]	;GET BYTE
	UMOVEM A,1		;AND UPDATE USERS POINTER
	RETSKP			;AND GIVE BYTE BACK
;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::SE1CAL
	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
CHKPSX::SAVEQ
	JUMPE B,RETO		;IF NO PASSWORD STRING, RETURN
	PUSH P,B
	MOVE B,DIRORA		;GET ADDRESS OF MAPPED DIR
	LOAD B,DRPSW,(B)	;GET ADDRESS OF PASSWORD STRING
	JUMPE B,[SUB P,BHC+1
		JRST RETZ]
	ADD B,DIRORA		;GET ABSOLUTE ADDRESS OF PASSWORD STRING
	MOVE C,1(B)
	TLNN C,774000
	JRST [	SUB P,BHC+1
		JRST RETZ]	; Null password never matches
	MOVSI A,(POINT 7,0(B),35)
	POP P,C
	TLC C,-1		; SEE IF LH = -1
	TLCN C,-1
	HRLI C,(<POINT 7,0>)	;YES, SET UP BYTE POINTER
	MOVEI Q1,MAXLC		;SET UP LIMIT OF CHARACTERS
CHKPS1:	XCT CHKPST		;GET NEXT BYTE
	CAIL D,"A"+40		;LOWERCASE?
	CAILE D,"Z"+40
	SKIPA
	SUBI D,40		;YES, CONVERT IT TO UPPERCASE
	ILDB Q3,A
	CAME D,Q3
	JRST CHKPS2		;NO MATCH, GO READ REST OF STRING
	JUMPE D,RSKP		;MATCH
	SOJG Q1,CHKPS1		;COUNT DOWN MAX STRING LENGTH
	JRST RETZ		;STRING TOO LONG

CHKPS2:	CAIN Q1,MAXLC		;FIRST CHARACTER?
	JUMPE D,RETO		;YES, IF NULL, THEN DONT NEED TO WAIT
CHKPS3:	JUMPE D,RETZ		;END OF USER'S STRING?
	SOJLE Q1,RETZ		;NO, READ ALL CHARACTERS YET?
	XCT CHKPST       	;NO, READ WHOLE STRING TO FOUL PAGE
	JRST CHKPS3		;  FAULT WATCHERS

CHKPST:	XCTBU [ILDB D,C] 
; 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 ;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
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
	JRST ACCES7		;NO. GO DO IT SEPARATELY

;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 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 SETJSB		;MAP THE OBJECT JOB'S JSB (RETURNS OFFSET IN T1)
	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 /]
	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?
	JRST [	MOVEI T1,^D3000 ;YES. WAIT A WHILE TO FOIL PASSWORD THIEVES
		DISMS
		JRST .+1]
	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		;MARK THAT 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
;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
;JSYS TO SET/CLEAR ADDRESS BREAK
;CALLING SEQUENCE:
;ACCEPTS IN	1/ FUNCTION CODE,,PROCESS HANDLE
;	ADBRK
;RETURNS +1: ALWAYS
;USAGE OF ACS 2 AND 3 ARE DETERMINED BY THE FUNCTION CODE

.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,.ABGAD		;IN RANGE?
	ITERR (ARGX02)		;NOPE
	HRRZ P1,T1		;PRESERVE FORK HANDLE IN P1
	CALL @[	IFIW!ABSET
		IFIW!ABRED
		IFIW!ABCLR
		IFIW!ABGAD](T2)	;DISPATCH ON FUNCTION CODE
	 ITERR			;ERROR RETURN
	MRETNG			;GOOD

;SET USER ADDRESS BREAK

ABSET:	CALL BRKAVL		;ADDRESS BREAK AVAILABLE?
	 RETBAD (ABRKX1)	;NO, MUST BE SM10
	UMOVE P2,2		;GET ADDRESS
	UMOVE P3,3		; AND FLAGS
	LSH P3,-<^D35-^L<AB%XCT>> ;RIGHT-JUSTIFY FLAGS (ASSUMES AB%XCT IS
				; RIGHTMOST FLAG BIT)
	CALL FLOCK		;LOCK FORK STRUCTURE
	MOVE T1,P1		;GET FORK HANDLE
	CALL SETLFX		;Map process' PSB and check for execute-only
	MOVEM P2,ADRBRK(T1)	;STUFF ADDRESS INTO PSB
	STOR P3,ABFLG,(T1)	; AND FLAGS TOO
	CAIN P1,.FHSLF		;SETTING MY OWN BREAK?
	 CALL [	DMOVE T1,P2	;YES, GET ARGS FOR SETBRK
		JSP T4,SETBRK	; AND POKE THE CPU
		RET]
	CALL CLRLFK		;UNMAP PSB
	CALL FUNLK		;UNLOCK FORK STRUCTURE
	RETSKP			;AND RETURN

;READ USER ADDRESS BREAK

ABRED:	CALL BRKAVL		;ADDRESS BREAK AVAILABLE?
	 RETBAD (ABRKX1)	;NO, QUIT NOW
	CALL FLOCK		;LOCK FORK STRUCTURE
	MOVE T1,P1		;GET FORK HANDLE
	CALL SETLFK		;MAP PSB
	MOVE T2,ADRBRK(T1)	;GET BREAK INFO
	ANDX T2,EXPCBT		;MASK OUT ALL BUT 23-BIT ADDRESS
	LOAD T3,ABFLG,(T1)	;GET FLAGS
	LSH T3,<^D35-^L<AB%XCT>> ;PUT BITS IN RIGHT PLACE (ASSUMES AB%XCT
				; IS RIGHTMOST FLAG BIT)
	XCTU [	DMOVEM T2,2]	;RETURN ANSWERS TO USER
	CALL CLRLFK		;UNMAP PSB
	CALL FUNLK		;UNLOCK
	RETSKP

;CLEAR USER ADDRESS BREAK

ABCLR:	CALL BRKAVL		;BREAK AVAILABLE?
	 RETBAD (ABRKX1)	;NO, MUST BE SM10
	CALL FLOCK		;LOCK FORK STRUCTURE
	MOVE T1,P1		;GET FORK HANDLE
	CAIN T1,.FHSLF		;CLEARING OUR OWN BREAKS?
	 CALL [	SETZB T1,T2	;YES, POKE THE CPU NOW
		JSP T4,SETBRK	; ..
;**;[1831] Add 1 line at ABCLR:+7L	PED	13-FEB-81
		MOVE T1,P1	;[1831] RESTORE FORK HANDLE
		RET]
	CALL SETLFX		;Map PSB and check for execute-only
	SETZM ADRBRK(T1)	;CLEAR OUT ADDRESS BREAK INFO
	CALL CLRLFK		;UNMAP PSB
	CALL FUNLK
	RETSKP

;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 BRKAVL		;ADDRESS BREAK AVAILABLE?
	 RETBAD (ABRKX1)	;NO, QUIT
	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
;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
	CAIGE T3,NJOBS		;LEGAL JOB NUMBER?
	SKIPGE JOBRT(T3)	;AND JOB ASSIGNED?
	RETERR (ALCX4,<UNLOCK DEVLCK>) ;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,<UNLOCK DEVLCK>) ;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:	UNLOCK DEVLCK		;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,<UNLOCK DEVLCK>) ;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,<UNLOCK DEVLCK>) ;NO, TELL CALLER
	HRLM T3,DEVUNT(T2)	;YES, PUT IT IN FREE POOL
	JRST ALCALR		;GO RETURN
;SET THE DEVICE TABLES LOCK.
;MUST BECOME NOINT SO CONTROL DOESN'T RETURN TO USER WITH LOCK
;SET.

LCKDVL:: NOINT
	SE1CAL
	AOSN DEVLCK		;ATTEMPT LOCK
	RET			;SUCESS
	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
; Change account

.CACCT::MCENT
	STKVAR <CACUSR>
	MOVE A,JOBNO
	MOVE B,JOBDIR(A)	;GET LOGIN DIRECTORY NUMBER
	TRNN B,777777
	RETERR(CACTX2)
	HRLI B,USRLH		;MAKE IT A 36-BIT USER NUMBER
	MOVEM B,CACUSR		;SAVE IT
;**;[1823] Replace one line at .CACCT+8.L with 7.Lines	RAS	29-DEC-80
	NOINT			;[1823] NOINT between Accounts
	SKIPL T1,LOGDES		;[1823] Setup for logging of change
	DOBE			;[1823] Wait till logging device is ready
	HRROI T2,[ASCIZ/Changed/] ;[1823] String to head logging with
	CALL LOGUSD		;[1823] Log change and set up for USAGE
	CALL LOGTUS		;[1823] Perform the Usage logout
	MOVE A,CACUSR		;[1823] get back user number
	CALL CNVDIR		;CONVERT THIS TO A DIR NUMBER
	CALL SETDIR		;MAP IN DIRECTORY
;**;[1823] Change one line at .CACCT+11.L  		RAS	29-DEC-80
	 RETERR ( ,<OKINT>)	;[1823] SETDIR FAILURE
	UMOVE A,1
	MOVE B,CACUSR		;GET BACK USER NUMBER
	CALL SETACT
;**;[1924] Change 1823 line at .CACCT +15L	JGZ	18-AUG-81
;**;[1823] Change one line and add one at .CACCT: +15L  RAS	29-DEC-80
	 RETERR( ,<CALL USTDIR	;[1823]
		   OKINT >)	;[1823] Free interrupts again.
	CALL USTDIR
;**;[1823] Add comment at .CACCT+17.L		RAS	29-DEC-80
	CALL LOGCJM		;[1823] Start a session entry for this account
	CALL LGTAD		;GET DATE/TIME
	MOVEM A,CTIMON		;SAVE IN JSB
;**;[1823] Add one line at .CACCT+20.L		RAS	29-DEC-80
	OKINT			;[1823] Things are done now
	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>
	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:	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>
	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
; Clear input buffer

.CFIBF::MCENT
;**;[1844] Change and add two lines at .CFIBF: +1L	JGZ	13-APR-81
	CALL CHKTTR		;[1844] IS THIS A TERMINAL?
	 MRETNG			;[1844]  NO, THEN THIS IS A NOOP
	CALL CHKTTY		;[1844] CAN WE GET THE TERMINAL?
	 ITERR ()		;[1844] NO, 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

; Clear file output buffer

.CFOBF::MCENT
;**;[1844] Change and add two lines at .CFOBF: +1L	JGZ	13-APR-81
	CALL CHKTTR		;[1844] IS THIS A TERMINAL?
	 MRETNG			;[1844]  NO, THEN THIS IS A NOOP
	CALL CHKTTY		;[1844] CAN WE GET THE TERMINAL?
	 ITERR ()		;[1844] NO, 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
; 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
;CRJOB -- CREATE A JOB OTHER THAN THIS ONE

;CALL:	1		;FLAG BITS
;	2		;POINTER TO ARGUMENT BLOCK
;	CRJOB
;RETURNS:
;	+1		;ERROR
;	+2		;SUCCESS
;	IN 1		;JOB NUMBER OF NEWLY CREATED JOB
;
;FLAGS IN AC1:
;B0	CJ%LOG		;ON - TRY TO LOG THE NEW JOB IN
;			;OFF - CREATE AN UN-LOGGED-IN JOB
;B1	CJ%NAM		;ON - USE NAME AND PASSWORD IN ARG BLOCK
;			;OFF - LOG IN AS SAME USER AS EXECUTOR OF CRJOB
;B2-3	CJ%ACT		;ACCOUNT FIELD. 0 - USE CURRENT ACCOUNT
;			;1 - USE ACCOUNT SUPPLIED IN ARG BLOCK
;			;2 - USE DEFAULT ACCOUNT OF NEW JOB'S USER
;B4	CJ%ETF		;ON - PUT EXEC IN TOP FORK OF NEW JOB
;			;OFF - FILE REQUESTED BY B5 IS IN TOP FORK
;B5	CJ%FIL		;ON - FILENAME IN ARG BLOCK SHOULD BE GET'ED
;			;OFF - JUST AN EXEC. NO FILE.
;B6	CJ%ACS		;ON - IF B5 IS ON, PUT AC'S FROM ARG INTO FORK
;			;     WHICH HAS THE FILE GET'ED INTO IT
;B7	CJ%OWN		;ON - MAINTAIN OWNERSHIP OF THE NEW JOB
;			;OFF - DISOWN THE NEW JOB
;B8	CJ%WTA		;ON - WAIT TILL ATTACHED BEFORE RUNNING NEW JOB
;B9	CJ%NPW		;ON - NO PASSWORD CHECK IN NEW JOB LOGIN
;			;     (REQUIRES WHEEL/OPER, OR B1 OFF)
;B10	CJ%NUD		;ON - NO UPDATE OF LAST-LOGIN DATE.
;B11	CJ%SPJ		;ON - DO SPJFN WITH ARG IN ARG BLOCK
;B12	CJ%CAP		;ON - SET NEW JOB'S CAPMSK RH TO MY CURRENT
;			;     CAPENB RH, UNTIL IT LOGS IN.
;B13	CJ%CAM		;CAPABILITY MASK AFTER LOGIN
;B14	CJ%SLO		;SIGNAL THE SUPPLIED PID AT LOGOUT TIME
;B17	CJ%DSN		;ON - DISOWN EXISTING JOB (IF IT'S MINE), JOB
;			;     NUMBER IS IN AC 3
;IN PARAMETER BLOCK:
;WD0	.CJNAM		;STRING POINTER TO NAME FOR LOGIN
;WD1	.CJPSW		;STRING POINTER TO PASSWORD FOR LOGIN
;WD2	.CJACT		;ACCOUNT DESIGNATOR/STRING POINTER FOR LOGIN
;WD3	.CJFIL		;STRING POINTER TO FILENAME TO GET
;WD4	.CJSFV		;SFRKV OFFSET TO START FILE
;WD5	.CJTTY		;TTY DESIGNATOR, OR NULL DESIGNATOR, FOR CTTY
;WD6	.CJTIM		;TIME LIMIT (NOT IMPLEMENTED)
;WD7	.CJACS		;POINTER TO 16 WORDS OF AC'S FOR FORK
;WD8	.CJEXF		;EXEC FLAGS, FOR AC1 OF STARTED EXEC
;WD9	.CJPRI		;PRIMARY JFN'S FOR SPJFN IN NEW JOB
;WD10	.CJCPU		;CPU LIMIT (ZERO MEANS NONE)
;WD11	.CJCAM		;CAPABILITY MASK
;WD12	.CJSLO		;PID TO SEND LOGOUT MSG TO
.CRJOB::MCENT			;CREATE JOB JSYS
	GTOKM (.GOCJB,,[RETERR ()])	;GETOK FOR .CRJOB AND ITRAP IF ERROR
CRJOB1:	NOINT			;PROTECT THE CRJLCK RESOURCE
	LOCK (CRJLCK,<JRST CRJLKF>)
	SETZM CRJANS		;CLEAR THE RESULT COMMUNICATION WD
	MOVE T1,JOBNO		;GET MY JOB NUMBER
	MOVEM T1,CRJONJ		;FOR CREATEE TO SEE
	MOVE T1,CAPENB		;AND MY CAPS
	MOVEM T1,CRJOJC		; ..
	UMOVE Q1,1		;FLAGS FROM CALLER
	MOVEM Q1,CRJAC1		;STORE THEM FOR NEW JOB
	TXNE Q1,CJ%DSN		;REQUEST TO DISOWN A JOB?
	JRST CRJDSN		;YES.
	TXNN T1,SC%WHL+SC%OPR	;IS THIS A PRIVILEGED JOB?
	TXNE Q1,CJ%LOG+CJ%ETF	;NO. MUST HAVE EXEC IN TOP FK, OR LOGIN
	SKIPA			;OK.
	JRST CRJILG		;NO GOOD. GIVE ILLEG COMBINATION ERROR.
	UMOVE Q2,2		;OK, GET POINTER TO ARG BLOCK
	SETOM CRJTTY		;ASSUME DETACHED NEW JOB
	UMOVE T1,.CJTTY(Q2)	;GET THE TTY DESIGNATOR
	CAIN T1,.NULIO		;NUL DESIGNATOR?
	JRST CRJB1A		;YES. OK.
	CAIL T1,400000		;NO, SEE IF IT'S A VALID TTY
	CAIL T1,400000+NLINES	; ..
	JRST CRJTTX		;NOT A LEGAL TTY NUMBER
	MOVE T2,T1		;GET TTY DESIGNATOR IN T2
	SUBI T2,400000		;TTY NUMBER IS A REAL TTY.
	NOSKED			;CHECK TO SEE IF IT'S AVAILABLE.
	CALL GTCJOB		;STABLE STATE OF TTFORK...
	 JRST CRJOTX		;TTY NOT ASSIGNED
	CAMN T3,JOBNO		;IS THE TTY ASSIGNED TO ME?
	CAMN T2,CTRLTT		;AND NOT MY CONTROLLING TERMINAL?
CRJOTX:	JRST [	OKSKED		;NOT A VALID TTY FOR THIS USE
		JRST CRJTTX]	;FAIL.
	PUSHJ P,CHKDEV		;SEE IF IT'S ASSIGNED TO ME
	  JRST CRJOTX		;IT'S NOT.
	TXNN T3,DV%ASN		;ASSIGNED?
	JRST CRJOTX		;NO.
	UMOVE Q1,T1		;RESTORE AC'S CLOBBERED ABOVE
	UMOVE Q2,T2
	UMOVE T1,.CJTTY(Q2)	;GET TTY DESIGNATOR AGAIN
	ANDI T1,377777		;JUST THE LINE NUMBER
	MOVEM T1,CRJTTY		;STORE THE TTY TO START JOB ON
	OKSKED			;LET TTFORK CHANGE NOW
	TRO T1,400000		;AND NOW RELEASE IT FROM THIS JOB
	RELD
	 JFCL
;FALL THRU
;FALLS THRU FROM ABOVE
CRJB1A:	JE CJ%LOG,Q1,CRJOB4	;JUMP IF NOT LOGGING IN
	TXNN Q1,CJ%NAM		;USING SUPPLIED PASSWORD AND NAME?
	JRST CRJOB2		;NO, USE MINE.
	UMOVE T2,.CJNAM(Q2)	;GET THE SUPPLIED NAME STRING
	MOVEI T1,CRJUSR-1	;WHERE TO PUT THE TEXT
	PUSHJ P,CPYFU1		;COPY THE STRING
	 JRST CRJCPX		;FAILED?
	UMOVE T2,.CJPSW(Q2)	;COPY THE PASSWORD
	MOVEI T1,CRJPSW-1	;TO HERE
	PUSHJ P,CPYFU1		; ..
	 JRST CRJCPX		;CAN'T?
	JRST CRJOB4		;OK, HAVE NAME AND PASSWORD NOW

;HERE'S THE FAIL PATH ON THE LOCK MACRO ABOVE.
CRJLKF:	OKINT
	MOVEI T1,CRJLCK		;WAIT, INTERRUPTABLE, FOR THE LOCK
	PUSHJ P,DISL
	JRST CRJOB1		;AND GO GRAB IT NOW.

;HERE TO COPY MY OWN NAME AND PASSWORD FOR NEW JOB. ACTUALLY,
; JUST PUT MY NAME IN, AND CAUSE LOGIN TO NOT CHECK PASSWORD.
CRJOB2:	HRRZ T2,JOBNO		;THIS JOB NUMBER
	HRRZ T2,JOBDIR(T2)	;HERE IS MY LOGGED IN USER NUMBER
	HRLI T2,USRLH		;MAKE A USER NUMBER
	HRROI T1,CRJUSR		;PUT THE NAMESTRING HERE
	DIRST			;CONVERT TO STRING
	 JRST CRJXXX		;FAILED
	MOVX T1,CJ%NPW		;SET THE BIT SO THAT LOGIN
	IORM T1,CRJAC1		; WILL NOT CHECK PASSWORD
;FALL THRU TO ACCOUNT HANDLING
;FALLS THRU FROM ABOVE

;NOW GET THE ACCOUNT FOR NEW JOB
CRJOB4:	SETZM CRJACT		;DEFENSIVE CHECKS ON ACCOUNT.
	LOAD T1,CJ%ACT,Q1	;SEE WHERE TO GET ACCOUNT FROM
	TRNE T1,.CJUDA		;WANT DEFAULT ACCOUNT?
	JRST CRJB5Z		;YES. NOTHING TO SET UP.
	TRNE T1,.CJUAA		;NO, MINE, OR SUPPLIED?
	JRST CRJOB5		;SUPPLIED.
;GET STRING ACCOUNT FOR CURRENT JOB
CRJB4A:	MOVE T1,[XWD ACCTSR,CRJACT+1]
	BLT T1,CRJACT+10	;COPY THE ACCOUNT STRING
	JRST CRJB5S		;DONE WITH THE ACCOUNT

;HERE IF ACCOUNT WAS SUPPLIED IN ARG BLOCK.
CRJOB5:	UMOVE T2,.CJACT(Q2)	;GET ACCT NUMBER/POINTER FROM BLOCK
	MOVE T1,T2		;SEE IF NUMERIC OR STRING
	TLC T1,(5B2)		; ..
	TLNE T1,(7B2)		; ..
	JRST CRJB5A		;STRING.
	MOVEM T2,CRJACT		;NUMERIC.
	JRST CRJB5Z		;DONE WITH ACCOUNT

CRJB5A:	MOVEI T1,CRJACT		;COPY STRING TO HERE + 1
	PUSHJ P,CPYFU1		; ..
	 JRST CRJCPX		;CAN'T COPY IT?
CRJB5S:	MOVE T1,[000700,,CRJACT] ;MUST BE POSITIVE NUMBER
	MOVEM T1,CRJACT		;POINTER TO THE ACCOUNT
CRJB5Z:	JRST CRJB5I		;DONE WITH ACCOUNT. GO LOOK FOR INFERIOR
;MORE CRJOB. HERE TO DEAL WITH INFERIOR FORK
CRJB5I:	UMOVE T2,.CJEXF(Q2)	;GET FLAGS FOR EXEC, IN CASE NEEDED
	MOVEM T2,CRJEXF		;SAVE FOR LATER
	UMOVE T2,.CJSFV(Q2)	;START FORK VECTOR OFFSET
	HRRZM T2,CRJEVO		;SAVE THAT TOO
	UMOVE T2,.CJPRI(Q2)	;AND PRIMARY JFN'S, MAYBE NEEDED TOO
	MOVEM T2,CRJPJF		; ..
	TXNN Q1,CJ%FIL		;IS THERE A FILE TO RUN?
	JRST CRJB5Y		;NO.
	MOVEI T1,CRJFIL-1	;YES, GET ITS FILE NAME
	UMOVE T2,.CJFIL(Q2)	;FROM HERE IN ARG BLOCK
	MOVEI T3,<5*40>-1	;CHARACTERS THAT CAN FIT IN STORAGE BLK
	PUSHJ P,CPYFU2		;COPY THE STRING
	 JRST CRJCPX		;CAN'T?
	TXNN Q1,CJ%ACS		;WANT THE AC'S SET UP?
	JRST CRJB5C		;NO
	MOVEI T1,20		; Length of AC block
	UMOVE T2,.CJACS(Q2)	;YES. GET THE POINTER TO THEM
	XMOVEI T3,CRJFAC	; Place to store user's
	CALL BLTUM1		;COPY AC'S, ADDING PCS IF NECESSARY
CRJB5C:
CRJB5Y:	;END OF CODE DEALING WITH THE INFERIOR FORK TO RUN
	UMOVE T2,.CJCAM(Q2)	;CAPABILITIES MASK FOR LOGIN
	TXNN Q1,CJ%CAM		;SUPPLIED?
	SETO T2,0		;NO, ASSUME ALL BITS ALLOWED
	MOVEM T2,CRJCAM		;SAVE TO MASK AT LOGIN TIME
	UMOVE T2,.CJSLO(Q2)	;A PID TO SIGNAL AT LOGOUT TIME
	TXNN Q1,CJ%SLO		;UNLESS NOT TO USE ONE
	MOVEI T2,0		;IN WHICH CASE, USE ZERO
	MOVEM T2,CRJSLO		;SAVE IT
	UMOVE T2,.CJCPU(Q2)	;CPU LIMIT TO APPLY (ZERO IF NONE)
	MOVEM T2,CRJCPU		; ..
;FALL THRU
;FALLS THRU FROM ABOVE
;HERE TO ACTUALLY PUT IN THE REQUEST FOR SCHEDULER TO START THE JOB
	MOVSI T1,-2		;FLAG OF -2 FOR JOBSRT MEANS CRJOB
	HRRI T1,JOBSRT		;AND SCHED LEVEL CODE ADDR
	CALL SCDRQ7		;REQUEST IT.
	MOVEI T1,CRJANS		;NOW WAIT FOR AN ANSWER.
	CALL DISN		; ..
	MOVE T1,CRJANS		;WHAT HAPPENED?
	JUMPGE T1,CRJXXX	;IF PLUS, IT FAILED.
	HLRZ T1,CRJONJ		;IT SUCCEEDED. GET THE JOB NUMBER
	UMOVEM T1,1		;RETURN IT TO THE CALLER.
CRJXIT:	UNLOCK CRJLCK		;RELEASE THE STORAGE LOCK
	SMRETN			;SUCCESS RETURN.

CRJDSN:	UMOVE T1,3		;GET JOB NUMBER TO DISOWN
	CAIL T1,0		;A LEGAL JOB NUMBER?
	CAIL T1,NJOBS		; ..
	JRST CRJILG		;NO. ILLEGAL ARG FAILURE
	NOSKED			;FREEZE THE OWNERSHIP TABLE
	HRRZ T2,JOBONT(T1)	;GET THE JOB'S OWNER
	CAMN T2,JOBNO		;IS IT ME?
	SETOM JOBONT(T1)	;YES. I GIVE IT UP.
	OKSKED			;FREE THE TABLE
	CAME T2,JOBNO		;WAS IT OK?
	JRST CRJILG		;NO. FAIL.
	JRST CRJXIT		;YES. GIVE SUCCESS RETURN.

CRJCPX:				;COPY OF USER STUFF FAILED
CRJILG:	MOVEI T1,CRJBX1		;ILLEGAL PARAMETER OR BIT COMBINATION
	JRST CRJXXX
CRJTTX:	MOVEI T1,CRJBX4		;BAD TTY REQUESTED
CRJXXX:	UNLOCK CRJLCK		;FREE THE STORAGE BLOCK
	OKINT
	JRST MRETNE		;RETURN FAIL, ERROR NUMBER IN 1
; 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
;**;[1866] Add 4 lines at .DELDF: +4L		RAS	5-MAY-81
;**;[3188] Remove 4 lines at .DELDF+4L		DEE	12-DEC-84
	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
; 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

; 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
; 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
	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

; 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
; Enter fact file
; Call:	LH(1)	; Minus entry size
;	RH(1)	; Location of entry
;	EFACT
; Return
;	+1	; Error
;	+2	; Ok

.EFACT::MCENT
	MOVE B,CAPENB
	MOVE C,0(P)		;GET CALLER'S PC
	TXNE C,UMODF		;CALLED FROM MONITOR?
	TXNE B,SC%WHL!SC%OPR	;NO, PRIVILEGED?
	SKIPA B,FACTSW		;YES, OK SO FAR
	RETERR(EFCTX1)
	TLNN B,(SF%FAC)
	SMRETN			; Fact file not on
	HLRO B,A		; Get size
	CAMG B,[-^D64]
	RETERR(EFCTX2)		; Too big
	NOINT
	PUSH P,CAPENB		; Save current caps
	MOVEI A,SC%WHL+SC%OPR	; Set bits to ensure access to
	IORM A,CAPENB		; Accounts directory and fact file
	MOVEI C,^D30
EFACT2:	HRROI B,FCTFIL		;GET POINTER TO NAME OF FACT FILE
	MOVSI A,(GJ%PHY!GJ%SHT)
	GTJFN
	 JRST EFACT3
	PUSH P,1
	MOVE 2,[XWD 440000,20000]
	OPENF			; Open for append
	JRST EFACT4
EFACT6:	POP P,1
	UMOVE C,1
	UMOVE B,(C)
	HLRE D,C
	MOVNS D
	DPB D,[POINT 6,B,35]
	JRST .+2
EFACT1:	UMOVE B,(C)
	BOUT
	 ERJMP [HRRZ B,LSTERR	;GET ERROR CODE FOR BUGCHK
		BUG(EFACF3,<<B,ERRCOD>>)
		JRST EFCT1A]
	AOBJN C,EFACT1
EFCT1A:	CLOSF
	 BUG(EFACF1,<<A,ERRCOD>>)
	POP P,CAPENB		; Restore caps
	SMRETN
EFACT4:	CAIE A,OPNX9
	SETZ C,
	POP P,1
	RLJFN
	 JFCL
	SOJLE C,EFACT3
	MOVEI A,^D4000
	DISMS
	JRST EFACT2

EFACT3:	HRROI 2,FCTFIL		;GET POINTER TO NAME OF FACT FILE
	MOVSI 1,(GJ%FOU!GJ%PHY!GJ%SHT)
	GTJFN
	 JRST EFACT9
	MOVEI C,^D30
EFACT8:	PUSH P,1
	MOVE 2,[XWD 440000,20000]
	OPENF
	JRST EFACT5
	JRST EFACT6

EFACT5:	CAIE A,OPNX9
	JRST EFACT7
	SOJLE C,EFACT7
	MOVEI A,^D4000
	DISMS
	POP P,1
	JRST EFACT8

EFACT7:	POP P,1
	RLJFN
	JFCL
EFACT9:	POP P,CAPENB		; Restore caps
	RETERR(EFCTX3)
; 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
;**;[1812] Change one line at .ERSTR: +18L	JGZ	5-DEC-80
	 JRST EMRET1		;[1812] NO, MUST HAVE CORRECT BASE ADDRESS
	ANDI C,077777		;FLUSH NON-SIGNIFICANT BITS
;**;[1812] Change one line at .ERSTR: +20L	JGZ	5-DEC-80
	JUMPE C,EMRET1		;[1812] ZERO IS ILLEGAL ERROR CODE

; We now have error number in c, parameters in 4-10, bits and count in b

	PUSH P,B
	HRROI 2,[ASCIZ /SYSTEM:ERRMES.BIN/]
	MOVSI 1,(GJ%OLD!GJ%PHY!GJ%SHT)
	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
NOFIL:	POP P,B
	MOVE D,[POINT 7,[ASCIZ /CANNOT FIND ERROR MESSAGE FILE/]]
NOFILL:	ILDB B,D
;**;[1812] Change one line at NOFILL: +1L	JGZ	5-DEC-80
	JUMPE B,EMRET1		;[1812] RETURN AT END OF STRING
	CALL ERST9
;**;[1812] Change one line at NOFILL: +3L	JGZ	5-DEC-80
	 JRST EMRET1		;[1812] 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)
;**;[1812] Change two lines at ERSTD0: +0L	JGZ	5-DEC-80
ERSTD0:	CLOSF			;[1812] CLOSE THE FILE
	JFCL
	JRST MRETN

;**;[1812] Change 3 lines at NOFIL1: +0L	JGZ	5-DEC-80
NOFIL2:	CLOSF			;[1812] CLOSE THE FILE
	 JFCL			;[1812] IGNORE ERRORS
	JRST EMRET1		;[1812] AND ERROR RETURN PRESERVING LSTERR
; GET ACCOUNT
;
; CALL:	1/ 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 ?
	MOVE T1,JOBNO		;YES, GET JOB NUMBER
	CAIL T1,0		;NOT SELF - WAS JOB NUMBER REQUEST
	CAIL T1,NJOBS		; A LEGAL JOB NUMBER ?
	ITERR (GACCX1)		;NO - INVALID JOB NUMBER SPECIFIED

; 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
; 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
; 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
;**;[2813]CHANGE 1 LINE AT DEFSTR (GOKTRM...)+0L	TAM	14-SEP-82
DEFSTR	(GOKTRM,15,35,36)	;[2813] 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
;	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
	MOVEI T2,.RESGP		;SET GENERAL GROUP
	CALL ASGRES		;ASSIGN RESIDENT SPACE
	 RETBAD (MONX01,<OKINT>) ;NO 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,JOBNO		;SAVE JOB NUMBER OF REQUESTOR
	STOR T2,GOKJBN,(T1)
	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(ILGOKM,<<T1,GOKFCN>>)
		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,MONX01	;CHECK FOR NO RESOURCES
		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
	SKIPE T2,BLKADR		;HAVE SPECIAL BLOCK ADDRESS?
	JRST [	CALL 0(T2)	;GO DO THE DISMISS
		 JRST [	MOVEM T1,LSTERR ;SAVE ERROR
			CALL GETOK3 ;PROCESS BLOCK
			 NOP	;WHO CARES?
			MOVE T1,LSTERR ;RETRIEVE ERROR CODE
			RETBAD ()] ;ERROR
		CALLRET GETOK3]	;AND PROCEED
	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(GIVTMR,<<T2,FUNC>>)
	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
;**;[2816] CHANGE 1 LINE AT DISOK:+14L	TAM	27-SEP-82
	TRNN T2,20		;[2816] 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
;
; 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
;**;[2831] ADD 1 LINE AT RCVA1:+13L	TAM	6-OCT-82
	JRST [	SETZM RCVTMO	;[2831] INSURE THAT TIMER 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(RCVNOE)	;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
;**;[2858]ADD 2 LINES AT RCVGLP:+20L	TAM	11-NOV-82
	SKIPG T1		;[2858]NON NEGATIVE?
	ITERR (ARGX17)		;[2858]NO
	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::SKIPE T1,RCVTMO		;HAS THE TIMER BEEN STARTED?
	CAMLE T1,TODCLK		;YES, HAS IT GONE OFF?
	RET			;NO
	CALL ACJKIL		;DON'T ASK THE ACJ ANYMORE
	SETZM RCVTMO		;TURN OFF RCVOK TIMER
	BUG (RCVTMR)		;SAY RCVOK TIMEOUT OCCURRED
	RET
;
; 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

;**;[3166] Change 1 line at GOKFUL:+4L		GPL	16-Sep-1984
	RESCD			;[3166] Must be resident

;ACJKIL -ROUTINE TO KILL THE ACJ FORK AND CLEANUP

ACJKIL::SAVET			;SAVE TEMPS
	SETZ T1,
	NOINT			;DISABLE INTERRUPTS
	CSKED			;CRIT SKED
	LOCK GOKLCK		;LOCK UP THE QUEUE
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
;**;[2816] CHANGE 2 LINES AT ACJKL:+6L	TAM	27-SEP-82
	MOVEI T2,1		;[2816] ASSUME ALL OK
	MOVEM T2,1(T1)		;[2816] 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
	UNLOCK GOKLCK		;UNLOCK
	ECSKED			;ALLOW SCHEDULING
	OKINT			;ALLOW INTERRUPTS
	RET			;RETURN

;**;[3166] Add 1 line at ACJDON:+6L	GPL	16-Sep-1984
	SWAPCD			;Back to swappable code
; 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

; 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
; 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
	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		;...
	 JRST [	UMOVE B,3	;SEE IF USER HAS GIVEN THE PASSWORD
		CALL CHKPSX
		 ITERR(GTDIX1,<ULKDIR
			MOVE T2,T1
			MOVEI T1,^D3000	;WAIT 3 SECS
			SKIPN T2	;UNLESS NO PASSWORD GIVEN
			DISMS>)		;ILLEGAL PASSWORD GIVEN
		JRST .+1]	;USER GAVE THE CORRECT PASSWORD
	SETO P1,		;MARK ONLY LIMITED ACCESS
GTDIR3:	MOVE A,DIRORA		; GET BASE OF MAPPED DIR AREA
	SOJLE 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
GTDIR1:	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
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)
;**;[2814] ADD 1 LINE AT GTDIR2:+20L	TAM	14-SEP-82
	SKIPG T1,TPRCYC		;[2814] USE TAPE RECYCLE PERIOD IF ONE SET
	MOVEI T1,.STDFE		; Default offline expiration
;**;[2814] DELETE 2 LINES AT GTDIR2:+22L	TAM	14-SEP-82
;	CAMLE T1,TPRCYC		;[2814] Greater than system max?
;	MOVE T1,TPRCYC		;[2814] Yes, then use spec'd max
	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
;**;[1927] Change 1907 lines at GTDGRP: +2L	JGZ	21-AUG-81
;**;[1907] REPLACE 2 LINES WITH 1 LINE AT GTDGRP: + 2L	TAM	9-JUL-81
	SOJLE C,R		;[1907] MAX NUMBER OF GROUPS, RET 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
;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		;NOW LIMITED TO .FHSLF
;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)

PLOCK0::SAVEPQ
	HLRZ T1,Q2		;CHECK FOR THIS FORK ONLY
	CAIE T1,.FHSLF		; ...
	RETBAD (ARGX12)		;ERROR
	MOVE T1,FORKX		;GET INDEX OF THIS PROCESS
	HLL Q2,FKPGS(T1)	;GET SPTN OF PAGE TABLE
	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 FREE SPACE
	 RETBAD (MONX01,<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
; Login
;ACCEPTS:
;	T1/USER NUMBER
;	T2/POINTER TO PASSWORD STRING
;	T3/5B2+ACCOUNT NUMBER
;		OR
;	   POINTER TO ACCOUNT STRING

;	LOGIN

;RETURNS +1: FAILURE
;		T1/ERROR CODE
;	 +2: SUCCESS
;		T1/DATE AND TIME OF LAST LOGIN
;		T2/UPDATED STRING POINTER
;		T3/UPDATED STRING POINTER (IF APPLICABLE)

;PSI OFF THROUGHOUT BECAUSE OF CALL SETDIR

.LOGIN::MCENT
	GTOKM (.GOLOG,<T1>,[RETERR ()])	;GETOK AND RETERR IF ILLEGAL
	STKVAR <LOGUSR>
	MOVE A,JOBNO
	MOVEI B,777777
	TDNE B,JOBDIR(A)	; Is this job currently logged in?
	RETERR(LGINX5)
	SKIPN FREJOB		;ANY JOB SLOTS LEFT (1 NEEDED FOR ATTACH'ES)
	RETERR (LGINX6)		;NO, DO NOT ALLOW LOGINS.
	UMOVE A,1		;GET THE USER NUMBER
	MOVEM A,LOGUSR		;SAVE IT
	CALL CNVDIR		;CONVERT THIS NUMBER TO A DIRECTORY #
	MOVEM A,P1		;SAVE (STRUCTURE UNIQUE CODE,,DIRECTORY NUMBER)
	CALL SETDIR		; MAP IN THIS DIRECTORY AND GO NOINT
	 RETERR(LGINX3)
	MOVE Q1,DIRORA		; GET BASE ADR OF MAPPED DIR
	CALL CPYUGP		;GET A COPY OF USER GROUPS INTO JSB
	 MOVEI A,0		;NO GROUPS FOR THIS USER
	MOVEM A,Q2		;SAVE POINTER
	LOCK JSSTLK		;LOCK JSB STRUCTURE DATA
	HLRZ A,P1		;GET UNIQUE CODE FOR STRUCTURE
	CALL GTSTOF		;GET OFFSET IN JSB FOR THIS STRUCTURE
	 JRST [	UNLOCK JSSTLK	;NO SPACE. UNLOCK JSB STRUCTURE DATA
		CALL USTDIR	;UNLOCK DIRECTORY AND STRUCTURE LOCKED
		RETERR]		; BY SETDIR AND GO OKINT
	STOR Q2,JSGRP,(B)	;SAVE POINTER TO GROUPS
	HRRZ A,P1		;GET DIRECTORY NUMBER ON PS
	STOR A,JSADN,(B)	;INDICATE USER HAS ACCESSED THIS DIRECTORY
	UNLOCK JSSTLK		;UNLOCK THE JSB STRUCTURE DATA
	LOAD B,DRMOD,(Q1)	; GET MODE BITS
	MOVEM B,MODES
	TXNE B,MD%FO		;FILES ONLY DIRECTORY?
	RETERR(LGINX2,<ULKDIR>)	;CAN'T LOGIN TO FILES-ONLY DIRECTORY

;PASSWORD IS NOT REQUIRED IF CONTROLLING TTY IS A PTY AND EITHER:
; 1. THIS JOB BEING LOGGED IN AS SAME USER, OR
; 2. USER IS A SC%WHL OR SC%OPR
;CHECK FOR THESE CONDITIONS

	MOVE A,CTRLTT		;CTRL TTY OF THIS JOB
	CALL PTGETJ		;GET JOB NO. OF JOB OWNING PTY OR -1
	MOVE B,A
	JUMPL B,LOGI2		;JUMP IF NOT A PTY
	HRRZ D,JOBDIR(B)	;GET "WHO" OF CONTROLLING JOB
	XCTU [HRRZ C,1]	;GET "WHO" TRYING TO LOGIN HERE
	CAMN C,D		;SAME?
	JRST LOGI1		;YES, NO PASSWORD CHECK
	MOVE A,B		;CONTROLLING JOB NUMBER FOR CALL
	CALL GJCAPS		;GET CAPABILITIES OF CONTROLLING JOB
	MOVE B,A
	TXNE B,SC%WHL+SC%OPR	;CONTROLLING JOB HAS CAPABILITIES?
	JRST LOGI1		;YES, NO PASSWORD CHECK
;ALSO BYPASS PASSWORD CHECK IF IN THE MIDST OF CRJOB AND THE
;CREATOR OF THIS JOB ASKED FOR PASSWORD TO BE BYPASSED AND THE
;CREATOR WAS AN ENABLED WHEEL/OPERATOR.
LOGI2:	SKIPE T2,CRJFLG	;IS THIS A CRJOB INTERNAL LOGIN?
	TRNN T2,1		;YES. REQUESTED TO BYPASS PSWD CHK?
	SKIPA			;NO. SO CHECK IT.
	JRST LOGI1		;YES. BYPASS CHECKING PASSWORD.
	CALL CHKPSW
	 JRST LOGI3		;INCORRECT PASSWORD
	; ..
	; ..
LOGI1:	SETZM D			;ASSUME WE HAVE AN ACCOUNT STRING
	XCTU [SKIPN A,3]	;GET ACCOUNT STRING
	MOVEI D,1		;NONE THERE
	MOVE B,LOGUSR		;GET USER NUMBER
	XCT [	CALL SETACT
		CALL SETACL](D) ;EXECUTE PROPER ROUTINE
	 RETERR (,<ULKDIR>)	;UNLOCK DIR
	CALL LGTAD		;DO LOCAL GTAD
	LOAD T2,DRDAT,(Q1)	;PICK UP LAST LOGIN D&T
	MOVEM T2,LSTLGN		;SAVE IT FOR GETJI
	JUMPL A,LOGI4		;DONT SET LOGIN TIME IF DAYTIME NOT SET
;DO NOT UPDATE LAST-LOGIN DATE IF REQUESTOR OF A PRIVILEGED CRJOB
;SAID NOT TO. THIS IS FOR SERVER LOGINS, SUCH AS FILE TRANSFER.
	SKIPE T3,CRJFLG	;IS IT A CRJOB?
	TRNN T3,2		;YES. NO-UPDATE BIT ON?
	SKIPA			;NO, SO UPDATE AS NORMAL
	JRST LOGI4		;YES. BYPASS THE UPDATE.
	STOR A,DRDAT,(Q1)	;UPDATE TIME
LOGI4:	XCTU [EXCH B,1]		;GET DIRECTORY TO LOG INTO
	MOVE A,JOBNO		;GET THIS JOB'S NUMBER
	HRRZM B,JOBDIR(A)	;SAVE AS LOGGED IN DIRECTORY
	MOVE A,STRTAB		;GET SDB ADDRESS OF STRUCTURE 0 (PUBLIC)
	LOAD A,STRUC,(A)	;GET ITS UNIQUE STRUCTURE CODE
	STOR A,JSUC		;SAVE AS CONNECTED STRUCTURE CODE
	STOR B,JSDIR		;MAKE THIS THE CONNECTED DIRECTORY
	CALL CPYCDN		;COPY THE CONNECTED DIR NAME TO JSB
	MOVE B,DIRORA		;POINTER TO DIRECTORY
	OPSTR <ADD B,>,DRNAM,(B) ;GET PNTR TO NAME STRING
				;COPY NAME STRING TO
	MOVEI C,USRNAM+1	; JSB STORAGE
	LOAD A,NMLEN,(B)	;GET NUMBER OF WORDS IN STRING
	AOS B			;UPDATE POINTER TO STRING
	HRRZM A,USRNAM		;SAVE LENGTH OF STRING
	SOS A			;COPY ALL BUT THE HEADER WORD
	CALL XBLTA		;COPY STRING
	REPEAT 0,<
	CALL TTWHOK		;IS IT OK TO BE A WHEEL ON THIS TTY?
	 JRST [	MOVEI T2,0	;NO. SO CLEAR RH CAPS.
		JRST LOGI1A]	; ..
	>
	LOAD T2,DRPRV,(Q1)	;GET PRIVILEGE BITS
LOGI1A:	HRRM T2,CAPMSK		;SETUP RH CAPS - LH SETUP AT JBFINI
	ULKDIR
	MOVEI T1,SPIDTB+.SPQSR	;PID OF QUASAR
	CALL LOGIMS		; SEND A LOGIN MESSAGE TO QUASAR
	 JFCL			; NO QUASAR
	CALL SKDLOG		;GET CLASS ASSIGNMENT IF NECESSARY
;**;[3127]REMOVE 1 LINE AT LOGI1A + 6L	20-JUN-84	TAB
;[3127]	CALL LOGONM		; Type logon message
	MOVE A,TODCLK		;UPTIME
	MOVEM A,CONSTO
	CALL LGTAD
	MOVEM A,CTIMON		;SAVE TIME ON
;**;[3127]ADD 1 LINE AT LOGI1A+ 11L	20-JUN-84	TAB
	CALL LOGONM		;[3127]TYPE LOGIN MESSAGE AND DO USAGE
	MOVE T2,CTRLTT		;GET CONTROLLING TERMINAL LINE NUMBER
	MOVEI T3,.MOSMY		;ACCEPT SYSTEM MESSAGE CODE
	SKIPL T2		;SKIP IF DETACHED...
	CALL TTSNTS		;SET TERMINAL TO ACCEPT SYSTEM MESSAGES
BP$020:				;(MOVE A,JOBNO): BREAKPOINT FOR CREATE MAIN FORK
				;ASSUMES FORKX HAS FORK INDEX, GETS JOB INDEX FORM FKJOB(FORKINDEX)
	MOVE A,JOBNO
	SETZM JOBRT(A)
	SETZM CAPENB
	SMRETN

;HERE IF INCORRECT PASSWORD

LOGI3:	ULKDIR
	MOVE B,A		;SAVE FLAG FROM CHKPSX
	MOVEI A,^D3000		;WAIT 3 SEC TO FOIL PASSWORD THIEVES
	SKIPN B			;DISMS ONLY IF NEEDED
	DISMS
	RETERR(LGINX4)
; Number input
; Call:	1	; Source designator
;	NIN
; Return
;	+1	; Error
;	+2	OK
;	2	NUMBER

.NIN::	MCENT
	CAILE 3,1
	CAILE 3,^D10
	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:	UMOVEM A,3		;RETURN ERROR CODE TO USER
	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
;**;[3064] Add 1 line at NIN9: +7L	CRJ	3-Jan-84
	JFCL 17,.+1		;[3064] Clear PC flags
	ADD C,B			; Add in digit
;**;[3064] Add 2 lines at NIN9: +7L	CRJ	3-Jan-84
	JCRY [SETOM P1		;[3064] Remember the overflow
		JRST .+1]	;[3064] Rejoin code

NIN91:	CALL DIGIN
	RET
	JRST NIN9

DIGIN:	CALL BIN1
	 RET			;EOF REACHED
DIGIN1:	SUBI 2,60
	JUMPL 2,CPOPJ
	CAILE 2,^D9
	 JRST [	CAIL 2,"A"-60
		CAILE 2,"Z"-60
		 RET
		SUBI 2,"A"-"9"-1
		JRST .+1]
	XCTU [CAMGE 2,3]
	RETSKP
	RET
; 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
	JRST [	MOVE A,LSTERR
		UMOVEM A,3
		EMRETN]		; Take error return
	SMRETN
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
; 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 <SID,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.
;****

;SID - 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,SID		;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
;**;[2003] Add 3 lines at PMAP10: +6L	JGZ	17-MAR-82
	MOVE B,FILSTS(A)	;[2003] GET THE JFN STATUS BITS
	TXNN B,OPNF		;[2003] IS JFN OPEN?
	 JRST PMPER4		;[2003]  NO...GENERATE ERROR
	LOAD A,FILUC,(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,SID		;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,SID		;GET SOURCE
	CAME A,[-1]		;IF DELETE DON'T UPDATE IT
	ADDM Q2,SID		;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,SID		;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:	SETZM JF1		;NONE HERE
	MOVE A,DID		;GET DESTINATION IDENT
;**;[3174]  Change 1 line at PMAP0:+2			DML	11-Oct-84
	SKIPL B,SID		;[3174] IS SOURCE IDENT A FILE?
	JUMPGE A,[MOVEI A,PMAPX2 ;NO, IF DEST NOT A FILE THEN ERROR
		JRST PMAPER]
;**;[3174]  Replace 1 line with 9 at PMAP0:+5		DML	11-Oct-84
	CAMN B,[-1]		;[3174] Delete only?
	IFSKP.			;[3174] No, not delete only
	  UMOVE B,3		;[3174] Get user requested access
	  MOVX C,PM%WT		;[3174] Get write access bit
	  SKIPL A		;[3174] Is the destination a file?
	  IORM C,B		;[3174] Yes, grant PM%WT for all sections
	ELSE.			;[3174]
	  TDZ B,B		;[3174] Yes delete only, so no section creates
	ENDIF.			;[3174]
	CALL CPMAPX		; Convert to ptn.pn and get access
				;  also check for execute-only
	 MOVEM D,JF1		;RETURNS LOCKED JFN
;**;[2899]REPLACE 1 LINE WITH 5 AT PMAP0:+12L	TAM	11-JAN-83
	JUMPE A,[MOVE A,SID	;[2899] IF ZERO COULDN'T GET IT. CHECK FOR DELETE
		 CAIN D,LNGFX1	;[2899] COULDN'T GET BECAUSE OF NONEX PT?
		 CAME A,[-1]	;[2899] AND DELETING?
		 JRST PMPER2	;[2899] SOME OTHER ERROR OR NOT DELETING
		 JRST PMAP7]	;[2899] 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,SID		; 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
	 JRST [	MOVEM D,JF1	;SAVE LOCKED JFN
		TXNN B,READF	;HAVE READ ACCESS TO THE FILE?
		JRST PMPER1	;NO. ERROR
		JRST .+1]	;YES. ALLOW THE MAP THEN
	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	;NO, IF NOT EMPTY THEN ERROR
		JRST PMAPER]
	MOVE A,PMTL			;RECOVER IDENT
	ADDI A,1		;GO TO NEXT PAGE
	SOJG Q1,PMAPC5		;DO ALL PAGES
PMAP55:	NOINT			;MUST BE NOINT AT PMAP5
	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,SID		;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
PMAP4:	NOINT			;MUST BE NOINT WHEN DIDDLING MAP COUNTS
	MOVE Q1,Q2		;GET COUNT FOR PAGE SCAN LOOP
	SETO Q3,		;INIT OFN/JFN ASSOCIATION TO NIL
	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
	CALL MSCANP		;FIND NON-0 PAGE AND GET ACCESS
	JUMPE B,PMAP5		;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,PMAP3		; Jump if empty
	TLNE A,(PA%PRV)
	JRST PMAP3		; Or if private
	MOVE A,PMTL		; Is indirect or share
	CALL MRPT		; Get it's id
	 JRST PMAP3		; Not file
	HLRZ B,A		;GET OFN
	CAIN B,0(Q3)		;QUICK CHECK - SAME AS LAST ONE?
	JRST [	HLLZ A,Q3	;YES, GET SAME JFN AS LAST ONE
		JRST PMAP6]
	MOVE Q3,B		;NOT SAME OFN, REMEMBER THIS ONE
	CALL OFNJFX		; Convert to jfn
	 JRST [	SETO Q3,	;NO JFN, FORGET OFN TOO
		JRST PMAP3]
	HLL Q3,A		;REMEMBER JFN/OFN ASSOCIATION
PMAP6:	HLRZ A,A		;GET JFN OF PAGE
	IMULI A,MLJFN		;CONVERT TO INTERNAL INDEX
	HLRZ C,FILLFW(A)	;GET JFN SHARE COUNT
	SUBI C,2		;REDUCE FOR PAGE BEING REMOVED
	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
		SETO Q3,	;FORGET THIS JFN
		JRST .+1]	;NOW OK TO REDUCE COUNT
	HRLM C,FILLFW(A)	;SET REDUCED COUNT
PMAP3:	MOVE A,PMTL		;RECOVER IDENT
	ADDI A,1		;GO TO NEXT PAGE
	SOJG Q1,PMAPC2		;DO ALL PAGES
	; ..
	; ..
;NOW CALL KERNAL ROUTINE TO CHANGE THE ACTUAL MAPS

PMAP5:	MOVE A,PMTS
	MOVE C,PMTA
	MOVE B,PMTD
	TXO C,PM%TPU+PM%CPY+PM%ABT ;RETAIN CERTAIN BITS
	CALL CKMMOD		;CHECK FOR MONITOR CALL
	SKIPA			;NOT. IS USER
	TXO C,PM%IND		;IT IS. ALLOW INDIRECT POINTERS
	XCTU [AND C,3]
	MOVE 4,Q2		;GET COUNT
	CALL MSETPT		;DO MULTIPLE PT SET
	OKINT			;NOW MAP AND JFN MAP COUNTS MUST AGREE
	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
PMAP7:	CALL PMAPRL		;RELEASE FILE LOCKS
	RET
;ERROR RETURN FROM PMAP

;**;[2003] Add 2 lines at PMPER2: +0L	JGZ	17-MAR-82
PMPER4:	MOVEI A,DESX5		;[2003] GET ERROR CODE
	JRST PMAPER		;[2003]  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
	CALL PMAPRL		;GO RELEASE ANY FILE LOCKS
	JRST ITRAP

;ROUTINE TO RELEASE ANY ACCUMULATED FILE LOCKS

PMAPRL:	SKIPE A,JF1		;HAVE ONE HERE?
	CALL LUNLK0		;YES. UNLOCK IT THEN
	RET			;DONE
;ACCEPTS:	A/PROCESS HANDLE OR JFN
;		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
	PUSH P,A		;SAVE THE JFN
	TXNN B,PM%WT		;DID USER WANT WRITE?
	SETZ B,			;NO. PREVENT PT CREATES
	CALL JFNOF4		;GET OFN AND STATUS
	 JRST [	SUB P,BHC+1
		CAIE A,LNGFX1	;COULDN'T CREATE PT?
		JRST PMAPER	;NO. GENERAL ERROR
		MOVE D,A	;SAVE ERROR CODE
		SETZ A,		;YES. RETURN CONDITION
		RETSKP]		;SAYING IT IS A PROCESS
	EXCH A,0(P)		;SAVE OFN, GET BACK JFN
	HLRZS A			;JFN ONLY
	IMULI A,MLJFN		;MAKE IT AN INTERNAL VALUE
	CALL STRDMO		;VERIFY AND LOCK UP STRUCTURE
	 JRST [	SUB P,BHC+1	;CLEAN UP STACK
		JRST PMAPER]	;AND GIVE PROPER ERROR
	MOVE D,A		;REMEMBER THIS JFN HAS STRUCTURE LOCK
	POP P,A			;GET BACK ID
	TXNN B,<RNDF>		;OPENED FOR APPEND MODE?
	JRST [	MOVE A,D	;GET BACK JFN
		CALL LUNLK0	;FREE STRUCTURE LOCK
		MOVEI A,PMAPX2	;THIS IS NOT ALLOWED
		JRST PMAPER]
	MOVSI C,(PM%RWX)		;GIVE ALL ACCESS
	TXNN B,WRTF		;UNLESS FILE NOT OPEN FOR WRITE
	TLZ C,(PM%WT)		;IN WHICH CASE DISALLOW WRITE
	RET

FRKMPX:	CALL FKHPTX		;Convert FRK.PN to PTN.PN
				; and check for execute-only
	 JRST PMAPER		;Error-- Release any locks and give error
	JRST FRKMP1		;Continue below . . .

FRKMAP:	CALL FKHPTN
	 JRST PMAPER		;Error-- Release any locks and give error
FRKMP1:	MOVSI C,(PM%RWX)
	RETSKP			;SAY IS A FORK HANDLE
;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,1(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
	CALLRET MSETPT		;CLEAR THEM
;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
	XCTU [HLRZ T1,2]	;GET LHS OF PPN
	CAIE T1,PPNLH		;VALID PPN?
	ITERR (PPNX1)		;NO
	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 #
	XCTU [HRR T1,2]		;GET RHS OF PPN
	CALL DIRST0		;CONVERT TO STRING
	 ITERR ()		;PROBLEM WITH DIR?
	JRST MRETN		;GIVE RETURN
;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
;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
; 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(,<UNLOCK DEVLCK>) ;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
;**;REMOVE 1 LINE AT RELD1:+11L	TAM	3-MAR-83
;[2923]	HRRZ P3,P4		;DEVICE ONLY
	MOVE T2,RELDIX		;T2/ INDEX TO DEVICE TABLES
	CALL DSMNT0		;AND DISMOUNT DEVICE
	 JFCL
RELD2:	UNLOCK DEVLCK
	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		;YES. RELEASE IT
	 JRST RELDWT		;FAILED. GO WAIT UNTIL IT CAN SUCCEED
;**;[2923]REPLACE 1 LINE AT RELDA3:+6L	TAM	3-MAR-83
;[2923]	HRRZ P3,P4		;ADDRESS ONLY
	HRRZ T2,Q1		;[2923] GET INDEX AGAIN
	CALL DSMNT0		;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 (,<UNLOCK DEVLCK
		  OKINT>)	;NO. FAIL
	UNLOCK DEVLCK		;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

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
	CALL ALCMES
	 JFCL
RELDD1:	RETSKP


RELDD3:	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 TTYDEA		;DEALLOCATE ITS DYNAMIC DATA
	 RETBAD			;FAILED. RETURN FAILURE
RELDD4:	MOVE B,RELDIX		;RESTORE INDEX TO DEVICE TABLES
	JRST RELDD0		;FINISH PROCESSING
; 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
RSTFK:	MOVEI A,400000
	CIS
	DIR
	SETZB T2,T3		;ZERO BOTH INTERRUPT AND DEFERRED WORD MASK
	STIW
	MOVNI 2,1
	DIC
;**;[3001] Add one line at RSTFK: + 7L	TAB	22-AUG-83
	SETZM ARTHTR		;[3001]CLEAR ARITH TRAP SET BY SWTRP%
	MOVE 1,[CZ%ABT+400000]	;SAY DELETE NONX FILES
	CLZFF
	RWSET			;RELEASE WORKING SET
	SKIPL PATADR		;FORCED NON-COMPATIBILITY?
	SETZM PATADR		;NO, CLEAR COMPAT ENTRY VECTOR
	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
;**;[2007] Add 1 and change 1 line at RSTFK: +19L	JGZ	21-MAR-82
	CALL NETKFK		;[2007] RESET ARPANET CONNECTIONS
	MRETNG			;[2007] DONE
; 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

;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

; 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
; 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
	TRVAR <<DUMMY,3>,JF1>	;MUST MATCH TRAVR IN PMAP
	SETZM JF1
;**;[1766] Add one line at .RMAP: +3L	JGZ	26-AUG-80
	CALL FLOCKN		;[1766] LOCK THE FORK LOCK
;**;[1924] Change 1825 lines at .RMAP: +4L	JGZ	18-AUG-81
;**;[1825] Change two lines at .RMAP: +4L	RAS	6-JAN-81
	CALL FKHPTN		;[1825]  Convert frk.pn to ptn.pn
	 ITERR (,<CALL FUNLK>)	;[1825] FAILED, FREE FORK LOCK.
	CALL MRPT		; Call map routine
	 JRST RMAPFK
	PUSH P,B
	CALL OFNJFN
RMAP0:	 SETO A,		; Unidentifiable
RMAP1:	POP P,B
	UMOVEM A,1
	UMOVEM B,2
;**;[1766] Change at RMAP1: +3L	JGZ	26-AUG-80
	CALL FUNLK		;[1766] FREE THE FORK STRUCTURE LOCK
	MRETNG			;[1766] RETURN

RMAPFK:	PUSH P,B
	JUMPE A,RMAP0
	CALL PTNFKH
;**;[1766] Change one line at RMAPFK: +3L	JGZ	26-AUG-80
	 ITERR (,<CALL FUNLK>)	;[1766] FAILED, FREE FORK LOCK.
	JRST RMAP1
; Read accessiblity of page
; Call:	LH(A)	; Fork or file handle
;	RH(A)	; Page number
;	RPACS

.RPACS::MCENT
	TRNE 1,777000		;DOES THE PAGE NUMBER SAY "LONG FILE"?
	SKIPGE 1		;IS THIS FORK HANDLE?
	JRST RPACS1		;YES - THEN SHORT FILE IS ASSUMED
	HLRZS A			;NO - USER ASKING FOR LONG FILE
;**;[1779] Add two lines at .RPACS: +5L	JGZ	4-SEP-80
	CAML T1,MAXJFN		;[1779] COULD IT BE A GOOD JFN?
	 ITERR (DESX3)		;[1779] NO WAY
	IMULI A,MLJFN		; CONVERT TO INTERNAL INDEX
	MOVE A,FILSTS(A)
	TXNN A,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 LUNLK0		;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
; 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
; SET JOB PARAMETERS
;ACCEPTS IN 1/	JOB NUMBER
;	    2/	FUNCTION CODE
;	    3/	VALUE OR POINTER TO ARG BLOCK
;	SETJB
;RETURNS +1:	ALWAYS

.SETJB::MCENT
	SETZ T4,		;LOCAL FLAG AC
	UMOVE T1,1		;GET JOB NUMBER
	CAMN T1,[-1]		;SELF?
	MOVE T1,JOBNO		;YES, GET OWN JOB NUMBER
	SKIPL T1		;CHECK FOR LEGALITY
	CAIL T1,NJOBS
	ITERR (SJBX4)		;ILLGEAL JOB NUMBER
	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 SETJSB		;MAP IN JSB OF JOB
	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

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>)
	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
;**;[3078] Add 1 line at SJBSRM+13	DEE	5-MAR-84
;**;[3182] Remove previous edit		DEE	14-NOV-84
	RET
;
;	SET JOB BATCH STREAM NUMBER AND FLAGS
;
SJBBAT:	MOVX T1,SC%OPR!SC%WHL	;WHEEL AND OPR ONLY
	TDNN T1,CAPENB
	ITERR (SJBX6)		;NOT ENOUGH CAPS
	MOVEM T3,BATSTF(P1)	;SAVE NEW FLAGS
	RET			;RETURN OK
; Set control character output control

.SFCOC::MCENT
;**;[1844] Replace two lines and revamp at .SFCOC: +1L	JGZ	14-APR-81
	CALL CHKTTR		;[1844] IS THIS A TERMINAL?
	 MRETNG			;[1844]  NO, THEN THIS IS A NOOP
	CALL CHKTTY		;[1844] CAN WE ACCESS THE TERMINAL?
;**;[3040] Replace one line at .SFCOC:+4L	CRJ	8-Nov-83
	 ITERR (DESX2)		;[1844][3040] No, return proper error
	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

; Set file modes
;

.SFMOD::MCENT
;**;[1844] Replace two lines and revamp at .SFMOD: +1L	JGZ	14-APR-81
	CALL CHKTTR		;[1844] IS THIS A TERMINAL?
	 MRETNG			;[1844]  NO, THEN THIS IS A NOOP
	CALL CHKTTY		;[1844] CAN WE ACCESS THE TERMINAL?
	 EMRETN ()		;[1844]  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

; Set file position

.SFPOS::MCENT
;**;[1844] Replace two lines and revamp at .SFPOS: +1L	JGZ	14-APR-81
	CALL CHKTTR		;[1844] IS THIS A TERMINAL?
	 MRETNG			;[1844]  NO, THEN THIS IS A NOOP
	CALL CHKTTY		;[1844] CAN WE ACCESS THE TERMINAL?
	 EMRETN ()		;[1844]  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
;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
;IF T1 IS (FORK HANDLE,,SECTION NUMBER), SECTION NUMBER MUST BE ZERO
;AND COUNT MUST BE 1

;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

;NOTE: FOR RELEASE 4, ONLY CREATION AND DELETION OF PRIVATE SECTION
;ARE SUPPORTED. CODE FOR FORK-TO-FORK (SECTION 0 ONLY) AND FORK-TO-FILE
;MAPPING EXISTS BUT IS NOT GUARANTEED TO WORK.

.SMAP::	MCENT
	CALL CKXADR		;EXT ADDRESSING SUPPORTED?
	 iterr ()		;no - return error to user
	SKIPE T1		;ALLOW CREATION OF PRIVATE SECTION
	CAMN T1,[-1]		;ALLOW UNMAP
	SKIPA
	ITERR (ARGX23)		;DON'T ALLOW OTHERS
	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.

;VERIFY DESTINATION PROCESS AND GET SPT INDEX FOR PSB

	HLRZ T1,Q2		;GET FORK HANDLE FOR DESTINATION
	CALL FLOCKN		;LOCK THE FORK STRUCTURE, ALLOW NESTING
	CALL STJFKR		;GET JOB-WIDE HANDLE
	 ITERR (,<CALL FUNLK>)	;ERROR
	HRRZ T1,SYSFK(T1)	;GET SYSTEM-WIDE HANDLE
	HRL Q2,FKPGS(T1)	;SAVE PSB I.D.
	;..
;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.
	SETZM P5		;INIT FILE REG
SMAP0:	MOVE T1,P4		;GET PSB,,SEC
	CALL CHKMAP		;SEE IF A PRIVATE SECTION
	 JRST [	JUMPE T1,SMAP5	;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
		JRST .+1]
	MOVE T1,P4		;GET BACK ARG AGAIN
	CALL SECJFN		;SEE IF A JFN
	 JRST SMAP2		;NOT
	MOVE P5,T1		;SAVE OFN
	HRL 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,SMAP5		;A FILE?
	HRRZ T1,P5		;YES. GET OFN THEN
	CALL RELOFN		;FREE IT
	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
	SETZM P5		;AND INIT REGISTER FOR NEXT TRY
SMAP5:	ADDI P4,1		;NEXT I.D.
	SOJG P3,SMAP0		;DO ALL SECTION
	JRST SMAP8
;ALL SECTIONS CLEAR. DO NEW MAPPING

SMAP8:	TXZ Q3,<<-1B17>^!<PM%RD!PM%WT>> ;ONLY ALLOW READ AND WRITE
	UMOVE T1,1		;GET USER'S SOURCE ARGUMENT
	CAMN T1,[-1]		;DELETE ONLY?
	JRST SMAP9		;DONE. SUCCESS

;NOT A DELETE. SEE WHAT WE ARE TRYING TO SMAP TO

	JUMPE T1,[	SETOM T1 ;INDICATE PRIVATE SECTION
			DMOVE T2,Q2 ;GET ARGUMENTS
			HLLZS T3 ;ACCESS BITS ONLY
			CALL SECMAP ;CREATE PRIVATE SECTION
			 ITERR (,<CALL FUNLK>)
			JRST SMAP9]
	JUMPG T1,[	CALL SMFILE ;IF FILE. GO DO IT
			 ITERR (,<CALL FUNLK>) ;ERROR
			JRST SMAP9] ;DONE

;SOURCE IS A FORK. MUST BE SECTION 0 ONLY.

	CAIN Q1,0		;FROM SECTION 0?
	TRNE Q3,777776		;YES. AND ONE SECTION ONLY?
	ITERR (ARGX24,<CALL FUNLK>) ;NO. ERROR THEN
	HLRZS T1		;GET SOURCE HANDLE
	CALL STJFKR		;CONVERT TO JOB-WIDE HANDLE
	 ITERR (,<CALL FUNLK>)	;ERROR
	HRRZ T1,SYSFK(T1)	;GET SYSTEM-WIDE HANDLE
	HLRZ T1,FKPGS(T1)	;GET PT I.D.
	DMOVE T2,Q2		;GET OTHER ARGS
	HLLZS T3		;ISOLATE ACCESS
	CALL SECMAP		;MAP IT
	 ITERR (,<CALL FUNLK>)
SMAP9:	CALL FUNLK		;DID IT
	MRETNG			;AND RETURN
; Set fact switch
;ACCEPTS IN 1/	FUNCTION CODE
;	    2/	NEW SETTING
;	SMON
; Traps if process hasn't wheel/operator privilege

.SMON::	MCENT
	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:	SETZM NETON		;CODE 44, VALUE 0
	SETOM NETON		;CODE 44, VALUE NON-ZERO
	JFCL			;CODE 45, VALUE ZERO
	AOS IMPDRQ		;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
	CALL STHSTJ		;CODE 50, VALUE ZERO
	CALL STHSTJ		;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
NSMON2==<.-SMON2T>/2		;MAXIMUM CODE VALUE LESS 36

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 [	NOINT		;DISABLE INTERRUPTS
		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
	NOINT			;DISABLE INTERRUPTS
SGSET:	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
;THE 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		  !
		+-----------------------------------------+



		+--------------------+--------------------+
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
DEFSTR	(SNPB2,SNPBP+3,35,36)	;JRST MONADR+2

	SNPBSZ==5		;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
	HLL T1,FKPGS(T1)	;GET PTN OF FORK
	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(SNPLKF)
	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,SNPB1,(T1)	;GET ADDRESS OF BP
	JUMPE T3,SNPF2D		;IF 0, THEN NO BP DEFINED HERE
	HRRZI T3,-1(T3)		;GET ADDRESS OF BP IN MONITOR
	CAIN T3,0(T4)		;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
	MOVSI T3,(JRST)		;SET UP JRST .+1
	HRRI T3,1(T2)		;...
	STOR T3,SNPB1,(T1)	;STORE JRST .+1 INSTRUCTION INTO BLOCK
	HRRI T3,2(T2)		;SET UP JRST .+2
	STOR T3,SNPB2,(T1)	;STORE IT IN BP BLOCK ALSO
	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,SNPB1,(T1)	;GET ADDRESS+1 OF WHERE TO PUT BP
	HRRZS T2
	MOVE T3,-1(T2)		;GET INSTRUCTION BEING REPLACED
	CAME T3,SNPBII(T1)	;IS IT SAME AS ORIGINAL
	BUG(SNPIC)
	MOVSI T3,(JRST)		;SET UP JRST BP INSTRUCTION
	HRRI T3,SNPBP(T1)	;GET ADDRESS OF BP CODE
	MOVEM T3,-1(T2)		;INSERT THE BREAK POINT
	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,SNPB1,(T1)	;GET ADRRESS+1 OF BP
	HRRZS T3
	MOVEM T2,-1(T3)		;PUT BACK INSTRUCTION
	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(SNPODB)
	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(SNPUNL)
	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
	SKIPE HSYBLK		;SYMBOLS IN ALTERNATE ADDRESS SPACE?
	SKIPA P3,HSYPTR		;YES, GET ITS SYMBOL TABLE POINTER
	MOVE P3,.JBSYM		;NO, GET NORMAL POINTER
	SKIPL P3		;MAKE SURE IT LOOKS REASONABLE
	 RETERR (SNOP14)		;NO, SAY NO SUCH SYMBOL
	TRVAR <SYMPAG,SYMOFF,SYMCNT>	;ALLOCATE STORAGE
	SETO Q2,		;INITIALIZE COUNT OF MATCHES
	UMOVE Q3,2		;GET USER'S ARGUMENT
	HLRO T1,P3		;GET LENGTH OF SYMBOL TABLE
	MOVMS T2,T1		;MAKE POSITIVE IN BOTH ACS
	LSH T1,-1		;CONVERT TO NUMBER OF SYMBOLS
	MOVEM T1,SYMCNT		;SET COUNT
	HRRZ T1,P3		;GET FIRST LOCATION OF SYMBOLS
	ADD T1,T2		;ADD TO GET LAST SYMBOL ADDRESS + 1
	MOVEM T1,SYMOFF		;INITIALIZE SYMOFF
	SKIPN HSYBLK		;ARE THE SYMBOLS IN OUR ADDRESS SPACE?
	JRST SNPD67		;YES, NO FANCY MAPPING NEEDED
	IDIVI T1,PGSIZ		;SPLIT INTO PAGE AND OFFSET
	PUSH P,T2		;SAVE OFFSET
	ADDI T1,1		;COMPENSATE FOR SOS DONE IN MAPSYM
	MOVEM T1,SYMPAG		;ACT LIKE WE WERE AT THAT PAGE
	NOINT			;MUST BE NOINT TO MAP SYMBOL PAGES
	CALL MAPSYM		;MAP IN FIRST SYMBOL PAGE
	POP P,SYMOFF		;REINITIALIZE OFFSET INTO PAGE
SNPD67:	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
	CALL SYMUMP		;UNMAP THE SYMBOL TABLE
	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,<CALL SYMUMP>)	;ERROR IF NOT
NAMSRL:	CALL NXTSYM		;GET NEXT SYMBOL PAIR
	 RETERR (SNOP13,<CALL SYMUMP>)	;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,SYMOFF		;DECREMENT OFFSET 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,<CALL SYMUMP>)	;NO, MULTIPLY DEFINED SYMBOL
	JRST FNDVLL		;SAME VALUE, THAT IS OK


FNDVDN:	SKIPGE Q2		;FIND THE SYMBOL?
	 RETERR (SNOP14,<CALL SYMUMP>)	;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,<CALL SYMUMP>)	;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
	SKIPN HSYBLK		;SYMBOL TABLE IN NORMAL ADDRESS SPACE?
	JRST [	SOS T1,SYMOFF	;YES, JUST DECREMENT OFFSET
		MOVE P1,(T1)	;GET VALUE OF SYMBOL
		SOS T1,SYMOFF	;DECREMENT AGAIN
		MOVE T1,(T1)	;GET SYMBOL NAME
		RETSKP]		;AND SKIP
	SOSGE T1,SYMOFF		;DECREMENT OFFSET INTO PAGE
	CALL MAPSYM		;WENT OFF PAGE, MAP IN NEW ONE
	MOVE P1,FPG1A(T1)	;GET VALUE OF SYMBOL
	SOSGE T1,SYMOFF		;DECREMENT OFFSET AGAIN
	CALL MAPSYM		;WENT OFF PAGE, MAP IN NEW ONE
	MOVE T1,FPG1A(T1)	;GET SYMBOL NAME
	RETSKP			;GOOD RETURN



MAPSYM:	MOVEI T1,PGSIZ		;GET WORDS IN A PAGE
	ADDB T1,SYMOFF		;ADD TO THE OFFSET WHICH WENT NEGATIVE
	SOS T2,SYMPAG		;BACK UP TO PREVIOUS PAGE
	JUMPL T1,MAPSYM		;CONTINUE IF STILL NEGATIVE
	MOVEI T1,.IMMAP		;FUNCTION TO MAP SYMBOL PAGE
	MOVEI T3,FPG1		;PAGE WHERE MAPPING IS GOING
	MOVEI T4,1		;ONE PAGE
	CALL .IMOPR		;GET THE PAGE OF SYMBOLS
	 BUG(SYMNOM)	;FAILED
	MOVE T1,SYMOFF		;RESTORE OFFSET
	RET			;AND RETURN



;ROUTINE TO UNMAP THE SYMBOL TABLE.


SYMUMP:	SKIPN HSYBLK		;SYMBOLS IN OUR ADDRESS SPACE?
	RET			;YES, NOTHING TO UNMAP
	MOVEI T1,.IMUMP		;FUNCTION TO UNMAP SYMBOLS
	MOVEI T2,FPG1		;PAGE WHERE SYMBOLS WERE MAPPED
	MOVEI T3,1		;ONE PAGE
	CALL .IMOPR		;UNMAP THE SYMBOLS
	 BUG(SYMNOU)
	OKINT			;INTERRUPTS OK NOW
	RET			;RETURN
;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
;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: ERROR OR OUTPUT BUFFER IS EMPTY
;		T2/ 0 IF EMPTY
;			OR
;		    ERROR CODE IF ERROR

.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,B
		CALL ULKTTY	;ALLOW DEALLOCATION
		JRST EMRET1]
	CALL ULKTTY		;ALLOW DEALLOCATION
;**;[1844] Delete one line and revamp at .SOBE: +12L	JGZ	14-APR-81
	TDZA T1,T1		;[1844] INDICATE NO CHARACTERS IN BUFFER
SOBE1:	MOVEM T1,LSTERR		;[1844] SAVE ERRORS IN LSTERR
	UMOVEM A,B		;[1844] RETURN ERROR CODE OR 0
	SMRETN

; 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
; 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 LUNLK0	;YES. UNLOCK IT
		JRST 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
	SUB P,BHC+1
	JRST SPAC2

SPACCF:	POP P,C
	AND C,[XWD 160000,0]
	JRST SPAC2

SPACP1:	SUB P,BHC+1
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 LUNLK0		;YES. FREE IT
	JRST MRETN
;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/PS:<SPOOL>/]	;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
; Set tab stops

.STABS::MCENT
	CALL CHKTTY
	 JRST MRETN
	UMOVE 1,2
	UMOVE 3,3
	UMOVE 4,4
	CALL TTSTBS
	JRST MRETN
; 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
	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
; 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
	 JRST [	UMOVEM A,2	;RETURN ERROR CODE IN 2
		EMRETN ()]	;GIVE ERROR RETURN
	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
; 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?
	 JRST [	CALL CHKTTY	;DO WE HAVE ACCESS?
		 ITERR (DESX2,<OKSKED>) ;NO. RETURN ERROR
		JRST .+1]	;YES. PROCEED
	OKSKED
	MOVE T2,Q1		;GET LINE NUMBER
STI2:	UMOVE T1,T2		;GET CHARACTER
	CALL TTSTI		;PUT CHARACTER IN INPUT BUFFER
	 ITERR ()
	JRST MRETN
; 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:	SKIPA T1,NETON		;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
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
;**;[3003]Add 1 line at TGTOK: + 6L	TAB	29-AUG-83
	HRR T1,T2		;[3003]PUT ORGINAL VALUE BACK IN RH
	RET			;RETURN FLAGS,,FUNCTION TO USER
;USAGE JSYS
;	1/ FLAGS,,FUNCTION
;	2/ ADDRS OF PARAMETERS

.USAGE::
	HRRZ T3,T1		;Get function
	CAIE T3,.USSAS		;Set or
	CAIN T3,.USRAS		; read accounting shifts?
	 JRST USG001		;Yes-- OK if USAGE not enabled
	MOVE T3,FACTSW		;SEE IF ENABLED
	TXNN T3,SF%USG		;???
	 JRST MRETN		;NO - JUST RETURN
USG001:
	HRRZ T3,T1		;GET FUNCTION
	CAILE T3,MXUFN		;VALID?
	ITERR (ARGX02)
	CALL @UFCNTB(T3)	;DISPATCH
	 ITERR ()		;RETURN ERROR
	JRST MRETN		;RETURN

;USAGE FUNCTION TABLE

UFCNTB:	DTBDSP (UFNENT)		; 0 - MAKE ENTRY
	DTBDSP (UFNCLS)		; 1 - CLOSE OUT FILE
	DTBDSP (UFNCKP)		; 2 - PERFORM CHECKPOINT
	DTBDSP (UFNLGI)		; 3 - LOGIN
	DTBDSP (UFNLGO)		; 4 - LOGOUT
	DTBDSP (UFNCHG)		; 5 - SESSION CHANGE
	DTBDSP (UFNCKI)		; 6 - SET CHECKPOINT INTERVAL (MINS)
	DTBDSP (UFNENA)		; 7 - ENABLE ACCOUNT VALIDATION
	DTBDSP (UFNCAS)		; 10 - Change accounting shift
	DTBDSP (UFNSAS)		; 11 - Set accounting shifts
	DTBDSP (UFNRAS)		; 12 - Read accounting shifts
   MXUFN==.-UFCNTB-1

;ROUTINE TO CHECK FOR PRIVS

USGPRV:	MOVE T2,CAPENB		;GET CAP'S
	MOVE T3,MPP		;LOOK BACK TO CALLERS PC
	MOVE T3,0(T3)		; FLAGS
	TXNE T3,UMODF		;CALLED FROM MONITOR?
	TXNE T2,SC%WHL!SC%OPR	; OR PRIV.
	RETSKP			;OK TO GO ON
	RETBAD (CAPX1)		;NEITHER - FAIL
;DEFINITIONS OF INTERNAL FORMAT OF SYSTEM-DATA FILE

;WORDS 0 & 1 ARE QUEUE HEADERS

DEFSTR (UHTYP,UQDAT+0,17,18)	;TYPE CODE
DEFSTR (UHLEN,UQDAT+0,35,18)	;ENTRY LENGTH
DEFSTR (UHTAD,UQDAT+1,35,36)	;ENTRY DATE/TIME
DEFSTR (UHDRV,UQDAT+2,5,6)	;DEC REVISION #
DEFSTR (UHCRV,UQDAT+2,11,6)	;CUST REVISION #
DEFSTR (UHTMT,UQDAT+2,17,6)	;TERMINAL TYPE CODE
DEFSTR (UHJNO,UQDAT+2,35,18)	;JOB #
DEFSTR (UHPNM,UQDAT+3,35,36)	;PROGRAM NAME (SIXBIT)
DEFSTR (UHPVR,UQDAT+4,35,36)	;PROGRAM VERSION NUMBER (STD FORM)
DEFSTR (UHMVR,UQDAT+5,35,36)	;MONITOR VERSION NUMBER (STD FORM)
DEFSTR (UHJTS,UQDAT+6,0,1)	;BATCH := 1 , T/S := 0
DEFSTR (UHULN,UQDAT+6,5,5)	;USER NAME STRING LEN
DEFSTR (UHSL1,UQDAT+6,11,6)	;STRING LENGTH #1 (ACCOUNT)
DEFSTR (UHSL2,UQDAT+6,17,6)	;STRING LENGTH #2 (SESSION REMARK)
DEFSTR (UHLNO,UQDAT+6,35,18)	;LINE NUMBER
DEFSTR (UHNOD,UQDAT+7,35,36)	;NODE NAME (SIXBIT)

UHNAM==UQDAT+10			;LOC OF FIRST WORD OF USER NAME
UHMIN==UQDAT+20			;MINIMUM ENTRY SIZE (FOR ASGSWP)

USQMAX==^D20			;MAX USAGE QUEUE LENGTH
;RECORD LENGTH TABLE

RECLTB:	0			;0 - ILLEGAL
	MOVEI T1,UHMIN+^D16	;1 - MONITOR RESTART
	MOVEI T1,UHMIN+^D22	;2 - SESSION RECORD
	0			;3 - ILLEGAL
	0			;4 - ILLEGAL
	MOVEI T1,UHMIN+^D2	;5 - DATE/TIME CHANGE
	0			;6 - BATCH PROCESSOR
	MOVEI T1,UHMIN+^D27	;7 - INPUT SPOOLER
	MOVEI T1,UHMIN+^D30	;8 - OUTPUT SPOOLER
	CALL UGETDL		;9 - DISK STORAGE USAGE
	0			;10 - DISK SPINDLE USAGE
	MOVEI T1,UHMIN+^D29	;11 - STRUCTURE MOUNT
	MOVEI T1,UHMIN+^D35	;12 - MAGTAPE MOUNT
	0			;13 - DECTAPE MOUNT (TOPS10)
	0			;14 - FILE COMMAND (TOPS10)
	MOVEI T1,UHMIN+^D29	;15 - FILE RETRIEVED
	MOVEI T1,UHMIN+^D29	;16 - FILE ARCHIVED
	MOVEI T1,UHMIN+^D29	;17 - FILE MIGRATED
	MOVEI T1,UHMIN+^D29	;18 - FILE COLLECTED
MXRCTP==.-RECLTB-1

;FORMAT TABLE INDEXED BY RECORD TYPE

UFNFRM:	0			;0 - ILLEGAL
	-UFRSTL,,UFRSTT		;1 - RESTART RECORD
	-UFLOGL,,UFLOGT		;2 - SESSION RECORD
	0			;3 - ILLEGAL
	0			;4 - ILLEGAL
	-UFTADL,,UFTADT		;5 - DATA/TIME CHANGE
	0			;6 - BATCH PROCESSOR
	-UFINPL,,UFINPT		;7 - INPUT SPOOLER
	-UFOUTL,,UFOUTT		;8 - OUTPUT SPOOLER
	-UFDSKL,,UFDSKT		;9 - DISK STORAGE USAGE
	0			;10 - DISK SPINDLE USAGE
	-UFSTRL,,UFSTRM		;11 - STRUCTURE MOUNT
	-UFMTAL,,UFMTAM		;12 - MAGTAPE MOUNT
	0			;13 - DECTAPE MOUNT (TOPS10)
	0			;14 - FILE COMMAND (TOPS10)
	-UFRETL,,UFRETT		;15 - FILE RETRIEVE
	-UFRETL,,UFRETT		;16 - FILE ARCHIVED
	-UFRETL,,UFRETT		;17 - FILE MIGRATED
	-UFRETL,,UFRETT		;18 - FILE COLLECTED
;TABLE FOR DATE/TIME CHANGE FORM

UFTADT:	[-1],,.USDTL		;DATE/TIME BEFORE CHANGE (MANDATORY)
UFTADL==.-UFTADT

;TABLE FOR SYSTEM RESTART FORM

UFRSTT:	[0,,SVN],,.USSNM	;SYSTEM NAME
	[EXP SVNM],,.USMVR	;MONITOR VERSION NUMBER
	SYSTAD,,.USMBD		;MONITOR BUILD DATE/TIME
;**;[1942] Add one line at UFRSTT: +3L		RAS	15-SEP-81
	USGMUP,,.USMUP		;[1942] MONITOR UPTIME (IN SECONDS)
	APRSER,,.USCP0		;SERIAL NUMBER (CPU0)
	[-1],,.USLCK		;DATE/TIME LAST CHECKPOINT (MAND.)
UFRSTL==.-UFRSTT

;TABLE OF SESSION RECORD ITEMS

UFLOGT:	[0,,ACCTSR],,.USACT	;ACCOUNT STRING
	[0,,JSSRM+1],,.USCOM	;SESSION REMARK
	CTIMON,,.USSST		;SESSION START TIME
	CONCON,,.USCCT		;CONSOLE CONNECT TIME
	JBRUNT,,.USRTM		;RUNTIME
	JBBNAM,,.USBJN		;BATCH JOB NAME
	JBBSEQ,,.USBSN		;BATCH SEQUENCE NUMBER
UFLOGL==.-UFLOGT		;LENGTH OF TABLE

CKOFF==:-UFLOGL+2		;OFFSET FROM END OF DATA FOR
				;BEGINNING OF CHECKPOINT DATA
CKITMS==:3			;NUMBER OF CHECKPOINT ITEMS

;TABLE FOR DISK USAGE STATISTICS

UFDSKT:	[-1],,.USSTR		;STRUCTURE NAME
	[-1],,.USDIR		;DIRECTORY NAME
	[-1],,.USNRF		;NUMBER OF ACCOUNTS
	[-1],,.USTUS		;TOTAL SPACE USED
	[-1],,.USTNF		;TOTAL NUMBER OF FILES
	[-1],,.USLIQ		;LOGGED IN QUOTA
	[-1],,.USLOQ		;LOGGED OUT QUOTA
	[-1],,.USLLI		;DATE/TIME LAST LOGIN
	[-1],,.USDSX		;STRUCTURE/DIRECTORY INFO WORD (SPECIAL)
	[-1],,.USDST		;DISK STATISTICS TABLE
UFDSKL==.-UFDSKT
;TABLE FOR INPUT SPOOLER RECORD (NO DEFAULTS)

UFINPT:	[-1],,.USACT		;ACCOUNT STRING
	[-1],,.USTXT		;SYSTEM/OPERATOR TEXT
	[-1],,.USSRT		;SPOOLER RUNTIME
	[-1],,.USSDR		;DISK READS
	[-1],,.USSDW		;DISK WRITES
	[-1],,.USJNM		;JOB NAME
	[-1],,.USQNM		;QUEUE NAME
	[-1],,.USSDV		;ACTUAL INPUT DEVICE
	[-1],,.USSSN		;SEQUENCE NUMBER
	[-1],,.USSUN		;SPOOLER UNITS (CARDS)
	[-1],,.USCRT		;DATE/TIME OF REQUEST
	[-1],,.USDSP		;DISPOSITION
	[-1],,.USPRI		;PRIORITY
UFINPL==.-UFINPT

;TABLE FOR OUTPUT SPOOLER RECORD (NO DEFAULTS)

UFOUTT:	[-1],,.USACT		;ACCOUNT STRING
	[-1],,.USTXT		;SYSTEM/OPERATOR TEXT
	[-1],,.USSRT		;SPOOLER RUNTIME
	[-1],,.USSDR		;DISK READS
	[-1],,.USSDW		;DISK WRITES
	[-1],,.USJNM		;JOB NAME
	[-1],,.USQNM		;QUEUE NAME
	[-1],,.USSDV		;ACTUAL OUTPUT DEVICE
	[-1],,.USSSN		;SEQUENCE NUMBER
	[-1],,.USSUN		;SPOOLER UNITS (OUTPUT)
	[-1],,.USCRT		;DATE/TIME OF REQUEST
	[-1],,.USDSP		;DISPOSITION
	[-1],,.USPRI		;PRIORITY
	[-1],,.USSNF		;NUMBER OF FILES PROCESSED
	[-1],,.USSCD		;SCHEDULED DATE/TIME
	[-1],,.USFRM		;FORMS TYPE
UFOUTL==.-UFOUTT

;TABLE FOR STRUCTURE MOUNT RECORD (NO DEFAULTS)

UFSTRM:	[-1],,.USACT		;ACCOUNT STRING
	[-1],,.USTXT		;SYSTEM/OPERATOR TEXT
	[-1],,.USSSI		;STRUCTURE ID
	[-1],,.USSTP		;STRUCTURE TYPE CODE
	[-1],,.USTNP		;TOTAL NUMBER OF PACKS
	[-1],,.USKTP		;CONTROLLER TYPE
	[-1],,.USDTP		;DEVICE TYPE
	[-1],,.USDSP		;DISPOSITION
	[-1],,.USCRT		;DATE/TIME OF REQUEST
	[-1],,.USSCD		;SCHEDULED DATE/TIME
	[-1],,.USSRV		;SERVICED DATE/TIME
	[-1],,.USMCT		;MOUNT COUNT BEFORE MOUNT
	[-1],,.USDCT		;MOUNT COUNT AFTER DISMOUNT
	[-1],,.USATP		;ACCESS TYPE
	[-1],,.USEUT		;ELASPED USE TIME
UFSTRL==.-UFSTRM
;TABLE FOR MAGTAPE MOUNT RECORD (NO DEFAULTS)

UFMTAM:	[-1],,.USACT		;ACCOUNT STRING
	[-1],,.USTXT		;SYSTEM/OPERATOR TEXT
	[-1],,.USVID		;VOLUME IDENTIFIER
	[-1],,.USVSN		;VISUAL SERIAL NUMBER
	[-1],,.USMRF		;THOUSANDS OF FRAMES READ
	[-1],,.USMWF		;THOUSANDS OF FRAMES WRITTEN
	[-1],,.USDSP		;DISPOSITION
	[-1],,.USCRT		;DATE/TIME OF REQUEST CREATION
	[-1],,.USSCD		;SCHEDULED DATE/TIME
	[-1],,.USSRV		;SERVICED DATE/TIME
	[-1],,.USKTP		;TYPE OF CONTROLLER
	[-1],,.USMLT		;LABEL TYPE
	[-1],,.USMLS		;LABEL STATE
	[-1],,.USMRD		;NUMBER OF PHYSICAL RECORDS READ
	[-1],,.USMWR		;NUMBER OF PHYSICAL RECORDS WRITTEN
	[-1],,.USFSI		;FILE SET IDENTIFIER
	[-1],,.USSRE		;NUMBER OF SOFT READ ERRORS
	[-1],,.USSWE		;NUMBER OF SOFT WRITE ERRORS
	[-1],,.USHRE		;NUMBER OF HARD READ ERRORS
	[-1],,.USHWE		;NUMBER OF HARD WRITE ERRORS
	[-1],,.USEUT		;ELAPSED USE TIME
UFMTAL==.-UFMTAM

UFRETT:	[-1],,.USACT		; Account of file or retrieve requestor
	[-1],,.USDIR		; Directory of file
	[-1],,.USSSI		; SIXBIT STRUCTURE ID
	[-1],,.USUSG		; # pages involved
	[-1],,.USTP1		; Tape 1 ID
	[-1],,.USTS1		; Saveset # for tape 1
	[-1],,.USTF1		; Tape file # for tape 1
	[-1],,.USTP2		; Tape 2 ID
	[-1],,.USTS2		; Saveset for tape 2
	[-1],,.USTF2		; Tape file # for tape 2
	[-1],,.USRSN		; Reason file moved offline
UFRETL==.-UFRETT
;PASS SPECIAL FUNCTION TO JOB 0 AND WAIT

UFNCAS:				;Change accounting shift
UFNCLS:				;Close checkpoint file
UFNCKP:				;Checkpoint all jobs
	CALL USGPRV		;VALIDATE PRIVS
	 RETBAD ()
UFNCK1:	NOINT			;BEST TO BE NOINT
	MOVEI T1,2		;GET 2 WORDS
	CALL ASGSWP		;FROM SWAPPABLE FREE SPACE
	 JRST [	CALL ASGWAT	;WAIT FOR STORAGE
		JRST UFNCK1]	;TRY AGAIN
	XCTU [HRRZ T2,1]	;RE-FETCH USER FUNCTION
	STOR T2,UQFCN,(T1)	;SAVE IN BLOCK
	LOCK (USGLOK)		;WANT DATA BASE LOCKED FOR THIS FCN
	CALL ONUSQ		;QUEUE UP MESSAGE
	OKINT
	AOS JB0FLG		;POKE JOB 0 FOR THESE
	MOVEI T1,USGWAT		;WAIT TILL FUNCTION DONE!
	MDISMS			;DISMISS
	RETSKP			;GOOD RETURN

;RESIDENT SCHEDULAR TEST TO WAIT FOR JOB 0 TO DO FUNCTION

	RESCD

USGWAT:	SKIPL USGLOK		;UNLOCKED?
	JRST 0(4)		;NO - WAIT SOME MORE
	JRST 1(4)		;YES - WAKEUP

	SWAPCD

;JACKET ROUTINE TO ENABLE ACCOUNT VALIDATION

UFNENA:	MOVE T1,CAPENB		;GET ENABLED CAPABILITIES
	TXNN T1,SC%WHL!SC%OPR	;WHOPER DOING THIS?
	ITERR (CAPX1)		;NO, RETURN ERROR
	CALL ENACT		;GO DO THE WORK
	 RETBAD ()
	RETSKP			;GIVE SUCCESSFUL RETURN
;ROUTINE TO SET CHECKPOINT INTERVAL

;**;[2890]Add two line at UFNCKI: +0L	RWW	21-DEC-82
UFNCKI:	CALL	USGPRV		;[2890]CHECK PRIVS
	 RETBAD()		;[2890]no privs, return an error
	UMOVE T1,2		;GET USER ARGUMENT
	IMULI T1,^D60000	;CONVERT TO MS
	MOVEM T1,CKPINV		;SET INTERVAL
	RETSKP			;GOOD RETURN

;WRITE ENTRY INTO USAGE FILE

UFNENT:	CALL UFNINI		;BUILD HEADER
	 RETBAD ()		;ERROR
	LOAD T1,UHTYP,(Q1)	;GET ENTRY TYPE CODE
UFNEN0:	CAIL T1,.UTUSR		;USER-DEFINED ENTRY TYPE?
	 JRST [	CALL UFNFAR		;YES-- FILL ARBITRARY RECORD BLOCK
		 JRST UFNINX		;ERROR-- RETURN TO USER
		JRST UFNEN1]		;ENTRY ALL FINISHED-- PUT ON QUEUE
	MOVE T1,UFNFRM(T1)	;GET FORM POINTER
	CALL UFNFIL		;FILL IN FORM
	 JRST UFNINX		;MISSING ITEM
UFNEN1:	MOVE T1,Q1		;POINT TO RECORD FOR QUEUE
	CALL ONUSQ		;ENQUE MESSAGE
	OKINT			;DONE
	RETSKP			;...

;COMMON ROUTINE TO HANDLE ALL JOB LOGGING

UFNLGI:
UFNLGO:
UFNCHG:	SKIPN JOBNO		;IGNORE FOR JOB 0
	RETSKP
	CALL UFNINI		;INIT BLOCK
	 RETBAD ()		;PASS ERROR UP
	MOVEI T1,.UTSEN		;SESSION ENTRY TYPE CODE
	CALLRET UFNEN0		;FILL IN REMAINDER AND QUEUE IT
;ROUTINE TO FILL RECORD FROM TABLE SPECIFIED
;CALL:	T1/ -LEN,,TABLE-BEG
;	Q1/ POINTER TO BEGINNING OF BUFFER
;	Q2/ POINTER TO USER'S RECORD DESCRIPTOR BLOCK
;	Q3/ POINTER TO FIRST FREE DATA ITEM
;
;COPY DATA INTO BUFFER AND UPDATE HEADER TO SHOW LENGTH
;RETURN WITH Q3 UPDATED TO END OF BLOCK

UFNFIL:	TRVAR <UFCHI,STRLX>
	SETOM STRLX		;INIT INDEX
	MOVE T4,T1		;COPY TO T4
UFNFL1:	MOVEM T4,UFCHI		;SAVE INDEX
	HRRZ T1,0(T4)		;FETCH ITEM CODE
	HLRZ T2,0(T4)		;ADDRS OF DEFAULT ITEM
	MOVE T2,0(T2)		;SETUP DEFAULT
	CALL UFWFET		;GET WORD
	 RETBAD ()		;PASS UP ERROR
	LDB T3,[POINTR (T1,US%TYP)] ;GET DATA TYPE
	CAILE T3,MXUITP		;MAX USAGE ITEM TYPE?
	RETBAD (USGX03)		;ILLEGAL USAGE ITEM TYPE
	CALL @UTYPTB(T3)	;FILL IN DATA ITEM
	 RETBAD ()		;PASS ERROR UP
	MOVE T4,UFCHI		;RESTORE INDEX
	AOBJN T4,UFNFL1		;LOOP TILL ALL DONE

;HERE WHEN ALL DONE FILLING THE ENTRY

UFNFIE:	MOVE T1,Q3		;COPY POINTER
	SUBI T1,1(Q1)		;ACTUAL DATA LENGTH
	STOR T1,UHLEN,(Q1)	;STORE IN RECORD
	MOVE T1,UQDAT(Q1)	;COPY HEADER
	MOVEM T1,0(Q3)		;TO LAST WORD
	RETSKP

;STRING LENGTH TABLE

STRLNT:	STOR T2,UHSL1,(Q1)	;STORE IN STRING LEN #1
	STOR T2,UHSL2,(Q1)	;STORE IN STRING LEN #2

;USAGE ITEM TYPE TABLE

UTYPTB:	DTBDSP (UFLASC)		;0 - STRING
	DTBDSP (UFLSIX)		;1 - SIXBIT WORD
	DTBDSP (UFLOCT)		;2 - OCTAL WORD
	DTBDSP (UFLDEC)		;3 - DECIMAL WORD
	DTBDSP (UFLDAT)		;4 - DATE/TIME WORD
	DTBDSP (UFLTAB)		;5 - TABLE (SPECIAL)
	DTBDSP (UFLVER)		;6 - VERSION NUMBER
	DTBSKP			;7 - SPACE FILL (SKIP)
   MXUITP==.-UTYPTB-1
;ROUTINE TO STORE FULL WORDS
;T2 / DATA WORD

UFLVER:
UFLOCT:
UFLDEC:
UFLDAT:	MOVEM T2,0(Q3)		;SAVE WORD IN BUFFER
	AOJA Q3,RSKP		;ADVANCE POINTER AND RETURN

;ROUTINE TO STORE STRING
;T2 / STRING POINTER

UFLASC:	TLCE T2,-1		;CHECK FOR 0,,ADDRS
	TLC T2,-1		;NO - MUST BE BPNTR
	CALL UFCPY0		;COPY STRING INTO BLOCK
	 RET
	AOS T1,STRLX		;STEP INDEX
	XCT STRLNT(T1)		;STORE LENGTH
	RETSKP			;GOOD RETURN

;ROUTINE TO FILL IN TABLE INFO
;T2 / TABLE BASE ADDRS

;**;[2607] Change one line at UFLTAB: +0L	JGZ	3-APR-82
UFLTAB:	SAVEAC <Q1,Q2>		;[2607] SAVE Q1,Q2
	STKVAR <TBLCNT,TBLSTO>
	MOVE Q2,T2		;SAVE BASE ADDRS
	UMOVE T1,0(Q2)		;FETCH TABLE HEADER
	HRRZ T2,T1		;GET LENGTH OF ADDITIONAL ITEMS
	MOVNM T2,TBLCNT		;SAVE NEG COUNT
	HLRZ Q1,T1		;GET LENGTH OF TABLE

UFLTB1:	MOVEM Q3,TBLSTO		;SAVE ADDRS OF STRING LENGTH
	AOS Q3			;STEP TO NEXT LOC
	UMOVE T3,1(Q2)		;FETCH WORD FROM TABLE
	HRRZ T2,T3		;ADDRESS OF DATA ITEMS
	HRL T2,TBLCNT		;FORM -N,,ADDRS
UFLTB2:	UMOVE T1,0(T2)		;GET ITEM
	MOVEM T1,0(Q3)		;STORE IN BUFFER
	AOS Q3			;ADVANCE TO NEXT LOC
	AOBJN T2,UFLTB2		;LOOP OVER ALL ITEMS
	HLRO T2,T3		;GET POINTER TO STRING
	CALL UFCPY0		;COPY TO BUFFER
	 JFCL
	HRRZM T2,@TBLSTO	;STASH LENGTH
	AOS Q2			;STEP TO NEXT LOC
	SOJG Q1,UFLTB1		;LOOP OVER TABLE
	RETSKP			;DONE
;ROUTINE TO GET SIXBIT ARGUMENT, MAY BE POINTER TO AN ASCIZ STRING

UFLSIX:	HLRZ T1,T2		;CHECK FOR POINTER
	CAIE T1,-1
	CAIN T1,(POINT 7,,)
	JRST UFLSX0		;STRING - COPY IT FIRST
UFLSXX:	MOVEM T2,0(Q3)		;STORE WORD
	AOJA Q3,RSKP		;AND GIVE GOOD RETURN

;ASCIZ STRING POINTER - CONVERT TO SIXBIT

UFLSX0:	STKVAR <SIXBP>
	MOVE T1,T2		;COPY POINTER
	HRLI T1,(POINT 7,,)
	MOVEI T4,6		;MAX 6 CHARS
	SETZ T2,		;CLEAR ANSWER
	MOVE T3,[POINT 6,T2]
	MOVEM T3,SIXBP		;INIT OUTPUT BP
UFLSX1:	XCTBU [ILDB T3,T1]	;FETCH A CHAR
	JUMPE T3,UFLSXX		;DONE IF NULL
	SUBI T3,40		;CONVERT TO SIXBIT
	IDPB T3,SIXBP		;SAVE IN RESULT
	SOJG T4,UFLSX1		;LOOP TILL DONE
	JRST UFLSXX		;STORE RESULT
; UFNFAR -- FILL ARBITRARY RECORD FOR USER ENTRY TYPE
;
; CALL:
;	Q1/ POINTER TO BEGINNING OF BUFFER
;	Q2/ POINTER TO USER'S RECORD DESCRIPTOR BLOCK
;	Q3/ POINTER TO FIRST FREE DATA ITEM
;
; RETURNS:
;	+1:	ERROR, CODE IN T1
;	+2:	SUCCESS, ENTRY READY TO PUT ON QUEUE
;
; DESTROYS T1-T4, Q3

UFNFAR:	CALL UFNFNA		;FIND THE "ARBITRARY RECORD TYPE" ITEM
				; RETURNS USER ADDRESS IN T3

;FORM AOBJN POINTER TO REMAINING DATA BLOCK IN Q3

	LOAD T1,UQLEN,(Q1)	;GET LENGTH OF DATA BLOCK
	ADD T1,Q1		;FIND END OF BLOCK
	SUBM Q3,T1		;GET -VE WORDS LEFT TO FILL IN T1
	HRL Q3,T1		;FORM AOBJN POINTER IN Q3

;LOOP THROUGH THE USER'S RECORD DESCRIPTOR BLOCK (T3) FOR ALL ITEMS
; AND STORE THEM IN DATA BLOCK (Q3)

UFNFA1:	UMOVE T1,0(T3)		;GET ITEM TYPE WORD
	JUMPE T1,UFNFIE		;END-- ALL DONE, COMPUTE LENGTH AND RETURN +2 FROM UFNFAR
	JUMPGE Q3,[RETBAD (ARGX05)] ;IF NO ROOM-- RDB MUST HAVE GROWN!!
	MOVEM T1,0(Q3)		;STORE THE ITEM TYPE WORD IN THE DATA BLOCK
	AOBJN Q3,.+1		;COUNT THAT WORD IN DATA BLOCK
	ADDI T3,2		;POINT TO NEXT USER ENTRY NOW

	LDB T4,[POINTR (T1,US%TYP)] ;EXTRACT ITEM TYPE
	CAIN T4,.USSPC		;SPACE FILL?
	 JRST UFNFA1		;YES-- NO DATA FOR THIS
	UMOVE T2,-1(T3)		;GET USER'S DATA WORD OR POINTER
	CAMN T2,[EXP -1]	;USER WANT DEFAULT VALUE FOR THIS ITEM?
	 RETBAD (USGX03)	;YES-- THERE ARE NO DEFAULTS IN ARBITRARY ENTRIES
	CAIN T4,.USASC		;ASCII STRING?
	 JRST UFNFA5		;YES-- MUST COPY WHOLE STRING

;ALL OTHER DATA TYPES ARE EXACTLY ONE WORD-- GET THE WORD AND PUT IT AWAY

	TXNE T1,US%IMM		;IMMEDIATE MODE DATA ITEM?
	 JRST UFNFA3		;YES-- WE HAVE THE DATA ITEM IN T2
	MOVX T2,<MOVE T2,@0>	;NO-- MUST PERFORM INDIRECT FETCH
	HRRI T2,-1(T3)		; VIA THE USER'S DATA WORD POINTER
	XCTUU T2		;FETCH USER'S DATA WORD TO T2
UFNFA3:	JUMPGE Q3,[RETBAD (ARGX05)] ;IF NO ROOM-- RDB MUST HAVE GROWN!!
	MOVEM T2,0(Q3)		;STORE THE USER'S DATA WORD IN DATA BLOCK
	AOBJN Q3,.+1		;COUNT THAT WORD IN DATA BLOCK
	JRST UFNFA1		;LOOP FOR ALL ITEMS

;ASCII STRING ITEM-- COPY THE ENTIRE STRING TO THE DATA BLOCK

UFNFA5:	LDB T1,[POINTR (T1,US%LEN)] ;GET LENGTH OF STRING IN BYTES
	ADDI T1,4		;ROUND UP
	IDIVI T1,5		; TO FULL WORDS
	UMOVE T2,-1(T3)		;GET ADDRESS OF STRING
UFNFA6:	JUMPLE T1,UFNFA1	;DONE IF NO MORE USER WORDS LEFT, GET NEXT ITEM
	UMOVE T4,0(T2)		;GET WORD FROM USER'S STRING
	ADDI T2,1		;BUMP USER STRING ADDRESS
	JUMPGE Q3,[RETBAD (ARGX05)] ;IF NO ROOM-- RDB MUST HAVE GROWN!!
	MOVEM T4,0(Q3)		;STORE IT IN DATA BLOCK
	AOBJN Q3,.+1		;COUNT THAT WORD IN DATA BLOCK
	SOJA T1,UFNFA6		;COUNT DOWN WORD COUNT, LOOP FOR ENTIRE STRING
;ROUTINE TO SETUP BLOCK OF STORAGE AND FILL IN HEADER INFO
;RETURNS: +1 ERROR CODE IN T1
;	  +2 NOINT
;	Q1/	STORAGE BLOCK FROM ASGSWP
;	Q2/	POINTER TO USER'S ARGLST
;	Q3/	POINTER TO FIRST FREE WORD IN BLOCK

UFNINI:	CALL USGPRV		;CHECK PRIVS
	 RETBAD ()
UFNIN0:	UMOVE Q2,2		;GET CALLER ARGS
	XCTU [HRRZ T2,0(Q2)]	;GET RECORD TYPE CODE
	CAIG T2,MXRCTP		;VALIDATE
	SKIPN T1,RECLTB(T2)	;SKIP IF VALID TYPE CODE
	 JRST [	CAIL T2,.UTUSR		;MAYBE IT'S A USER ENTRY 5000-9999
		CAILE T2,^D9999		; . . ?
		 RETBAD (USGX01)	;NO-- REALLY INVALID ENTRY TYPE
		CALL UFNINS		;USER ENTRY TYPE-- COMPUTE LENGTH
		JRST UFNI01]		;LENGTH OF USER ENTRY NOW IN T1
	XCT T1			;RETURNS LENGTH IN T1
UFNI01:	NOINT			;BEST BE NOINT
	MOVE T2,USQCNT		;SEE IF OVER QUEUE QUOTA
	CAIGE T2,USQMAX		;...
	CALL ASGSWP		;ALLOCATE STORAGE
	 JRST [	CALL ASGWAT	;WAIT FOR SOME
		JRST UFNIN0]	;START OVER
	MOVE Q1,T1		;SAVE POINTER TO BLOCK
	XCTU [HRRZ T1,1]	;GET USER FUNCTION AGAIN
	STOR T1,UQFCN,(Q1)	;STORE IN QUEUE HEADER
	UMOVE T2,0(Q2)		;GET ARG HEADER
	STOR T2,UHTYP,(Q1)	;STORE TYPE IN BLOCK
	LDB T1,[POINT 9,T2,8]	;GET DEC REV
	STOR T1,UHDRV,(Q1)
	LDB T1,[POINT 9,T2,17]	;GET CUST REV
	STOR T1,UHCRV,(Q1)
	GTAD			;CURRENT DATE/TIME
	STOR T1,UHTAD,(Q1)
	MOVE T1,JOBNO		;JOB NUMBER
	STOR T1,UHJNO,(Q1)
;**;[3036]	Add 5 lines at UFNI01+22L	YKT	NOV-03-83
;	SETZRO UHNOD,(Q1)	;[3036] NODE (ZERO FOR NOW)
;**;[3110] Change 1 line at UFNI01+23L		DEE	18-MAY-84
	MOVEI T1,LLSR		;[3036][3110] REMOVE INDEX REGISTER P1 - LLSR HAS NODE NAME
	HRLI T1,440700		;[3036]
	CALL ASZSIX		;[3036]
;**;[3041]	Modify one line			YKT	NOV-08-83
;	 JFCL			;[3041][3036]
	SETZM T1		;[3041]
	STOR T1,UHNOD,(Q1)	;[3036]
	MOVE T1,[EXP SVNM]	;MONITOR VERSION NUMBER
	STOR T1,UHMVR,(Q1)
	MOVEI Q3,0		;INIT TO ZERO
	STOR Q3,UHJTS,(Q1)
	MOVE T1,CTRLTT		;CONTROLLING TERMINAL
	STOR T1,UHLNO,(Q1)	;SAVE
	JUMPL T1,[MOVEI Q3,'D'	;SAY DETACHED
		  MOVX T1,OB%BSS ;GET BATCH STREAM SET FLAG
		  TDNN T1,BATSTF ;DETACHED BATCH JOB?
		  TDZA T1,T1	; NO, MARK TIMESHARING
		  SETOM T1	; YES, REMEMBER
		  JRST UFNI02]	;AND GO STORE FLAG
	CAMN T1,CTYLNO		;CTY?
	MOVEI Q3,'C'		;YES
	CAMGE T1,CTYLNO		;REAL TTY
	MOVEI Q3,'T'		;YES
	CALL PTYGBB		;SEE IF PTY
	 JRST [	SKIPN Q3	;ANYTHING?
		MOVEI Q3,'U'	;NO - UNKNOWN
		JRST UFNIN1]	;PROCEDE
	MOVEI Q3,'P'		;SAY ITS A PTY
UFNI02:	STOR T1,UHJTS,(Q1)	;STORE BATCH/TS FLAG
	;..
	;..

UFNIN1:	STOR Q3,UHTMT,(Q1)	;STORE TERMINAL TYPE CODE
;**;[2635]ADD 7 LINES AT UFNIN1:+1L	TAM	28-JUL-82
	MOVEI T1,.USNOD		;[2635]NODE TYPE CODE
	LOAD T2,UHNOD,(Q1)	;[2635]DEFAULT
	CALL UFWFET		;[2635]ONE SUPPLIED?
	 JRST [CAIE T1,USGX02	;[2635]NONE?
	       JRST UFNINX	;[2635]SOME OTHER ERROR
	       JRST .+1]	;[2635]USE DEFAULT
	STOR T2,UHNOD,(Q1)	;[2635]SAVE IT
	MOVEI T1,.USJTY		;JOB TYPE CODE
	LOAD T2,UHJTS,(Q1)	;USE DEFAULT
	CALL UFWFET		;GET ARG IF SUPPLIED
	 JRST [	CAIE T1,USGX02	; USE DEFAULT IF ITEM NOT FOUND
		JRST UFNINX	; ELSE ERROR
		JRST .+1]
	STOR T2,UHJTS,(Q1)	;NOW STORE ACTUAL WANTED
	MOVEI T1,.USPNM		;CALLING PROGRAM NAME
	MOVE T2,JOBNO		;DEFALUT TO SYSTEM NAME
	MOVE T2,JOBPNM(T2)	;...
	CALL UFWFET		;FIND ENTRY & FETCH
	 JRST [	CAIE T1,USGX02	;USE DEFAULT IF ITEM NOT FOUND
		JRST UFNINX	;ERROR EXIT
		JRST .+1]
	STOR T2,UHPNM,(Q1)	;STORE
	MOVEI T1,.USPVR		;PROGRAM VERSION
	MOVEI T2,0		;DEFAULT NONE
	CALL UFWFET
	 JRST [	CAIE T1,USGX02	;USE DEFAULT IF ITEM NOT FOUND
		JRST UFNINX	;ERROR EXIT
		JRST .+1]
	STOR T2,UHPVR,(Q1)	;STORE
	MOVEI T1,.USNM2		;USER NAME
	MOVEI T2,USRNAM+1	;DEFAULT
	MOVEI Q3,UHNAM(Q1)	;POINT TO NAME STRING ADDRS
	CALL UFCPYU		;COPY STRING
	 JRST [	CAIE T1,USGX02	;USE DEFAULT IF ITEM NOT FOUND
		JRST UFNINX	;ERROR EXIT
		CALL UFCPY0	;USE DEFAULT (IN T2)
		 JFCL		;WONT HAPPEN
		JRST .+1]
	STOR T2,UHULN,(Q1)	;STORE LENGTH
	RETSKP			;RETURN

;ERROR EXIT WITH OKINT (CODE IN T1)

UFNINX:	PUSH P,T1		;SAVE CODE
	MOVE T1,Q1		;POINT TO BLOCK
	LOAD T2,UQLEN,(T1)	;SETUP SIZE
	CALL RELSWP		;RELEASE SPACE
	OKINT			;ALLOW INTS
	POP P,T1		;RESTORE CODE
	RETBAD ()
; UFNINS -- COMPUTE DATA BLOCK LENGTH FOR ARBITRARY USER ENTRIES 5000-9999
;
; CALL:
;	Q2/	POINTER TO USER'S RECORD DESCRIPTOR BLOCK
;
; RETURNS:
;   +1:	ALWAYS
;	T1/	SIZE OF DATA BLOCK NEEDED (FOR ASGSWP)
;
; DESTROYS T1-T4

UFNINS:	CALL UFNFNA		;FIND FIRST ARBITRARY RECORD ITEM, USER ADDRESS IN T3
	MOVX T4,UHMIN+1		;START COUNT WITH REQUIRED PART OF DATA BLOCK

;LOOP THROUGH USER'S RECORD DESCRIPTOR BLOCK AND COUNT THE SIZE OF EACH ENTRY IN T4

UFNIS1:	UMOVE T1,0(T3)		;GET ITEM TYPE CODE WORD
	JUMPE T1,UFNIS9		;ZERO MEANS END-- COMPUTE SIZE AND RETURN
	ADDI T4,1		;COUNT THE ITEM TYPE WORD
	ADDI T3,2		;STEP TO NEXT USER ITEM NOW

	LDB T2,[POINTR (T1,US%TYP)] ;GET ITEM DATA TYPE
	CAIN T2,.USSPC		;SPACE FILL?
	 JRST UFNIS1		;YES-- NO DATA WORD FOR THIS
	CAIE T2,.USASC		;ASCII STRING?
	 AOJA T4,UFNIS1		;NO-- DATA IS EXACTLY ONE WORD, SO COUNT AND GET NEXT ITEM

;ASCII STRING-- SIZE IN WORDS IS ( <LENGTH IN BYTES> + 4 ) / 5

	LDB T1,[POINTR (T1,US%LEN)] ;GET LENGTH IN BYTES
	ADDI T1,4		;ROUND UP
	IDIVI T1,5		; TO FULL WORDS
	ADD T4,T1		;COUNT THE STRING LENGTH
	JRST UFNIS1		;LOOP FOR NEXT ITEM

;END OF BLOCK-- RETURN LENGTH IN T1

UFNIS9:	MOVE T1,T4		;COPY LENGTH
	RET			;RETURN +1 FROM UFNINS


; UFNFNA -- FIND FIRST ARBITRARY RECORD ENTRY
; CALL:	Q2/	POINTER TO USER RECORD DESCRIPTOR BLOCK
; RETURNS:
;  +1:	T3/	POINTER TO USER'S ARBITRARY RECORD DESCRIPTOR
; DESTROYS T1-T4

UFNFNA:	MOVE T3,Q2		;COPY BEGINNING OF USER REC DESC BLK
UFNFN1:	UMOVE T1,1(T3)		;GET AN ITEM CODE WORD--SKIP HEADER
	JUMPE T1,UFNFN9		;ZERO IS END-- RETURN NOW
	LDB T2,[POINTR (T1,US%COD)] ;GET ITEM CODE
	CAIE T2,.USUAR		;ARBITRARY RECORD DELIMITER?
	 JRST [	ADDI T3,2		;NO-- BUMP TO NEXT ITEM
		JRST UFNFN1]		; AND GO ON LOOKING
UFNFN9:	AOJA T3,R		;YES-- RETURN CORRECT POINTER FROM UFNFNA
;ROUTINE TO COPY STRING ARGUMENT INTO USAGE BLOCK
; CALL:	T1/	ITEM CODE
;	T2/	DEFAULT STRING PNTR
;	Q3/	DEST ADDRS
;
;RETURN +1	ERROR
;	+2	LENGTH IN T2, UPDATED ADDRS IN Q3

UFCPYU:	CALL UFWFET		;GET WORD (SHOULD BE POINTER)
	 RETBAD ()		;PASS ERROR UP
UFCPY0:	MOVEI T1,-1(Q3)		;POINT TO DESTINATION ADDRS
	TLNN T2,-1		;MAYBE 0,,ADDRS
	JRST UFCPY2		;YES - STRING IN MONITOR SPACE
	CALL CPYFU1		;COPY STRING FROM USER SPACE
	 JFCL			;CANT HAPPEN
UFCPYX:	IBP T2			;ADVANCE TO NULL
	MOVEI T1,1(T2)		;POINT TO WORD AFTER STRING
	SUBI T2,-1(Q3)		;NUMBER OF FULL WORDS
	MOVE Q3,T1		;RETURN UPDATED POINTER IN Q3
	RETSKP			;GOOD RETURN

UFCPY2:	HRLI T1,(<POINT 7,,35>)	;DESTINATION BP
	HRLI T2,(<POINT 7,,>)	;SOURCE BP
	SETZ T3,		;TERMINATE ON NULL
	SOUT			;COPY STRING
	MOVE T2,T1		;RETURN UPDATED STRING IN T2
	JRST UFCPYX		;COMMON EXIT

;ROUTINE TO FETCH LENGTH OF DISK USAGE BLOCK

UGETDL:	MOVEI T1,.USDST		;LOOK FOR THIS ITEM TYPE
	SETO T2,		;NO DEFAULT
	CALL UFWFET		;...
	 JRST [	MOVEI T1,UHMIN+^D24
		RET]		;RETURN DEFAULT
	UMOVE T3,0(T2)		;FETCH TABLE HEADER
	HRRZ T1,T3		;NUMBER OF DATA ITEMS PER ENTRY
	ADDI T1,MAXLW+1		; PLUS MAX STRING LENGTH+1
	HLRZS T3		;NUMBER OF TABLE ENTRIES
	IMUL T1,T3		;TOTAL ITEMS (MAX STORAGE)
	ADDI T1,UHMIN+^D24	; PLUS FIXED AMOUNT
	RET			;RETURN
;ROUTINE TO FIND ENTRY IN CALLER'S LIST
;   T1/ DESIRED ARG TYPE CODE
;RETURNS:  T1/ ITEM DESC
;	   T2/ DATA ENTRY
;	   T3/ POINTER TO ENTRY

USFFND:	MOVE T3,Q2		;COPY ARG BLOCK ADDRS
	MOVE T4,T1		;COPY ARG TO T4
USFFN1:	UMOVE T1,1(T3)		;FETCH ARG
	JUMPE T1,[RETBAD (USGX02)] ;NOT FOUND
	ADDI T3,2		;POINT TO DATUM
	LDB T2,[POINTR (T1,US%COD)] ;GET ITEM CODE
	CAME T2,T4		;CHECK MATCH
	JRST USFFN1		;NO - LOOP
 	UMOVE T2,0(T3)		;RETURN 2ND WORD
	CAMN T2,[-1]		;-1 GIVEN
	TXO T1,US%IMM		;YES - SET IMMED FLAG
	RETSKP			;GOOD RETURN

;ROUTINE TO FETCH WORD ITEM FROM ARGLIST (RETURN IN T2)
; CALL:	T1/ ITEM CODE
;	T2/ DEFAULT VALUE

UFWFET:	STKVAR <DFLT>
	MOVEM T2,DFLT		;SAVE DEFAULT VALUE
	CALL USFFND		;FIND ITEM
	 RETBAD (,<MOVE T2,DFLT>)
	LDB T4,[POINTR (T1,US%TYP)]
	TXNN T1,US%IMM		;IMMEDIATE CODE?
	CAIN T4,.USASC		;STRING TYPE?
	JRST UFWFT1		;YES - DONT FETCH WORD
	HRLI T3,(<MOVE T2,@0>)	;NO - FORM INDIRECT FETCH
	XCTUU T3		; AND GET ACTUAL VALUE
UFWFT1:	CAME T2,[-1]		;WANT DEFAULT?
	RETSKP			;NO - GOOD RETURN
	MOVE T2,DFLT		;YES - GET IT
	CAMN T2,[-1]		;DEFAULT ALLOWED?
	RETBAD (USGX03)		;NO RETURN ERROR
	RETSKP			;RETURN

;ROUTINE TO WAIT A BIT FOR FREE STORAGE

ASGWAT:	OKINT			;ALLOW INTS
	AOS JB0FLG		;POKE JOB 0
	MOVEI T1,^D1000		;WAIT 1 SEC
	DISMS
	RET			;RETURN
;ROUTINE TO QUEUE UP MESSAGE FOR JOB 0
; T1/ ADDRS OF MESSAGE

ONUSQ:	NOSKED			;PREVENT RACES
	AOS USQCNT		;INCREMENT
	SETZRO UQLNK,(T1)	;MARK END OF QUEUE
	MOVE T2,USGEND		;GET END POINTER
	STOR T1,UQLNK,(T2)	;STORE LINK TO NEXT ITEM
	MOVEM T1,USGEND		;NEW POINTER
	OKSKED
	RET			;RETURN

;ROUTINE TO REMOVE TOP ITEM FROM Q

OFFUSQ::NOINT			;BE NOINT FOR RELFRE
	NOSKED			;INTERLOCK
	SOS USQCNT		;DECREMENT
	SKIPN T1,USGBEG		;ANYTHING ON QUEUE?
	 JRST [	OKSKED			;NO--
		OKINT
		RET]			; JUST RETURN
	LOAD T2,UQLNK,(T1)	;GET POINTER TO NEXT
	MOVEM T2,USGBEG		;STORE NEW HEAD
	JUMPN T2,OFFUS1		;JUMP IF MORE ON LIST
	MOVEI T2,USGBEG-1	;RESET END
	MOVEM T2,USGEND		; ...
OFFUS1:	OKSKED			;ALLOW SCHED
	LOAD T2,UQLEN,(T1)	;GET LENGTH
	CALL RELSWP		;RELEASE BLOCK AND RETURN
	OKINT
	RET
; ENABLE ACCOUNT VALIDATION
; RETURNS: +1	ERROR, ERROR CODE IN AC1
;	   +2	SUCCESS

ENACT::STKVAR <<ENFDB,3>,ENJFN>
	LOCK ACTLCK
	MOVE T1,ACTOFN		;ACCOUNT DATA BASE OFN
	CAMN T1,[-1]		;IS AN OFN ASSIGNED YET?
	JRST ENAC0		;NO, JUST CONTINUE
	SETZ T1,		;UNMAP PAGE WITH HASH TABLE
	HRRZI T2,HSHPG
	CALL SETMPG
	SETZ T1,		;UNMAP ACCOUNT WINDOW PAGE
	HRRZI T2,ACTPG
	CALL SETMPG
	SETOM ACTPGN		;NO ACCT WINDOW PAGE MAPPED IN NOW
	MOVE T1,ACTOFN
	CALL RELOFN		;RELEASE THE OFN
	CAMGE T1,[-1]		;IS THE FILE COMPLETELY CLOSED?
	RETBAD (ENACX1,<UNLOCK ACTLCK>)	;NO, ERROR
	SETOM ACTOFN		;NOW WE HAVE NO OFN FOR ACCT DATA BASE

ENAC0:	MOVX T1,GJ%OLD+GJ%SHT+.GJDEF
	HRROI T2,[ASCIZ/PS:<SYSTEM>ACCOUNTS-TABLE.BIN/]
	GTJFN			;GET JFN FOR MOST RECENT DATA BASE
	 RETBAD (ENACX2,<UNLOCK ACTLCK>)
	MOVEM T1,ENJFN		;SAVE JFN FOR NOW
	MOVX T2,<3,,.FBCTL>	;GET FDB STATUS WORD AND XB DISK ADDRESS
	MOVEI T3,ENFDB		;PLACE TO PUT FDB INFO
	GTFDB
	 ERJMP ENACX		;CATCH ANY ERRORS
	MOVE T1,ENFDB		;EXAMINE FILE STATUS
	TXNE T1,FB%LNG		;IS IT A LONG FILE?
	RETBAD (ENACX3,<UNLOCK ACTLCK>)

;**;[6732] Remove edit 1724 and replace one line with 4 EHL 26-june-85
	MOVE T1,[540000,,SYSTDN] ;[6732] Get quota remaining
	CALL IGTDAL		;[6732] ...
	 RETBAD (,<UNLOCK ACTLCK>)
	MOVE T4,T1		;[6732] Logged-in quota
	SUB T4,T2		;[6732] minus current usage is quota remaining


	MOVEI T1,ENFDB
	MOVE T1,2(T1)		;GET XB DISK ADDRESS
	MOVEI T2,PSNUM		;AND STRUCTURE # OF PS:
	MOVEI T3,SYSTDN		;DIR # OF <SYSTEM>
;**;[1724] Replace one line at ENAC0: +16L	JGZ	4-JUN-80
;	HRLZI T4,377777		;[1724]INFINITE REMAINING QUOTA
	CALL ASGOFN		;GET AN OFN FOR THE DATA BASE
	 RETBAD (ENACX4,<UNLOCK ACTLCK>)
	MOVEM T1,ACTOFN		;SAVE THE NEW OFN
	HRLZS T1		;OFN,, PAGE ZERO
	MOVX T2,PM%RD		;READ ACCESS TO THE HASH PAGE
	HRRI T2,HSHPG
	CALL SETMPG		;MAP IN THE HASH TABLE AT HSHPG
	MOVE T1,ENJFN		;GET JFN FOR FILE
	RLJFN			;RELEASE IT
	 RETBAD ( ,<UNLOCK ACTLCK>)
	SETOM ACTPGN		;NO ACCT WINDOW PAGE MAPPED IN NOW
	SETOM AVALON		;ACCOUNT VALIDATION NOW TURNED ON
	UNLOCK ACTLCK		;ALL DONE FIDDLING WITH THESE PAGES NOW
	RETSKP			;GIVE GOOD RETURN

ENACX:	RETBAD ( ,<UNLOCK ACTLCK>)
;Set/read automatic accounting shift change table functions
;
; User args:
;	AC2/	Table address
;
; Table format:
;	XWD actual number of entries, maximum number of entries
;	<table entry>
;	. . .
;	<table entry>
;
; Table entry format:
;	LH:  Days-of-week entry is applicable, bit n on means
;		day-of-week n (0=Monday)
;	RH:  Time in seconds since midnight when shift change should occur

MAXASC==^D100			;Maximum number of entries in table

;Set table

UFNSAS:	CALL USGPRV		;Check priviledges
	 RETBAD ()		;No luck
	UMOVE T2,2		;Get table address
	XCTU [HLRZ Q1,0(T2)]	;Get actual number of enties from table header
	CAILE Q1,MAXASC		;Reasonable table size?
	 RETBAD (ARGX04)	;No-- agument block too long

;Get non-resident dynamic storage for the new table

	NOINT			;DON'T ALLOW ^C WHILE FREE SPACE NOT SIGNED OUT
	JUMPE Q1,UFNSA2		;If table is zero length, just remove old one
	MOVEI T1,1(Q1)		;Get size of table + 1 (for size word)
	CALL ASGSWP		;Get storage
	 RETBAD ()		;None available-- return error

;Form AOBJN pointer to new table in Q1

	MOVEI T3,1(T1)		;Get address + 1 in T3 (for BLT)
	MOVE T1,Q1		;Get length (for BLT)
	MOVN Q1,Q1		;Get -ve size
	HRLZ Q1,Q1		; to LH
	HRR Q1,T3		;Form AOBJN pointer

;Copy user's table into monitor space

	UMOVE T2,2		;Get table address
	ADDI T2,1		;Skip header word
	CALL BLTUM1		;Copy table from monitor space

;Set new table, remove old one if any

UFNSA2:
	LOCK ASCLOK		;Lock database and pointer
	EXCH Q1,ASCPTR		;Store new pointer, get old one
	UNLOCK ASCLOK		;Unlock database
	JUMPE Q1,UFNSA8		;All done if no old table
	MOVEI T1,-1(Q1)		;Get address of size word
	MOVE T2,0(T1)		;Get size of block from size word
	CALL RELSWP		;Return the block to free pool

UFNSA8:	OKINT
	CALL NXTASC		;Compute next accounting shift change
	RETSKP			;Return successful from UFNSAS


;Read table

UFNRAS:	CALL USGPRV		;Check for privilged user
	 RETBAD ()		;No luck
	LOCK ASCLOK		;Lock database and pointer
	HLRE T1,ASCPTR		;Get -ve length of table
	MOVN T1,T1		;Compute number of entires
	UMOVE T3,2		;Get user table address
	XCTU [HRRZ T2,0(T3)]	;Get max size of user table
	CAMGE T2,T1		;Will monitor table fit in user table?
	 JRST [	UNLOCK ASCLOK
		RETBAD (ARGX05)] ;No-- Argument block too small
	XCTU [HRLM T1,0(T3)]	;Yes-- store size of actual table
	HRRZ T2,ASCPTR		;Get monitor's table address
	ADDI T3,1		;Skip header word in user table
;**;[1787] Change one line at UFNRAS: +13L	JGZ	24-SEP-80
	SKIPE T1		;[1787] Any data to move?
	 CALL BLTMU1		;Yes-- copy monitor table to user space
	UNLOCK ASCLOK		;Unlock database
	RETSKP			;Return successful from UFNRAS
;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,[ERJMP]		;IS THIS AN ERJMP OR ERCAL
	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
; 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
	MOVE T1,LSTERR
	ITERR ( )		;ERROR RETURN

   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 <STRINX,VERABJ,VERHDR,VERLOC,VERLUK,VERNUM,<VERTMP,2>,VERCLS,VEREPT>
	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
;**;[2836]ADD 1 LINE AT VERAC1:+6L	TAM	14-OCT-82
	LOCK ACTLCK		;[2836]LOCK UP DATA BASE
	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 (HSHERR)
		RETBAD (VACCX0)]
	MOVEI T2,HSHPG+1	;START OF HASH VALUES ON HSHPG
	ADD T2,T1		;HASH VALUE IS INDEX INTO TABLE
;**;[2836]DELETE 1 LINE AT VERAC0:+7L	TAM	14-OCT-82
;**;[1872] Add one line at VERAC0: +7L		RAS	12-MAY-81
;	LOCK ACTLCK		;[1872] LOCK THE DATA BASE
	MOVE T2,0(T2)		;GET HASH TABLE ENTRY
	JUMPE T2,BADRET		;IF NO ENTRY THERE, ACCOUNT IS INVALID
;**;[1872] Delete one line at VERAC0: +10L	RAS	12-MAY-81
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
;**;[1970] ADD 2 LINES AT VERAC5: + 2L	TAM	14-DEC-81
	CAILE T1,777		;[1970] LEGAL PAGE NUMBER
	JRST BADREB		;[1970] NO, BUGCHK AND FAIL
	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
	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
	MOVEM T3,VERCLS		;SAVE 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
	GTAD			;GET CURRENT TIME AND DATE
	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

;**;[1971] ADD 1 LINE AT BADREB: + 1L	TAM	6-JAN-82
;**;[1970] ADD 1 LINE AT BADRET: - 1L	TAM	14-DEC-81
BADREB:	BUG(ACTBBD)		;[1970] ACCOUNT FILE IS CORRUPT.
	SETZM ACTPGN		;[1971] NO PAGE WAS MAPPED.
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
	MOVEM T3,VERCLS		;SAVE CLASS
	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(CRSPAG)
	RETBAD (VACCX0)

VERAX1:	BUG(BADTAB)
	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
;**;[1774] Change one line at SCNAC0: +14L	JGZ	2-SEP-80
		MOVEI Q2,ACTPG	;[1774] MAKE Q2 POINT TO TOP OF NEW PAGE
		JRST .+1]	;AND CONTINUE
;**;[3143] Add label at SCNAC0:+16	DEE	30-JUL-84
;**;[3143] Change 1 line in SCNAC0:+20	DEE	30-JUL-84
SCNAC3:	LOAD T1,BKTYP,(Q2)	;[3143]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
;**;[1774] Change one line at SCNAC0: +23L	JGZ	2-SEP-80
		MOVEI Q2,ACTPG	;[1774] MAKE Q2 POINT TO FIRST BLOCK ON PAGE
		JRST SCNAC3]	;[3143]AND CHECK IT
	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
;**;[3173] REMOVE EDIT 3128 AGAIN
;**;[3128] Change 1 line at SCNUNO+5 and remove 3 following lines
;**;[3128] (SPR #20108)
;**;[3137] CANCEL 3128
;**;[3153]	FINAL FIX SPR# 20108
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
;**;[3173]REMOVE COMMENTED OUT LINES AND WHOLE EDIT
       	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
	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
	MOVE T3,VERHDR		;GET ADDRESS OF ACCOUNT HEADER BLOCK
	LOAD T3,ACCLS,(T3)	;GET CLASS FOR ACCOUNT
	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


	TNXEND

	END