Google
 

Trailing-Edge - PDP-10 Archives - BB-KL11L-BM_1990 - t20src/acjusr.mac
Click t20src/acjusr.mac to see without markup as text/plain
There are 9 other files named acjusr.mac in the archive. Click here to see a list.
; Edit= 133 to ACJUSR.MAC on 14-Sep-89 by GSCOTT
;Implement support for GETOK functions .GODSK, .GOSJP, and .GOSPR. 
;RIP:<7.UTILITIES>ACJUSR.MAC.1004 14-Jul-89 11:56:40, Edit by GSCOTT
;(131) Allow attach of not-logged-in jobs for FTPSRT.
;RIP:<7.UTILITIES>ACJUSR.MAC.1003 25-May-89 15:39:09, Edit by GSCOTT
;(130) Edit 127 forgot about the case that the user is not enabled.
;RIP:<7.UTILITIES>ACJUSR.MAC.1002 23-May-89 20:38:23, Edit by GSCOTT
;(127) Fix unkillable directories, RCDIR in GOCRDT kept directory cached.
;RIP:<7.UTILITIES>ACJUSR.MAC.1001  8-Apr-89 14:49:19, Edit by GSCOTT
;(126) Add GETOK functions .GOGTD and .GOSTD.
;RIP:<7.UTILITIES>ACJUSR.MAC.1000 20-Mar-89 10:48:06, Edit by GSCOTT
;(106) Correct extra space output in GOSMNL.
;RIP:<7.UTILITIES>ACJUSR.MAC.998  9-Feb-89 10:12:28, Edit by GSCOTT
;(105) CRDIR policy had a bug allowing building new non-files-only directories.
;RIP:<7.UTILITIES>ACJUSR.MAC.996  4-Feb-89 10:40:12, Edit by GSCOTT
;(104) Do not log on special cases of FB%SEC bit changes.
;RIP:<7.UTILITIES>ACJUSR.MAC.995  2-Feb-89 21:06:05, Edit by GSCOTT
;(103) Always allow setting of new file nosecure.
;RIP:<7.UTILITIES>ACJUSR.MAC.993  2-Feb-89 10:26:48, Edit by GSCOTT
;(102) Change a couple of strings output to the log file.
;RIP:<7.UTILITIES>ACJUSR.MAC.991, 31-Jan-89 14:27:54, Edit by RASPUZZI
;(76) Test T4 for CD%MOD before making a decision about the mode bits in CRDIRT
;RIP:<7.UTILITIES>ACJUSR.MAC.987 26-Jan-89 11:20:12, Edit by GSCOTT
;(72) Add NOSECURE keyword to ACCESS.CONTROL
;RIP:<7.UTILITIES>ACJUSR.MAC.986 26-Jan-89 10:06:42, Edit by GSCOTT
;(71) Add DENY-CTY and LOGIN-CTY support.
;RIP:<7.UTILITIES>ACJUSR.MAC.985 25-Jan-89 09:48:55, Edit by GSCOTT
;(70) Minor bug and a bad comment in CRDIR policy code.
;RIP:<7.UTILITIES>ACJUSR.MAC.984 24-Jan-89 17:00:19, Edit by GSCOTT
;(67) Make job information blocks, clean up attach and login policy code.
;RIP:<7.UTILITIES>ACJUSR.MAC.978 19-Jan-89 13:29:47, Edit by GSCOTT
;(63) Add support for user functions
;RIP<7.UTILITIES>ACJUSR.MAC.973 12-Jan-89 22:43:41, Edit by GSCOTT
;(61) Log "function n" if SMON function not in table of functions.
;RIP:<7.UTILITIES>ACJUSR.MAC.967 12-Jan-89 09:41:46, Edit by GSCOTT
;(57) Add "new" short bug typeout SMON function.
;RIP:<7.UTILITIES>ACJUSR.MAC.964 10-Jan-89 10:50:15, Edit by GSCOTT
;(56) Test was backwards in GOCRDL to say "set" or "clear".
;RIP:<7.UTILITIES>ACJUSR.MAC.960  5-Jan-89 12:13:06, Edit by GSCOTT
;(55) Provide check for CRDIRs on FOREIGN structures.
;RIP:<7.UTILITIES>ACJUSR.MAC.952  4-Jan-89 14:58:38, Edit by GSCOTT
;(54) Don't allow user/directory groups or passwords on any <ROOT-DIRECTORY>.
;RIP:<7.UTILITIES>ACJUSR.MAC.932  4-Jan-89 11:09:34, Edit by GSCOTT
;(53) Asciify the GETAB tables for logging.
;RIP:<7.UTILITIES>ACJUSR.MAC.929  3-Jan-89 15:45:11, Edit by GSCOTT
;(52) Asciify the INFO% functions logged.
;RIP:<7.UTILITIES>ACJUSR.MAC.928  3-Jan-89 15:21:02, Edit by GSCOTT
;(51) Update copyright date.
;RIP:<7.UTILITIES>ACJUSR.MAC.926  3-Jan-89 13:29:37, Edit by GSCOTT
;(47) Log more information for CRDIRs.
;RIP:<7.UTILITIES>ACJUSR.MAC.917 30-Dec-88 11:32:23, Edit by GSCOTT
;(46) Prevent logging into ROOT-DIRECTORY or making it non-files-only.
;RIP:<7.UTILITIES>ACJUSR.MAC.916 29-Dec-88 10:38:55, Edit by GSCOTT
;(45) Remove edit 43, instead allow any secure operation if no ACCESS.CONTROL.
;RIP:<7.UTILITIES>ACJUSR.MAC.915 28-Dec-88 14:36:08, Edit by GSCOTT
;(44) Add support for OF%NXS bit on .GOOPN function.
;RIP:<7.UTILITIES>ACJUSR.MAC.914 28-Dec-88 13:03:11, Edit by GSCOTT
;(43) Allow setting and clearing of FB%SEC if enabled and file is new.
;RIP:<7.UTILITIES>ACJUSR.MAC.911 20-Dec-88 11:41:45, Edit by GSCOTT
;(42) Enhance logging of TMON/SMON functions.
;RIP:<7.UTILITIES>ACJUSR.MAC.905 14-Dec-88 18:49:44, Edit by GSCOTT
;(37) Add LOGIN-xxxx keywords to user profile.
;RIP:<7.UTILITIES>ACJUSR.MAC.897  7-Dec-88 14:49:27, Edit by GSCOTT
;(31) DECnet policy routine can now be activated due to NO POLICY setting.
;RIP:<7.UTILITIES>ACJUSR.MAC.890  7-Dec-88 01:33:21, Edit by GSCOTT
;(30) Implement DENY-xxx keywords for functions.
;RIP:<7.UTILITIES>ACJUSR.MAC.881  6-Dec-88 21:35:56, Edit by GSCOTT
;(27) Implement ALL as keyword in ACCESS.CONTROL, clean up here and there.
;RIP:<7.UTILITIES>ACJUSR.MAC.875  6-Dec-88 20:12:16, Edit by GSCOTT
;(26) Implement SET PRIME-TIME-BEGIN and SET PRIME-TIME-END
;RIP:<7.UTILITIES>ACJUSR.MAC.862 30-Nov-88 10:33:11, Edit by GSCOTT
;(20) Allow policy for GOACC to allow connections to "owned" subdirectories.
;RIP:<7.UTILITIES>ACJUSR.MAC.858 30-Nov-88 10:08:07, Edit by GSCOTT
;(17) Add POLICY keyword.
;RIP:<7.UTILITIES>ACJUSR.MAC.850 29-Nov-88 17:34:19, Edit by GSCOTT
;(16) Allow hyphen at end of line in ACCESS.CONTROL, move code to ACJDEC.
;RIP:<7.UTILITIES>ACJUSR.MAC.812 29-Nov-88 09:53:18, Edit by GSCOTT
;(15) Implement ACCESS.CONTROL facility for secure files.
;RIP:<7.UTILITIES>ACJUSR.MAC.754 22-Nov-88 13:28:10, Edit by GSCOTT
;(12) Yet more info to log file.
;RIP:<7.UTILITIES>ACJUSR.MAC.741 21-Nov-88 22:12:33, Edit by GSCOTT
;(11) More information with TLINK logging.
;RIP:<7.UTILITIES>ACJUSR.MAC.723 21-Nov-88 15:36:55, Edit by GSCOTT
;(10) Allow WHEEL to login to batch under OPERATOR.
;RIP:<7.UTILITIES>ACJUSR.MAC.721 21-Nov-88 13:33:04, Edit by GSCOTT
;(5) Fix bug in GOLOGT where second GTDIR would fail.
;RIP:<7.UTILITIES>ACJUSR.MAC.718 20-Nov-88 12:30:25, Edit by GSCOTT
;(2) Fix problem with DISFNC, adding FU%GOK.
;RIP:<GSCOTT>ACJUSR.MAC.716 20-Nov-88 12:06:05, Edit by GSCOTT
;(1) Creation.

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1989.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A  LICENSE AND MAY BE USED AND  COPIED
;	ONLY IN  ACCORDANCE  WITH  THE  TERMS OF  SUCH  LICENSE  AND  WITH  THE
;	INCLUSION OF THE ABOVE  COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY  OTHER
;	COPIES THEREOF MAY NOT BE PROVIDED  OR OTHERWISE MADE AVAILABLE TO  ANY
;	OTHER PERSON.  NO  TITLE TO  AND OWNERSHIP  OF THE  SOFTWARE IS  HEREBY
;	TRANSFERRED.
;
;	THE INFORMATION IN THIS  SOFTWARE IS SUBJECT  TO CHANGE WITHOUT  NOTICE
;	AND SHOULD  NOT  BE CONSTRUED  AS  A COMMITMENT  BY  DIGITAL  EQUIPMENT
;	CORPORATION.
;
;	DIGITAL ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY OF  ITS
;	SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.

	TITLE ACJUSR - Access Control Facility Policy Administrator and Logger
	SUBTTL Gregory A. Scott
	Subttl	Table of Contents

;		     Table of Contents for ACJUSR
;
;				  Section		      Page
;
;
;    1. General Comments . . . . . . . . . . . . . . . . . . .   5
;    2. Definitions
;        2.1    Environment  . . . . . . . . . . . . . . . . .   6
;        2.2    Storage  . . . . . . . . . . . . . . . . . . .   7
;        2.3    Tables
;            2.3.1    Function Enable/Disable Tables . . . . .   8
;            2.3.2    Function Profile Tables  . . . . . . . .  10
;            2.3.3    User Profile Tables  . . . . . . . . . .  12
;    3. Logging  . . . . . . . . . . . . . . . . . . . . . . .  14
;        3.1    GOASD (ASND%)  . . . . . . . . . . . . . . . .  15
;        3.2    GOCAP (EPCAP%) . . . . . . . . . . . . . . . .  16
;        3.3    GOCJB (CRJOB%) . . . . . . . . . . . . . . . .  17
;        3.4    GOLOG (LOGIN%) . . . . . . . . . . . . . . . .  18
;        3.5    GOCFK (CFORK%) . . . . . . . . . . . . . . . .  19
;        3.6    GOTBR (MTOPR% to set Terminal Baud Rate) . . .  20
;        3.7    GOLGO (LGOUT%) . . . . . . . . . . . . . . . .  21
;        3.8    GOENQ (ENQC% ENQ Quota Set)  . . . . . . . . .  22
;        3.9    GOCRD (CRDIR%) . . . . . . . . . . . . . . . .  23
;        3.10   GOSMT (MSTR% to Increment Mount Count) . . . .  26
;        3.11   GOMDD (MDDT%)  . . . . . . . . . . . . . . . .  27
;        3.12   GOCLS (SKED% to set scheduler class) . . . . .  28
;        3.13   GOCL0 (Class Set at Login) . . . . . . . . . .  29
;        3.14   GOMTA (MTA Access) . . . . . . . . . . . . . .  30
;        3.15   GOACC (ACCES%) . . . . . . . . . . . . . . . .  32
;        3.16   GOOAD (OPENF% Assign Device) . . . . . . . . .  33
;        3.17   GODNA (DECnet) . . . . . . . . . . . . . . . .  34
;        3.18   GOANA (Arpanet)  . . . . . . . . . . . . . . .  35
;        3.19   GOATJ (ATACH%) . . . . . . . . . . . . . . . .  37
;        3.20   GOINF (INFO%)  . . . . . . . . . . . . . . . .  38
;        3.21   GOLAT (LATOP%) . . . . . . . . . . . . . . . .  40
;        3.22   GOCTM (CTERM Connection) . . . . . . . . . . .  42
;        3.23   GOTTM (TTMSG%) . . . . . . . . . . . . . . . .  43
;        3.24   GOSMN (SMON%)  . . . . . . . . . . . . . . . .  44
;        3.25   GOHSY (HSYS%)  . . . . . . . . . . . . . . . .  47
;        3.26   GOSGT (SYSGT%) . . . . . . . . . . . . . . . .  48
;        3.27   GOGTB (GETAB%) . . . . . . . . . . . . . . . .  49
;        3.28   GOOPN (OPENF% with FB%SEC) . . . . . . . . . .  52
;        3.29   GORNF (RNAMF% with FB%SEC) . . . . . . . . . .  53
;        3.30   GODLF (DELF%/DELNF% with FB%SEC) . . . . . . .  54
;        3.31   GOTLK (TLINK%) . . . . . . . . . . . . . . . .  55
;        3.32   GOCRL (CRLNM%) . . . . . . . . . . . . . . . .  57
;        3.33   GODTC (DTACH%) . . . . . . . . . . . . . . . .  58
;        3.34   GOCFD (CHFDB% of FB%SEC) . . . . . . . . . . .  59
;        3.35   GOGTD (Get directory information)  . . . . . .  60
;        3.36   GOSTD (Set time) . . . . . . . . . . . . . . .  61
;        3.37   GODSK (DSKOP% JSYS)  . . . . . . . . . . . . .  62
;        3.38   GOSJP (SJPRI% JSYS)  . . . . . . . . . . . . .  65
	Subttl	Table of Contents (page 2)

;		     Table of Contents for ACJUSR
;
;				  Section		      Page
;
;
;        3.39   GOSPR (SJPRI% JSYS)  . . . . . . . . . . . . .  66
;        3.40   GOUSR (User test function) . . . . . . . . . .  67
;        3.41   Logging only if needed . . . . . . . . . . . .  68
;    4. Policy . . . . . . . . . . . . . . . . . . . . . . . .  69
;        4.1    GOASD (ASND%)  . . . . . . . . . . . . . . . .  70
;        4.2    GOCAP (EPCAP%) . . . . . . . . . . . . . . . .  71
;        4.3    GOCJB (CRJOB%) . . . . . . . . . . . . . . . .  72
;        4.4    GOLOG (LOGIN%) . . . . . . . . . . . . . . . .  73
;        4.5    GOCFK (CFORK%) . . . . . . . . . . . . . . . .  76
;        4.6    GOTBR (MTOPR% to set Terminal Baud Rate) . . .  77
;        4.7    GOLGO (LGOUT%) . . . . . . . . . . . . . . . .  78
;        4.8    GOENQ (ENQC% ENQ Quota Set)  . . . . . . . . .  79
;        4.9    GOCRD (CRDIR%) . . . . . . . . . . . . . . . .  80
;        4.10   GOSMT (MSTR% to Increment Mount Count) . . . .  84
;        4.11   GOMDD (MDDT%)  . . . . . . . . . . . . . . . .  85
;        4.12   GOCLS (SKED% to set scheduler class) . . . . .  86
;        4.13   GOCL0 (Class Set at Login) . . . . . . . . . .  87
;        4.14   GOMTA (MTA Access) . . . . . . . . . . . . . .  88
;        4.15   GOACC (ACCES%) . . . . . . . . . . . . . . . .  89
;        4.16   GOOAD (OPENF% Assign Device) . . . . . . . . .  90
;        4.17   GODNA (DECnet) . . . . . . . . . . . . . . . .  91
;        4.18   GOANA (Arpanet)  . . . . . . . . . . . . . . .  92
;        4.19   GOATJ (ATACH%) . . . . . . . . . . . . . . . .  93
;        4.20   GOINF (INFO%)  . . . . . . . . . . . . . . . .  96
;        4.21   GOLAT (LATOP%) . . . . . . . . . . . . . . . .  97
;        4.22   GOCTM (CTERM Connection) . . . . . . . . . . .  98
;        4.23   GOTTM (TTMSG%) . . . . . . . . . . . . . . . .  99
;        4.24   GOSMN (SMON%)  . . . . . . . . . . . . . . . . 100
;        4.25   GOHSY (HSYS%)  . . . . . . . . . . . . . . . . 101
;        4.26   GOSGT (SYSGT%) . . . . . . . . . . . . . . . . 102
;        4.27   GOGTB (GETAB%) . . . . . . . . . . . . . . . . 103
;        4.28   GOOPN (OPENF% with FB%SEC) . . . . . . . . . . 104
;        4.29   GORNF (RNAMF% with FB%SEC) . . . . . . . . . . 105
;        4.30   GODLF (DELF%/DELNF% with FB%SEC) . . . . . . . 106
;        4.31   GOTLK (TLINK%) . . . . . . . . . . . . . . . . 107
;        4.32   GOCRL (CRLNM%) . . . . . . . . . . . . . . . . 108
;        4.33   GODTC (DTACH%) . . . . . . . . . . . . . . . . 109
;        4.34   GOCFD (CHFDB% of FB%SEC) . . . . . . . . . . . 110
;        4.35   GOGTD (Get directory information)  . . . . . . 113
;        4.36   GOSTD (Set time) . . . . . . . . . . . . . . . 114
;        4.37   GODSK (DSKOP% JSYS)  . . . . . . . . . . . . . 115
;        4.38   GOSJP (SJPRI% JSYS)  . . . . . . . . . . . . . 116
;        4.39   GOSPR (SPRIW% JSYS)  . . . . . . . . . . . . . 117
;        4.40   GOUSR (User test function) . . . . . . . . . . 118
;        4.41   Deny by Terminal Line Type . . . . . . . . . . 119
	Subttl	Table of Contents (page 3)

;		     Table of Contents for ACJUSR
;
;				  Section		      Page
;
;
;    5. Subroutines
;        5.1    Find Line Type Entry . . . . . . . . . . . . . 120
;        5.2    Deny, Unusual, Failed setting  . . . . . . . . 122
;        5.3    Check Capabilities . . . . . . . . . . . . . . 123
;        5.4    Check Time for Enable  . . . . . . . . . . . . 124
;        5.5    CRDIR Snooping . . . . . . . . . . . . . . . . 125
;            5.5.1    Find Request Block . . . . . . . . . . . 126
;            5.5.2    Find User's ACs  . . . . . . . . . . . . 127
;            5.5.3    Get Directory String . . . . . . . . . . 128
;            5.5.4    Get User Argument Block  . . . . . . . . 129
;            5.5.5    Read Physical Memory . . . . . . . . . . 130
;            5.5.6    Snoop Monitor Symbols  . . . . . . . . . 131
;    6. End of ACJUSR  . . . . . . . . . . . . . . . . . . . . 132
	SUBTTL General Comments

	COMMENT ~

This module of the Access Control Facility implements two functions: Policy
administration (deciding to allow or deny the request) and logging (extraction
of all data furnished to us by the operating system) for each Access Control
(GETOK%) function.  

This module is constructed so that local site changes can be kept seperate from
the more sensitive code that resides in the modules that actually allow or deny
the request (using GIVOK%).  Functions can be added easily to this module by
making an entry in the function table and writing a GOxxxT test routine and a
GOxxxL logging routine.

This module was written in November 1988 by Gregory A. Scott, Digital Equipment
Corporation, Marlboro, Massachusetts.  Ideas for the policy portions of this
module and the CRDIR snooping code is from the modified ACJ for TOPS-20
development cluster written by Mike Raspuzzi.

Future enhancements:

	Setting or clearing privs on directories should be [Unusual].
	Implement policy for MTA access: if label TOPS-20 and non-owner user
	 can connect to owner's PS dir without a password then consider this 
	 user an owner of the tape and allow access to the tape (GOMTA).
	If the TLINK function is operating, the periodic re-TLINKing of 
	 jobs being spyed on could be inactivated and instead we would 
	 reestablish the link after the TLINK (to break links with us)
	 is allowed.
	If LOGOUT function enabled, then stop spying when job logs out. 
	~
	SUBTTL Definitions -- Environment

;Normalize MACRO, load TOPS-20 standard definitions, define ACs, get MACREL.

	SALL			;Clean listing
	.DIREC FLBLST		;First line binary only

	SEARCH MONSYM		;Get the usual monitor symbols

	SEARCH MACSYM		;Get the usual macros
	.REQUI SYS:MACREL	;Load the usual support routines 
	STDAC.			;Get the usual ACs

;ACJ specific initialization.

	SEARCH ACJSYM		;Get our symbols
	LOHIGH			;Tell me we need two segments for this
	LOWCD			;Start off in low memory
	SUBTTL Definitions -- Storage

;Storage used in policy decisions.

GTDIRB:	BLOCK .CDDGP+1		;User GTDIR% block (default size of 15 words)
GTDIRC:	BLOCK .CDDGP+1		;Controlling job GTDIR% block (default size)
GTDIRT:	BLOCK .CDDGP+1		;Target job GTDIR% block (default size)
MSTRB:	BLOCK .MSGSI+1		;MSTR% .MSGSS block
SKEDB:	BLOCK .SAJCL+1		;SKED% block for setting job class at login
DIRBLK:	BLOCK ^D<40*5>/5	;Block to make directory or filename string

;Storave used in CRDIR snooping routines.

MONSPT:	BLOCK 1			;Snooped address of SPT
ACB:	BLOCK 1			;Snooped offset of PAC in PSB, used to read ACs
PSBPG:	BLOCK 1			;Snooped address of monitor FKPGS table
GETOKQ:	BLOCK 1			;Snooped address of monitor's GETOK queue

SPTENT:	BLOCK 1			;Entry from SPT when looking for arg blocks
PSB:	BLOCK 1			;Will have FKPGS+FORK
CURBLK:	BLOCK 1			;Address of current block
UACS:	BLOCK 20		;User's ACs are here
NXTBLK:	BLOCK 1			;Address of next block
	REQFRK==3		;Fork number is at this offset in request
	REQNUM==11		;Request number is at this offset in request
REQBLK:	BLOCK 14		;Hidden part of GETOK% block
UARGBK:	BLOCK .CDPPN+1		;User's CRDIR% argument block
XPKBLK:	BLOCK .XPUAD+1		;XPEEK% block
	SUBTTL Definitions -- Tables -- Function Enable/Disable Tables

;Tables used to create keywords, function codes, and actions for each possible
;GETOK function.  This macro will be expanded wherever a table is needed.  Any
;new GETOK function codes should be added to this table.  Note that keywords
;must remain in alphabetical order.

DEFINE GFUNCT,<
	XLIST
	FUN(ACCESS,<Access>,GOACC)
	FUN(ARPANET-ACCESS,<Arpanet>,GOANA)
	FUN(ASSIGN-DEVICE,<Assign>,GOASD)
	FUN(ASSIGN-DUE-TO-OPENF,<Open-assign>,GOOAD)
	FUN(ATTACH-JOB,<Attach>,GOATJ)
	FUN(CAPABILITIES,<Caps>,GOCAP)
	FUN(CLASS-ASSIGNMENT,<Class>,GOCLS)
	FUN(CLASS-SET-AT-LOGIN,<Class-set-at-login>,GOCL0)
	FUN(CREATE-DIRECTORY,<Create-directory>,GOCRD)
	FUN(CREATE-FORK,<Create-fork>,GOCFK)
	FUN(CREATE-JOB,<CRJOB>,GOCJB)
	FUN(CREATE-LOGICAL-NAME,<Create-logical-name>,GOCRL)
	FUN(CTERM,<Cterm>,GOCTM)
	FUN(DECNET-ACCESS,<DECnet>,GODNA)
	FUN(DETACH,<Detach>,GODTC)
	FUN(DSKOP,<DSKOP>,GODSK) ;[133]
	FUN(ENQ-QUOTA,<ENQ-quota>,GOENQ)
	FUN(GET-DIRECTORY,<Get-directory>,GOGTD) ;[126]
	FUN(GETAB,<GETAB>,GOGTB)
	FUN(HSYS,<HSYS>,GOHSY)
	FUN(INFO,<INFO>,GOINF)
	FUN(LATOP,<LATOP>,GOLAT)
	FUN(LOGIN,<Login>,GOLOG)
	FUN(LOGOUT,<Logout>,GOLGO)
	FUN(MDDT,<MDDT>,GOMDD)
	FUN(MTA-ACCESS,<MTA-access>,GOMTA)
	FUN(SECURE-CHFDB,<Secure-CHFDB>,GOCFD)
	FUN(SECURE-DELF,<Secure-DELF>,GODLF)
	FUN(SECURE-OPENF,<Secure-OPENF>,GOOPN)
	FUN(SECURE-RNAMF,<Secure-RNAMF>,GORNF)
	FUN(SET-TIME,<Set-time>,GOSTD)	;[126]
	FUN(SJPRI,<SJPRI>,GOSJP) ;[133]
	FUN(SMON,<SMON>,GOSMN)
	FUN(SPRIW,SPRIW,GOSPR)	;[133]
	FUN(STRUCTURE-MOUNT,<Str-mount>,GOSMT)
	FUN(SYSGT,<SYSGT>,GOSGT)
	FUN(TERMINAL-SPEED,<Terminal-speed>,GOTBR)
	FUN(TLINK,<TLINK>,GOTLK)
	FUN(TTMSG,<TTMSG>,GOTTM)
	FUN(USER-TEST,<User-test-function>,GOUSR)
	LIST
>				;End of DEFINE GFUNCT
	LOWCD			;Low code

;Get the storage used for remembering the per function access control profile.

	DEFINE FUN(KEY,LOG,COD),<'COD'B: EXP 0>
FUNCTB:	GFUNCT			;Generate profile word for each GETOK function
	FUNSIZ==.-FUNCTB	;Count number of functions we are handing
FUNAOB:	XWD -FUNSIZ,0		;Make AOB pointer to these tables

;Make tables of .GOXXX code, GOxxxL logging, GOxxxT test routines.

	DEFINE FUN(KEY,LOG,COD),<EXP .'COD'>
FUNCOD:	GFUNCT			;Make table of .GOxxx codes

	DEFINE FUN(KEY,LOG,COD),<XWD [ASCIZ/LOG/],'COD'L>
FUNLOG:	GFUNCT			;Make table of GOxxxL addresses

	DEFINE FUN(KEY,LOG,COD),<EXP 'COD'T>
FUNTST:	GFUNCT			;Make table of GOxxxT addresses

;Define a table of initial GETOK function values so that they can be reset
;on a crash of the access control facility.

FUNTMO:	BLOCK FUNSIZ		;Place to store TMON functions from monitor

;Define the tables of keywords and corresponding function numbers.

	DEFINE FUN(KEY,LOG,COD),<[ASCIZ/KEY/],,.'COD'>
FUNTBL:	TBEGIN			;Plant TBLUK header
FUNKEY:	GFUNCT			;Generate command keywords for each table
	TEND			;Count expanded keywords
	SUBTTL Definitions -- Tables -- Function Profile Tables

	HIGHCD			;Used in profile generation only

;Define table of characteristics for each function listed above.

DEFINE FUNGEN,<
	XLIST			;Don't show this part
	TAB(CONSOLE,NO,<Console>,FU%CON)
	TAB(DENY-BATCH,NO,<Deny Batch>,FU%DBA)
	TAB(DENY-CTY,NO,<Deny CTY>,FU%DCT)
	TAB(DENY-DECNET,NO,<Deny DECnet>,FU%DDN)
	TAB(DENY-DETACHED,NO,<Deny Detached>,FU%DDE)
	TAB(DENY-LAT,NO,<Deny LAT>,FU%DLA)
	TAB(DENY-LOCAL,NO,<Deny Local>,FU%DLO)
	TAB(DENY-PTY,NO,<Deny PTY>,FU%DPT)
	TAB(DENY-REMOTE,NO,<Deny Remote>,FU%DRM)
	TAB(DENY-TCP,NO,<Deny TCP>,FU%DTC)
	TAB(LOG,NO,<Log>,FU%LOG)
	TAB(NO,,,0)
	TAB(POLICY,NO,<Policy>,FU%POL)
	LIST			;Resume listing
>				;End of DEFINE FUNGEN

;For each GETOK function "funct", there is a profile word of bits "functB".
;This word contains what action should be taken for each GETOK function.
;Note: 1B3-1B8 are reserved for future use in ACJSYM/ACJDEC, and 1B17-1B35 are
;reserved for customer implementations.


;	1B0-1B8 reserved for use in ACJSYM/ACJDEC
;	FU%ENA==1B1		;If 1 enable this function, if 0 do not enable
;	FU%GOK==1B2		;If 1 we are getting OKs on this function

	FU%LOG==1B7		;If 1 log into log file
	FU%CON==1B8		;If 1 log on console terminal

	FU%DBA==1B9		;If 1 deny Batch access
	FU%DCT==1B10		;If 1 deny CTY access
	FU%DDN==1B11		;If 1 deny DECnet access
	FU%DDE==1B12		;If 1 deny Detached access
	FU%DLA==1B13		;If 1 deny LAT access
	FU%DLO==1B14		;If 1 deny Local access
	FU%DPT==1B15		;If 1 deny PTY access
	FU%DRM==1B16		;If 1 deny Remote access
	FU%DTC==1B17		;If 1 deny TCP access

;	1B17-35 reserved for customer defined bits.
;Define table of switches used in ENABLE command.

	DEFINE TAB(KEY,NOF,SHO,BIT),<TENTRY (KEY,[BIT])>
ENATBL:	TBEGIN			;Plant TBLUK header
ENAKEY:	FUNGEN			;Generate per-function switch table
	TEND			;Count the commands
ENAAOB:	-<.-ENAKEY>,,0		;AOB pointer to table

;Define table of keywords to type after NO.

	DEFINE TAB(KEY,NOF,SHO,BIT),<IFNB <NOF>,<TENTRY (KEY,[BIT])>>
ENANOT:	TBEGIN			;Plant TBLUK header
	FUNGEN			;Generate per-function NO table
	TEND			;Count the commands

;Define table of keywords for SHOW command output

	DEFINE TAB(KEY,NOF,SHO,BIT),<[ASCIZ/SHO/],,0>
ENASHO:	FUNGEN

;Default enable bits are used in FINDIT and DOENAB routines in ACJDEC.

	LOWCD

ENADEF:	EXP FU%ENA!FU%LOG!FU%POL ;Default P2 on ENABLE command (incl FU%ENA)
	SUBTTL Definitions -- Tables -- User Profile Tables

	HIGHCD			;This is used in profile phase only

;The user table will be pointed to by a TBLUK style table (for profile
;generation).  The right halfword of this table will be an offset into two
;other tables: one table of user numbers and one table of user profile bits.

DEFINE USEGEN,<
	XLIST			;Don't show this table please
	TAB(CLASS-AT-LOGIN,,<Class at login>,US%CLA,DEC)
	TAB(ENABLE-NON-PRIME-TIME,NO,<Enable non-prime>,US%ENP,BIT)
	TAB(LOGIN-BATCH,NO,<Login Batch>,US%BAT,BIT)
	TAB(LOGIN-CTY,NO,<Login CTY>,US%CTY,BIT)
	TAB(LOGIN-DECNET,NO,<Login DECnet>,US%DNA,BIT)
	TAB(LOGIN-DETACHED,NO,<Login Detached>,US%DET,BIT)
	TAB(LOGIN-LAT,NO,<Login LAT>,US%LAT,BIT)
	TAB(LOGIN-LOCAL,NO,<Login Local>,US%LOC,BIT)
	TAB(LOGIN-PTY,NO,<Login PTY>,US%PTY,BIT)
	TAB(LOGIN-REMOTE,NO,<Login Remote>,US%REM,BIT)
	TAB(LOGIN-TCP,NO,<Login TCP>,US%TCP,BIT)
	TAB(NO,,,0,BIT)
	TAB(SPY-ON,NO,<Spy on>,US%SPY,BIT)
	LIST			;Resume listing
>				;End of DEFINE USEGEN

;Define bits in the user profile.

	;1B0			;Free
	US%ENP==1B1		;User is allowed to enable during non-prime
	US%SPY==1B2		;User should be spyed on whenever logged in
	US%BAT==1B3		;Login Batch
	US%CTY==1B4		;Login CTY
	US%DNA==1B5		;Login DECnet
	US%DET==1B6		;Login Detached
	US%LAT==1B7		;Login LAT
	US%LOC==1B8		;Login Local
	US%PTY==1B9		;Login PTY
	US%REM==1B10		;Login Remote
	US%TCP==1B11		;Login TCP
	US%CLA==77B17		;Class assignment at login (B12-B17)

;Right half reserved for customers.
;Define table of keywords used in USER command.  The data is the bit to
;to set if a BIT functon, byte pointer to data if a value function.

	DEFINE TAB(KEY,NOF,TXT,DAT,TYP),<
		IFIDN <TYP>,<BIT>,<TENTRY(KEY,<[DAT]>)>
		IFIDN <TYP>,<DEC>,<TENTRY(KEY,<[POINTR 0,DAT]>)>>

USETBL:	TBEGIN			;Plant TBLUK header
USEKEY:	USEGEN			;Generate table of bits to check in ACJUSR
	TEND			;Count the commands
USEAOB:	-<.-USEKEY>,,0		;AOB pointer to table

;Define table of keywords to type after NO

	DEFINE TAB(KEY,NOF,TXT,DAT,TYP),<IFNB <NOF>,<TENTRY (KEY,[DAT])>>
USENOT:	TBEGIN			;Plant TBLUK header
	USEGEN			;Generate per-function NO table
	TEND			;Count the commands

;Define table of routines to parse the field called PRSxxx.

	DEFINE TAB(KEY,NOF,TXT,DAT,TYP),<EXP PRS'TYP>
USEPRS:	USEGEN			;Rable of parsing routines

;Define table of strings for SHOW command and show action routines SHOxxx.

	DEFINE TAB(KEY,NOF,TXT,DAT,TYP),<[ASCIZ/TXT/],,SHO'TYP>
USESHO:	USEGEN			;Generate table for SHOW command

;Define dispatch table for WRITE command routines WRIxxx.

	DEFINE TAB(KEY,NOF,TXT,DAT,TYP),<EXP WRI'TYP>
USEWRI:	USEGEN			;Generate table for SHOW command

	LOWCD			;Some data in LOWCD

;Define default user profile bits, referred to by policy portion.

USEDEF:	EXP US%BAT!US%CTY!US%DNA!US%DET!US%LAT!US%LOC!US%PTY!US%REM!US%TCP
	SUBTTL Logging

	LOWCD			;Rest of module is LOWCD only

;For each access control function defined in ACJSYM, there will be two routines
;in this module that the ACJDEC module will call.  The names are based on the
;names of the functions (GOxxx).  The logging routine is called GOxxxL.

;The logging routine (GOxxxL) will furnish additional information to the log
;file, and is always called (even if the function is not being logged).

;Each logging routine will be called with the following ACs set up:
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;The logging routine will preserve all of those ACs except T1 and P2.

;An updated T1, which points to the logging text, will be returned.  This byte
;pointer to the logging text is kept in TEXTBP and so T1 and be reloaded from
;TEXTBP.  The logging routine may turn off the FU%LOG and FU%CON bits in P2 to
;further prevent logging of particular users (or particular circumstances).

;The logging routine will always return +1.
	SUBTTL Logging -- GOASD (ASND%)

;Logging routine for GOASD.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOASDL:	HRROI T2,[ASCIZ/, /]	;Load comma space string
	CALL ISOUT		;(T1,T2/T1) Send that first
	MOVE T2,.GEADD(Q1)	;Load device designator
	CALLRET ODEVST		;(T1,T2/T1) Perform DEVST and return
	SUBTTL Logging -- GOCAP (EPCAP%)

;Routine to log the changing of capabilities
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOCAPL:	HRROI T2,[ASCIZ/, desired/] ;Load label for this
	CALL ISOUT		;(T1,T2/T1) Label this next bit
	HRRZ T4,.GENCP(Q1)	;Load new caps
	JUMPN T4,OCAPAB		;(T1,T4/T1) If any, send them and return
	HRROI T2,[ASCIZ/ none/]	;Load string saying none
	CALLRET ISOUT		;(T1,T2/T1) Send that 
	SUBTTL Logging -- GOCJB (CRJOB%)

;Routine to log CRJOBs
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOCJBL:	RET			;Nothing special to log
	SUBTTL Logging -- GOLOG (LOGIN%)

;Routine to log logins.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOLOGL:	MOVEI T4,CJBLK		;Point to area to return data into 
	SETZM CJBLK+.JILNO	;Zero controlling job's login directory number 
	SKIPL T1,JIBLK+.JICPJ	;Load controlling job, skip if none
	CALL GETINF		;(T1,T4/T4) Get job information
	 SKIPA T1,TEXTBP	;Error or no ctrl job, reload pointer and skip
	SKIPA T1,TEXTBP		;No error, reload text pointer and skip
	RET			;Return if can't get information

	HRROI T2,[ASCIZ/, by/] ;Load little blurb text
	CALL ISOUT		;(T1,T2/T1) Send that string
	CALLRET OGETJI		;(T1,T4/T1) Output all information about job
	SUBTTL Logging -- GOCFK (CFORK%)

;Logging routine for GOCFK.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOCFKL:	HRROI T2,[ASCIZ/, using /] ;Label the string
	MOVE T3,.GEFCT(Q1)	;Load number of forks
	CALLRET OLDEC		;(T1-T3/T1) Send to logging area
	SUBTTL Logging -- GOTBR (MTOPR% to set Terminal Baud Rate)

;Logging routine for GOTBR.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOTBRL:	HRROI T2,[ASCIZ/, TTY/]	;Load label for terminal number today
	MOVE T3,.GELIN(Q1)	;Load line number
	CALL OLOCT		;(T1,T2,T3/T1) Label that octal number
	HRROI T2,[ASCIZ/ input /] ;Label input speed
	HLRZ T3,.GESPD(Q1)	;Load input speed
	CALL OLDEC		;(T1,T2,T3/T1) Send and label input speed
	HRROI T2,[ASCIZ/ output /] ;Label output speed
	HRRZ T3,.GESPD(Q1)	;Load output speed
	CALLRET OLDEC		;(T1,T2,T3/T1) Send and label output speed
	SUBTTL Logging -- GOLGO (LGOUT%)

;Routine to log a logout.
;Flag entry in the log file if this job is logging out another job.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOLGOL:	MOVEI T4,CJBLK		;Point to block to get info into
	SKIPL T1,.GERLG(Q1)	;Job number logging out, -1 if caller
	CALL GETINF		;(T1/) Get job information
	 SKIPA T1,TEXTBP	;Error or no target, reload pointer and skip
	SKIPA T1,TEXTBP		;Point to text area again if something to say
	RET			;Return if nothing to say
	HRROI T2,[ASCIZ/, target/] ;Label following
	CALL ISOUT		;(T1,T2/T1) Send that first
	CALLRET OGETJI		;(T1,T2/T1) Output all information about job
	SUBTTL Logging -- GOENQ (ENQC% ENQ Quota Set)

;Logging routine for GOENQ.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOENQL:	HRROI T2,[ASCIZ/, desired /] ;Label the string
	MOVE T3,.GEEQU(Q1)	;Load desired quota
	CALL OLDEC		;(T1-T3/T1) Send to logging area
	MOVEM T1,TEXTBP		;Save the pointer

	SKIPL T1,.GEEUN(Q1)	;Get target job number, skip if self
	CAMN T1,JIBLK+.JIJNO	;Is it for this job?
	IFSKP.			;Not for this job, display target job number
	  MOVEI T4,CJBLK	;Point to cotnrolling job block
	  CALL GETINF		;(T1,T4/T4) Get job information
	  ANSKP.		;If it skipped 
	    MOVE T1,TEXTBP	;Load text pointer again
	    CALLRET OGETJI	;(T1,T4/T1) Output all information about job
	ENDIF.			;End of job check

	MOVE T1,TEXTBP		;Target job same as us, reload the pointer
	RET			;Return
	SUBTTL Logging -- GOCRD (CRDIR%)

;Routine to log CRDIRs.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

;Newer monitors return the CRDIR argument block, directory string, and user's
;AC2.  Older monitors do not give us anything to work with.  The CHKCRD routine
;will root around and try to copy the user's CRDIR argument block by looking at
;monitor data structures and physical memory.  If no information exists after
;calling this routine, log nothing.

GOCRDL:	CALL CHKCRD		;(Q1/) Check for old format CRDIR argument 
	MOVE T1,TEXTBP		;Reload pointer to text buffer
	SKIPN .GEDIR(Q1)	;Any stuff present?
	RET			;Nope, nothing to tell about, so return now

;Output the directory name first.

	HRROI T2,[ASCIZ/, /]	;Point to comma space
	CALL ISOUT		;(T1,T2/T1) Send that to log buffer
	HRROI T2,.GEDIR(Q1)	;Point to directory
	CALL ISOUT		;(T1,T2/T1) Send that to log file

;Log any changes that we might be interested in today.

	MOVSI T4,-CRDSIZ	;Load AOB pointer to tables
	DO.			;Loop for all of them
	  MOVE T3,CDBTAB(T4)	;Load bit to test
	  TDNN T3,.GECFL(Q1)	;Is this bit set?
	  IFSKP.		;Yes, tell us about it
	    HRRO T2,CDTTAB(T4)	;Load descriptive string about this into T2
	    XCT CDXTAB(T4)	;Load possible additional data into T3
	    CALL @CDATAB(T4)	;(T1,T2,T3/T1) Call routine to create text
	  ENDIF.		;End of output code
	  AOBJN T4,TOP.		;Loop for all items
	OD.			;End of interpretation loop
;Tell about interesting mode bits.

	MOVE T4,.GECFL(Q1)	;Is this bit set?
	TXNN T4,CD%MOD		;Changing mode bits?
	IFSKP.			;Yes, see if to files only or not
	  MOVE T3,.GECAB+.CDMOD(Q1) ;Get directory mode bits
	  HRROI T2,[ASCIZ/ files-only/] ;Assume files only
	  TXNN T3,CD%DIR	;Directory files only?
	  HRROI T2,[ASCIZ/ non-files-only/] ;No, shout this
	  CALL ISOUT		;(T1,T2/T1) Tell me yes or now
	  HRROI T2,[ASCIZ/ secure/] ;Load "secure" pointer
	  TXNE T3,CD%SEC	;Making directory secure?
	  CALL ISOUT		;(T1,T2/T1) Tell me so
	ENDIF.			;End of mode change code

;Tell about capability changes.  Must be last information output.

	TXNN T4,CD%PRV		;User setting capabilities?
	IFSKP.			;Yes
	  HRROI T2,[ASCIZ/ caps/] ;Load label for following text
	  CALL ISOUT		;(T1,T2/T1) Take me along 
	  MOVE T4,.GECAB+.CDPRV(Q1) ;Load capability mask
	  HRROI T2,[ASCIZ/ none/] ;Assume no caps
	  TRNN T4,-1		;Any set now?
	  CALLRET ISOUT		;(T1,T2/T1) None, send to log file and return
	  CALLRET OCAPAB	;(T1,T4/T1) Send capabiltity mask out
	ENDIF.			;End of user setting caps code

	RET			;Return with logging all done
;These macros create the tables for interpretation of each interesting CRDIR
;bit in AC2.  If logging for a particular bit is no longer desired, comment out
;a line in the following macro.  Each line is of the form:
;	CD < string>,bit-to-test,,routine-to-call
;or	CD < string >,bit-to-test,<adr-of-additional-data>,routine-to-call

DEFINE CRDGEN,<
	XLIST			;Clean listing please
	CD < password>,CD%PSW,,ISOUT
	CD < working >,CD%LIQ,<MOVE T3,.GECAB+.CDLIQ(Q1)>,OLDEC
	CD < permanent >,CD%LOQ,<MOVE T3,.GECAB+.CDLOQ(Q1)>,OLDEC
	CD < number >,CD%NUM,<HRRZ T3,.GECAB+.CDNUM(Q1)>,OLOCT
	CD < default-protection >,CD%FPT,<HRRZ T3,.GECAB+.CDFPT(Q1)>,OLOCT
	CD < directory-protection >,CD%DPT,<HRRZ T3,.GECAB+.CDDPT(Q1)>,OLOCT
	CD < retention-count >,CD%RET,<MOVE T3,.GECAB+.CDRET(Q1)>,OLDEC
	CD < dir-group>,CD%DGP,,ISOUT
	CD < user-group>,CD%UGP,,ISOUT
	CD < subdirectory-quota >,CD%SDQ,<MOVE T3,.GECAB+.CDSDQ(Q1)>,OLDEC
	CD < default-account>,CD%DAC,,ISOUT
	CD < PPN >,CD%PPN,<MOVE T3,.GECAB+.CDPPN(Q1)>,OLPPN
	CD < killing>,CD%DEL,,ISOUT
	LIST			;Resume listing
>				;End of DEFINE CRDGEN

	DEFINE CD(A,B,C,D),<XWD 0,[ASCIZ/A/]>
CDTTAB:	CRDGEN			;Table of text strings for each AC2 bit
	CRDSIZ==.-CDTTAB	;Compute number of elements in the table

	DEFINE CD(A,B,C,D),<EXP B>
CDBTAB:	CRDGEN			;Table of bits to test from user's AC2

	DEFINE CD(A,B,C,D),<
		IFNB <C>,<C>
		IFB <C>,<JFCL>>
CDXTAB:	CRDGEN			;Table of instructions to load additional data

	DEFINE CD(A,B,C,D),<EXP D>
CDATAB:	CRDGEN			;Table of action routines for each bit
	SUBTTL Logging -- GOSMT (MSTR% to Increment Mount Count)

;Logging routine for GOSMT.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOSMTL:	HRROI T2,[ASCIZ/, /]	;Load comma space structure label
	CALL ISOUT		;(T1,T2/T1) Send that first
	MOVE T2,.GESDE(Q1)	;Load device designator
	CALLRET ODEVST		;(T1,T2/T1) Perform DEVST and return
	SUBTTL Logging -- GOMDD (MDDT%)

;Routine to log a job entering MDDT
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOMDDL:	RET			;No additional data today
	SUBTTL Logging -- GOCLS (SKED% to set scheduler class)

;Logging routine for GOCLS.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOCLSL:	MOVE T1,.GOTJB(Q1)	;Get target job number
	MOVEI T4,CJBLK		;Point to area to return data into 
	CALL GETINF		;(T1,T4/T4) Get job information
	 SKIPA T1,TEXTBP	;Error, reload pointer  and skip
	SKIPA T1,TEXTBP		;No error, reload text pointer and skip
	RET			;Return if can't get information
	HRROI T2,[ASCIZ/, class /] ;Load label for class number
	MOVE T3,.GECLS(Q1)	;Load class desired
	CALL OLDEC		;(T1,T2,T3/T1) Send class and its label
	HRROI T2,[ASCIZ/ for/]	;Label the job
	CALL ISOUT		;(T1,T2/T1) Send that along
	CALLRET OGETJI		;(T1,T4/T1) Output all information about job
	SUBTTL Logging -- GOCL0 (Class Set at Login)

;Logging routine for GOCL0.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOCL0L:	LDB T3,[POINTR P4,US%CLA] ;Load class
	JUMPE T3,R		;Return (do nothing) if zero
	HRROI T2,[ASCIZ/, class /] ;Load label for this class
	CALLRET OLDEC		;(T1,T2,T3/T1) Send that along and return
	SUBTTL Logging -- GOMTA (MTA Access)

;Logging routine for GOMTA.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer
;Send unit number first.

GOMTAL:	HRROI T2,[ASCIZ/, unit /] ;Load MT unit number
	MOVE T3,.GEUNT(Q1)	;Load unit number
	CALL OLOCT		;(T1,T2,T3/T1) Send number along

;Label type.

	MOVSI T4,-LABSIZ	;Load count of label types
	DO.			;Loop for find label type
	  HRRZ T2,LABTAB(T4)	;Load a label type
	  CAME T2,.GELTP(Q1)	;Match supplied label type?
	  IFSKP.		;Yes this is it!
	    HLRO T2,LABTAB(T4)	;Point to ASCIZ
	    EXIT.		;End the loop
	  ENDIF.		;End of we got it code
	  AOBJN T4,TOP.		;Loop for all entries in table
	  HRROI T2,[ASCIZ/ unknown-label-type/] ;Load generic unknown text
	OD.			;End of loop
	CALL ISOUT		;(T1,T2/T1) Send label type

;Code from HDR1.

	SKIPN .GEACC(Q1)	;HDR1 access specified?
	IFSKP.			;Yes
	  HRROI T2,[ASCIZ/ HDR1-access /] ;Point to label string
	  CALL ISOUT		;(T1,T2/T1) Send that too
	  MOVE T2,.GEACC(Q1)	;Point to access
	  IDPB T2,T1		;Store it
	ENDIF.
;User number if any.

	SKIPN .GEUSN(Q1)	;Is there a user number?
	IFSKP.			;Yes
	  HRROI T2,[ASCIZ/ user /] ;Point to string for user
	  CALL ISOUT		;(T1,T2/T1) Send that along
	  MOVE T2,.GEUSN(Q1)	;Load user number
	  CALL ODIRST		;(T1,T2/T1) Send that to log
	ENDIF.			;End of user number output

;User's desired access bits.

	HRROI T2,[ASCIZ/ desired /] ;Point to next label
	CALLRET ISOUT		;(T1,T2/T1) Send it
	MOVSI T4,-FPBSIZ	;Load AOBJN pointer
	MOVE T3,.GEACD(Q1)	;Load access bits
	DO.			;Loop through access bits
	  HLRO T2,FPBTAB(T4)	;Load address of asciz string
	  TDNE T3,FPBTAB(T4)	;Is this bit set?
	  CALL ISOUT		;(T1,T2/T1) Yes, send string along
	  AOBJN T4,TOP.		;Loop for all strings
	OD.			;End of access checking loop
	RET			; and return

;Table of access bits.

FPBTAB:	TENTRY (< directory listing>,FP%DIR)
	TENTRY (< append>,FP%APP)
	TENTRY (< execute>,FP%EX)
	TENTRY (< write>,FP%WR)
	TENTRY (< read>,FP%RD)
	FPBSIZ==.-FPBTAB	;Count entries in table

;Table of MTA label types.

LABTAB:	TENTRY (< unlabeled>,.LTUNL) ;Unlabeled
	TENTRY (< ANSI label>,.LTANS) ;ANSI standard label
	TENTRY (< EBCDIC label>,.LTEBC) ;Something pretending to be IBM labels
	TENTRY (< TOPS-20 label>,.LTT20) ;Our label type
	LABSIZ==.-LABTAB	;Number of entries
	SUBTTL Logging -- GOACC (ACCES%)

;Routine to log the connects or accesses.
;Supply the directory that the user wants to access or connect to.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOACCL:	MOVSI T4,-ACCSIZ	;Load -count,,0 for table search
	DO.			;Loop for asciifying bits in user AC1
	  HLRO T2,ACCTAB(T4)	;Load something to say today
	  HRRZ T3,ACCTAB(T4)	;Load address of bits to test
	  MOVE T3,(T3)		;Load the mask to test
	  TDNE T3,.GOAC0(Q1)	;Is this bit set?
	  CALL ISOUT		;(T1,T2/T1) Yes it is in fact
	  AOBJN T4,TOP.		;Loop for all of those bits
	OD.			;End of flags translation loop

;Put the directory string into a place for later use by GOACCT.

	MOVE T4,T1		;Copy output pointer to T4 for a little bit
	HRROI T1,DIRBLK		;Point to directory block
	MOVE T2,.GOAC1(Q1)	;Get directory number of attempted access
	CALL ODIRST		;(T1,T2/T1) Make directory to string
	MOVE T1,T4		;Reload output pointer
	HRROI T2,DIRBLK		;Point to directory block
	CALLRET ISOUT		;(T1,T2/T1) Output all of that and return

;Table to verbalize those pesky ACCES JSYS bits.

ACCTAB:	TENTRY(<, connect >,[AC%CON])
	TENTRY(<, access >,[AC%OWN])
	TENTRY(<, end-access >,[AC%REM])
	TENTRY(<, encrypt-password >,[AC%PWD])
	ACCSIZ==.-ACCTAB
	SUBTTL Logging -- GOOAD (OPENF% Assign Device)

;Logging routine for GOOAD.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOOADL:	HRROI T2,[ASCIZ/, device /] ;Load device
	CALL ISOUT		;(T1,T2/T1) Send that first
	MOVE T2,.GEADD(Q1)	;Load device designator
	CALLRET ODEVST		;(T1,T2/T1) Perform DEVST and return
	SUBTTL Logging -- GODNA (DECnet)

;Routine to log DECnet access.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GODNAL:	HRROI T2,[ASCIZ/, to /]	;Load label for next text
	CALL ISOUT		;(T1,T2/T1) Send that text first
	HRROI T2,.GEHST(Q1)	;Point to ASCII node name
	CALL ISOUT		;(T1,T2/T1) Send node name
	RET			;Return
	SUBTTL Logging -- GOANA (Arpanet)

;Routine to log arpanet access today.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow
;Returns +1 always, T1/ updated text log buffer pointer

GOANAL:	HRROI T2,[ASCIZ/, to /]	;Label the next little string
	CALL ISOUT		;(T1,T2/T1) Send that to the logging buffer
	MOVE T2,T1		;Destination byte pointer should be in 2 now
	MOVX T1,.GTHNS		;Translate host # to string function
	MOVE T3,.GEHSN(Q1)	;Host number for GTHST
	GTHST%			;Output host name
	 ERCAL GOANA2		;(T2/T2) If error, output the number and skip
	  MOVE T1,T2		;Reload the output pointer if GTHST worked

	LDB T3,[POINTR T4,HS%STY] ;Get operating system type code
	HRROI T2,[ASCIZ/ (unknown)/] ;Load default host type
	CAIG T3,ANASIZ		;Higher than we know?
	HRROI T2,@ANATAB(T3)	;No, output system type
	CALL ISOUT		;(T1,T2/T1) Send out host type

	HRROI T2,[ASCIZ/ port /] ;Load the socket label
	MOVE T3,.GEPRT(Q1)	;Load the port number
	CALLRET OLDEC		;(T1,T2,T3/T1) Send that to logging buffer

GOANA2:	SAVEAC <Q2,Q3>		;Save a couple of ACs
	MOVE T1,T2		;Reload the output pointer to T1
	MOVEI Q3,4		;Load number of octets to print
	MOVE Q2,[POINT 8,.GEHSN(Q1),3] ;Make ILDB pointer to data
	DO.			;For each octet
	  ILDB T2,Q2		;Load a TCP octet
	  CALL ODEC		;(T1,T2/T1) Output a octet in decimal
	  SOJG Q3,RSKP		;Skip return when all octets are output
	  HRROI T2,[ASCIZ/./]	;Point to a hot dot
	  CALL ISOUT		;(T1,T2/T1) Append that to the string
	  JRST TOP.		;Loop for all octets
	OD.			;End of TCP loop
;Table of host types for logging.

ANATAB:	[ASCIZ / (other)/]	;(0)
	[ASCIZ / (Tenex)/]	;(1)
	[ASCIZ / (ITS)/]	;(2)
	[ASCIZ / (TOPS-10)/]	;(3)
	[ASCIZ / (TIP)/]	;(4)
	[ASCIZ / (MTIP)/]	;(5)
	[ASCIZ / (ELF)/]	;(6)
	[ASCIZ / (ANTS)/]	;(7)
	[ASCIZ / (Multics)/]	;(10)
	[ASCIZ / (TOPS-20)/]	;(11)
	[ASCIZ / (UNIX)/]	;(12)
	[ASCIZ / (Network)/]	;(13)
	[ASCIZ / (Fuzzball)/]	;(14)
	[ASCIZ / (VMS)/]	;(15)
	[ASCIZ / (TAC)/]	;(16)
	[ASCIZ / (MSDOS)/]	;(17)
	ANASIZ==.-ANATAB-1	;Highest known system type
	SUBTTL Logging -- GOATJ (ATACH%)

;Logging routine for attach.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOATJL:	HRRZ T1,.GOTJB(Q1)	;[131] Get target job number
	MOVEI T4,TJBLK		;Point to area to return data into 
	CALL GETINF		;(T1,T4/T4) Get job information
	 SKIPA T1,TEXTBP	;Error, reload pointer and skip
	SKIPA T1,TEXTBP		;No error, reload text pointer and skip
	RET			;Return if can't get information
	HRROI T2,[ASCIZ/, target/] ;Load little blurb text
	CALL ISOUT		;(T1,T2/T1) Send that string
	CALL OGETJI		;(T1,T4/T1) Output all information about job
	HRROI T2,[ASCIZ/ to TTY/] ;Load label text for terminal
	MOVE T3,.GOTTY(Q1)	;Load terminal number
	CAME T3,JIBLK+.JITNO	;Is it the same as the caller's TTY?
	CALL OLOCT		;(T1,T2,T3/T1) No, send TTY to log buffer
	RET			;Return with T1 updated
	SUBTTL Logging -- GOINF (INFO%)

;Logging routine for GOINF.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOINFL:	CALL OCOMMA		;(T1/T1) Send a comma to the log file
	HRROI T2,[ASCIZ/ job /] ;Label for the job number
	MOVE T3,.GEJOB(Q1)	;Load the number of the job
	CAME T3,JIBLK+.JIJNO	;Is it the same job number?
	CALL OLDEC		;(T1,T2,T3/T1) Nope, label and display job no
	HRROI T2,[ASCIZ/ node /] ;Load label for node number
	MOVE T3,.GECIN(Q1)	;Load CI node number
	CALL OLDEC		;(T1,T2,T3/T1) Send to logging buffer
	MOVSI T4,-INFSIZ	;Load AOB pointer for table
	DO.			;Loop through table to find function
	  HRRZ T3,INFTAB(T4)	;Load the function code
	  CAMN T3,.GEINF(Q1)	;Does this one match?
	  EXIT.			;Yes, get out an print it
	  AOBJN T4,TOP.		;Nope, get the next one please
	  HRROI T2,[ASCIZ/ function /] ;No match, load label for function
	  MOVE T3,.GEINF(Q1)	;Load function number that wasn't found
	  CALLRET OLOCT		;(T1,T2,T3/T1) Send all of that to log 
	OD.			;End of loop
	CALL OSPACE		;(T1/T1) Output a space then
	HLRO T2,INFTAB(T4)	; point to text describing this function
	CALLRET ISOUT		;(T1,T2/T1) Output that and return now please
;Table of INFO% functions and string to send to log file.

INFTAB:	TENTRY (<get-CI-nodes>,.INCIN)
	TENTRY (<CNFIG%>,.INCFG)
	TENTRY (<DIRST%>,.INDST)
	TENTRY (<GETAB%>,.INGTB)
	TENTRY (<GETJI%>,.INGJI)
	TENTRY (<GTTYP%>,.INGTY)
	TENTRY (<INLNM%>,.ININL)
	TENTRY (<LNMST%>,.INLNS)
	TENTRY (<MSTR%>,.INMSR)
	TENTRY (<MTOPR%>,.INMTO)
	TENTRY (<MUTIL%>,.INMUT)
	TENTRY (<RCUSR%>,.INRCR)
	TENTRY (<SKED%>,.INSKD)
	TENTRY (<SNOOP%>,.INSNP)
	TENTRY (<SYSGT%>,.INSGT)
	TENTRY (<TMON%>,.INTMN)
	TENTRY (<XPEEK%>,.INXPK)
	TENTRY (<DVCHR%>,.INDVC)
	TENTRY (<NTINF%>,.INNTF)
	TENTRY (<STDEV%>,.INSTV)
	TENTRY (<DEVST%>,.INDVT)
	TENTRY (<SYSTAT>,.INSYS)
	TENTRY (<jobs-of-user>,.INJOB)
	TENTRY (<RCDIR%>,.INRCD)
	TENTRY (<TIME%>,.INTIM)
	INFSIZ==.-INFTAB
	SUBTTL Logging -- GOLAT (LATOP%)

;Logging routine for GOLAT.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer
;Output function code first

GOLATL:	MOVSI Q2,-LATSIZ	;Load size of table
	HRRZ T4,.GEFUN(Q1)	;Load function code
	DO.			;Loop to find entry to match
	  HRRZ T3,LATTAB(Q2)	;Load entry from table
	  HLRO T2,LATTAB(Q2)	;Load string in case we need it
	  CAMN T3,T4		;Match?
	  EXIT.			;Yes
	  AOBJN Q2,TOP.		;Loop for all of them
	  HRROI T2,[ASCIZ/ unknown-function/] ;I dunno which one
	OD.			;End of loop T2/ string pointer
	CALL ISOUT		;(T1,T2/T1) Send function to logging text area

;Output port name if any.

	SKIPN .GESRN(Q1)	;Server name specified?
	IFSKP.			;Yes
	  HRROI T2,[ASCIZ/ server /] ;Label the server
	  CALL ISOUT		;(T1,T2/T1) Send that label
	  HRROI T2,.GESRN(Q1)	;Load the server name pointer
	  CALL ISOUT		;(T1,T2/T1) Send that also
	ENDIF.			;End of server output code

;Output port name if any.

	SKIPN .GEPRN(Q1)	;Port name specified?
	IFSKP.			;Yes
	  HRROI T2,[ASCIZ/ port /] ;Label the port
	  CALL ISOUT		;(T1,T2/T1) Send that label
	  HRROI T2,.GEPRN(Q1)	;Load the port name pointer
	  CALL ISOUT		;(T1,T2/T1) Send that also
	ENDIF.			;End of port output code
;Output service name.

	SKIPN .GESVN(Q1)	;Service name specified?
	IFSKP.			;Yes
	  HRROI T2,[ASCIZ/ service /] ;Label the service
	  CALL ISOUT		;(T1,T2/T1) Send that label
	  HRROI T2,.GESVN(Q1)	;Load the service name pointer
	  CALL ISOUT		;(T1,T2/T1) Send that also
	ENDIF.			;End of service output code

	RET			;Nothing special

;Table of LATOP functions, includes all of them in case monitor changed.

LATTAB:	TENTRY(<, set>,.LASET)
	TENTRY(<, clear>,.LACLR)
	TENTRY(<, show-characteristics>,.LASCH)
	TENTRY(<, show-terminal-connect>,.LASTC)
	TENTRY(<, show-adjacent-servers>,.LASAS)
	TENTRY(<, show-counters>,.LASCO)
	TENTRY(<, zero-counters>,.LAZCO)
	TENTRY(<, request-host-initiated-connect>,.LARHC)
	TENTRY(<, terminate-host-initiated-connect>,.LATHC)
	TENTRY(<, show-host-initiated-connect>,.LASHC)
	LATSIZ==.-LATTAB
	SUBTTL Logging -- GOCTM (CTERM Connection)

;Logging routine for GOCTM.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOCTML:	HRROI T2,[ASCIZ/, from /] ;Label the text to follow
	CALL ISOUT		;(T1,T2/T1) Send that
	HRROI T2,.GEWHO(Q1)	;Point to who this is
	CALLRET ISOUT		;(T1,T2/T1) Send that and return
	SUBTTL Logging -- GOTTM (TTMSG%)

;Logging routine for GOTTM.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOTTML:	HRROI T2,[ASCIZ/, to/]	;Load usual label text
	CALL ISOUT		;(T1,T2/T1) Send that
	SKIPL T3,.GEDTY(Q1)	;Load user's AC1 argument, skip if sendall
	TXNN T3,TT%REM		;Remote sendall?
	IFSKP.			;Yes
	  TXC T3,.CSALL		;Let me see here,
	  TXCE T3,.CSALL	; is it is all nodes today?
	  IFSKP.		;Yes, it is all nodes
	    HRROI T2,[ASCIZ/ all nodes/] ;Indicate so
	    CALL ISOUT		;(T1,T2/T1) Send that along
	  ELSE.			;Otherwise it was just one node
	    LDB T3,[POINTR .GEDTY(Q1),.TTCIN] ;Load CI node specifier
	    HRROI T2,[ASCIZ/ node /] ;Load label text
	    CALL OLDEC		;(T1,T2,T3/T1) Send label and decimal number
	  ENDIF.		;End of not all nodes check
	ENDIF.			;End of remote sendall check
	HRRZ T3,.GEDTY(Q1)	;Load the terminal number again
	CAIE T3,-1		;Is it a sendall?
	IFSKP.			;Yes
	  HRROI T2,[ASCIZ/ all lines/] ;Load where its is going
	  CALLRET ISOUT		;(T1,T2/T1) Log that and return
	ENDIF.			;Otherwise it was not a sendall
	TXZ T3,.TTDES		;Turn off terminal designator bit
	HRROI T2,[ASCIZ/ TTY/]	;Load the label for the terminal number
	CALLRET OLOCT		;(T1,T2,T3/T1) Send octal terminal and return
	SUBTTL Logging -- GOSMN (SMON%)

;Logging routine for GOSMN.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOSMNL:	HRROI T2,[ASCIZ/, /]	;Load label for first part of data
	CALL ISOUT		;(T1,T2/T1) Send that to the log
	MOVSI T4,-SMNSIZ	;Load -<number of SMON functions>,,0
	DO.			;Loop looking for the right one
	  HRRZ T3,SMNTAB(T4)	;Get a function code
	  CAME T3,.GESMF(Q1)	;Match the one we are called with?
	  IFSKP.		;If a match
	    HLRO T2,SMNTAB(T4)	;Load string that makes it text
	    CALL ISOUT		;(T1,T2/T1) Send function name
	    EXIT.		;Get out of loop
	  ENDIF.		;OK, it didn't match this function
	  AOBJN T4,TOP.		;Loop for all of them looking for it
	  HRROI T2,[ASCIZ/function /] ;[106] Unknown function name
	  MOVE T3,.GESMF(Q1)	;Load SMON function
	  CALL OLOCT		;(T1,T2,T3/T1) Send function number along
	OD.			;End of loop
	HRROI T2,[ASCIZ/ value /] ;Load value label
	MOVE T3,.GESMV(Q1)	;Load actual value please sir
	CALLRET OLOCT		;(T1,T2,T3/T1) Send that out and return
;Table of SMON/TMON functions, unlikely ones are commented out.

SMNTAB:	
;	TENTRY (<allow-fact>,.SFFAC)
;	TENTRY (<CHECKD-found-errors>,.SFCDE)
;	TENTRY (<CHECKD-running>,.SFCDR)
;	TENTRY (<manual-start-in-progress>,.SFMST)
	TENTRY (<remote-logins>,.SFRMT)
	TENTRY (<PTY-logins>,.SFPTY)
	TENTRY (<CTY-login>,.SFCTY)
	TENTRY (<operator-in-attendance>,.SFOPR)
	TENTRY (<local-logins>,.SFLCL)
;	TENTRY (<bit-table-errors found on startup>,.SFBTE)
	TENTRY (<user-change-directory-characteristics>,.SFCRD)
	TENTRY (<Arpanet-logins>,.SFNVT)
	TENTRY (<wheel-login-CTY>,.SFWCT)
	TENTRY (<wheel-login-local>,.SFWLC)
	TENTRY (<wheel-login-remote>,.SFWRM)
	TENTRY (<wheel-login-PTYs>,.SFWPT)
	TENTRY (<wheel-login-Arpanet>,.SFWNV)
;	TENTRY (<usage-file>,.SFUSG)
	TENTRY (<full-latency-optimization>,.SFFLO)
	TENTRY (<magtape-allocation>,.SFMTA)
	TENTRY (<system-message-level-0>,.SFMS0)
	TENTRY (<system-message-level-1>,.SFMS1)
	TENTRY (<job-0-output>,.SFBGS)
	TENTRY (<DECnet-logins>,.SFMCB)
	TENTRY (<disk-preallocation>,.SFDPR)
	TENTRY (<LAT-logins>,.SFLAT)
	TENTRY (<wheel-login-LAT>,.SFWLT)
	TENTRY (<wheel-login-DECnet>,.SFWDN)
;Following are functions that do not map into bits in FACTSW.  

	TENTRY (<Arpanet-on>,.SFNTN)
	TENTRY (<Apranet-down-up>,.SFNDU)
	TENTRY (<Arpanet-host-table-initialize>,.SFNHI)
	TENTRY (<set-time-zone>,.SFTMZ)
	TENTRY (<Arpanet-host-number>,.SFLHN)
	TENTRY (<account-validation>,.SFAVR)
	TENTRY (<enable-status-reporting>,.SFSTS)
	TENTRY (<GETOK-enable>,.SFSOK)
	TENTRY (<max-ordinary-offline-expiration>,.SFMCY)
	TENTRY (<read-date-update>,.SFRDU)
	TENTRY (<max-archive-expiration>,.SFACY)
	TENTRY (<retrieval-waits>,.SFRTW)
	TENTRY (<tape-mount-controls>,.SFTDF)
	TENTRY (<working-set-preloading>,.SFWSP)
	TENTRY (<daylight-Saving-Time-method>,.SFDST)
	TENTRY (<short-bug-output>,.SFBUG)
	TENTRY (<allow-disk-for-MSCP-server>,.SFMSD)
	TENTRY (<SPEAR-event-counter>,.SFSPR)
	TENTRY (<carrier-off-time>,.SFCOT)
	TENTRY (<hangup-action-if-not-logged-in>,.SFHU0)
	TENTRY (<hangup-action-if-logged-in>,.SFHU1)
	TENTRY (<EXEC-flags-word>,.SFXEC)
	TENTRY (<ethernet-address>,.SFSEA)
	TENTRY (<don't-care-disk>,.SFDCD)
	TENTRY (<LAT-state>,.SFLTS)
	TENTRY (<CLUDGR-SYSAP>,.SFCLU)
	TENTRY (<remote-send-alls>,.SFTMG)
	TENTRY (<offline-structures-timer>,.SFOFS)
	TENTRY (<login-structure>,.SFLGS)
	TENTRY (<minimum-password-length>,.SFMPL)
	TENTRY (<system-ACJ>,.SFACJ)
	TENTRY (<password-expiration>,.SFPEX)
	TENTRY (<password-dictionary>,.SFPWD)
	TENTRY (<hangup-on-detach>,.SFHDT)
	SMNSIZ==.-SMNTAB
	SUBTTL Logging -- GOHSY (HSYS%)

;Logging routine for GOHSY.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOHSYL:	SKIPE .GESDT(Q1)	;Time specified?
	IFSKP.			;Nope, cancel
	  HRROI T2,[ASCIZ/, cancel/] ;What was it again?
	  CALLRET ISOUT		;(T1,T2/T1) Send that and return
	ENDIF.			;Otherwise there was a time specified
	HRROI T2,[ASCIZ/, down /] ;Load down time label
	CALL ISOUT		;(T1,T2/T1) Send that
	MOVE T2,.GESDT(Q1)	;Load shutdown time
	CALL OODTIM		;(T1,T2/T1) Send that
	SKIPN .GERES(Q1)	;Is there an up time?
	RET			;Nope, just return
	HRROI T2,[ASCIZ/ up /]	;Load up at label
	CALL ISOUT		;(T1,T2/T1) Send that
	MOVE T2,.GERES(Q1)	;Load actual up at time
	CALLRET OODTIM		;(T1,T2/T1) Send that and return
	SUBTTL Logging -- GOSGT (SYSGT%)

;Logging routine for GOSGT.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOSGTL:	HRROI T2,[ASCIZ/, table /] ;Load the label
	CALL ISOUT		;(T1,T2/T1) Send it
	MOVE T2,.GETBN(Q1)	;Load sixbit stuff
	CALLRET OSIXBI		;(T1,T2/T1) Send that and return
	SUBTTL Logging -- GOGTB (GETAB%)

;Logging routine for GOGTB.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOGTBL:	HRROI T2,[ASCIZ/, /]	;Point to comma space
	CALL ISOUT		;(T1,T2/T1) Output that first

	HRRZ T3,.GETBN(Q1)	;Load that table entry number
	CAILE T3,GTBSIZ		;Do we know this table's name?
	IFSKP.			;Yes, in fact we do
	  MOVE T2,GTBTAB(T3)	;Load SIXBIT table number
	  CALL OSIXBI		;(T1,T2/T1) Send that along
	ELSE.			;Otherwise we don't know the table name
	  HRROI T2,[ASCIZ/table /] ;Load label for table number
	  CALL OLOCT		;(T1,T2,T3/T1) No, label and print the number
	ENDIF.			;OK, something has now been said about table

	HRROI T2,[ASCIZ/ index /] ;Label the index number
	HLRZ T3,.GETBN(Q1)	;Load the number to display
	CALLRET OLOCT		;(T1,T2,T3/T1) Send the label and number, ret
;Table of GETAB names, kept here in table order and in SIXBIT to be compact.

GTBTAB:	SIXBIT /JOBTTY/		;(0) Job number to tty number
	SIXBIT /JOBRT/		;(1) Job runtime
	SIXBIT /TICKPS/		;(2) Ticks per second
	SIXBIT /JOBDIR/		;(3) Job number to directory numbers (obs)
	SIXBIT /TTYJOB/		;(4) Tty number to job number
	SIXBIT /NCPGS/		;(5) Number physical core pages
	SIXBIT /DEVNAM/		;(6) Device name
	SIXBIT /DEVCHR/		;(7) Device characteristics
	SIXBIT /DEVUNT/		;(10) Device unit numbers
	SIXBIT /DSKERR/		;(11) Disk error words (obs)
	SIXBIT /DRMERR/		;(12) Drum error words (obs)
	SIXBIT /SYSVER/		;(13) Version text
	SIXBIT /SYSTAT/		;(14) Statistics
	SIXBIT /QTIMES/		;(15) Sched queue times
	SIXBIT /JOBNAM/		;(16) Job number to program name
	SIXBIT /SNAMES/		;(17) Subsystem name
	SIXBIT /STIMES/		;(20) Subsystem time
	SIXBIT /SPFLTS/		;(21) Subsystem page faults
	SIXBIT /SSIZE/		;(22) Subsystem size integral
	SIXBIT /SNBLKS/		;(23) Subsystem number wakeups
	SIXBIT /DBUGSW/		;(24) DBUGSW, DCHKSW
	SIXBIT /LOGDES/		;(25) Log, job 0 designators
	SIXBIT /PTYPAR/		;(26) PTY parameters
	SIXBIT /SYMTAB/		;(27) GETAB symbol table
	SIXBIT /DWNTIM/		;(30) HSYS variables
	SIXBIT /JOBPNM/		;(31) Job number to program name
	SIXBIT /BLDTD/		;(32) Monitor build time and date
	SIXBIT /LSTDRN/		;(33) Last dir number assigned (obs)
	SIXBIT /APRID/		;(34) Apr serial number
	SIXBIT /HQLAV/		;(35) High queue load averages
	SIXBIT /LQLAV/		;(36) Low queue load averages
	SIXBIT /NETRDY/		;(37) Arpanet status
	SIXBIT /IMPHRT/		;(40) Host ready (obs)
	SIXBIT /HSTSTS/		;(41) Dead host status (obs)
	SIXBIT /HSTNAM/		;(42) Host names (obs)
	SIXBIT /HOSTN/		;(43) Host name index (obs)
	SIXBIT /NETLSK/		;(44) Local socket (obs)
	SIXBIT /GNTFSK/		;(45) Foreign socket (obs)
	SIXBIT /NETAWD/		;(46) Arpa connection address (obs)
	SIXBIT /NETBAL/		;(47) Bit allocation (obs)
	SIXBIT /NETSTS/		;(50) Connection status (obs)
	SIXBIT /NETBUF/		;(51) Arpanet buffers (obs)
	SIXBIT /NETBTC/		;(52) Byte count statistics (obs)
	SIXBIT /IMPLT1/		;(53) Imp link table one (obs)
	SIXBIT /IMPLT2/		;(54) Imp link table two (obs)
	SIXBIT /IMPLT3/		;(55) Imp link table three (obs)
	SIXBIT /IMPLT4/		;(56) Imp link table four (obs)
	SIXBIT /LHOSTN/		;(57) Local host number
;Table of GETAB names in SIXBIT continued.

	SIXBIT /JBONT/		;(60) Owning job
	SIXBIT /NSWPGS/		;(61) Default swapping pages
	SIXBIT /SCOUNT/		;(62) Count snames table
	SIXBIT /MONVER/		;(63) Monitor version (address 137)
	SIXBIT /CISTAT/		;(64) CI statistics
	GTBSIZ==.-GTBTAB	;Compute size of table
	SUBTTL Logging -- GOOPN (OPENF% with FB%SEC)

;Logging routine for GOOPN.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOOPNL:	CALL OCOMMA		;(T1/T1) Send a comma to the log file
	MOVSI T4,-OPNSIZ	;Load size of table
	DO.			;Loop for asciifying bits in user AC1
	  HLRO T2,OPNTAB(T4)	;Load something to say today
	  HRRZ T3,OPNTAB(T4)	;Load address of bits to test
	  TDNE T3,.GEOAC(Q1)	;Is this bit set?
	  CALL ISOUT		;(T1,T2/T1) Yes it is in fact
	  AOBJN T4,TOP.		;Loop for all of those bits
	OD.			;End of flags translation loop
	CALL OSPACE		;(T1/T1) Send space to the file please
	HRROI T2,.GEFIL(Q1)	;Load filename string pointer
	CALLRET ISOUT		;(T1,T2/T1) Send that and return

;Table for logging OPENF bits.

OPNTAB:	TENTRY(< read>,OF%RD)
	TENTRY(< write>,OF%WR)
	TENTRY(< append>,OF%APP)
	TENTRY(< read-unrestricted>,OF%RDU)
	TENTRY(< thawed>,OF%THW)
	TENTRY(< preserve-dates>,OF%PDT)
	TENTRY(< new-file>,OF%NXS)
	OPNSIZ==.-OPNTAB	;Size of table
	SUBTTL Logging -- GORNF (RNAMF% with FB%SEC)

;Logging routine for GORNF.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GORNFL:	HRROI T2,[ASCIZ/, /]	;Load label for filename (comma space)
	CALL ISOUT		;(T1,T2/T1) Send it
	HRROI T2,.GEFIL(Q1)	;Load filename string pointer
	CALLRET ISOUT		;(T1,T2/T1) Send that and return
	RET			;Nothing special
	SUBTTL Logging -- GODLF (DELF%/DELNF% with FB%SEC)

;Logging routine for GODLF.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GODLFL:	CALL OCOMMA		;(T1/T1) Send a comma to the log file
	MOVSI T4,-DLFSIZ	;Load size of table
	DO.			;Loop for asciifying bits in user AC1
	  HLRO T2,DLFTAB(T4)	;Load something to say today
	  HRRZ T3,DLFTAB(T4)	;Load address of bits to test
	  MOVE T3,(T3)		;Get bit mask from that address
	  TDNE T3,.GEDAC(Q1)	;Is this bit set?
	  CALL ISOUT		;(T1,T2/T1) Yes it is in fact
	  AOBJN T4,TOP.		;Loop for all of those bits
	OD.			;End of flags translation loop
	CALL OSPACE		;(T1/T1) Now send a space to the log
	HRROI T2,.GEFIL(Q1)	;Load filename string pointer
	CALLRET ISOUT		;(T1,T2/T1) Send that and return
	RET			;Nothing special

DLFTAB:	TENTRY(< no-release-JFN>,[DF%NRJ])
	TENTRY(< expunge>,[DF%EXP])
	TENTRY(< forget>,[DF%FGT])
	TENTRY(< directory>,[DF%DIR])
	TENTRY(< archive>,[DF%ARC])
	TENTRY(< contents-only>,[DF%CNO])
	DLFSIZ==.-DLFTAB
	SUBTTL Logging -- GOTLK (TLINK%)

;Logging routine for GOTLK.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOTLKL:	SAVEAC <Q2>		;Get a Q
	MOVE Q2,.GETTB(Q1)	;Load the users bits
	CALL OCOMMA		;(T1/T1) Send a comma to the log file

;First interpret the hard to interpret bits.

	TXNN Q2,TL%SAB		;Setting receive or refuse links?
	IFSKP.			;Yes
	  TXNN Q2,TL%ABS	;Accept 
	  SKIPA T2,[-1,,[ASCIZ/ refuse links/]]	;Refuse links
	  HRROI T2,[ASCIZ/ receive links/] ;Receive links
	  CALL ISOUT		;(T1,T2/T1) Send that
	ENDIF.			;End of links code

	TXNN Q2,TL%STA		;Setting receive or refuse advice?
	IFSKP.			;Yes
	  TXNN Q2,TL%AAD	;Receive advice?
	  SKIPA T2,[-1,,[ASCIZ/ refuse advice/]] ;Refuse advice
	  HRROI T2,[ASCIZ/ receive advice/] ;Receive advice
	  CALL ISOUT		;(T1,T2/T1) Send that
	ENDIF.			;End of advice code

;Output the rest of the bits from a table of bits.

	MOVSI T4,-TLKSIZ	;Load size of table
	DO.			;Loop for asciifying bits in user AC1
	  HLRO T2,TLKTAB(T4)	;Load something to say today
	  HRRZ T3,TLKTAB(T4)	;Load address of bits to test
	  MOVE T3,(T3)		;Get bit mask from that address
	  TDNE T3,Q2		;Is this bit set?
	  CALL ISOUT		;(T1,T2/T1) Yes it is in fact
	  AOBJN T4,TOP.		;Loop for all of those bits
	OD.			;End of flags translation loop
;Bits are all interpreted, now output the object and remote fields as needed.

	TXNN Q2,TL%ERO!TL%EOR!TL%COR!TL%CRO!TL%SAB!TL%STA ;Object?
	IFSKP.			;Yes
	  HRROI T2,[ASCIZ/ object /] ;Load label for filename
	  CALL ISOUT		;(T1,T2/T1) Send object label along
	  HRRZ T3,.GETTB(Q1)	;Load object number
	  CAIE T3,-1		;Is it 777777 (self)?
	  IFSKP.		;Yes
	    HRROI T2,[ASCIZ/self/] ;Use string of self
	    CALL ISOUT		;(T1,T2/T1) Send to log file rather than 777777
	  ELSE.			;Otherwise
	    TXZN T3,.TTDES	;Designator?
	    SKIPA T2,[-1,,[ASCIZ/JFN /]] ;It was a JFN
	    HRROI T2,[ASCIZ/TTY/] ;It was a TTY
	    CALL OLOCT		;(T1,T2,T3/T1) No send that number
	  ENDIF.		;End of value check
	ENDIF.			;End of output object number code

	TXNN Q2,TL%ERO!TL%EOR!TL%COR!TL%CRO ;Remote possible?
	IFSKP.			;Yes
	  HRROI T2,[ASCIZ/ remote /] ;Label remote
	  CALL ISOUT		;(T1,T2/T1) Send remote label along
	  HRRZ T3,.GERMT(Q1)	;Load the remote value
	  CAIE T3,-1		;Is it 777777 (all)?
	  IFSKP.		;Yes
	    HRROI T2,[ASCIZ/all/] ;Use string of all
	    CALL ISOUT		;(T1,T2/T1) Send to log file rather than 777777
	  ELSE.			;Otherwise
	    TXZN T3,.TTDES	;Designator?
	    SKIPA T2,[-1,,[ASCIZ/JFN /]] ;It was a JFN
	    HRROI T2,[ASCIZ/TTY/] ;It was a TTY
	    CALL OLOCT		;(T1,T2,T3/T1) No send that number
	  ENDIF.		;End of value check
	ENDIF.			;End of output remote code
	RET			;Return now

;Table to TLINK bits that aren't hard to comprehend.

TLKTAB:	TENTRY(< clear remote-to-object>,[TL%CRO])
	TENTRY(< clear object-to-remote>,[TL%COR])
	TENTRY(< establish object-to-remote>,[TL%EOR])
	TENTRY(< establish remote-to-object>,[TL%ERO])
	TLKSIZ==.-TLKTAB
	SUBTTL Logging -- GOCRL (CRLNM%)

;Logging routine for GOCRL.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOCRLL:	MOVSI T4,-CRLSIZ	;Load size of table
	DO.			;Loop for asciifying bits in user AC1
	  HLRO T2,CRLTAB(T4)	;Load something to say today
	  HRRZ T3,CRLTAB(T4)	;Load value to test for
	  CAMN T3,.GECFN(Q1)	;Does this value match?
	  CALL ISOUT		;(T1,T2/T1) Yes it would be wise to say so
	  AOBJN T4,TOP.		;Loop for all of those bits
	OD.			;End of flags translation loop
	HRROI T2,.GELNM(Q1)	;Point to logical name if any
	SKIPE .GELNM(Q1)	;Skip if none
	CALL ISOUT		;(T1,T2/T1) Send logical name oto
	RET			;All done here 

;Table for GOCRLL

CRLTAB:	TENTRY(<, create >,.CLNSY)
	TENTRY(<, delete >,.CLNS1)
	TENTRY(<, delete-all-logical-names >,.CLNSA)
	CRLSIZ==.-CRLTAB
	SUBTTL Logging -- GODTC (DTACH%)

;Logging routine for GODTC.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GODTCL:	RET			;Nothing special
	SUBTTL Logging -- GOCFD (CHFDB% of FB%SEC)

;Logging routine for GOCFD.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOCFDL:	MOVE T3,.GESFS(Q1)	;Load .FBCTL bits for this file if we allow 
	HRROI T2,[ASCIZ/, set /] ;Assume setting the bit
	TXNN T3,FB%SEC		;Are we settin the file secure today?
	HRROI T2,[ASCIZ/, clear /] ;Clear!
	CALL ISOUT		;(T1,T2/T1) Send that along
	HRROI T2,[ASCIZ/new /]	;Load the string to send to log file
	TXNE T3,FB%NXF		;Is this a new (not closed yet) file?
	CALL ISOUT		;(T1,T2/T1) Send that along if file is new
;	HRROI T2,[ASCIZ/nex /]	;Load the string to send to log file
;	TXNE T3,FB%NEX		;Is this a non existant new file type?
;	CALL ISOUT		;(T1,T2/T1) Send that along if file is new
	HRROI T2,.GEFIL(Q1)	;Point to filename
	CALLRET ISOUT		;(T1,T2/T1) Send filename and return
	SUBTTL Logging -- GOGTD (Get directory information)

;[126] Logging routine for GOGTD.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOGTDL:	SKIPE .GEDNO(Q1)	;[126] Skip if getting defaults
	IFSKP.			;[126] Yes, getting defaults
	  HRROI T2,[ASCIZ/, defaults/] ;[126] I guess he wants defaults
	  CALLRET ISOUT		;[126] (T1,T2/) Send that along and return
	ENDIF.			;[126] End of defaults wanted code

	HRROI T2,[ASCIZ/, /]	;[126] Label the seperator string
	CALL ISOUT		;[126] (T1,T2/) Send that along
	MOVE T2,.GEDNO(Q1)	;[126] Get the directory
	CALL ODIRST		;[126] (T1,T2/T1,T2) Send the directory name 
	TLNE T2,-1		;[126] Did the DIRST work?
	RET			;[126] Yes, return now
	HRROI T2,[ASCIZ/ argument /] ;[126] Maybe its illegal dorectory number
	MOVE T3,.GEDNO(Q1)	;[126] Load the argument supplied
	CALLRET OLOCT		;[126] (T1,T2,T3/T1) Output all of that and ret
	SUBTTL Logging -- GOSTD (Set time)

;[126] Logging routine for GOSTD.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOSTDL:	HRROI T2,[ASCIZ/, setting /] ;[126] Label the time
	CALL ISOUT		;[126] (T1,T2/) Send that along
	MOVE T2,.GESTT(Q1)	;[126] Get the time to set
	CALLRET OODTIM		;[126] (T1,T2/T1) Output the time and return
	SUBTTL Logging -- GODSK (DSKOP% JSYS)

;[133] Logging routine for GODSK.
;[133] Called with
;[133]	T1/ pointer to text log buffer
;[133]	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;[133]	P1/ offset into function tables
;[133]	P2/ FUNCTB bits from tables (FU%xxx)
;[133]	P3/ offset for user profile tables
;[133]	P4/ USRPRO profile bits for this user (US%xxx)
;[133] Returns +1 always, T1/ updated text log buffer pointer

GODSKL:	SAVEAC <Q2,Q3>		;[133] Save a Q or two for our use
	MOVE Q2,.GEST2(Q1)	;[133] Load the control flags,,word count
;[133] Output the type of addressing and unit number or structure name.

	LDB T4,[POINTR .GEST1(Q1),DOP%AT] ;[133] Load address type
	CAIE T4,.DOPSR		;[133] Check structure relative first
	IFSKP.			;[133] Yes, its structure relative
	  HRROI T2,[ASCIZ/, str /] ;[133] So indicate
	  CALL ISOUT		;[133] (T1,T2/T1) that it is structure relative
	  LDB T3,[POINTR .GEST1(Q1),DOP%SN] ;[133] Load structure number
	  CAIE T3,<.RTJST (DOP%SN,DOP%SN)> ;[133] Is field all ones?
	  IFSKP.		;[133] Yes, structure designator in T4
	    MOVE T2,.GEST4(Q1)	;[133] Load device designator
	    CALL ODEVST		;[133] (T1,T2/T1) Change it into a device
	  ELSE.			;[133] Otherwise it is probably PS
	    SKIPE T3		;[133] Want structure PS?
	    SKIPA T2,[-1,,[ASCIZ/?/]] ;[133] Illegal value for this field
	    HRROI T2,[ASCIZ/PS/] ;[133] Yes, it is PS, so say so please
	    CALL ISOUT		;[133] (T1,T2/T1) So just say PS if so
	  ENDIF.		;[133] End of structure name output code
	  LDB Q3,[POINTR .GEST1(Q1),DOP%RA] ;[133] Load the relative address
	ELSE.			;[133] End of structure relative output code
	  HRROI T2,[ASCIZ/, unit /] ;[133] Must be a disk unit instead
	  TXNN Q2,DOP%NF	;[133] Use CKU from T4?
	  IFSKP.		;[133] Yes please use the new format
	    SKIPGE .GEST4(Q1)	;[133] Is it a real looking CKU?
	    IFSKP.		;[133] Yes, it is
	      LDB T3,[POINTR .GEST4(Q1),DOP%C2] ;[133] Load the controller
	      CALL OLDEC	;[133] (T1,T2,T3/T1) Output that channel
	      HRROI T2,[ASCIZ/ /] ;[133] Label for kontroller
	      LDB T3,[POINTR .GEST4(Q1),DOP%K2] ;[133] Load the kontroller
	      CAIE T3,<.RTJST (DOP%K2,DOP%K2)> ;[133] Is field all ones?
	      CALL OLDEC	;[133] (T1,T2,T3/T1) Output that kontroller
	      HRROI T2,[ASCIZ/ /] ;[133] Label for unit
	      LDB T3,[POINTR .GEST4(Q1),DOP%U2] ;[133] Load the unit
	      CALL OLDEC	;[133] (T1,T2,T3/T1) Output that unit
	    ELSE.		;[133] Otherwise illegal new style unit
	      HRROI T2,[ASCIZ/, ill unit/] ;[133] It is probably DS poking
	      CALL ISOUT	;[133] (T1,T2/T1) Send illegal string along
	    ENDIF.		;[133] End of new style cku format code
	  ELSE.			;[133] Use old style C and U, T2/ label pointer
	    LDB T3,[POINTR .GEST1(Q1),DOP%CN] ;[133] Load the controller
	    CALL OLDEC		;[133] (T1,T2,T3/T1) Output that channel
	    LDB T3,[POINTR .GEST1(Q1),DOP%UN] ;[133] Load the unit
	    HRROI T2,[ASCIZ/ /]	;[133] Label for unit
	    CALL OLDEC		;[133] (T1,T2,T3/T1) Output that unit
	  ENDIF.		;[133] End of old style chan/unit code
	  LDB Q3,[POINTR .GEST1(Q1),DOP%UA] ;[133] Load unit address
	ENDIF.			;[133] Disk address is in Q3
;[133] Output the rest of the bits from a table of bits.

	MOVSI T4,-DOPSIZ	;[133] Load size of table
	DO.			;[133] Loop for asciifying bits in user AC1
	  HLRO T2,DOPTAB(T4)	;[133] Load something to say today
	  HRRZ T3,DOPTAB(T4)	;[133] Load address of bits to test
	  MOVE T3,(T3)		;[133] Get bit mask from that address
	  TDNE T3,Q2		;[133] Is this bit set?
	  CALL ISOUT		;[133] (T1,T2/T1) Yes it is in fact
	  AOBJN T4,TOP.		;[133] Loop for all of those bits
	OD.			;[133] End of flags translation loop

;[133] Output desired disk address and then we are done.

	MOVE T3,Q3		;[133] Load the address please
	HRROI T2,[ASCIZ/ adr /] ;[133] Load text of address
	CALLRET OLOCT		;[133] (T1,T2,T3/T1) Send along the address

;[133] Table of bits to text for the GODSKL.

DOPTAB:	TENTRY(< ero>,[DOP%EO]) ;[133] Error if offline
	TENTRY(< iel>,[DOP%IL])	;[133] Inhibit error logging
	TENTRY(< ier>,[DOP%IR])	;[133] Inhibit error recovery
	TENTRY(< wri>,[DOP%WR]) ;[133] Write as opposed to read
	TENTRY(< phy>,[DOP%PS]) ;[133] Physical, must be last
	DOPSIZ==.-DOPTAB	;[133] Size of table
	SUBTTL Logging -- GOSJP (SJPRI% JSYS)

;[133] Logging routine for GOSJP.
;[133] Called with
;[133]	T1/ pointer to text log buffer
;[133]	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;[133]	P1/ offset into function tables
;[133]	P2/ FUNCTB bits from tables (FU%xxx)
;[133]	P3/ offset for user profile tables
;[133]	P4/ USRPRO profile bits for this user (US%xxx)
;[133] Returns +1 always, T1/ updated text log buffer pointer

GOSJPL:	MOVE T1,.GEST1(Q1)	;[133] Load the target job number
	MOVEI T4,TJBLK		;[133] Point to area to return data into 
	CALL GETINF		;[133] (T1,T4/T4) Get job information
	IFSKP.			;[133] If that worked
	  MOVE T1,TEXTBP	;[133] Reload the pointer to text buffer
	  HRROI T2,[ASCIZ/, job/] ;[133] Load little blurb text
	  CALL ISOUT		;[133] (T1,T2/T1) Send that string
	  CALL OGETJI		;[133] (T1,T4/T1) Output all info about job
	ELSE.			;[133] Otherwise couldn't get the data
	  MOVE T1,TEXTBP	;[133] Reload the pointer to text buffer
	  MOVE T3,.GEST1(Q1)	;[133] Load what user gave in T1
	  HRROI T2,[ASCIZ/, job /] ;[133] Point to the label string
	  CALL OLDEC		;[133] (T1,T2,T3/T1) Send the job number along
	ENDIF.			;[133] End of job output code

	CALLRET GOSPR1		;[133] (T1,Q1/T1) Use GOSPRL routine for rest
	SUBTTL Logging -- GOSPR (SJPRI% JSYS)

;[133] Logging routine for GOSPR.
;[133] Called with
;[133]	T1/ pointer to text log buffer
;[133]	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;[133]	P1/ offset into function tables
;[133]	P2/ FUNCTB bits from tables (FU%xxx)
;[133]	P3/ offset for user profile tables
;[133]	P4/ USRPRO profile bits for this user (US%xxx)
;[133] Returns +1 always, T1/ updated text log buffer pointer

GOSPRL:	MOVE T3,.GEST1(Q1)	;[133] Load the fork handle
	HRROI T2,[ASCIZ/, fork /] ;[133] Load the label to it
	CALL OLOCT		;[133] Output fork handle first

;[133] Output runtime percent, system bit, and run queues for GOSJPL & GOSPRL.

GOSPR1:	LDB T3,[POINTR .GEST2(Q1),JP%RTG] ;Load runtime guarantee
	IFN. T3			;[133] Is it set?
	  HRROI T2,[ASCIZ/ guarantee /] ;[133] Label it with this
	  CALL OLDEC		;[133] (T1,T2,T3/T1) Send out the percentage
	ENDIF.			;[133] End of percentage output code
	MOVE T3,.GEST2(Q1)	;[133] Load user's AC2 again
	HRROI T2,[ASCIZ/ system-priority/] ;[133] Load text for JP%SYS
	TXNE T3,JP%SYS		;[133] Is the system bit on?
	CALL ISOUT		;[133] (T1,T2/T1) Yes, indicate so

	LDB T3,[POINTR .GEST2(Q1),JP%MNQ] ;Load minimum queue
	IFN. T3			;[133] Is it set?
	  SOJ T3,		;[133] Yes, it was specified as desired queue+1
	  HRROI T2,[ASCIZ/ min-Q /] ;[133] Label it with this
	  CALL OLDEC		;[133] (T1,T2,T3/T1) Send out the min queue
	ENDIF.			;[133] End of min queue output code

	LDB T3,[POINTR .GEST2(Q1),JP%MXQ] ;Load max queue
	IFN. T3			;[133] Is it set?
	  SOJ T3,		;[133] Yes, it was specified as desired queue+1
	  HRROI T2,[ASCIZ/ max-Q /] ;[133] Label it with this
	  CALL OLDEC		;[133] (T1,T2,T3/T1) Send out the max queue
	ENDIF.			;[133] End of max queue output code

	RET			;[133] Return with logging done
	SUBTTL Logging -- GOUSR (User test function)

;New DEC-defined functions should be added before this function.

;This is the logging routine for the test user function.
;Called with
;	T1/ pointer to text log buffer
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always, T1/ updated text log buffer pointer

GOUSRL:	RET			;Just return, no additional data needed today
	SUBTTL Logging -- Logging only if needed

;This is a policy routine that is called after log text is constructed, sends
;it only if needed.
;Returns +1 always.

USRLOG:	HRROI T1,TEXTBU		;Point to text buffer
	TXNE P2,FU%LOG		;Log this function?
	CALL SENLOG		;(T1/) Yes, send text buffer to log file

	TXNE P2,FU%CON		;Send to console?
	CALL PTEXT		;(/) Print text buffer on terminal 

	RET			;Return to ACJDEC
	SUBTTL Policy

;For each access control function defined in ACJSYM, there will be two routines
;in this module that the ACJDEC module will call.  The names are based on the
;names of the functions (GOxxx).  The test routine (GOxxxT) will perform the
;policy checks associated with the function.

;Each test routine will be called with the following ACs set up:
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;All of those ACs are preserved by the test routines.

;The test routine is only called when the bit FU%POL is set in the function
;bits (FUNCTB indexed by function offset, also carried in P2).

;If logging of particular status strings is wanted, the test routine should
;light FL%DEN ("[Denied]"), FL%UNU ("[Unusual]"), or FL%FAI ("[Failed]") in F
;by calling SETDEN, SETUNU, or SETFAI.

;If it is desired for logging to be disabled, the routine can clear the FU%LOG
;and or the FU%CON bits in P2.

;The test routine will return +1 to deny access and +2 to allow access.
	SUBTTL Policy -- GOASD (ASND%)

;Test routine for GOASD.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;We are called by the monitor for each ASND%.  
;Only allow Wheel or Operator to assign MTA devices.

GOASDT:	HLRZ T1,.GEADD(Q1)	;Load the device type
	CAIE T1,.DVDES+.DVMTA	;Magtape device?
	RETSKP			;Nope, allow it always
	CALL CHKWOP		;(/) Wheel or operator?
	 RETSKP			;Yes, allow always
	CALLRET SETDEN		;(/) Nope deny assignment of MTA devices
	SUBTTL Policy -- GOCAP (EPCAP%)

;Test for change of capabilities.
;Enabling WHEEL or OPERATOR is only allowed if
;	User is not on a TCP line
;	User is detached
;	User is not batch only
;	It is prime time or non-prime time and user is in table
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;The monitor calls us for each EPCAP%.  We disallow setting of WHEEL or
;OPERATOR on during non-prime time unless the user has been allowed to.

GOCAPT:	MOVE T2,.GENCP(Q1)	;Get the desired capabilities
	TXNN T2,SC%WHL!SC%OPR	;Wants to set WHEEL or OPERATOR?
	RETSKP			;No, return and allow it

	HRRZ T2,JIBLK+.JIUNO	;Load user number 
	JUMPE T2,RSKP		;OK to enable if not logged in yet (RMSFAL)

	CALL CHKTIM		;Find out who and what time
	 CALLRET SETDEN		;(/) User cannot enable at this time

	RETSKP			;Allow the capability setting
	SUBTTL Policy -- GOCJB (CRJOB%)

;Special routine to test to allow CRJOB
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us on each and every CRJOB% JSYS call.

GOCJBT:	CALL CHKWOP		;(/) Check if wheel or operator
	 RETSKP			;Yes, allow the CRJOB
	CALLRET SETDEN		;Nope, deny the CRJOB
	SUBTTL Policy -- GOLOG (LOGIN%)

;Routine to test for logins.
;Called with CJBLK set up with controlling job information and 
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;The monitor calls us for each attempted LOGIN.  This routine starts a spy
;fork if we are watching this user.  We disallow logins if:
;	Trying to LOGIN to ROOT-DIRECTORY.
;	User is over quota on PS:<user>.
;	Controlling job has OPERATOR caps and trying to LOGIN to WHEEL user.
;	User profile specifies that user cannot LOGIN to this line type.
;	WHEEL-only LOGINs are set and user is not WHEEL.

GOLOGT:	HRRZ T1,JIBLK+.JIUNO	;Load the user number
	CAIN T1,ROOTDN		;Is it ROOT-DIRECTORY?
	CALLRET SETDEN		;(/) Yes, deny this always!
	HLL T1,JIBLK+.JILNO	;Make it a directory number
	MOVEM T1,JIBLK+.JILNO	; and put it back there for later

;Don't allow logins if user is over quota on PS:<user>.

	GTDAL%			;Get directory allocation on PS:<user>
	IFNJE.			;If that worked
	  CAMG T2,T3		;Pages in use more than permanent quota?
	  IFSKP.		;Yes, used more than permanent quota
	    SKIPGE T1,JIBLK+.JITNO ;Get user's terminal number
	    CALLRET SETDEN	;(/) Detached, so don't send message
	    TXO T1,.TTDES	;Make TTY designator
	    HRROI T2,[ASCIZ/LOGIN denied because your login directory is currently over quota.
You cannot login to the system until this has been fixed.
/]				;The message to send
	    TTMSG%		;Let'em have it
	     ERNOP.		;Don't care if there was an error today
	    CALLRET SETDEN	;(/) Deny the login
	  ENDIF.		;End of quota check
	ENDIF.			;End of GTDAL worked code
;Get the capability mask of the user attempting to LOGIN.

	MOVE T1,JIBLK+.JILNO	;We need to get the capability mask of user
	MOVEI T2,GTDIRB		;Point to storage
	SETZ T3,		;No password please
	GTDIR%			;Get directory info
	 ERJMP SETDEN		;(/) If owie directory deny the login

;Make sure any jobs under PTYCON don't get any more caps than the controlling
;job (don't allow job with OPERATOR to login to job with WHEEL).

	SKIPL JIBLK+.JIBAT	;Is this a batch job?
	SKIPGE JIBLK+.JICPJ	;Is there a controlling job?
	IFSKP.			;It is not a controlled job nor is it batch
	  SKIPN T1,CJBLK+.JILNO	;Controlling job's login directory number 
	  CALLRET SETDEN	;(/) Not available, deny the login
	  MOVEI T2,GTDIRC	;Point to storage
	  SETZ T3,		;No password please
	  GTDIR%		;Get directory info on controlling job
	   ERJMP SETDEN		;(/) Deny the login if this fails
	  MOVE T1,GTDIRC+.CDPRV	;Get capability word
	  TXNE T1,SC%WHL	;Is it a wheel job?
	  IFSKP.		;Controlling job is not a wheel job
	    MOVE T1,GTDIRB+.CDPRV ;Get capability word for login directory
	    TXNE T1,SC%WHL	;Non wheel controlling trying to get wheel?
	    CALLRET SETDEN	;(/) Yes, deny this
	  ENDIF.		;End of non-wheel controlling job check
	ENDIF.			;End of controlling job check
;See if user profile allows LOGIN to this line type.

	MOVEI T4,JIBLK		;Point to the job block, it has line type
	CALL FNDLIN		;(T4/T3,T4) Find line type today
	TDNN P4,DENUSB(T3)	;Can user even login to this line type?
	CALLRET SETDEN		;(/) No, deny access

;See if wheel only logins are set.  If so only let user LOGIN if he is WHEEL.

	MOVE T1,DENTMN(T3)	;Load type of line
	TMON%			;Peek at monitor
	IFNJE.			;If no error on that one
	  IFN. T2		; and if wheel logins are set today
	    MOVE T1,GTDIRB+.CDPRV ;Get capability word for login directory
	    TXNN T1,SC%WHL	;Is this user a wheel?
	    CALLRET SETDEN	;(/) Non wheel, deny the login
	  ENDIF.		;End of wheel logins set check
	ENDIF.			;End of wheel login TMON worked code

;See if user needs to be spyed on and if so set up spy fork.

	TXNE P4,US%SPY		;Need to spy on this user
	SKIPGE ARGBLK+.RCTER	;Yes, are we detached?
	RETSKP			;No need to spy on this job
	MOVE T1,JIBLK+.JIUNO	;Load user number next
	HRRZ T2,JIBLK+.JIJNO	;Load job number
	CALL SPYON		;(T1,T2/) Start up a logging fork
	  JFCL			;Proably we are already watching her
	CALLRET SETUNU		;Say this was unusual and return +2
	SUBTTL Policy -- GOCFK (CFORK%)

;Test routine for GOCFK.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for each CFORK% that creates more than FKCNT forks.

GOCFKT: RETSKP			;Just allow always
	SUBTTL Policy -- GOTBR (MTOPR% to set Terminal Baud Rate)

;Test routine for GOTBR.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for each attempt to set terminal speed.  Disallow the setting
;of the speed unless wheel or operator.

GOTBRT:	CALL CHKWOP		;(/) See if wheel or operator
	 RETSKP			;Yes, allow
	CALLRET SETDEN		;(/) No, deny
	SUBTTL Policy -- GOLGO (LGOUT%)

;Test routine for logouts.
;Does not allow users to logout if they are over quota.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;The monitor calls this routine each and every time a job wants to logout.

GOLGOT:	SKIPL .GERLG(Q1)	;Job number logging out, -1 if caller
	RETSKP			;Logging out another job always works
	MOVE T1,.GEUSD(Q1)	;Get used pages in directory
	MOVE T2,.GEQUO(Q1)	;Get user's quota
	CAMG T1,T2		;More used than quota?
	RETSKP			;No, then LOGOUT is OK

	SKIPGE T1,JIBLK+.JITNO	;Get terminal number
	CALLRET SETDEN		;(/) Detached, deny the request anyway
	TXO T1,.TTDES		;Make TTY device designator
	HRROI T2,[ASCIZ/LOGOUT denied because your login directory is currently over quota.
Please get under quota before logging out.
/]
	TTMSG%			;Send to user
	 ERNOP.			;Ignore errors, user will figure it out
	CALLRET SETDEN		;(/) Deny the request returning +1
	SUBTTL Policy -- GOENQ (ENQC% ENQ Quota Set)

;Test routine for GOENQ.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us only if setting ENQ quota (ENQC% function .ENQCC) and the
;user is not wheel or operator.

GOENQT:	CALL CHKWOP		;(/) Check if wheel or operator
	 RETSKP			;Yes, allow it
	CALLRET SETDEN		;(/) Just say no
	SUBTTL Policy -- GOCRD (CRDIR%)

;Routine to test for CRDIR.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;The monitor calls us on each and every CRDIR% JSYS.  Note that if an older
;monitor is being used, the logging routine tried to steal the argument block.

GOCRDT:	SETZM GTDIRB		;First, clear first word of the block
	MOVE T1,[GTDIRB,,GTDIRB+1] ;Load a BLT pointer to it
	BLT T1,GTDIRB+.CDDGP	;Clear the entire block

;Try to get the directory number of this directory, this will fail if this is a
;new directory.  The remembered directory number (GTDIRB+.CDNUM) will be zero
;if new directory.

	MOVX T1,RC%EMO		;Exact match only this time please
	HRROI T2,.GEDIR(Q1)	;Point to the directory we are changing
	RCDIR%			;Get the directory string to a directory number
	 ERSKP.			;Skip if error in the RCDIR
	TXNE T1,RC%NOM		;Did we get a "no match" from the monitor?
	SETZ T3,		;Either RCDIR failed or we got no match
	MOVEM T3,GTDIRB+.CDNUM	;Save directory number or 0 if new directory

;Now try to get the status of this structure (domestic or foreign) for later.

	MOVX T1,<.MSGST+1,,.MSGSS> ;Set two word arg block, get str status fcn
	MOVEI T2,MSTRB		;Argument block starts here
	HRROI T3,.GEDIR(Q1)	;Use directory name furnished by monitor
	MOVEM T3,MSTRB+.MSGSN	;Save pointer to structure name
	MSTR%			;Get structure status
	 ERJMP SETDEN		;(/) If error, deny the request
;It is very important to not allow <ROOT-DIRECTORY> to have a password, user
;groups, directory groups, or be non-files-only for security reasons.  You
;don't want anyone to ACCESS or CONNECT the <ROOT-DIRECTORY> or LOGIN to
;ROOT-DIRECTORY, as owner access to the ROOT-DIRECTORY means any directory is
;yours to change.

	HRRZ T3,GTDIRB+.CDNUM	;Load the directory number today
	CAIE T3,ROOTDN		;Is it <ROOT-DIRECTORY> for this structure?
	IFSKP.			;Yes it is the root directory, special checks
	  TXO F,FL%UNU		;Indicate request is unusual
	  MOVE T2,.GECFL(Q1)	;Load user's AC2 (change bits) for this CRDIR

	  MOVE T3,.GECAB+.CDMOD(Q1) ;Load the bits user wants to change
	  TXNE T2,CD%MOD	;Changing mode word?
	  TXNE T3,CD%DIR	;Yes, making it non-files-only?
	  CAIA			;Not setting mode word or setting files-only
	  CALLRET SETDEN	;Setting non-files-only, deny this request

	  TXNE T2,CD%PSW	;Setting a password?
	  SKIPN .GECAB+.CDPSW(Q1) ;Yes, is there a password supplied?
	  CAIA			;Not setting password or setting null one
	  CALLRET SETDEN	;Setting non null password, deny this request

	  TXNE T2,CD%UGP	;Setting user groups?
	  SKIPN .GECAB+.CDUGP(Q1) ;Yes, is there a user group list supplied?
	  CAIA			;Not setting user groups or setting null list
	  CALLRET SETDEN	;Setting non null group list, deny this request

	  TXNE T2,CD%DGP	;Setting directory groups?
	  SKIPN .GECAB+.CDDGP(Q1) ;Yes, is there a directory group list?
	  CAIA			;Not setting dir groups or setting null list
	  CALLRET SETDEN	;Setting non null group list, deny this request
	ENDIF.			;End of <ROOT-DIRECTORY> policy code
;If structure is FOREIGN, we don't care what happens to it (a mounted BS: and
;PS: cannot be made FOREIGN).  If structure is DOMESTIC, check capabilites and
;if a enabled WHEEL, let anything happen.

	MOVE T2,MSTRB+.MSGST	;Load structure status word
	TXNE T2,MS%DOM		;Is structure domestic?
	CALL CHKWHL		;(/) Is this user a wheel?
	 JRST GOCRD2		;[130] Str foreign or user is enabled wheel
	MOVE T4,.GECFL(Q1)	;No, get user's AC2 (change bits) from CRDIR

;The structure is DOMESTIC and the user is not a WHEEL.  The directory mode
;(SECURE and FILES-ONLY) and capabilities (WHEEL and OPERATOR and
;SEMI-OPERATOR) cannot be changed except by WHEELs on DOMESTIC structures.  New
;directories on domestic structures must be NO SECURE and FILES-ONLY.

	SKIPN T1,GTDIRB+.CDNUM	;Get directory number back, skip if new dir
	IFSKP.			;If an old cirectory
	  MOVEI T2,GTDIRB	;Point to storage
	  SETZ T3,		;No password please
	  GTDIR%		;Get directory info
	   ERJMP SETDEN		;(/) Errors?  Deny the CRDIR
	ELSE.			;OK, the directory does not exist
	  TXNN T4,CD%MOD	;If a new directory, we must be setting mode
	  CALLRET SETDEN	;Not setting mode bits, dir is non-files-only
	ENDIF.			;OK, we have the information we need now

	MOVE T3,.GECAB+.CDMOD(Q1) ;Get directory mode bits
	MOVE T2,T3		;Get a copy of the current mode bits
	XOR T3,GTDIRB+.CDMOD	;Light bits where changes are being made

	TXNN T4,CD%MOD		;Are changing mode bits?
	IFSKP.			;Yes
	  TXNE T3,CD%SEC	;Yes, changing secure?
	  TXNN T2,CD%SEC	; and making it secure now?
	  CAIA			;Not changing mode or not secure directory
	  CALLRET SETDEN	;Yes, deny the request
	  TXNE T3,CD%DIR	;Yes, changing files only?
	  TXNE T2,CD%DIR	; and making it non files only now?
	  CAIA			;Not changing mode or not secure directory
	  CALLRET SETDEN	;Yes, deny the request
	ENDIF.			;End of mode bit checks

	MOVE T3,.GECAB+.CDPRV(Q1) ;Get capability bits
	XOR T3,GTDIRB+.CDPRV	;Light bits in T3 where changes were made
	TXNE T4,CD%PRV		;Changing capability bits?
	TXNN T3,SC%WHL!SC%OPR!SC%SEM ;Changing wheel or operator or big-rigs?
	JRST GOCRD2		;[130] No, so allow the request
	CALLRET SETDEN		;Setting wheel or operator, deny
;[130] Attempts to kills a directory will fail with "Directory file is mapped"
;if we leave an entry in the directory cache because of the RCDIR and/or CRDIR
;above.  So, when indicating success we coma here to insure that directory
;cache is cleared if a CD%DEL is set.

GOCRD2:	MOVE T2,.GECFL(Q1)	;[130] Load user's AC2 (CRDIR change bits)
	TXNN T2,CD%DEL		;[130] Trying to murder this directory?
	RETSKP			;[130] No let's have a skip return
	HRROI T2,[ASCIZ/PS:<ROOT-DIRECTORY>/] ;[130] I hope this dir exists
	MOVX T1,RC%EMO		;[130] Exact match only will do for RCDIR
	RCDIR%			;[130] Get rid of dir cache entry
	 ERNOP.			;[130] I don't care (that much) if RCDIR fails
	RETSKP			;[130] Skip return always
	SUBTTL Policy -- GOSMT (MSTR% to Increment Mount Count)

;Test routine for GOSMT.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor always calls us for each and every increment mount count function.

GOSMTT:	RETSKP			;Just allow always
	SUBTTL Policy -- GOMDD (MDDT%)

;Test routine for MDDT entry.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us only if user has Wheel OR Operator capability.  Disallow
;entering MDDT by anyone over TCP connections, non-wheels, anyone on a PTY.

GOMDDT:	CALL CHKWHL		;(/) Is this a wheel?
	 RETSKP			;Yes, allow the entry into MDDT
	CALLRET SETDEN		;(/) Nope, deny the request
	SUBTTL Policy -- GOCLS (SKED% to set scheduler class)

;Test routine for GOCLS.
;Only allows wheel or operator to set job's scheduler class.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for all job class setting, but if a user is not wheel or
;operator and is trying to set another job's class, we will not be consulted
;and the user will get a CAPX1 error.

GOCLST:	CALL CHKWOP		;(/) See if wheel or operator
	 RETSKP			;Yes, allow
	CALLRET SETDEN		;(/) No, deny
	SUBTTL Policy -- GOCL0 (Class Set at Login)

;Test routine for GOCL0.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us each time a job logs in only if the class scheduler is on and
;class assignments are by the policy program (us).  A SKED% JSYS is used to set
;the job in a particular class as specified by the user profile word.

GOCL0T:	LDB T3,[POINTR P4,US%CLA] ;Load class
	JUMPE T3,RSKP		;Skip return (do nothing) if zero

	MOVEI T1,SKEDB+.SAJCL+1	;Load size of argument block
	HRRZ T2,JIBLK+.JIJNO	;Load job number
	DMOVEM T1,SKEDB+.SACNT	;Set up count and job number (.SAJOB)
	MOVEM T3,SKEDB+.SAJCL	;Store class of job also

	MOVEI T1,.SKSCJ		;Set job scheduler class function
	MOVEI T2,SKEDB		;Point to block
	SKED%			;Do it
	 ERJMP SETUNU		;Unusual if failed
	RETSKP			;Just allow always
	SUBTTL Policy -- GOMTA (MTA Access)

;Test routine for GOMTA.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for labelled MTA access where the label type is TOPS-20 and
;access is by non-owner and there is a protection failure, or if ANSI labels
;and volume accessability is not "full", or if EBCDIC labels and accessability
;byte is from 1 to 3 inclusive.  A MTU% JSYS can be used to check the labels on
;the tape for user access to labelled tape.

GOMTAT:	RETSKP			;Just allow always
	SUBTTL Policy -- GOACC (ACCES%)

;Test code for access or connect function.  
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;The monitor calls us only if the user is (NOT (wheel or operator)) AND (user
;gave bad password).  Therefore this request is normally always denied.
;We allow a directory's owner to connect to his/her subdirectories.

GOACCT:	MOVE T1,.GOAC0(Q1)	;Load the first user AC which are the bits
	TXNN T1,AC%CON		;Is it a connect?
	CALLRET SETDEN		;(/) Nope, deny the request
	MOVX T1,<2,,.MSGSS>	;Set two word arg block, get str status fcn
	MOVEI T2,T3		;Argument block starts at T3
	HRROI T3,DIRBLK		;Use directory block set up by GOACCL
	MSTR%			;Get structure status
	 ERJMP SETDEN		;(/) If error, deny the request
	TXNN T4,MS%DOM		;Is structure domestic?
	CALLRET SETDEN		;(/) Nope, deny the connect

;User is attempting to connect to a directory on a domestic structure.  
;If the directory is a subdirectory of the user's home directory allow it.
;We know that USRSTR/ username and DIRBLK/ directory.

	MOVE T1,[POINT 7,DIRBLK] ;Point to directory block
	DO.			;Loop to eat until left angly bracket
	  ILDB T2,T1		;Load a character of the string
	  CAIN T2,74		;Is it a left angly?
	  EXIT.			;Yes, get out of loop
	  JUMPN T2,TOP.		;Keep looping unless null seen
	  CALLRET SETDEN	;Deny request if can't find left angly
	OD.			;Now T1 points to the directory name
	MOVE T3,[POINT 7,USRSTR] ;Point to username of requestor
	DO.			;Loop to see if username matches
	  ILDB T2,T1		;Load a character from directory
	  ILDB T4,T3		;Load a character from username
	  CAIN T2,(T4)		;Do they still match?
	  LOOP.			;Yes, loop until mismatch
	OD.			;So now we have a mismatch
	JUMPN T4,SETDEN		;Deny request if not at end of username
	RETSKP			;Allow request 
	SUBTTL Policy -- GOOAD (OPENF% Assign Device)

;Test routine for GOOAD.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for each OPENF% JSYS that assigns a device.
;Only allow Wheel or Operator to assign MTA devices.

GOOADT:	HLRZ T1,.GEADD(Q1)	;Load the device type
	CAIE T1,.DVDES+.DVMTA	;Magtape device?
	RETSKP			;Nope, allow it always
	CALL CHKWOP		;(/) Wheel or operator?
	 RETSKP			;Yes, allow always
	CALLRET SETDEN		;(/) Nope deny assignment of MTA devices
	SUBTTL Policy -- GODNA (DECnet)

;Routine to test for DECnet access.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us on each and every DECnet OPENF%.

GODNAT:	HRRZ T2,ARGBLK+.RCCAP	;Get this set of capabilities
	TRNE T2,SC%DNA		;Is the DECnet-ACCESS capability set ?
	RETSKP			;Yes, allow the access
	CALLRET SETDEN		;(/) Nope, deny it
	SUBTTL Policy -- GOANA (Arpanet)

;Test routine for arpanet access
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for each TCP/IP OPENF%.  This routine allows access for 
;users with SC%ANA capability.

GOANAT:	HRRZ T2,ARGBLK+.RCCAP	;Get this set of capabilities
	TRNE T2,SC%ANA		;ARPANET-ACCESS set ?
	RETSKP			;Yes, allow the access
	CALLRET SETDEN		;(/) Nope, deny it
	SUBTTL Policy -- GOATJ (ATACH%)

;Policy control routine for attach.
;Called with TJBLK set up with target job information and 
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables (for source job)
;	P4/ USRPRO profile bits for this user (US%xxx) (for source job)
;Returns +1 to deny, +2 to allow

;Monitor calls us for each ATACH%.  We have to find the proper target job's
;user profile first.  We disallow the attach if:
;	Batch job (batch cannot attach to anything).
;	User profile says that target user cannot LOGIN to source line type.
;	WHEEL-only LOGINs are set and target job is not WHEEL user.
;	Target job is batch job and user doing attach is not WHEEL.
;	Job has OPERATOR caps and target job is WHEEL user.

GOATJT:	SKIPGE JIBLK+.JIBAT	;Is this a batch job?
	CALLRET SETDEN		;(/) Yes, batch cannot attach anywhere

;The source job's user profile has been selected, however we really want the
;profile of the target job's user, so we have to get the target's username.

	SETZ P3,		;Load default which is user not found in table
	MOVE P4,USEDEF		;Load default bits to allow logins at least
	HRROI T1,DIRBLK		;Point to user string storage area
	MOVE T2,TJBLK+.JIUNO	;Load user number not from ARGBLK mind you
	CALL ODIRST		;(T1,T2/T1,T2) Send that to the username string
	TLNN T2,-1		;Not logged in or unknown user?
	RETSKP			;[131] (/) OK to allow this for FTPSRT

;Now we try to find the target job's user profile in our database.

	MOVEI T1,USRTBL		;Point to the user profile table
	HRROI T2,DIRBLK		;Point to string to compare against
	CALL WTBLUK		;(T1,T2/T1,T2,T3) Do a wild TBLUK function
	TXNE T2,TL%NOM		;No match?
	IFSKP.			;Nope, a match
	  HRRZ P3,(T1)		;Return the offset into USRPRO and such tables
	  MOVE P4,USRPRO(P3)	;Reload the profile bits
	ENDIF.			;Now we have the proper user profile bits
;User profile bits in P3 and P4 are now for target user.  Now get the
;capability mask of the target job's username.

	MOVE T1,TJBLK+.JILNO	;We need to get the capability mask of user
	MOVEI T2,GTDIRT		;Point to storage for the directory info
	SETZ T3,		;No password please
	GTDIR%			;Get directory info
	 ERJMP SETDEN		;(/) If owie directory deny the attach

;See if user profile allows LOGIN to line type that the ATACH is being done on.

	MOVEI T4,JIBLK		;Point to the job block 
	CALL FNDLIN		;(T4/T3,T4) Find line type today
	TDNN P4,DENUSB(T3)	;Can user even login to this line type?
	CALLRET SETDEN		;(/) No, deny access

;See if WHEEL-only LOGINs are set.  If so only let user attach if target wheel.

	MOVE T1,DENTMN(T3)	;Load type of line
	TMON%			;Peek at monitor
	IFNJE.			;If no error on that one
	  IFN. T2		; and if wheel logins are set today
	    MOVE T1,GTDIRT+.CDPRV ;Get capability word for login directory
	    TXNN T1,SC%WHL	;Is this user a wheel?
	    CALLRET SETDEN	;Non wheel, deny the login
	  ENDIF.		;End of wheel logins set check
	ENDIF.			;End of wheel login TMON worked code
;A job with wheel can attach to anything.  The monitor will allow an enabled
;user with operator to attach to a user with wheel without a password - we deny
;this.  (If a non-enabled user with operator tries to attach to a user with
;wheel and gets the password right we will let the attach happen.)  The monitor
;will allow a job controlled by user with operator to attach to a user with
;wheel without a password - we deny this.

	CALL CHKWHL		;(/) Skip if not wheel
	IFSKP.			;Job doing that ATACH is not wheel
	  MOVE T1,GTDIRT+.CDPRV ;Get capability word login of target directory
	  TXNN T1,SC%WHL	;Is this target job a wheel user?
	  IFSKP.		;Yes, target job is wheel user
	    CALL CHKWOP		;(/) Is it enabled operator trying to attach?
	     CALLRET SETDEN	;(/) Yes, don't allow operator attach to wheel
	    SKIPGE T1,JIBLK+.JICPJ ;Is there a controlling job?
	    IFSKP.		;Yes there is a controlling job
	      MOVEI T4,CJBLK	;Point to controlling job information block
	      CALL GETINF	;(T1,T4/T4) Get information about controller
	       CALLRET SETDEN	;(/) If owie, deny the attach
	      MOVE T1,CJBLK+.JILNO ;Get controlling job's login directory 
	      MOVEI T2,GTDIRC	;Point to storage for that directory
	      SETZ T3,		;No password please
	      GTDIR%		;Get directory info on controlling job
	       ERJMP SETDEN	;(/) Deny the login if this fails
	      MOVE T1,GTDIRC+.CDPRV ;Get capability word of controller job
	      TXNE T1,SC%WHL	;Is it a wheel user controlling source job?
	      CALLRET SETDEN	;(/) Nope, don't allow the attach
	    ENDIF.		;End of controlling job check
	  ENDIF.		;End of target job is a wheel user checks
	ENDIF.			;End of source job is not enabled wheel checks

	RETSKP			;Allow the attach
	SUBTTL Policy -- GOINF (INFO%)

;Test routine for GOINF.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for all INFO% JSYS except when it thinks the INFO% comes from
;a GALAXY component.

GOINFT: RETSKP			;Just allow always
	SUBTTL Policy -- GOLAT (LATOP%)

;Test routine for GOLAT.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us on all .LARHC (request host connect) functions only.

GOLATT:	CALL CHKWOP		;(/) Wheel or operator?
	 RETSKP			;Yes, allow
	CALLRET SETDEN		;No, deny it
	SUBTTL Policy -- GOCTM (CTERM Connection)

;Test routine for GOCTM.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us from job 0 on each CTERM connection.  The nodename and/or
;user name can be checked to allow access to this system.  NOTE: a hostile user
;program can send over any source data that it wants to in the CTERM connect
;message.

GOCTMT: RETSKP			;Just allow always
	SUBTTL Policy -- GOTTM (TTMSG%)

;Test routine for GOTTM.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls this routine for all TTMSG% unless TTMSG% is being done by the
;monitor (previous context is monitor).

GOTTMT:	CALL CHKWOP		;(/) Check wheel or operator
	 RETSKP			;Allow it
	CALLRET SETDEN		;(/) Deny it
	SUBTTL Policy -- GOSMN (SMON%)

;Test routine for GOSMN.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx) 
;Returns +1 to deny, +2 to allow

;Monitor calls this routine for SMON% functions not done by Wheel or Operator.

GOSMNT:	CALL CHKWOP		;(/) Check if wheel or operator
	 RETSKP			;Yes, allow it
	CALLRET SETDEN		;(/) Just say no
	SUBTTL Policy -- GOHSY (HSYS%)

;Test routine for GOHSY.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for each HSYS% JSYS.

GOHSYT:	MOVE T1,ARGBLK+.RCCAP	;Load user's capabilities
	TXNE T1,SC%WHL!SC%OPR!SC%MNT ;Wheel or operator or maintenance?
	RETSKP			;Just allow it then
	CALLRET SETDEN		;(/) Nope
	SUBTTL Policy -- GOSGT (SYSGT%)

;Test routine for GOSGT.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for each SYSGT% when the previous context is not monitor.

GOSGTT:	RETSKP			;Just allow always
	SUBTTL Policy -- GOGTB (GETAB%)

;Test routine for GOGTB.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for each GETAB% when the previous context is not monitor.

GOGTBT: RETSKP			;Just allow always
	SUBTTL Policy -- GOOPN (OPENF% with FB%SEC)

;Test routine for GOOPN.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for each OPENF% of a file with FB%SEC set and previous mode
;is not monitor mode.

GOOPNT:	MOVE T2,.GEOAC(Q1)	;Load open bits for this access
	MOVX Q2,SF.REA		;Assume read access
	TXNE T2,OF%WR		;Write access?
	MOVX Q2,SF.WRI		;Yes, write access
	TXNE T2,OF%APP		;Append access?
	MOVX Q2,SF.APP		;Yes, append access
	CALL SECFIL		;(Q1,Q2/) Check access to this file
	 CALLRET SETDEN		;Denied access
	RETSKP			;Allow the access to the file
	SUBTTL Policy -- GORNF (RNAMF% with FB%SEC)

;Test routine for GORNF.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for each RNAMF% of a file with FB%SEC set and previous mode
;is not monitor mode.

GORNFT:	MOVX Q2,SF.REN		;Trying to get rename access 
	CALL SECFIL		;(Q1,Q2/) Check access to this file
	 CALLRET SETDEN		;Denied access
	RETSKP			;Allow the access to the file
	SUBTTL Policy -- GODLF (DELF%/DELNF% with FB%SEC)

;Test routine for GODLF.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for each DELF%/DELNF% of a file with FB%SEC set and previous
;mode is not monitor mode.

GODLFT:	MOVX Q2,SF.DEL		;Trying to get delete access to this file
	CALL SECFIL		;(Q1,Q2/) Check access to this file
	 CALLRET SETDEN		;Denied access
	RETSKP			;Allow the access to the file
	SUBTTL Policy -- GOTLK (TLINK%)

;Test routine for GOTLK.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for each TLINK% JSYS when previous mode is not monitor mode.

GOTLKT:	TXNE P4,US%SPY		;Is this user being spyed upon?
	CALLRET SETUNU		;(/) This is unusual, log it so please
	RETSKP			;Just allow always
	SUBTTL Policy -- GOCRL (CRLNM%)

;Test routine for GOCRL.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for each CRLNM% JSYS functions .CLNS1, .CLNSA, or .CLNSY and
;user is not Wheel or Operator.

GOCRLT:	CALL CHKWOP		;(/) Wheel or operator?
	 RETSKP			;Just allow it
	CALLRET SETDEN		;(/) Deny it
	SUBTTL Policy -- GODTC (DTACH%)

;Test routine for GODTC.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for all DTACH% JSYS.

GODTCT: RETSKP			;Just allow always
	SUBTTL Policy -- GOCFD (CHFDB% of FB%SEC)

;Test routine for GOCFD.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for each CHFDB% of a file with FB%SEC set and previous mode
;is not monitor mode.

;There are currently three special cases of changing FB%SEC that are always
;allowed without logging in order to preserve the current and seperate actions
;of files that aren't secure.

;Special case 1: CHFDB to clear FB%SEC on a totally new file type always works
;with no logging.  This allows nosecure files to be created in a directory
;without some kind of ACCESS.CONTROL keywords (for example DUMPER restoring
;nosecure files) causing lots of unusual logging on files that are not intended
;to be secure.

;Special case 2: CHFDB not really changing SECURE on new file generation always
;works with no logging.  This allows new generations of files to be copied even
;if stupid programs (such as FCOPY and DUMPER) set the .FBCTL word with FB%SEC
;the same as it is now.  A case of this is when DUMPER restores new generations
;of nosecure files.

;Special case 3: If access is allowed because there is no ACCESS.CONTROL file
;and the user is trying to clear FB%SEC, let this happen wihout logging.  This
;happens when an existing nosecure file is overwritten with new contents and
;the program is attempting to clear FB%SEC.  A case of this is when DUMPER is
;restoring (overwriting) a nosecure MAIL.TXT.1.
;If the file already exists, always consult ACCESS.CONTROL.

GOCFDT:	MOVE T1,.GESFS(Q1)	;Load the new FBCTL word contents
	TXNN T1,FB%NXF		;Not yet closed file?
	JRST GOCFDF		;Nope, old file, always consult access.control

;We now will try to lookup the highest existing generation of the file to see
;what its FB%SEC bit is.  If setting this new generation of the file to the
;same as that of the currently highest generation we consider this a special
;case.

	HRROI T1,DIRBLK		;Point to temp area
	HRROI T2,.GEFIL(Q1)	;Point to the filename
	CALL ISOUT		;(T1,T2/T1) Copy it
	DO.			;Look backwards for last dot
	  SETO T2,		;Load a -1
	  ADJBP T2,T1		;Back up byte pointer by one
	  MOVE T1,T2		;Copy the byte pointer back then
	  LDB T2,T1		;I wish that there was a DLDB instruction
	  CAIE T2,"."		;Is this a dot yet?
	  LOOP.			;Nope
	OD.			;Now T1 points to last dot in string
	SETZ T2,		;Load a null
	DPB T2,T1		;Remove generation number from filename
	MOVX T1,GJ%OLD!GJ%SHT	;Short form old file
	HRROI T2,DIRBLK		;Point to filename
	GTJFN%			;Try to get a JFN, should be fast 
	 ERJMP GOCFDS		;Totally non existant file is special
	MOVE Q3,T1		;Save JFN
	MOVX T2,<1,,.FBCTL>	;Just need the one word
	MOVX T3,T4		;Return the one word here
	SETZ T4,		;In case GTFDB fails, file is not sec
	GTFDB%			;Get that word from the FDB
	 ERSKP.			;Skip if error in that call
	XOR T4,.GESFS(Q1)	;Now you find the bits that changed in T4
	MOVE T1,Q3		;Load the JFN back
	RLJFN%			;Dump that JFN
	 ERNOP.			;Ignore errors at this point
	TXNN T4,FB%SEC		;Changing FB%SEC?
	JRST GOCFDS		;No changes, a special case that succeeds
;	JRST GOCFDF		;Changing FB%SEC, look at ACCESS.CONTROL
;Here when we must check ACCESS.CONTROL, looking for [NO]SECURE access.

GOCFDF:	MOVE T1,.GESFS(Q1)	;Load the new FBCTL word contents
	MOVX Q2,SF.SEC		;Assume setting secure function
	TXNN T1,FB%SEC		;Is the user trying to set or clear?
	MOVX Q2,SF.NOS		;Clear, load the nosecure function
	CALL SECFIL		;(Q1,Q2/) Check access to the secure bit
	 CALLRET SETDEN		;Denied access to secure bit

;If access is allowed because there is no ACCESS.CONTROL file and the user is
;trying to clear FB%SEC, let this happen wihout logging.

	MOVE T1,.GESFS(Q1)	;Reload the flags
	TXNE F,FL%UNU		;Did it succeed because no access.control?
	TXNE T1,FB%SEC		;Was he trying to set or clear?
	RETSKP			;Making secure or there was an access.control

;Here to clear logging for special cases that always succeed.  Remove the TXZ
;instruction to always log each attempt of setting or clearing FB%SEC.

GOCFDS:	TXZ P2,FU%LOG		;Clearing secure on file without access.control
	RETSKP			;Allow the access
	SUBTTL Policy -- GOGTD (Get directory information)

;[126] Test routine for GOGTD.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for all GTDIR% JSYS.

GOGTDT: RETSKP			;[126] Just allow and log always
	SUBTTL Policy -- GOSTD (Set time)

;[126] Test routine for GOSTD.
;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for all STAD% JSYS.

GOSTDT: RETSKP			;[126] Just allow and log always
	SUBTTL Policy -- GODSK (DSKOP% JSYS)

;[133] Test routine for GODSK.
;[133] Called with
;[133]	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;[133]	P1/ offset into function tables
;[133]	P2/ FUNCTB bits from tables (FU%xxx)
;[133]	P3/ offset for user profile tables
;[133]	P4/ USRPRO profile bits for this user (US%xxx)
;[133] Returns +1 to deny, +2 to allow

;[133] Monitor calls us for each DSKOP% JSYS.

GODSKT:	MOVE T2,.GEST2(Q1)	;[133] Load the control flags,,word count
	TXNE T2,DOP%WR		;[133] Write as opposed to read?
	CALLRET SETUNU		;[133] (/) This is unusual, allow it
	RETSKP			;[133] Just allow and log always
	SUBTTL Policy -- GOSJP (SJPRI% JSYS)

;[133] Test routine for GOSJP.
;[133] Called with
;[133]	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;[133]	P1/ offset into function tables
;[133]	P2/ FUNCTB bits from tables (FU%xxx)
;[133]	P3/ offset for user profile tables
;[133]	P4/ USRPRO profile bits for this user (US%xxx)
;[133] Returns +1 to deny, +2 to allow

;[133] Monitor calls us for each SJPRI% JSYS not executed from monitor context.

GOSJPT: RETSKP			;[133] Just allow and log always
	SUBTTL Policy -- GOSPR (SPRIW% JSYS)

;[133] Test routine for GOSPR.
;[133] Called with
;[133]	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;[133]	P1/ offset into function tables
;[133]	P2/ FUNCTB bits from tables (FU%xxx)
;[133]	P3/ offset for user profile tables
;[133]	P4/ USRPRO profile bits for this user (US%xxx)
;[133] Returns +1 to deny, +2 to allow

;[133] Monitor calls us for each SPRIW% JSYS.

GOSPRT: RETSKP			;[133] Just allow and log always
	SUBTTL Policy -- GOUSR (User test function)

;NOTE: new DEC functions should be added immediately before this function.

;Test routine for GOUSR, which is the user test function.  All user
;functions (codes 400000-777777) should appear immediately after this one.

;Called with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

;Monitor calls us for each user function (function 400000)  We always allow it.

GOUSRT:	RETSKP			;Allow the function to succeed
	SUBTTL Policy -- Deny by Terminal Line Type

;Test routine for ACJUSR implemented controls (like DENY-xxx keywords)
;Called after GOxxxT routines with
;	Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables (FU%xxx)
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 to deny, +2 to allow

USRPOL:	MOVEI T4,JIBLK		;Point to job's information block
	CALL FNDLIN		;(T4/T3,T4) Get index into deny tables

	TDNE P2,DENFUB(T3)	;Is function denied for this line type?
	 CALLRET SETDEN		;(/) Deny access
	RETSKP			;Function is OK for this line type
	SUBTTL Subroutines -- Find Line Type Entry

;Routine called to find an entry in the deny line type table.
;Called with T4/ address of job information block
;Returns +1 always, T3/ index into tables.

FNDLIN:	SAVEAC <Q1,Q2,Q3>	;Save the Qs
	LDB Q1,[POINT 9,NTINFB+.NWTTF(T4),17] ;(no symbol for this field) 
	MOVE Q2,MORSPW(T4)	;Load speed word for this terminal
	MOVE Q3,.JITNO(T4)	;Load terminal number for this terminal
	MOVSI T3,-<DENSIZ-1>	;Load -<number in table-1>,,0 for AOB pointer
	DO.			;Until line type found
	  XCT DENCHK(T3)	;(Q1,Q2,Q3/) Is it a line match?
	  AOBJN T3,TOP.		;Nope, keep looking
	OD.			;End of look checking for line type
	RET			;Return with T4/ line type
;Now we define the tables used in the line type checking routines.
;Each entry is of the form
;	FUN(<Instr>,FunctionBit,UserBit,SMONfunct)
;Where
;	Instr is the instruction to test for line type, skips if a match
;	FunctionBit is bit to deny this function for this line type
;	UserBit is bit to allow logins for this line type
;	SMONfunct is SMON function to check for wheel logins for line type

;CAUTION: The order of checks is critical to proper operation of this feature.
;New network-type tests should be added immediately after the other network
;checks and before the "remote" check.

DEFINE DENGEN,<
	XLIST
	FUN(<SKIPL .JIBAT(T4)>,FU%DBA,US%BAT,.SFWPT) ;Batch check first
	FUN(<SKIPGE .JICPJ(T4)>,FU%DPT,US%PTY,.SFWPT) ;PTY check after batch
	FUN(<SKIPL .JITNO(T4)>,FU%DDE,US%DET,.SFWRM) ;DET check after PTY
	FUN(<CAME Q3,CTYLNO>,FU%DCT,US%CTY,.SFWCT) ;CTY check after det check
	FUN(<CAIE Q1,NW%DNA>,FU%DDN,US%DNA,.SFWDN) ;DECnet (NRT or CTERM)
	FUN(<CAIE Q1,NW%TCP>,FU%DTC,US%TCP,.SFWNV) ;TCP/IP Internet (TELNET)
	FUN(<CAIE Q1,NW%LAT>,FU%DLA,US%LAT,.SFWLT) ;LAT terminal
	FUN(<TXNN Q2,MO%RMT>,FU%DRM,US%REM,.SFWRM) ;Remote (dialup on FE)
	FUN(<CAIA>,FU%DLO,US%LOC,.SFWLC) ;Local, must be last
	LIST
>

;Now build the needed tables

	DEFINE FUN(A,B,C,D),<A>
DENCHK:	DENGEN			;Generate table of terminal test instructions
	DENSIZ==.-DENCHK	;Define symbol for number of tests

	DEFINE FUN(A,B,C,D),<B>
DENFUB:	DENGEN			;Generate table of function deny bits

	DEFINE FUN(A,B,C,D),<C>
DENUSB:	DENGEN			;Generate table of user allow bits

	DEFINE FUN(A,B,C,D),<D>
DENTMN:	DENGEN			;Generate table TMON wheel login functions
	SUBTTL Subroutines -- Deny, Unusual, Failed setting

;Here to say that request is denied.
;Returns +1 always.

SETDEN:	MOVEI T2,400000		;Return error
	SETZ T3,		;No specific code to return
	TXO F,FL%DEN		;Indicate request is denied
	RET			;Return +1 to deny request

;Here if request is unusual, allow it but note this in the log file.
;Returns +2 always.

SETUNU:	TXO F,FL%UNU		;Indicate request is unusual
	RETSKP			;Return +2 to allow request anyway.

;Here if request was in some way a failure.
;Returns +1 always.

SETFAI:	MOVEI T2,400000		;Return error
	SETZ T3,		;No specific code to return
	RET			;Return +1 to fail request
	SUBTTL Subroutines -- Check Capabilities

;Here to check if this user is a wheel or operator
;Returns +1 wheel or operator
;Returns +2 if not wheel or operator

CHKWOP:	MOVE CX,ARGBLK+.RCCAP	;Load user's capabilities
	TXNN CX,SC%WHL!SC%OPR	;Wheel or operator?
	AOS (P)			;Skip return
	RET			;Return

;Here to check if this user is a wheel
;Returns +1 wheel 
;Returns +2 if not wheel

CHKWHL:	MOVE CX,ARGBLK+.RCCAP	;Load user's capabilities
	TXNN CX,SC%WHL		;Wheel?
	AOS (P)			;Skip return
	RET			;Return
	SUBTTL Subroutines -- Check Time for Enable

;Routine to check if this user can enable caps after prime time.
;Returns +1 if function is denied
;Returns +2 To allow the function

CHKTIM:	TXNE P4,US%ENP		;User can enable non-prime?
	RETSKP			;Yes, return success now
	SETO T2,		;Current time
	SETZ T4,		;No flags
	ODCNV%			;Get time
	HRRZ T3,T3		;Day of week only
	CAIE T3,.SAT		;Is it Saturday?
	CAIN T3,.SUN		;Is it Sunday?
	RET			;Yes, can't enable
	HRRZ T4,T4		;Just get time
	CAMGE T4,PRIMEB		;Past prime time start?
	RET			;No, denied
	CAMLE T4,PRIMEE		;Before prime time end?
	RET			;Off hours, can't do this function
	RETSKP			;Time is OK
	SUBTTL Subroutines -- CRDIR Snooping

;This routine tries to make up for the deficiency in the GETOK argument block
;for the CRDIR% JSYS.  The monitor justs ask if it is OK for the user to do the
;CRDIR%, and doesn't furnish any of the CRDIR arguments.  This routine checks
;to see if we are running on a new monitor that furnishes the user's arguments.
;If so, we just return.  If not, we XPEEK% and PMOVE data out of the monitor,
;and this data is used to fix up the GETOK% request block to make it look like
;a newer monitor.  

;Since the fork doing the CRDIR% is in balance set wait while waiting for us to
;OK the CRDIR%, the CRDIR% arguments should also be in memory.  This is true of
;the EXEC who just has written the CRDIR% argument block.  Note that this
;routine assumes that the caller is using private page pointers where the data
;is (e.g. the CRDIR done from a fork which was created with CR%MAP).

;Call with Q1/ ARGBLK+.RCARA.
;Returns +1 always

CHKCRD:	SKIPE .GEDIR(Q1)	;Did monitor give us user arguments?
	RET			;Yes, just return now and avoid all of this
	SETZM .GECFL(Q1)	;No CRDIR% flags yet
	SETZM .GECAB(Q1)	;No block containing CRDIR% argument block

;Get monitor symbol values only if first time through here.

	SKIPN PSBPG		;Did we snoop the monitor symbols yet?
	CALL SNOOPM		;(/) No, snoop them from the monitor

;Find request block for this request and make the GETOK argument block look
;like the new monitor format.

	CALL FNDREQ		;(/) Find request block to get fork number
	 RET			;Can't find it

	CALL FNDUAC		;(/) Get user's ACs
	 RET			;Some problem, return now

	CALL STRGET		;(/) Now get directory string from user space

	CALLRET BLKGET		;(/) And lastly, get user's arg block and ret
	SUBTTL Subroutines -- CRDIR Snooping -- Find Request Block

;Here to find request block for this user.
;Returns +1 if not found or error looking
;Returns +2 if found, block in NXTBLK

FNDREQ:	MOVE T1,GETOKQ		;Get queue place
	MOVEI T2,CURBLK		;Put result here
	CALL XPEEK1		;(T1,T2/) Get it from the monitor
	 RET			;Failed!

FNDRE0:	MOVE T1,CURBLK		;Get address of current block
	MOVEI T2,NXTBLK		;Save request block here
	MOVEI T3,15		;Size of hidden part of block
	CALL XPEEKX		;(T1,T2,T3/) Get those words from monitor
	 RET			;We failed
	MOVE T3,REQNUM+NXTBLK	;Retrieve request number
	CAMN T3,ARGBLK+.RCRQN	;Is this the request we want?
	RETSKP			;Skip return indicates success
	SKIPN T2,NXTBLK		;Get address of next block
	RET			;If no more arg blocks, return +1
	MOVEM T2,CURBLK		;Make it current
	JRST FNDRE0		;Now see if this the one
	SUBTTL Subroutines -- CRDIR Snooping -- Find User's ACs

;We now have the request block we are looking for, get the user's ACs
;Call with Q1/ ARGBLK+.RCARA
;Returns +1 always

FNDUAC:	HLRZ T1,REQFRK+NXTBLK	;Get target fork number
	ADD T1,PSBPG		;Here's where the PT,,PSB will be
	MOVEI T2,PSB		;Put result here
	CALL XPEEK1		;(T1,T2/) Get that word
	 RET			;Return owie!
	HRRZ T1,PSB		;Get PSB address
	ADD T1,MONSPT		;Off set into SPT
	MOVEI T2,UACS		;Put SPT entry here briefly
	CALL XPEEK1		;(T1,T2/) Get that word from the monitor
	 RET			;I don't get it!
	HLRZ T1,UACS		;Get what we just read
	TRNE T1,77		;Was the PSB swapped out?
	RET			;Yes, oh well, return

;We now have the physical location of the user's ACs

	HRRZ T1,UACS		;Get physical page of user ACs
	LSH T1,PGSFT		;Shift to a page
	ADD T1,ACB		;AC block starts at this offset
	MOVEI T2,5		;Read only some of the ACs
	MOVEI T3,UACS		;Put them here
	CALL PHYRED		;(T1,T2,T3/) Read physical memory
	MOVE T2,UACS+2		;Load AC2 from user
	MOVEM T2,.GECFL(Q1)	;Save CRDIR% flags
	RETSKP			;Return +2
	SUBTTL Subroutines -- CRDIR Snooping -- Get Directory String

;This routine is called to read the string that the user supplied to the CRDIR%
;JSYS.  Note, this routine has severe limitations at the current time. It
;assumes that string is coming from section zero of the calling process. The
;correct thing to do is check for a section, go through USECTB and then find
;the page. This could take a long time if there are indirect pointers. For now,
;this will do.
;Call with Q1/ ARGBLK+.RCARA
;Returns +1 always

STRGET:	HLRZ T1,PSB		;Get SPT index for user page table
	ADD T1,MONSPT		;Load address where the page table is
	MOVEI T2,SPTENT		;Put the data here please
	CALL XPEEK1		;(T1,T2/) Get it from monitor
	 RET			;It failed!  How can this be?
	HLRZ T1,SPTENT		;Get swap status
	TRNE T1,77		;Page table swapped out?
	RET			;Yes, let this happen
	HRRZ T1,SPTENT		;Get physical page number
	LSH T1,PGSFT		;Make real address
	HRRZ T2,UACS+1		;Get address of byte pointer
	LSH T2,-PGSFT		;Just get page number
	ADD T1,T2		;Now we have then entry we want
	USRIO%			;Be a monitor (almost)
	 ERJMP R		;Shouldna happen
	PMOVE T2,T1		;Get page table entry
	 ERJMP R		;Owie
	JRSTF @[.+1]		;No longer in I/O mode

;Another assumption: we assume that the string is coming out of a private page
;from user space. If not, pointers would have to be chased.

	HRRZ T1,T2		;Just get physical page
	LSH T1,PGSFT		;Make it an address
	HRRZ T2,UACS+1		;Get the address the user specified back
	ANDI T2,777		;Just get offset in the page
	ADD T1,T2		;String should start here
	MOVEI T2,^D11		;Get eleven words from user space
	MOVE T3,ARGBLK+.RCARA	;Load arg block address
	MOVEI T3,.GEDIR(Q1)	;Get block for STR:<DIRECTORY> string
	CALLRET PHYRED		;(T1,T2,T3/) Go read string and return
	SUBTTL Subroutines -- CRDIR Snooping -- Get User Argument Block

;This routine gets the user's argument block that he is passing to CRDIR%.
;Call with Q1/ ARGBLK+.RCARA
;Returns +1 always

BLKGET:	HLRZ T1,PSB		;Get SPT index for user page table
	ADD T1,MONSPT		;Here's where the page table is
	MOVEI T2,SPTENT		;Here's where to put the data
	CALL XPEEK1		;(T1,T2/) Peek a word from the monitor
	 RET			;Big trouble in River City
	HLRZ T1,SPTENT		;Get swap status
	TRNE T1,77		;Page table swapped out?
	RET			;Yes, let this happen
	HRRZ T1,SPTENT		;Get physical page number
	LSH T1,PGSFT		;Make real address
	HRRZ T2,UACS+2		;Get address of argument block
	LSH T2,-PGSFT		;Just get page number
	ADD T1,T2		;Now we have then entry we want
	USRIO%			;Be a monitor (almost)
	 ERJMP R		;Shouldna happen
	PMOVE T2,T1		;Get page table entry
	 ERJMP R		;Wrong microcode
	JRSTF @[.+1]		;No longer in I/O mode

;Another assumption: we assume that the block is coming out of a private page
;from user space. If not, pointers would have to be chased.

	HRRZ T1,T2		;Just get physical page
	LSH T1,PGSFT		;Make it an address
	HRRZ T2,UACS+2		;Get address user furnished back
	ANDI T2,777		;Just get offset
	ADD T1,T2		;String should start here
	MOVEI T2,^D25		;Read twenty five words today
	MOVEI T3,.GECAB(Q1)	;Point to block containing CRDIR% argument
	CALLRET PHYRED		;(T1,T2,T3/) Go read block and return
	SUBTTL Subroutines -- CRDIR Snooping -- Read Physical Memory

;Routine to read words from monitor's physical memory into specified
;spot in user space.
;Call with:
;	T1/ Physical address in the monitor to start
;	T2/ Number of words
;	T3/ Place to start storing in user space
;	T4/ smashed
;Returns +1 - always with data in

PHYRED:	USRIO%			;Pretend we are the monitor
	 ERJMP R		;Should not ever happen
PHYRD0:	PMOVE T4,T1		;Get word phyically
	 ERJMP R		;KL microcode rev level too low
	MOVEM T4,(T3)		;Save in space we are supposed to
	AOS T1			;Next spot to read
	AOS T3			;Next spot to store
	SOJG T2,PHYRD0		;Loop for all words
	JRSTF @[R]		;Get out of I/O mode and return

;Here to perform XPEEK function.
;Call XPEEK1 for one word, XPEEKX for N words, with:
;	T1/ monitor address
;	T2/ user address
;	T3/ count of words (XPEEKX only)
;Returns +1 if error
;Returns +2 if OK

XPEEK1:	MOVEI T3,1		;Load a one for one word
XPEEKX:	DMOVEM T1,XPKBLK+.XPMAD	;Save monitor and user address (.XPUAD)
	MOVEM T3,XPKBLK+.XPCN1	;Save word count
	DMOVE T1,[EXP .XPUAD+1,.XPPEK] ;Size of arg block and function code
	DMOVEM T1,XPKBLK+.XPABL	;Save as first two words of argument block
	MOVEI T1,XPKBLK		;Point to block now
	XPEEK%			;Peek at the monitor
	 ERJMP R		;Return +1 if error
	RETSKP			;Return +2 if not
	SUBTTL Subroutines -- CRDIR Snooping -- Snoop Monitor Symbols

;Routine to SNOOP% out the monitor symbols we need.
;Returns +1 Always

SNOOPM:	MOVEI T1,.SNPSY		;Get address of ...
	MOVE T2,[RADIX50 0,FKPGS] ;... this monitor symbol
	SETZ T3,		;Search entire symbol table
	SNOOP%			;Get address
	 ERJMP SNOOPE		;Fatal error
	MOVEM T2,PSBPG		;Save for later

	MOVEI T1,.SNPSY		;SNOOP% another symbol
	MOVE T2,[RADIX50 0,GETOKF] ;ACJ queue pointer
	SETZ T3,		;Search whole symbol table
	SNOOP%			;Get address
	 ERJMP SNOOPE		;Oh no
	MOVEM T2,GETOKQ		;Save address of GETOK% queue

	MOVEI T1,.SNPSY		;Get next symbol
	MOVE T2,[RADIX50 0,SPT]	;Find the SPT
	SETZ T3,		;Zap this
	SNOOP%			;Get the address
	 ERJMP SNOOPE
	MOVEM T2,MONSPT		;Save SPT address here

	MOVEI T1,.SNPSY		;Get symbol
	MOVE T2,[RADIX50 0,UAC]	;This symbol is in PSB
	SETZ T3,		;Search whole symbol table
	SNOOP%			;Get address
	 ERJMP SNOOPE		;Fatal
	ANDI T2,777		;Only want relative offset in PSB
	MOVEM T2,ACB		;Save AC block offset here
	RET			;We are ready!

SNOOPE:	OJSERR (<Could not snoop monitor symbols>)
	RET
	SUBTTL End of ACJUSR

;Literals

USRLIT:	XLIST
	LIT
	LIST

;Get globular symbols

	GGLOBS

	END