Google
 

Trailing-Edge - PDP-10 Archives - BB-L014X-BM_1990 - t20src/acjdec.mac
There are 9 other files named acjdec.mac in the archive. Click here to see a list.
;RIP:<7.UTILITIES>ACJDEC.MAC.1248  4-Apr-89 20:14:57, Edit by GSCOTT
;(125) Sweep log file cache at time that system is going to be shutdown.
;RIP:<7.UTILITIES>ACJDEC.MAC.1235 30-Mar-89 11:59:54, Edit by GSCOTT
;(124) Substitute "*" in log file name for the current time.
;RIP:<7.UTILITIES>ACJDEC.MAC.1230 30-Mar-89 10:57:16, Edit by GSCOTT
;(123) Read LSN ACCESS.CONTROL files for feeble users.
;RIP:<7.UTILITIES>ACJDEC.MAC.1227 29-Mar-89 15:33:03, Edit by GSCOTT
;(122) Small log file fixes, cause entry into MDDT to sweep the log file cache.
;RIP:<7.UTILITIES>ACJDEC.MAC.1215 29-Mar-89 11:52:00, Edit by GSCOTT
;(121) Check for user deletion of access.control file to flush cache.
;RIP:<7.UTILITIES>ACJDEC.MAC.1210 29-Mar-89 01:44:11, Edit by GSCOTT
;(120) Write summary info to log file when closing it.
;RIP:<7.UTILITIES>ACJDEC.MAC.1193 29-Mar-89 00:16:04, Edit by GSCOTT
;(116) Fix log file line counter.
;RIP:<7.UTILITIES>ACJDEC.MAC.1183 28-Mar-89 23:31:06, Edit by GSCOTT
;(115) Look for filename first in cache flush of access.control files.
;RIP:<7.UTILITIES>ACJDEC.MAC.1178 28-Mar-89 22:38:19, Edit by GSCOTT
;(114) Add counter for cache flushes.
;RIP:<7.UTILITIES>ACJDEC.MAC.1159 28-Mar-89 10:50:17, Edit by GSCOTT
;(113) Log file cache sweep interval of zero disables the cache.
;RIP:<7.UTILITIES>ACJDEC.MAC.1157 28-Mar-89 10:43:02, Edit by GSCOTT
;(112) Make the log buffer three pages.
;RIP:<7.UTILITIES>ACJDEC.MAC.1155 24-Mar-89 02:13:10, Edit by GSCOTT
;(111) Implement the access control cache.
;RIP:<7.UTILITIES>ACJDEC.MAC.1083 21-Mar-89 17:20:03, Edit by GSCOTT
;(110) Sweep log file cache if reading log file, get new log file if renaming.
;RIP:<7.UTILITIES>ACJDEC.MAC.1070 20-Mar-89 13:31:36, Edit by GSCOTT
;(107) Implement the log file cache.
;RIP:<7.UTILITIES>ACJDEC.MAC.1042  2-Feb-89 10:23:25, Edit by GSCOTT
;(101) Don't output cap mask if job 0 in LOGSTA routine.
;RIP:<7.UTILITIES>ACJDEC.MAC.1040  1-Feb-89 11:38:29, Edit by GSCOTT
;(100) Bug in TAKCHK broke TAKE command lines over half the buffer size.
;RIP:<7.UTILITIES>ACJDEC.MAC.1039 31-Jan-89 18:23:01, Edit by GSCOTT
;(77) Make the log files secure when writing them.
;RIP:<7.UTILITIES>ACJDEC.MAC.1037 30-Jan-89 10:54:49, Edit by GSCOTT
;(75) Don't output bad information in spy file trailer.
;RIP:<7.UTILITIES>ACJDEC.MAC.1036 30-Jan-89 10:22:08, Edit by GSCOTT
;(74) Kill all inferior forks when crashing.
;RIP:<7.UTILITIES>ACJDEC.MAC.1033 30-Jan-89 10:02:23, Edit by GSCOTT
;(73) Output spy filename to log file if we can't open the spy file.
;RIP:<7.UTILITIES>ACJDEC.MAC.1031 26-Jan-89 11:20:21, Edit by GSCOTT
;(72) Add NOSECURE keyword to ACCESS.CONTROL
;RIP:<7.UTILITIES>ACJDEC.MAC.1030 26-Jan-89 10:07:01, Edit by GSCOTT
;(71) Add DENY-CTY and LOGIN-CTY support.
;RIP:<7.UTILITIES>ACJDEC.MAC.1028 24-Jan-89 17:01:52, Edit by GSCOTT
;(67) Make job information blocks, clean up attach and login policy code.
;RIP:<7.UTILITIES>ACJDEC.MAC.1010 19-Jan-89 22:50:33, Edit by GSCOTT
;(66) Fill text displayed by the SHOW command.
;RIP:<7.UTILITIES>ACJDEC.MAC.999 19-Jan-89 21:21:06, Edit by GSCOTT
;(65) Fill command lines output by the WRITE command.
;RIP:<7.UTILITIES>ACJDEC.MAC.996 19-Jan-89 17:46:14, Edit by GSCOTT
;(64) Improve logging of illegal requests.
;RIP:<7.UTILITIES>ACJDEC.MAC.985 19-Jan-89 13:28:48, Edit by GSCOTT
;(63) Add support for user functions.
;RIP:<7.UTILITIES>ACJDEC.MAC.982 12-Jan-89 23:12:28, Edit by GSCOTT
;(62) Ignore increment mount counts for ACJ just to be sure.
;RIP:<7.UTILITIES>ACJDEC.MAC.981 12-Jan-89 22:00:36, Edit by GSCOTT
;(60) Remove extra definition of RSKP, use MACREL's instead.
;RIP:<7.UTILITIES>ACJDEC.MAC.967  3-Jan-89 15:20:00, Edit by GSCOTT
;(51) Update copyright date.
;RIP:<7.UTILITIES>ACJDEC.MAC.966  3-Jan-89 15:18:48, Edit by GSCOTT
;(50) Add output in log file of number requests failed.
;RIP:<7.UTILITIES>ACJDEC.MAC.964  3-Jan-89 14:37:02, Edit by GSCOTT
;(47) Log more information for CRDIRs.
;RIP:<7.UTILITIES>ACJDEC.MAC.962 29-Dec-88 10:48:50, Edit by GSCOTT
;(45) Change policy to allow and log any secure operation if no ACCESS.CONTROL.
;RIP:<7.UTILITIES>ACJDEC.MAC.961 20-Dec-88 10:05:24, Edit by GSCOTT
;(41) Problem with previous edit (extra comma in BYTE 7 statement).
;RIP:<7.UTILITIES>ACJDEC.MAC.956 16-Dec-88 10:56:47, Edit by GSCOTT
;(40) Paginate the logging file.
;RIP:<7.UTILITIES>ACJDEC.MAC.955 14-Dec-88 18:50:16, Edit by GSCOTT
;(37) Add LOGIN-xxxx keywords to user profile.
;RIP:<7.UTILITIES>ACJDEC.MAC.950 14-Dec-88 17:56:36, Edit by GSCOTT
;(36) Restart ourselves if under job 0.
;RIP:<7.UTILITIES>ACJDEC.MAC.949 13-Dec-88 11:17:19, Edit by GSCOTT
;(35) Put username first in logging for easier reading.
;RIP:<7.UTILITIES>ACJDEC.MAC.948 12-Dec-88 14:04:11, Edit by GSCOTT
;(34) Add invisible bit when looking for ACCESS.CONTROL.
;RIP:<7.UTILITIES>ACJDEC.MAC.946  7-Dec-88 15:46:55, Edit by GSCOTT
;(32) In WRITE command only send keywords that differ from default enable bits.
;RIP:<7.UTILITIES>ACJDEC.MAC.940  7-Dec-88 01:33:04, Edit by GSCOTT
;(30) Implement DENY-xxx keywords for functions.
;RIP:<7.UTILITIES>ACJDEC.MAC.935  6-Dec-88 21:35:15, Edit by GSCOTT
;(27) Implement ALL as keyword in ACCESS.CONTROL, clean up here and there.
;RIP:<7.UTILITIES>ACJDEC.MAC.913  6-Dec-88 19:02:28, Edit by GSCOTT
;(26) Implement SET PRIME-TIME-BEGIN and SET PRIME-TIME-END
;RIP:<7.UTILITIES>ACJDEC.MAC.906  6-Dec-88 18:01:00, Edit by GSCOTT
;(25) Check for no functions enabled in SAVE command.
;RIP:<7.UTILITIES>ACJDEC.MAC.902  6-Dec-88 17:55:53, Edit by GSCOTT
;(24) Use TIME rather than HPTIM for uptime to prevent overflows after 4 days.
;RIP:<7.UTILITIES>ACJDEC.MAC.892  3-Dec-88 02:52:35, Edit by GSCOTT
;(23) OTIME routine needs to handle times in the range of days.
;RIP:<7.UTILITIES>ACJDEC.MAC.891  1-Dec-88 11:08:20, Edit by GSCOTT
;(22) Wrong AC tested in FINDIT after call to WTBLUK.
;RIP:<7.UTILITIES>ACJDEC.MAC.888 30-Nov-88 13:35:18, Edit by GSCOTT
;(21) Don't use TEXTBU in HDRLOG routine as logging routines could be using it.
;RIP:<7.UTILITIES>ACJDEC.MAC.883 30-Nov-88 10:05:27, Edit by GSCOTT
;(17) Add POLICY keyword.
;RIP:<7.UTILITIES>ACJDEC.MAC.880 29-Nov-88 17:34:19, Edit by GSCOTT
;(16) Move ACCESS.CONTROL code here, allow hyphen at end of line.
;RIP:<7.UTILITIES>ACJDEC.MAC.879 28-Nov-88 09:43:58, Edit by GSCOTT
;(14) Ignore errors from SPRIW.
;RIP:<7.UTILITIES>ACJDEC.MAC.872 22-Nov-88 20:27:01, Edit by GSCOTT
;(13) Support wild username specifications.
;RIP:<7.UTILITIES>ACJDEC.MAC.827 22-Nov-88 11:09:42, Edit by GSCOTT
;(12) Calculation of next midnight time was flawed.  Again.
;RIP:<7.UTILITIES>ACJDEC.MAC.817 21-Nov-88 21:12:02, Edit by GSCOTT
;(11) Another log file bug, smashed AC in NEWLOG.
;RIP:<7.UTILITIES>ACJDEC.MAC.811 21-Nov-88 15:12:38, Edit by GSCOTT
;(7) Statistics should be sent to log file.
;RIP:<7.UTILITIES>ACJDEC.MAC.807 21-Nov-88 14:29:59, Edit by GSCOTT
;(6) Repair setting timer interrupt in midnight routine.
;RIP:<7.UTILITIES>ACJDEC.MAC.801 20-Nov-88 22:53:48, Edit by GSCOTT
;(4) Suppress created symbol on ERSKP, support log file switch at midnight.
;RIP:<7.UTILITIES>ACJDEC.MAC.781 20-Nov-88 14:37:06, Edit by GSCOTT
;(3) Send JSYS error messages to log file if we have a log file JFN.
;RIP:<7.UTILITIES>ACJDEC.MAC.770 20-Nov-88 12:24:13, Edit by GSCOTT
;(2) Fix problem with DISFNC.
;RIP:<GSCOTT>ACJDEC.MAC.768 20-Nov-88 12:04:50, Edit by GSCOTT
;(1) Creation.

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1988, 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 ACJDEC - Access Control Facility Profile and Policy Driver 
	SUBTTL Gregory A. Scott
	Subttl	Table of Contents

;		     Table of Contents for ACJDEC
;
;				  Section		      Page
;
;
;    1. General Comments . . . . . . . . . . . . . . . . . . .   5
;    2. Definitions
;        2.1    Environment  . . . . . . . . . . . . . . . . .   6
;        2.2    Version and Entry Vector . . . . . . . . . . .   7
;        2.3    Storage
;            2.3.1    Low Segment Pages  . . . . . . . . . . .   8
;            2.3.2    Low Segment Writable . . . . . . . . . .   9
;            2.3.3    High Segment Writable  . . . . . . . . .  13
;        2.4    Interrupt System . . . . . . . . . . . . . . .  14
;        2.5    Command GTJFN Blocks . . . . . . . . . . . . .  16
;        2.6    Command State Block  . . . . . . . . . . . . .  18
;        2.7    Command Tables . . . . . . . . . . . . . . . .  19
;        2.8    Set Command Tables . . . . . . . . . . . . . .  20
;    3. Commands
;        3.1    Initialization . . . . . . . . . . . . . . . .  21
;        3.2    Top Level  . . . . . . . . . . . . . . . . . .  22
;        3.3    Disable Command  . . . . . . . . . . . . . . .  23
;        3.4    Enable Command . . . . . . . . . . . . . . . .  24
;        3.5    Help Command . . . . . . . . . . . . . . . . .  25
;        3.6    Save Command . . . . . . . . . . . . . . . . .  26
;        3.7    Set Command  . . . . . . . . . . . . . . . . .  27
;            3.7.1    Access Log File  . . . . . . . . . . . .  28
;            3.7.2    Log File Cache Sweep Interval  . . . . .  29
;            3.7.3    Prime Time . . . . . . . . . . . . . . .  30
;            3.7.4    Spy Check Interval . . . . . . . . . . .  31
;            3.7.5    Spy Log Directory  . . . . . . . . . . .  32
;        3.8    Show Command . . . . . . . . . . . . . . . . .  33
;            3.8.1    Show Functions . . . . . . . . . . . . .  34
;            3.8.2    Show Settings  . . . . . . . . . . . . .  36
;            3.8.3    Show User  . . . . . . . . . . . . . . .  37
;            3.8.4    Show Text On Terminal  . . . . . . . . .  40
;        3.9    Take Command . . . . . . . . . . . . . . . . .  41
;        3.10   User Command . . . . . . . . . . . . . . . . .  44
;        3.11   Write Command  . . . . . . . . . . . . . . . .  47
;            3.11.1   Write Settings . . . . . . . . . . . . .  49
;            3.11.2   Write User Profiles  . . . . . . . . . .  50
;            3.11.3   Write Function Profiles  . . . . . . . .  51
;            3.11.4   File Header  . . . . . . . . . . . . . .  52
;            3.11.5   Fill and Write Line to File  . . . . . .  53
;            3.11.6   Open/Close File  . . . . . . . . . . . .  54
;        3.12   Command Subroutines  . . . . . . . . . . . . .  55
	Subttl	Table of Contents (page 2)

;		     Table of Contents for ACJDEC
;
;				  Section		      Page
;
;
;    4. Access Control
;        4.1    Initialization . . . . . . . . . . . . . . . .  56
;            4.1.1    Capabilities and Interrupts  . . . . . .  57
;            4.1.2    Configuration  . . . . . . . . . . . . .  58
;            4.1.3    Access Control Functions . . . . . . . .  59
;        4.2    Processing Loop  . . . . . . . . . . . . . . .  61
;            4.2.1    Find Function Profile  . . . . . . . . .  62
;            4.2.2    Find User Profile  . . . . . . . . . . .  63
;            4.2.3    Check Request  . . . . . . . . . . . . .  64
;            4.2.4    Wait for failure . . . . . . . . . . . .  65
;            4.2.5    Log Request  . . . . . . . . . . . . . .  66
;        4.3    Subroutines
;            4.3.1    Wild TBLUK Routine . . . . . . . . . . .  67
;            4.3.2    Get User Information . . . . . . . . . .  68
;    5. Logging Routines
;        5.1    Midnight Timer Routines  . . . . . . . . . . .  72
;        5.2    System Shutdown Time Routines  . . . . . . . .  73
;        5.3    Initialization of Log File . . . . . . . . . .  75
;        5.4    Send Text to Log File  . . . . . . . . . . . .  78
;        5.5    Log File Cached Write  . . . . . . . . . . . .  79
;        5.6    Log File Cache Sweep Interrupts  . . . . . . .  80
;        5.7    Log File Cache Sweep . . . . . . . . . . . . .  81
;        5.8    Open/Close/Checkpoint Log File . . . . . . . .  82
;        5.9    New Page for Log File  . . . . . . . . . . . .  83
;        5.10   Statistics Logging . . . . . . . . . . . . . .  84
;        5.11   Start Logging a Request  . . . . . . . . . . .  87
;    6. Spy on Intruder  . . . . . . . . . . . . . . . . . . .  88
;        6.1    Start a Spy Fork . . . . . . . . . . . . . . .  89
;        6.2    Kill Spy Fork  . . . . . . . . . . . . . . . .  91
;        6.3    Start a Spy Fork
;            6.3.1    Get a Spy File . . . . . . . . . . . . .  92
;            6.3.2    Get a PTY  . . . . . . . . . . . . . . .  94
;        6.4    Spy Fork
;            6.4.1    Initialization . . . . . . . . . . . . .  95
;            6.4.2    Main Loop  . . . . . . . . . . . . . . .  96
;            6.4.3    Spy File I/O Routines  . . . . . . . . .  97
;            6.4.4    Error Recovery and Termination . . . . .  98
;            6.4.5    Timer Interrupts . . . . . . . . . . . .  99
;            6.4.6    Setup Spy Link . . . . . . . . . . . . . 100
;        6.5    Spy File Header/Trailer  . . . . . . . . . . . 101
;        6.6    Inferior Fork Termination Interrupt  . . . . . 102
	Subttl	Table of Contents (page 3)

;		     Table of Contents for ACJDEC
;
;				  Section		      Page
;
;
;    7. Secure Files . . . . . . . . . . . . . . . . . . . . . 103
;        7.1    Find File's Entry  . . . . . . . . . . . . . . 104
;        7.2    Check Desired Access . . . . . . . . . . . . . 105
;        7.3    Access Keywords  . . . . . . . . . . . . . . . 106
;        7.4    Access Control Cache . . . . . . . . . . . . . 107
;            7.4.1    Open File  . . . . . . . . . . . . . . . 108
;                7.4.1.1    Split Filename . . . . . . . . . . 109
;                7.4.1.2    Cache Find . . . . . . . . . . . . 110
;                7.4.1.3    Cache Stale Check  . . . . . . . . 111
;                7.4.1.4    Cached Open  . . . . . . . . . . . 112
;                7.4.1.5    Cached Input Setup . . . . . . . . 114
;            7.4.2    Close File
;                7.4.2.1    Read Finished  . . . . . . . . . . 115
;                7.4.2.2    Flush Cache  . . . . . . . . . . . 116
;        7.5    Action for Successful Access . . . . . . . . . 117
;        7.6    Read Line from File  . . . . . . . . . . . . . 119
;        7.7    Read Character from File . . . . . . . . . . . 120
;        7.8    Read Character from Line Buffer  . . . . . . . 121
;        7.9    Read Field from Line Buffer  . . . . . . . . . 122
;    8. Subroutines
;        8.1    Simulate STCMP . . . . . . . . . . . . . . . . 123
;        8.2    Simulate SOUT  . . . . . . . . . . . . . . . . 124
;    9. Output Subroutines
;        9.1    Output Information about Job . . . . . . . . . 125
;        9.2    Output Username/Device/Filename  . . . . . . . 126
;        9.3    Output Capability Mask . . . . . . . . . . . . 127
;        9.4    Small Output Routines  . . . . . . . . . . . . 128
;        9.5    Output Sixbit Word . . . . . . . . . . . . . . 129
;        9.6    Output Numbers . . . . . . . . . . . . . . . . 130
;        9.7    Output Floating Point Numbers  . . . . . . . . 132
;        9.8    Output Millisecond Times . . . . . . . . . . . 133
;        9.9    Output Standard Date/Time  . . . . . . . . . . 135
;        9.10   Output JSYS Error Message  . . . . . . . . . . 136
;   10. Error Handler
;       10.1    Error Messages . . . . . . . . . . . . . . . . 137
;       10.2    Panic and Control-C Interrupt  . . . . . . . . 138
;       10.3    Crash Handler  . . . . . . . . . . . . . . . . 139
;   11. End of ACJDEC  . . . . . . . . . . . . . . . . . . . . 142
	SUBTTL General Comments

	COMMENT ~

This Access Control Facility operates in two phases.  In the first ("profile")
phase, commands are entered to set up a database of which GETOK functions are
desired and which users need special treatment.  In the second ("policy") phase
the program implements the policy specified in the first phase by running as
the system access control facility.

This is the ACJDEC module.  This module of the access control facility
implements the initial phase (profile phase).  After the policy profile data
has been specified, a command generates a runnable ACJ.EXE which implements the
policy.

The ACJDEC module also contains the core Access Control Facility policy
program, which gets access control requests from the monitor and implements the
policy specified in the profile phase.  This module also contains subroutines
called by this module in the profile and policy phases.  These subroutines are
also called by the ACJUSR module.

The design of the program allows site specific policy implementations and
access control functions to be changed in the ACJUSR module.  It is expected
that any site should not have to change any code in the ACJDEC module,
particularly in the core access control code.  The ACJSYM module contains all
symbols that need to be shared between ACJDEC and ACJUSR.

This program was written in November 1988 by Gregory A. Scott, Digital
Equipment Corporation, Marlboro, Massachusetts.

Future enhancements to consider:
	Write logfiles with date and/or time included in filespec.
	Create some kind of idle job killer functionality.
	~
	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

	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 -- Version and Entry Vector

;Set copyright.

	.CPYRT <<1989>>		;Use the usual copyright macro there

;Define the entry vector

EV:	JRST START		;Normal start
	JRST START		;Reenter start
	EXP VACJ		;Version
	EVLEN==.-EV		;Length of entry vector
	SUBTTL Definitions -- Storage -- Low Segment Pages

;[107] This section defines pages allocated in the low segment.
;[107] Pages 0-77 and 400-477 are reserved for code.

	FLPAGE==000		;[107] First page allocated to low code
	LLPAGE==077		;[107] Last page allocated to low code
	FHPAGE==400		;[107] First page allocated to high code
	LHPAGE==477		;[107] Last page allocated to high code

	APAGE==LLPAGE+1		;[111] Start at page after low code

;[107] Define a macro to allocate pages in memory.

DEFINE ALLOCP (ASIZE,SYMBPG,SYMBBU,SYMBLP),< ;[107]
	IFL APAGE-<LHPAGE+1>,<	;[111] If current free page in low sen
	  IFGE <APAGE+ASIZE>-FHPAGE,< ;[111] and not enough space for block
	    APAGE==LHPAGE+1>>	;[111] Switch to high sec
	IFG <APAGE+ASIZE-1>-777,< ;[111] No more memory?
	  PRINTX ? Too much buffer space allocated
	  PASS2			;[107] Punt
	  END			;[107]  and get out of here
	>			;[107] End of IFE APAGE-LLPAGE
	IFNB <SYMBPG>,<SYMBPG==APAGE> ;[120] Define first page number if needed
	IFNB <SYMBLP>,<SYMBLP==APAGE+ASIZE-1> ;[120] Last page of buffer
	SYMBBU=APAGE_PGSFT	;[121] Address of page map buffer
	APAGE==APAGE+ASIZE	;[111] Point to next free page
>				;[107] End of DEFINE ALLOCP

;[111] First allocate pages for the access control file cache buffers.

	DEFINE ALLOCC(A),<ALLOCP (SCACHE,<CBXF'A>,<CBX'A>,<CBXL'A>)> ;[111] 
	......==0		;[111] Start with zero
	REPEAT NCACHE,<		;[111] For each cache entry
	  ALLOCC(\......)	;[111] Allocate the pages for it
	  ......==......+1>	;[111]  and count to next entry

;Now allocate some other page aligned space.

	ALLOCP (LOGBPC,LOGBFP,LOGBUF,LOGBLP) ;[112] Log file cache buffer
	ALLOCP (1,SECOPG,SECOBU,) ;[120] Map access.control overflow pages here
	ALLOCP (1,,TEXTBU,)	;[120] Place to put text into
	ALLOCP (1,,HEADBU,)	;[120] Place to make header text into
	SUBTTL Definitions -- Storage -- Low Segment Writable

	LOWCD			;Low segment code

;Misc storage.

STACK:	BLOCK PLEN		;Program stack
TEXTBP:	BLOCK 1			;Pointer into TEXTBU

;Storage used in statistics gathering.

NALLOW:	BLOCK 1			;Number of GETOKs allowed
NDENY:	BLOCK 1			;Number of GETOKs denied
NFAIL:	BLOCK 1			;Number of requests that failed
NHIT:	BLOCK 1			;[111] Number of access control cache hits
NMISS:	BLOCK 1			;[111] Number of access control cache misses
NFLUSH:	BLOCK 1			;[114] Number of access control cache flushes
RUNTIM:	BLOCK 1			;Program initial run time
PEOPLE:	BLOCK 1			;Program initial connect time

;Storage used in error reporting and crashing.

ERRBUF:	BLOCK ^D400/5		;Place to make error strings
ERRADR:	BLOCK 1			;Address of error string to print
LASERR:	BLOCK 1			;Last error at time of crash
BUGACS:	BLOCK 20		;ACs at time of crash
BUGPDL:	BLOCK BUGLEN		;Stack for the crash
BUGFIL:	BLOCK ^D<7+4+6+6+7+4+1>/5 ;Place to build filename

;Configuration information

TTYPTY:	BLOCK 1			;TTY number of first PTY
MAXPTY:	BLOCK 1			;Number of PTYs
CTYLNO:	BLOCK 1			;Line number of the CTY
OURNAM:	BLOCK 2			;Place to keep our ASCIZ node name
OPRUNO:	BLOCK 1			;User number of OPERATOR
OURUNO:	BLOCK 1			;User number of runner of profile generator
OURJOB:	BLOCK 1			;Our job number (0 or global job number)
LOGFIL:	BLOCK ^D<40*5>/5	;Log file name
PRIMEB:	BLOCK 1			;Time that prime time begins
PRIMEE:	BLOCK 1			;Time that prime time ends
;Storage used for access control housekeeping.

ARGBLK:	BLOCK ARGLEN		;RCVOK argument block
USRSTR:	BLOCK ^D<40*2>/5	;Store a username here
TODCLK:	BLOCK 1			;[107] Uptime at the time of the last request

;Job information blocks

JIBLK:	BLOCK JISIZ		;GETJI information for source job
CJBLK:	BLOCK JISIZ		;Controlling job information block
TJBLK:	BLOCK JISIZ		;Target job information block

;Storage used in remembering user profile.
;NOTE:	Offset in right half of USRKEY is the index into USRPRO.
;	Relative address in USRKEY is the index into USRNUM.

USRTBL:	BLOCK 1			;TBLUK table of [ASCIZ/user/],,profile offset
USRKEY:	BLOCK NUSERS		;Data for USRTBL
USRSTG:	BLOCK NUSERS*<USRCHR/5>	;ASCIZ username strings
USRPRO:	BLOCK NUSERS		;Profile word for each user in table
;Storage used in writing the log file.

LOGLIN:	BLOCK 1			;Place to keep number of lines on this page
LOGPAG:	BLOCK 1			;Place to keep page number of this log file
LOGJFN:	BLOCK 1			;Place to keep the log file JFN
LOGPTR:	BLOCK 1			;[107] Pointer into log buffer
LOGCNT:	BLOCK 1			;[107] Count of freespace remaining in LOGBUF
LOGINT:	EXP -1			;[113] Interval in seconds between sweeps
LOGFNA:	BLOCK ^D<5*40>/5	;[110] Currently open log file name
LOGFTI:	BLOCK ^D<2+1+3+1+4+1+2+1+2+1+2+1+1>/5 ;[124] Time used in log filename
LOGHSY:	BLOCK 1			;[125] Time that system is expected to HSYS

;Storage used in intruder spy facility.

SPYSLD:	BLOCK ^D160/5		;Spy log directory
SPYFIL: BLOCK ^D160/5		;Place to build temp string for filename
SPYINT:	BLOCK 1			;Interval between spy fork checks
	SPYFWZ==.		;First word to zero
SPYFRK:	BLOCK NSPYS		;Save inferior handles here
SPYJOB:	BLOCK NSPYS		;Job fork is watching
SPYUSR:	BLOCK NSPYS		;Usernumber that fork is monitoring
SPYJFN:	BLOCK NSPYS		;Log file JFN,,PTY JFN
SPYPDL:	BLOCK NSPYS*SPLEN	;Stacks for the spy forks
	SPYLWZ==.-1		;Last word to zero
;Storage used in ACCESS.CONTROL routines.

SECGTJ:	BLOCK .GJNOD+1		;Place to build long form GTJFN 
SECDIR:	BLOCK ^D<40*3>/5	;[111] Place to build "str:<directory>"
SECFNA:	BLOCK ^D<40*5>/5	;Place to build "file.type.gen"
SECFNV:	BLOCK ^D<40*5>/5	;[115] Place to build "file.type"
SECWRD:	BLOCK ^D<40*5>/5	;Place to read a field into
SECUSR:	BLOCK ^D<40*2>/5	;[115] Place to construct username
SECLIN:	BLOCK SECCPL		;Place to read in the access control line
SECPMP:	BLOCK 1			;Page of file that is mapped now
SECPCT:	BLOCK 1			;Count of pages left to map
SECBCT:	BLOCK 1			;Byte count of mapped data area
SECBPT:	BLOCK 1			;Pointer into mapped data area

;[111] Access control cache blocks

	DEFINE ALLOCC(A),<
	XLIST			;[121] Turn listing off
	PHASE 0			;[111] Start definition of cache block
CBXJFN:!BLOCK 1			;[111] JFN of this file
CBXCTL:!BLOCK 1			;[111] FBCTL word of file
CBXPTR:!POINT 7,CBX'A		;[111] Byte pointer to read cached buffer
CBXPAG:!XWD .FHSLF,CBXF'A	;[111] Page number of the buffer
CBXMAP:!BLOCK 1			;[111] Page count of cached file pages
CBXPCT:!BLOCK 1			;[111] Page count of entire file
CBXRTI:!BLOCK 1			;[111] Uptime at time that file was referenced
CBXMTI:!BLOCK 1			;[111] Uptime at time that file was mapped
CBXDIR:!BLOCK ^D<6+1+1+<39*2>+1+1>/5 ;[111] Directory where file lives
CBXFIL:!BLOCK ^D<6+1+1+<39*2>+1+6+1+7+1>/5 ;[115] str:<dir>access.control
CBXSIZ:!			;[111] Define size of the block
	DEPHASE			;[111] Get back to normal addressing
	LIST			;[121] Turn listing on
>				;[111] End of DEFINE ALLOCC

CBPOOL:	......==0		;[111] Start with zero
	REPEAT NCACHE,<		;[111] For each cache entry
	  ALLOCC(\......)	;[111] Allocate the storage for it
	  ......==......+1>	;[111]  and count to next entry
	SUBTTL Definitions -- Storage -- High Segment Writable

	HIGHCD			;High segment code/data

;Storage for command parsing

CMDBUF:	BLOCK <CBUFSZ==100>	;Command buffer
ATMBUF:	BLOCK <ABUFSZ==40>	;Atom buffer
GTJBLK:	BLOCK .GJATR+1		;Long form GTJFN buffer
CSBLOK:	BLOCK .CMGJB+1		;Command state block
CMTADB:	BLOCK 3			;Block to parse time into

LINWID:	BLOCK 1			;Width of the terminal for showing text
TAKJFN:	BLOCK 1			;Take file JFN
PRSJFN:	BLOCK 1			;JFN used while parsing
	SUBTTL Definitions -- Interrupt System

	LOWCD			;Low segment code

;First create macro to assign each channel we desire.
;If channel not specified assign one from the range 0-6.

DEFINE ASSCHN(LEV,CHN,ADR,NAM),< ;Level, channel, routine, symbol

	ONCHNS==ONCHNS!1B<^O<CHN>> ;Count this channel as one to enable

	IFNB <CHN>,<		;If channel specified
		CHAN'CHN==<LEV,,ADR> ;Construct this symbol for later
		IFNB <NAM>,<NAM==CHN> ;Name it if desired
	>			;End of IFNB <CHN>

	IFB <CHN>,<		;If we want to assign one
		ASSCHN(LEV,\FRECHN,ADR,NAM) ;Get one assigned and named
		FRECHN==FRECHN+1 ;Count up one channel
		IFE FRECHN-.ICAOV,< ;[125] If channel 0-5 now in use
			FRECHN==.ICNXP+1 ;[125] Jump over panics to chan 23
		>		;[125] End of IFE FRECHN-.ICAOV
	>			;End of IFB <CHN>

>				;End of DEFINE ASSCHN

	FRECHN==0		;Start assigning with channel zero
	ONCHNS==0		;Start with no channels enabled

;Macro to grow the channel table from definitions set with ASSCHN.

DEFINE CHNGEN,<			;Macro to expand channel table
	DEFINE PLANTC(NUM),<	;Macro to generate CHNTAB entry
		XLIST		;Stop listing momentarily
		IFNDEF CHAN'NUM,<EXP 0>	;Zero if no assignment
		IFDEF CHAN'NUM,<EXP CHAN'NUM> ;Plant one channel table entry
		LIST		;Resume listing now
		......==......+1 ;Ratchet the channel number by one
	>			;End of DEFINE PLANTC
	......==0		;Starting at channel 0
	REPEAT ^D36,<PLANTC (\......)> ;Plant each channel
>				;End of DEFINE CHNGEN

;Assign panic channels first.

	ASSCHN(1,\.ICPOV,PANIC)	;PDL overflows to PANIC
	ASSCHN(1,\.ICDAE,PANIC)	;Data errors to PANIC
	ASSCHN(1,\.ICQTA,PANIC)	;Disk full to PANIC
	ASSCHN(1,\.ICILI,PANIC)	;Ill inst to PANIC
	ASSCHN(1,\.ICIRD,PANIC)	;Ill mem read to PANIC
	ASSCHN(1,\.ICIWR,PANIC)	;Ill mem write to PANIC
	ASSCHN(1,\.ICMSE,PANIC)	;Sys resources exhausted to PANIC

;Assign other channels as needed.

	ASSCHN(1,,CNTRLC,CCCHAN) ;Control-C trap on same as panic channel
	ASSCHN(2,,MIDNIT,MDCHAN) ;Midnight interrupts
	ASSCHN(2,,INTLFF,LFCHAN) ;[107] Log file cache sweeps
	ASSCHN(2,,INTHSY,HFCHAN) ;[125] Hsys interrupt for log file sweep
	ASSCHN(3,\.ICIFT,FRKTRM) ;Inferior fork termination interrupt
	ASSCHN(3,,TIMINT,TICHAN) ;TIMER% interrupt (inferior fork use only)

;Make CHNTAB.

CHNTAB:	CHNGEN			;Generate channel table

;Set the level table here.

LEVTAB:	EXP LEV1PC		;Location to save level 1 PC return address
	EXP LEV2PC		;Location to save level 2 PC return address
	EXP LEV3PC		;Location to save level 3 PC return address

LEV1PC:	BLOCK 1			;Level 1 interrupt return PC
LEV2PC:	BLOCK 1			;Level 2 interrupt return PC
LEV3PC:	BLOCK 1			;Level 3 interrupt return PC
	SUBTTL Definitions -- Command GTJFN Blocks

	HIGHCD			;Back to high segment only code

;Save command GTJFN block

SAVGTJ:	GJ%FOU!GJ%MSG		;(.GJGEN) Flags and generation
	XWD .NULIO,.NULIO	;(.GJSRC) JFNs
	0			;(.GJDEV) Default device
	0			;(.GJDIR) Default directory
	POINT 7,[ASCIZ/ACJ/]	;(.GJNAM) Default file
	POINT 7,[ASCIZ/EXE/]	;(.GJEXT) Default type
	0			;(.GJPRO) Default protection
	0			;(.GJACT) Default account
	0			;(.GJJFN) Specified JFN
	0			;(.GJF2)  Additional flags

;Set Access-log-file command GTJFN block

ALFGTJ:	GJ%OFG			;(.GJGEN) Flags and generation parse only
	XWD .NULIO,.NULIO	;(.GJSRC) Jfns
	0			;(.GJDEV) Default device
	0			;(.GJDIR) Default directory
	0			;(.GJNAM) Default file
	0			;(.GJEXT) Default type
	0			;(.GJPRO) Default protection
	0			;(.GJACT) Default account
	0			;(.GJJFN) Specified JFN
	G1%SLN			;(.GJF2)  Additional flags

;Set Spy-log-directory command GTJFN block

SLDGTJ:	GJ%OFG			;(.GJGEN) Flags and generation parse only
	XWD .NULIO,.NULIO	;(.GJSRC) Jfns
	0			;(.GJDEV) Default device
	0			;(.GJDIR) Default directory
	0			;(.GJNAM) Default file
	0			;(.GJEXT) Default type
	0			;(.GJPRO) Default protection
	0			;(.GJACT) Default account
	0			;(.GJJFN) Specified JFN
	G1%SLN			;(.GJF2)  Additional flags
;Take command GTJFN block

TAKGTJ:	GJ%OLD			;(.GJGEN) Flags and generation
	XWD .NULIO,.NULIO	;(.GJSRC) Jfns
	0			;(.GJDEV) Default device
	0			;(.GJDIR) Default directory
	POINT 7,[ASCIZ/ACJPROFILE/] ;(.GJNAM) Default file
	POINT 7,[ASCIZ/CMD/]	;(.GJEXT) Default type
	0			;(.GJPRO) Default protection
	0			;(.GJACT) Default account
	0			;(.GJJFN) Specified JFN
	G1%IIN			;(.GJF2)  Additional flags

;Write command GTJFN block

WRIGTJ:	GJ%FOU!GJ%MSG		;(.GJGEN) Flags and generation
	XWD .NULIO,.NULIO	;(.GJSRC) Jfns
	0			;(.GJDEV) Default device
	0			;(.GJDIR) Default directory
	POINT 7,[ASCIZ/ACJPROFILE/] ;(.GJNAM) Default file
	POINT 7,[ASCIZ/CMD/]	;(.GJEXT) Default type
	0			;(.GJPRO) Default protection
	0			;(.GJACT) Default account
	0			;(.GJJFN) Specified JFN
	0			;(.GJF2)  Additional flags
	SUBTTL Definitions -- Command State Block

;Command state block template.

CSBTPL:	EXP COM2		;(.CMFLG) Reparse at COM2
	XWD .PRIIN,.PRIOU	;(.CMIOJ) Input and output JFNs
	POINT 7,[EXP ASCII "ACJDE",<BYTE(7)"C",76,0>] ;(.CMRTY) Ptr to prompt
	POINT 7,CMDBUF		;(.CMBFP) Pointer to start of buffer
	POINT 7,CMDBUF		;(.CMPTR) Pointer to next input
	EXP 5*CBUFSZ-1		;(.CMCNT) Count of space remaining after .CMPTR
	EXP 0			;(.CMINC) Number of unparsed chars after .CMPTR
	POINT 7,ATMBUF		;(.CMABP) Atom buffer pointer
	EXP 5*ABUFSZ-1		;(.CMABC) Atom buffer size in characters
	EXP GTJBLK		;(.CMGJB) Address of long form GTJFN block


;Break mask for user names when they are being read by CMKEY.

USRBRK:	EXP USRB0.,USRB1.,USRB2.,USRB3.
	SUBTTL Definitions -- Command Tables

;Command table - must be in alphabetical order
;	One entry for each command in the table
;	CMND(name,help,routine,noflag)

DEFINE COMGEN<
	XLIST
	CMND(DISABLE,<(function) ALL|name>,DODISA)
	CMND(ENABLE,<(function) ALL|name [profile]>,DOENAB)
	CMND(HELP,<(message)>,DOHELP)
	CMND(SAVE,<(program in) ACJ.EXE>,DOSAVE)
	CMND(SET,<(mode) keywords>,DOSET)
	CMND(SHOW,<ALL|FUNCTION [f]|SETTING [s]|USER [u]>,DOSHOW)
	CMND(TAKE,<(commands from) acjprofile.cmd.0>,DOTAKE)
	CMND(USER,<name [profile]>,DOUSER)
	CMND(WRITE,<(commands to) acjprofile.cmd.-1>,DOWRIT)
	LIST
>

;Command table suitable for use from COMND.

DEFINE CMND(A,B,C)<
	XWD [ASCIZ/A/],C
>

CMDTBL:	TBEGIN			;Insert table header
	COMGEN			;Generate top level keywords
	TEND			;Compute number of commands for header

;Table of keywords for HELP command.

DEFINE CMND(A,B,C)<
	[ASCIZ\  A 'B'
\]
>
COMHLP:	COMGEN			;Generate help text
	HLPNUM==.-COMHLP	;Set number of entries
	SUBTTL Definitions -- Set Command Tables

;Define a table of SET command keywords for setting and display

DEFINE SETGEN,<
	XLIST
	SETFUN(ACCESS-LOG-FILE,<Access Control log file>,<[-1,,LOGFIL]>,ISOUT,SETALF)
	SETFUN(LOG-FILE-CACHE-SWEEP-INTERVAL,<Log file cache sweep interval in seconds>,LOGINT,ODEC,SETLFI) ;[107]
	SETFUN(PRIME-TIME-BEGIN,<Prime time begin>,PRIMEB,OTOD,SETPTB)
	SETFUN(PRIME-TIME-END,<Prime time end>,PRIMEE,OTOD,SETPTB)
	SETFUN(SPY-CHECK-INTERVAL,<Spy check interval in seconds>,SPYINT,ODEC,SETSCI)
	SETFUN(SPY-LOG-DIRECTORY,<Spy log directory and file>,<[-1,,SPYSLD]>,ISOUT,SETSLD)
	LIST
>				;End of define SETGEN

;Table for SHOW SETTINGS command.

	DEFINE SETFUN(A,B,C,D,E),<XWD [ASCIZ/B is set to /],D>

SETSHT:	SETGEN			;Generate table of show text adr,,show routine
	SETNUM==.-SETSHT	;Compute load number in table

;Table for command keywords and storing the data.

	DEFINE SETFUN(A,B,C,D,E),<TENTRY(A,E)>
SETTBL:	TBEGIN			;Table header
SETKEY:	SETGEN			;Generate table
	TEND			;End of commands table

	DEFINE SETFUN(A,B,C,D,E),<EXP C>
SETDAT:	SETGEN			;Generate table of data to show

;Define a microtable used to string "SETTINGS" onto command keyword lists.

SHOTBL:	TBEGIN			;Plant the header
	TENTRY(ALL,DOSHOA)	;SHOW ALL
	TENTRY(FUNCTION,DOSHOF)	;SHOW FUNCTION function
	TENTRY(SETTINGS,DOSHOS)	;SHOW SETTINGS 
	TENTRY(USER,DOSHOU)	;SHOW USER user
	TEND			;Count that one keyword

;Define a microtable used to string "ALL" onto command keyword lists.

ALLTBL:	TBEGIN			;Plant the header
ALLKEY:	TENTRY(ALL,0)		;Just one keyword and that is all
	TEND			;Count that one keyword
	SUBTTL Commands -- Initialization 

	HIGHCD

;Here to start up the configuration phase of the program

START:	RESET%			;The world
	SETZ F,			;Load default flags
	MOVE P,[IOWD PLEN,STACK] ;Load stack pointer

	MOVE T1,[XWD CSBTPL,CSBLOK] ;Get BLT pointer for command state block
	BLT T1,CSBLOK+.CMGJB	;Move it to the command state block
	SETZM TAKJFN		;Not in a take file (any more)
	SETZM PRSJFN		;Not filename parsing (any more)

	MOVEI T1,NUSERS		;Load size of user table
	SKIPN USRTBL		;Is the user table already set up?
	MOVEM T1,USRTBL		;Save size of user table in the user table

	MOVEI T1,SPYDCI		;Load default spy interval
	SKIPN SPYINT		;Is one set?
	MOVEM T1,SPYINT		;Nope, set default

	MOVEI T1,LOGDCI		;[107] Load default spy interval
	SKIPGE LOGINT		;[113] Is one set (-1 at startup)?
	MOVEM T1,LOGINT		;[107] Nope, set default

	HRROI T1,LOGFIL		;Point to log file area
	HRROI T2,[ASCIZ/SYSTEM:LOGFILE.LOG/] ;Load default filespec
	SKIPN LOGFIL		;Is log file spec set up?
	CALL ISOUT		;(T1,T2/T1) Set it up now

	HRROI T1,SPYSLD		;Point to spy log file area
	HRROI T2,[ASCIZ/SYSTEM:ACJ-SPY/] ;Load default filespec
	SKIPN SPYSLD		;Is spy log file spec set up?
	CALL ISOUT		;(T1,T2/T1) Set it up now

	MOVEI T1,PRIMDB		;Load default begin time
	SKIPN PRIMEB		;Prime time begin set?
	MOVEM T1,PRIMEB		;No, set it now
	MOVEI T1,PRIMDE		;Load default end time
	SKIPN PRIMEE		;Prime time end set?
	MOVEM T1,PRIMEE		;No, set it now

	GJINF%			;Get this job's information
	MOVEM T1,OURUNO		;Save our user number for later
	MOVEI T1,.PRIIN		;Load primary terminal
	MOVEI T2,.MORLW		;Read line width
	MTOPR%			;Get the terminal line width
	 ERSKP.			;Skip if error
	CAIGE T3,^D40		;At least 40?
	MOVEI T3,^D40		;Don't look bad if width zero
	MOVEM T3,LINWID		;Save this here for later use

;	JRST COM1		;Start scanning commands
	SUBTTL Commands -- Top Level

;Here when ready to read a command from the terminal.

COM1:	MOVEI T2,[FLDDB. .CMINI] ;Get init function
	CALL COMANE		;(T2/T1,T2,T3) Do it

;See if we are doing a TAKE file and if so process another line out of it.

	CALL TAKCHK		;(/) Read a line from the TAKE file

;Here on a reparse

COM2:	SKIPE T1,PRSJFN		;Is there a parse JFN?
	RLJFN%			;Yes, release it please
	 ERNOP.			;Ignore errors
	SETZM PRSJFN		;No parse JFN any more

	MOVE P,[IOWD PLEN,STACK] ;Load stack pointer
	MOVEI T2,[FLDDB. .CMKEY,,CMDTBL,<a command,>] ;Point to commands
	CALL COMANE		;(T2/T1,T2,T3) Get a command
	HRRZ T2,(T2)		;Get dispatch address
	CALL (T2)		;(/) Do it
	JRST COM1		;Loop for more commands
	SUBTTL Commands -- Disable Command

;DISABLE (function) ALL|name

DODISA:	NOISE (function)	;Set noise words in front of the user
	MOVEI T2,[FLDDB. .CMKEY,,FUNTBL,<a function,>,,[
		  FLDDB. .CMKEY,CM%SDH,ALLTBL,<ALL for all functions>]]
	CALL COMANE		;(T2/T1-T3) Get a command
	HRRZ P3,(T2)		;Get the function code (or 0 for all)
	MOVEI P1,-FUNKEY(T2)	;Get address of enable bits
	CALL CONFIR		;(/) Confirm that please

;Single function specified, disable it and return.

	JUMPE P3,DODIS3		;Jump if ALL specified
	HRRZS FUNCTB(P1)	;Zero the left half of this entry
	RET			;Return

;All functions specified, disable all of them and return.

DODIS3:	MOVE T1,FUNAOB		;Load -number,,0
	DO.			;For each function
	  HRRZS FUNCTB(T1)	;Zero an entry into the table
	  AOBJN T1,TOP.		;Loop for all of them
	OD.			;End of clearing loop
	RET			;Return to get more commands
	SUBTTL Commands -- Enable Command

;ENABLE (function) ALL|name switch

DOENAB:	NOISE (function)	;Set noise words in front of the user
	MOVEI T2,[FLDDB. .CMKEY,,FUNTBL,<a function,>,,[
		  FLDDB. .CMKEY,CM%SDH,ALLTBL,<ALL for all functions>]]
	CALL COMANE		;(T2/T1-T3) Get a command
	HRRZ P3,(T2)		;Get the function code (or 0 for all)
	MOVEI P1,-FUNKEY(T2)	;Get offset for this function bits
	MOVE P2,ENADEF		;Load default bits to set in the mode word

;Parse profile keywords after function name.

DOENA1:	MOVEI T2,[FLDDB. .CMCFM,,,,,[
		FLDDB. .CMKEY,,ENATBL,<a profile keyword,>]]
	CALL COMANE		;(T2/T1-T3) Parse a switch or confirm
	LDB T3,[POINTR .CMFNP(T3),CM%FNC] ;Load the function parsed
	CAIN T3,.CMCFM		;Was it the confirm?
	JRST DOENA2		;Yep, it certainly was this time

	HRRZ T2,(T2)		;Load the address of the word with bits in it
	SKIPN T2,(T2)		;Skip if there is a bit to set
	IFSKP.			;There was a bit to set
	  TDO P2,T2		;Set the bit please
	  JRST DOENA1		;Loop until confirm seen
	ENDIF.			;Otherwise it must be "NO", parse keyword
	MOVEI T2,[FLDDB. .CMKEY,,ENANOT,<a profile keyword,>]
	CALL COMANE		;(T2/T1,T2,T3) Get the thing parsed
	HRRZ T2,(T2)		;Load address where the bits are
	TDZ P2,(T2)		;Clear specified bit
	JRST DOENA1		;Loop until confirm seen

;Bits for this function are now in P2, if single function set them and return.

DOENA2:	JUMPE P3,DOENA3		;Loop for all of them if ALL specified
	HLLM P2,FUNCTB(P1)	;Set bits the word where bits go today
	RET			;Return happily to the caller

;All functions specified, set each one of them with bits in P2 and return.

DOENA3:	MOVE T1,FUNAOB		;Load number of -functions,,0
DOENA4:	HLLM P2,FUNCTB(T1)	;Zero an entry into the table
	AOBJN T1,DOENA4		;Loop for all of them
	RET			;Return to get more commands
	SUBTTL Commands -- Help Command

;HELP (message)

DOHELP:	NOISE (message)		;Parse noise word por favor
	CALL CONFIR		;(/) Confirm the command, maybe log or echo it
	HRROI T1,TEXTBU		;Point to text buffer
	CALL OCRLF		;(T1/T1) Start with crlf
	HRROI T2,[VERSIO]	;Point to version string 
	CALL ISOUT		;(T1,T2/T1) Append version of this program 
	HRROI T2,HLPTXT		;Point to text
	CALL ISOUT		;(T1,T2/T1) Append that help text next
	CALL PTEXT		;(/) Print all of that on the terminal

	MOVSI T3,-HLPNUM	;Get number of elements in table
HELPLP:	HRRO T1,COMHLP(T3)	;Get pointer to help text
	PSOUT%			;Tell that one
	AOBJN T3,HELPLP		;Loop for all commands
	CALLRET PCRLF		;(/) Output extra crlf and return

HLPTXT:	ASCIZ/ commands:

/
	SUBTTL Commands -- Save Command

;SAVE (program in) ACJ.EXE

DOSAVE:	NOISE (program in)	;Mumble

;See if there is any functions enabled.

	MOVE T1,FUNAOB		;Load -number,,0
	MOVX T2,FU%ENA		;Load enable bits to test
	DO.			;For each function
	  TDNE T2,FUNCTB(T1)	;Is this function enabled?
	  EXIT.			;Get out, there is at least one enabled
	  AOBJN T1,TOP.		;Loop for all of them
	  EMSG <No functions enabled> ;This isn't making sense
	  RET			;Return now
	OD.			;So, there is at least function enabled	

;Parse the rest of the command.

	MOVE T1,[XWD SAVGTJ,GTJBLK] ;Make BLT pointer for source GTJFN
	BLT T1,GTJBLK+.GJF2	;Copy GTJFN block over there
	MOVEI T2,[FLDDB. .CMFIL,CM%SDH,,<filename to save into>]
	CALL COMANE		;(T1/T1-T3) Get filename
	MOVEM T2,PRSJFN		;Save JFN for a sec
	CALL CONFIR		;(/) Confirm that please

;Save ourselves as a runnable access control policy program.

	HRROI T1,TEXTBU		;Point to text buffer
	CALL OSPACE		;(T1/T1) Start with a space please
	MOVE T2,PRSJFN		;Load the JFN today
	CALL OJFNS		;(T1,T2/T1) Send the saved filename
	HRROI T2,[ASCIZ/ Saved
/]				;Label the preceeding filename
	CALL ISOUT		;(T1,T2/T1) Send that along as the end

	MOVEI T1,ASTART		;Load new start address
	HRRM T1,EV		;Save as new start address
IFE DBUGSW,HRRM T1,EV+1		; and as reenter address

	MOVE T1,PRSJFN		;Load the JFN back
	SETZM PRSJFN		;Don't try to release the JFN later
	HRLI T1,.FHSLF		;This fork
	MOVX T2,SS%CPY!SS%RD!SS%EXE!FLD(-SAVCNT,SS%NNP)!FLD(0,SS%FPN)
	SSAVE%			;Save our image
	 JSERRO (<Cannot create image>,,R) ;Owie!

	CALL PTEXT		;(/) Output the "saved" message

	HALTF%			;Halt the ACJ fork
	JRST .-1		;Don't allow continue
	SUBTTL Commands -- Set Command

;SET keyword value

DOSET:	MOVEI T2,[FLDDB. .CMKEY,,SETTBL,<item to set,>]
	CALL COMANE		;(T2/T1-T3) Get a set command
	MOVEI P1,-SETKEY(T2)	;Get offset for this function bits
	HRRZ T2,(T2)		;Get dispatch address
	CALLRET (T2)		;(/) Do it and return
	SUBTTL Commands -- Set Command -- Access Log File

;SET ACCESS-LOG-FILE str:<dir>file.typ

SETALF:	MOVE T1,[XWD ALFGTJ,GTJBLK] ;Make BLT pointer for source GTJFN
	BLT T1,GTJBLK+.GJF2	;Copy GTJFN block over there
	MOVEI T2,[FLDDB. .CMFIL,CM%SDH,,<filespec for access control logging>,SYSTEM:LOGFILE.LOG]
	CALL COMANE		;(T1/T1,T2,T3) Get filename
	MOVEM T2,PRSJFN		;Save JFN for a sec
	CALL CONFIR		;(/) Confirm that please

	HRROI T1,LOGFIL		;Point to log directory area
	MOVE T2,PRSJFN		;Load the JFN back, COM2 will release it
	MOVX T3,JS%PAF!FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!FLD(.JSAOF,JS%NAM)!FLD(.JSAOF,JS%TYP)
	JFNS%			;Make a string out of that
	 JSERRO (<Can't make access control filespec string>)
	RET			;Return to get more commands
	SUBTTL Commands -- Set Command -- Log File Cache Sweep Interval

;SET LOG-FILE-CACHE-INTERVAL n (seconds)

SETLFI:	NOISE (seconds)		;[107] Mumble

	MOVEI T2,[FLDDB. .CMNUM,CM%SDH,^D10,<cache sweep interval in seconds>] ;[107]
	CALL COMANE		;[107] (T2/T1-T3) Parse that number
	SKIPL P1,T2		;[113] Skip if greater than zero or zero
	IFSKP.			;[107] If zero or less
	  EMSG <Interval must be non-negative number> ;[113] Owie
	  RET			;[107] Return now
	ENDIF.			;[107] End of error code

	CALL CONFIR		;[107] (/) Confirm that command
	MOVEM P1,LOGINT		;[107] Save log file interval time
	RET			;[107]  and return
	SUBTTL Commands -- Set Command -- Prime Time

;SET PRIMT-TIME-BEGIN hh:mm
;SET PRIME-TIME-END hh:mm

SETPTB:	MOVEI T2,[FLDDB. .CMTAD,CM%SDH,CM%ITM!CM%NCI!CMTADB,<time in form hh:mm>]
	CALL COMANE		;(T2/T1,T2,T3) Parse that time
	CALL CONFIR		;(/) Confirm that

	MOVE T2,CMTADB+2	;Load the time in seconds since midnight
	HRRZM T2,@SETDAT(P1)	;Save the time
	RET			; and return
	SUBTTL Commands -- Set Command -- Spy Check Interval

;SET SPY-CHECK-INTERVAL n (seconds)

SETSCI:	NOISE (seconds)		;Mumble

	MOVEI T2,[FLDDB. .CMNUM,CM%SDH,^D10,<spy interval in seconds>]
	CALL COMANE		;(T2/T1-T3) Parse that number
	SKIPLE P1,T2		;Skip if greater than zero
	IFSKP.			;If zero or less
	  EMSG <Interval must be positive number>
	  RET			;Return now
	ENDIF.			;End of error code

	CALL CONFIR		;(/) Confirm that command
	MOVEM P1,SPYINT		;Save spy interval time
	RET			; and return
	SUBTTL Commands -- Set Command -- Spy Log Directory

;SET SPY-LOG-DIRECTORY str:<dir>file

SETSLD:	MOVE T1,[XWD SLDGTJ,GTJBLK] ;Make BLT pointer for source GTJFN
	BLT T1,GTJBLK+.GJF2	;Copy GTJFN block over there
	MOVEI T2,[FLDDB. .CMFIL,CM%SDH,,<directory to save spy logs into>,SYSTEM:ACJ-SPY]
	CALL COMANE		;(T1/T1-T3) Get filename
	MOVEM T2,PRSJFN		;Save JFN for a sec
	CALL CONFIR		;(/) Confirm that please

	HRROI T1,SPYSLD		;Point to spy log directory area
	MOVE T2,PRSJFN		;Load the JFN back, COM2 will release it
	MOVX T3,JS%PAF!FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!FLD(.JSAOF,JS%NAM)
	JFNS%			;Make a string out of that
	 JSERRO (<Can't make spy log filespec string>)
	RET			;Return to get more commands
	SUBTTL Commands -- Show Command

;SHOW ALL|FUNCTION [ALL|fun]|SETTING [ALL|setting]|USER [ALL|user]

DOSHOW:	MOVEI T2,[FLDDB. .CMKEY,,SHOTBL,<item to show,>,ALL] ;Parse keyword
	CALL COMANE		;(T2/T1-T3) Parse that please
	HRRZ T2,(T2)		;Load address to dispatch to
	CALLRET (T2)		;(/) Perform show function and return

;Here for SHOW ALL, confirm it first.  Show all possible things.
;Returns +1 always with all possible things showed.

DOSHOA:	CALL CONFIR		;(/) Confirm this event
	CALL SHOSEA		;(/) Show settings all
	CALL SHOFUA		;(/) Show functions all
	CALLRET SHOUSA		;(/) Show user all and return
	SUBTTL Commands -- Show Command -- Show Functions

;Here for SHOW FUNCTION ALL|function.

DOSHOF:	MOVEI T2,[FLDDB. .CMKEY,,FUNTBL,<a function,>,ALL,[
		  FLDDB. .CMKEY,,ALLTBL,<ALL for all functions>]]
	CALL COMANE		;(T2/T1,T2,T3) Parse that
	DMOVE P2,T2		;Save entry from table and which adr used
	CALL CONFIR		;(T1/T1) Confirm it
	HRRZ T2,(P2)		;Get rh of returned keyword entry
	JUMPE T2,SHOFUA		;(/) Use routine to perform ALL

	MOVEI P1,-FUNKEY(P2)	;Load offset for this function
	MOVE T2,FUNCTB(P1)	;Load the function enable bits
	TXNN T2,FU%ENA		;Is it enabled?
	SKIPA T2,[-1,,[ASCIZ/ Disabled function /]] ;Disabled function
	HRROI T2,[ASCIZ/ Enabled function /] ;Enabled function
;	CALLRET SHOFUN		;(T2,P1/) Yes, a function, send it and return

;Here to show information about a single function.
;Call with
;	T2/ pointer to ASCIZ starting text
;	P1/ function offset (into FUNKEY, etc.)
;Returns +1 always

SHOFUN:	HRROI T1,HEADBU		;Point to text buffer buffer
	CALL ISOUT		;(T1,T2/T1) Start off with this
	HLRO T2,FUNKEY(P1)	;Load name of this function string
	CALL ISOUT		;(T1,T2/T1) Append function name string
	MOVE T4,ENAAOB		;Load -n,,0 where n is the count of ENATBL
	DO.			;Loop through elements in table
	  HRRZ T3,ENAKEY(T4)	;Point to flag word
	  MOVE T3,(T3)		;Get that word with the bits in it
	  TDNN T3,FUNCTB(P1)	;Is this bit lit for this function?
	  IFSKP.		;Yes, tell me about this one
	    HRROI T2,[ASCIZ/, /] ;Load seperator
	    CALL ISOUT		;(T1,T2/T1) Append that
	    HLRO T2,ENASHO(T4)	;Point to string
	    CALL ISOUT		;(T1,T2/T1) Append that
	  ENDIF.		;End of output code
	  AOBJN T4,TOP.		;Loop for all function profile bits
	OD.			;End of loop
	CALL OCRLF		;(T1/T1) Append in a crlf
	CALLRET SHOWIT		;(/) Output all of that and return
;Show all enabled and disabled functions.
;Returns +1 always.

SHOFUA:	HRROI P3,[ASCIZ/The following functions are enabled:
	/]			;Start the list off right with this text
	MOVE P4,[TXNN T3,FU%ENA] ;Load instruction to execute
	CALL SHOFU2		;(T1,P3,P4/) Show all of the enabled ones

	HRROI P3,[ASCIZ/The following functions are disabled:
	/]			;Load initial text
	MOVE P4,[TXNE T3,FU%ENA] ;Load instruction to execute
;	CALLRET SHOFU2		;(T1,P3,P4/) Show all of the disabled ones

;Worker routine for SHOFUA, shows all enabled or disabled functions.
;Call with 
;	P3/ pointer to identifier string
;	P4/ TXN% T3,FU%ENA
;Returns +1 always, P1 and P3 smashed

SHOFU2:	MOVE P1,FUNAOB		;Load -functions,,0
	DO.			;Loop for all functions
	  MOVE T3,FUNCTB(P1)	;Load enable bits from the table
	  XCT P4		;Skip if we should show this one
	  IFSKP.		;Yes, show this one
	    MOVE T2,P3		;Load the next prepending text
	    HRROI P3,[ASCIZ/	/] ;Point to tab for next one
	    CALL SHOFUN		;(T2,P1/) Show this function
	  ENDIF.		;End of Missouri (show me) code
	  AOBJN P1,TOP.		;Loop for all function
	OD.			;End of for all functions loop
	RET			; and return when done
	SUBTTL Commands -- Show Command -- Show Settings

;Here for SHOW SETTINGS.

DOSHOS:	MOVEI T2,[FLDDB. .CMKEY,,SETTBL,<a setting,>,ALL,[
		  FLDDB. .CMKEY,,ALLTBL,<ALL for all settings>]]
	CALL COMANE		;(T2/T1,T2,T3) Parse that
	DMOVE P2,T2		;Save entry from table and which adr used
	CALL CONFIR		;(T1/T1) Confirm it
	HRRZ T2,(P2)		;Get rh of returned keyword entry
	JUMPE T2,SHOSEA		;(/) If ALL then use special routine
	MOVEI P1,-SETKEY(P2)	;Load offset of entry from table
	HRROI P3,[ASCIZ/ /]	;Load pointer to just a space string
;	CALLRET SHOSET		;(P1,P3/) Show settings and return

;Here to show program settings.
;Call with P1/ offset to SETTBL P3/ string for beginning of each line
;Returns +1 always.

SHOSET:	HRROI T1,HEADBU		;Point to text buffer buffer
	MOVE T2,P3		;Load initial text first
	CALL ISOUT		;(T1,T2/T1) Send it first
	HLRO T2,SETSHT(P1)	;Load text to print first
	CALL ISOUT		;(T1,T2/T1) Send that
	HRRZ T3,SETSHT(P1)	;Load address of routine to call
	MOVE T2,@SETDAT(P1)	;Get the data itself to pass to show routine
	CALL (T3)		;(T1,T2/T1) Show this item
	CALL OCRLF		;(T1/T1) Append a CRLF to all of that
	CALLRET SHOWIT		;(/) Show all of that and return

;Here to show all program settings.
;Returns +1 always.
	
SHOSEA:	HRROI T1,[ASCIZ/The following program settings are in effect:
/]				;Load the header
	PSOUT%			;Type it on terminal
	HRROI P3,[ASCIZ/	/] ;Load pointer to a tab
	MOVSI P1,-SETNUM	;Load -ive things to show,,0
	DO.			;Loop for all things to show
	  CALL SHOSET		;(P1,P3/) Send one to terminal
	  AOBJN P1,TOP.		;Loop for all of them
	OD.			;End of loop
	RET			;Return
	SUBTTL Commands -- Show Command -- Show User

;Here for SHOW USER ALL|wildusername.

DOSHOU:	MOVEI T2,[FLDDB. .CMKEY,,USRTBL,<a user profile,>,ALL,[
		  FLDDB. .CMKEY,CM%SDH,ALLTBL,<ALL for all user profiles>]]
	CALL COMANE		;(T2/T1,T2,T3) Parse that
	DMOVE P2,T2		;Save entry from table and which adr used
	CALL CONFIR		;(T1/T1) Confirm it
	HRRZ T2,(P2)		;Get rh of returned keyword entry
	JUMPE T2,SHOUSA		;(/) If it was ALL use special routine
	MOVEI P1,-USRKEY(P2)	;Load offset of entry from table
	HRROI T2,[ASCIZ/ /]	;Load prepending text
;	CALLRET SHOUSR		;(T2,P1/) Do just this user please

;Here to display information about a single user.
;Call with T2/ prepending text, P1/ offset into user table.
;Returns +1 always.

SHOUSR:	HRROI T1,HEADBU		;Point to text buffer
	CALL ISOUT		;(T1,T2/T1) Start with prepended text
	HRROI T2,[ASCIZ/User /]	;Label the next string
	CALL ISOUT		;(T1,T2/T1) Start off with this
	HLRO T2,USRKEY(P1)	;Load pointer to username string
	CALL ISOUT		;(T1,T2/T1) Append username string

	MOVE T4,USEAOB		;Load -n,,0
	DO.			;Loop through elements in table
	  HRRZ T2,USESHO(T4)	;Get dispatch address
	  CALL (T2)		;(T1,T3,P1/T1,P1) Output that
	  AOBJN T4,TOP.		;Loop for all function profile bits
	OD.			;End of loop
	CALL OCRLF		;(T1/T1) Append in a crlf
	CALLRET SHOWIT		;(/) Print that and return
;Here to show user profile that happens to be a bit.
;Output "keyword" if bit (in data word) is lit in profile.
;Call with T1/ output pointer, T4/ USExxx offset, P1/ USRxxx offset
;Returns +1 always with T1/ updated

SHOBIT:	HRRZ T3,USEKEY(T4)	;Load address of this keyword's flag word
	HRRZ T2,USRKEY(P1)	;Load offset into profile table
	MOVE T2,USRPRO(T2)	;Load user profile bits into T3
	XOR T2,USEDEF		;Set not-default bits to 1
	TDNN T2,(T3)		;Does this user not have default?
	RET			;Default, return now
	HRROI T2,[ASCIZ/, /]	;Load seperator
	CALL ISOUT		;(T1,T2/T1) Append that
	HRRZ T2,USRKEY(P1)	;Have to say something, load profile offset
	MOVE T2,USRPRO(T2)	;Load user profile bits
	TDNE T2,(T3)		;Skip if the bit is not lit
	IFSKP.			;If bit is off
	  HRROI T2,[ASCIZ/no /]	;Load no keyword
	  CALL ISOUT		;(T1,T2/T1) Just say no
	ENDIF.			;End of no code
	HLRO T2,USESHO(T4)	;Point to string
	CALLRET ISOUT		;(T1,T2/T1) Append that and return

;Here to show user profile that happens to be a decimal number.
;Output "keyword n", data word is byte pointer with 0 address.
;Call with T1/ output pointer, T4/ USExxx offset, P1/ USRxxx offset
;Returns +1 always with T1/ updated

SHODEC:	HRRZ T2,USEKEY(T4)	;Load address of byte pointer
	MOVE T2,(T2)		;Get bp into T2
	HRRZ T3,USRKEY(P1)	;Load offset into profile table
	HRRI T2,USRPRO(T3)	;Load user profile bits address into T3
	LDB T3,T2		;Get the value 
	JUMPE T3,R		;Return if zero
	HRROI T2,[ASCIZ/, /]	;Load seperator
	CALL ISOUT		;(T1,T2/T1) Append that
	HLRO T2,USESHO(T4)	;Point to string
	CALL ISOUT		;(T1,T2/T1) Append that 
	CALL OSPACE		;(T1/T1) A space next please
	MOVE T2,T3		;Reload the value
	CALLRET ODEC		;(T1,T2/T1) Output that and return
;Here when SHOW USER ALL command.
;Returns +1 always.

SHOUSA:	HLRZ P1,USRTBL		;Point to user table
	JUMPE P1,R		;Return if no user defined
	IMUL P1,[XWD -1,0]	;Make -users,,0
	HRROI P3,[ASCIZ/The following user profiles are defined:
	/]			;Label following
	DO.			;Loop to show user profiles
	  MOVE T2,P3		;Load the prependin text
	  HRROI P3,[ASCIZ/	/] ;Load a tab for the next one
	  CALL SHOUSR		;(T2,P1/) Show user profile
	  AOBJN P1,TOP.		;Loop for all of them
	OD.			;End of loop for each user profile
	RET			;Return
	SUBTTL Commands -- Show Command -- Show Text On Terminal

;Here to display show text on terminal based on its line width.
;Call with HEADBU/ ASCIZ text
;Returns +1 always.

;ACs:	T1/ destination pointer (TEXTBU)
;	T2/ source pointer (HEADBU)
;	T3/ current character
;	T4/ space available on this line
;	Q1/ copy of T1 at last space character
;	Q2/ copy of T2 at last space character

SHOWIT:	SAVEAC <Q1,Q2>		;Preserve these two ACs
	MOVE T1,[POINT 7,TEXTBU] ;Point to destination buffer
	MOVE T2,[POINT 7,HEADBU] ;Point to source buffer

SHOWI1:	MOVE T4,LINWID		;Load maximum characters per line
SHOWI2:	ILDB T3,T2		;Load a source byte
	IDPB T3,T1		;Store it in destination
	JUMPE T3,PTEXT		;Publish if a null seen

	CAIE T3,.CHLFD		;Is it a linefeed
	CAIN T3,.CHCRT		; or a return?
	JRST SHOWI1		;Yes, reset line counter and continue
	CAIN T3,","		;Is it a comma?
	DMOVEM T1,Q1		;Yes, remember where the last comma was
	CAIN T3,.CHTAB		;Is it a tab?
	SUBI T4,7		;Yes, account for it as 8 positions always
	SOJG T4,SHOWI2		;Loop for all characters on the line

	MOVE T1,Q1		;Reload destination pointer after space char
	HRROI T2,[BYTE(7).CHCRT,.CHLFD,.CHTAB,.CHTAB,0] ;Text is cr lf tab tab
	CALL ISOUT		;(T1,T2/T1) Break the line here
	MOVE T2,Q2		;Reload source pointer
	MOVE T4,LINWID		;Reload the terminal width
	SUBI T4,^D16		; account for those two tabs
	JRST SHOWI2		;  and reenter the loop
	SUBTTL Commands -- Take Command

;TAKE (commands from) file.typ

DOTAKE:	SKIPN TAKJFN		;Are we in a TAKE now?
	IFSKP.			;Yes
	  EMSG (Nested TAKE commands are illegal)
	  JRST TAKEOF		;Abort this take command
	ENDIF.			;That's all

	NOISE (commands from file) ;Mumble
	MOVE T1,[XWD TAKGTJ,GTJBLK] ;Make BLT pointer for source GTJFN
	BLT T1,GTJBLK+.GJF2	;Copy GTJFN block over there
	MOVEI T2,[FLDDB. .CMFIL,CM%SDH,,<take filename>]
	CALL COMANE		;(T1/T1-T3) Get filename
	MOVEM T2,PRSJFN		;Save JFN
	CALL CONFIR		;(/) Confirm that command

;Open up the file, set the I/o JFNs and so forth, and then return.

 	MOVE T1,PRSJFN		;Load JFN again
	MOVX T2,<FLD(7,OF%BSZ)!OF%RD> ;Read 7-bit bytes
	OPENF%			;Pry it open
	 ERJMP COMERR		;Error, return
	SETZM PRSJFN		;Don't release the JFN now
	MOVEM T1,TAKJFN		;Reload that JFN please
	MOVE T1,TAKGTJ+.GJSRC	;Load .NULIO,,.NULIO JFNs
	MOVEM T1,CSBLOK+.CMIOJ	;That is the input JFN now
	RET			;Return for all commands
;Routine to call after call to .CMINI function to process take file.
;Returns +1 always

TAKCHK:	SKIPN T1,TAKJFN		;Do we have a take JFN?
	RET			;Nope, return now
	HRROI T2,CMDBUF		;Point to command buffer
	MOVEI T3,<CBUFSZ*5>-1	;Load characters we can supply to buffer
	MOVEI T4,.CHLFD		;Load terminating character

;Loop reading one command from the file.  Check for hyphen at end of line.

TAKCH1:	SIN%			;String INput
	 ERJMP TAKEOF		;Check for EOF if error
	CAILE T3,<CBUFSZ*5>-4	;Have at least 3 characters been read?
	JRST TAKCH5		;Nope, no continuation possible
	MOVNI Q1,3		;Backup by this many bytes
	ADJBP Q1,T2		;Point back three
	ILDB Q2,Q1		;Get character two back
	CAIE Q2,"-"		;Hyphen?
	JRST TAKCH5		;No, cannot be continuation then
	ILDB Q2,Q1		;Get the next character
	CAIN Q2,.CHCRT		;Was it a return?
	JRST TAKCH1		;Yes, get the next line also please

;Entire command line has been read now, set up CSB, echo command, and return.

TAKCH5:	MOVEI T4,<CBUFSZ*5>-1	;Load mas possible characters transferred
	SUB T4,T3		;Compute number stored in buffer
	MOVEM T4,CSBLOK+.CMINC	;Save that as number of unparsed characters
	MOVEI T3,0		;Load a null character
	IDPB T3,T2		;Insure a null at end of text string
	MOVE T1,CSBLOK+.CMRTY	;Load the pointer to prompt string
	PSOUT%			;Send that to the terminal please
	HRROI T1,CMDBUF		;Point to command buffer again
	PSOUT%			;Send it to the terminal
	RET			;Back in the saddle again
;Come here when error reading from take file.  If IOX4 it must be the end of
;the take file, otherwise give error message.  Then close the TAKE file and go
;to COM1 to start getting commands from the terminal.

TAKEOF:	CALL GETERR		;(/T2) Get last error code into T2
	CAIE T2,IOX4		;Is it end of file on take command?
	OJSERR (<Error reading command file>) ;Nope, mumble about error instead

	HRROI T1,TEXTBU		;Point to text buffer
	HRROI T2,[ASCIZ/[End of /] ;Point bracket and start of message
	CALL ISOUT		;(T1,T2/T1) Send that along
	MOVE T2,TAKJFN		;Reload the JFN
	CALL OJFNS		;(T1,T2/T1) Send along the filename
	HRROI T2,[ASCIZ/]
/]				;Point to bracket cr lf string
	CALL ISOUT		;(T1,T2/T1) Send that along
	CALL PTEXT		;(/) Send all of that to terminal
	CALL TAKCLS		;(/) Close out the take file JFN
	JRST COM1		;Restart command

;Here to close TAKE file.
;Returns +1 always.

TAKCLS:	SKIPN T1,TAKJFN		;Reload the file's JFN
	RET			;None there
	CLOSF%			;Close it
	 ERCAL TAKCL3		;Maybe it wasn't open
	SETZM TAKJFN		;No more JFN
	MOVE T1,CSBTPL+.CMIOJ	;Load the primary input JFN
	MOVEM T1,CSBLOK+.CMIOJ	;That is the input JFN now
	RET

TAKCL3:	MOVE T1,TAKJFN		;Reload the JFN
	RLJFN%			;Release it
	 ERNOP.			;HFO?
	RET			;Return to above
	SUBTTL Commands -- User Command

;USER name profile

;AC usage in this routine
;	P2/ accumulated profile
;	P3/ offset to USExxx tables 

DOUSER:	MOVEI T2,[FLDDB. .CMUSR,CM%SDH,,<Username to set profile for>,,[
		  FLDBK. .CMFLD,CM%SDH,,<Wild user specification to set profile for>,,USRBRK]]
	CALL COMANE		;(T2/T1-T3) Parse username field
	LDB T3,[POINTR .CMFNP(T3),CM%FNC] ;Load the function parsed
	HRROI T1,USRSTR		;Place to keep user string
	CAIE T3,.CMFLD		;Was it the field parse?
	IFSKP.			;Yes
	  HRROI T2,ATMBUF	;Point to atom buffer source
	  CALL ISOUT		;(T1,T2/T1) Copy the user name down there 
	ELSE.			;Otherwise it was the username parse
	  CALL ODIRST		;(T1,T2/T1) Send username in there
	ENDIF.			;End of field/username parse code
	MOVE P2,USEDEF		;Load the default profile for a user 

;Get this user's profile.

DOUSE1:	MOVEI T2,[FLDDB. .CMCFM,,,,,[
		  FLDDB. .CMKEY,,USETBL,<a user profile keyword,>]]
	CALL COMANE		;(T2/T1-T3) Parse a keyword or confirm
	LDB T3,[POINTR .CMFNP(T3),CM%FNC] ;Load the function parsed
	CAIN T3,.CMCFM		;Was it the confirm?
	JRST DOUSE2		;Yep, it certainly was this time

	MOVEI P3,-USEKEY(T2)	;Load offset for USExxx tables
	CALL @USEPRS(P3)	;(P2,P3/P2) Parse this field
	JRST DOUSE1		;Loop for more keywords or confirm
;Here when we are ready to store this user's profile.

DOUSE2:	HLRZ T4,USRTBL		;Load entry count of table
	IMULI T4,USRCHR/5	;Compute offset into username storage area
	HRROI T1,USRSTG(T4)	;Point to storage area
	HRROI T2,USRSTR		;Point to atom buffer string we copied earlier
	CALL ISOUT		;(T1,T2/T1) Send that as the user name string

;See if user already in table.

	MOVEI T1,USRTBL		;See if this user is in the table
	HRROI T2,USRSTG(T4)	;Load the address of the string
	TBLUK%			;Is the user in the table already?
	 ERJMP DOUSE3		;Nope
	TXNE T2,TL%EXM		;Exact match for user in table?
	JRST DOUSE4		;Yep

;Add user to table.

DOUSE3:	MOVEI T1,USRTBL		;Point to user table
	HLRZ T2,USRTBL		;Get the offset again
	HRLI T2,USRSTG(T4)	;Get address of string,,offset
	TBADD%			;Add it to the table
	 JSERRO (<Cannot add user to table>)

;Set profile bits of user, entry address is now in T1 (from TBLUK or TBADD).

DOUSE4:	HRRZ T1,(T1)		;Load the entry offset for this user
	MOVEM P2,USRPRO(T1)	;Store new profile word
	RET			;Return for more commands
;Here to parse format field that is just a bit.
;"NO keyword" clears the bit an "keyword" sets the bit.
;Call with P2/ accumulated format bits, P3/ offset to USExxx 
;Returns +1 always with P2/ updated bits

PRSBIT:	HRRZ T2,USEKEY(P3)	;Load the address of the word with bits in it
	SKIPN T2,(T2)		;Skip if there is a bit to set
	IFSKP.			;There was a bit to set
	  TDO P2,T2		;Set the bit please
	  RET			;Loop until confirm seen
	ENDIF.			;Otherwise it must be "NO", parse keyword
	MOVEI T2,[FLDDB. .CMKEY,,USENOT,<a user profile keyword,>]
	CALL COMANE		;(T2/T1,T2,T3) Get the thing parsed
	HRRZ T2,(T2)		;Load address where the bits are
	TDZ P2,(T2)		;Clear specified bit
	RET			;Return to loop until confirm seen

;Here when parsing a keyword followed by a number.
;Call with P2/ accumulated format bits, P3/ offset to USExxx 
;Returns +1 always with P2/ updated bits

PRSDEC:	MOVEI T2,[FLDDB. .CMNUM,,^D10] ;Get a decimal number
	CALL COMANE		;(T2/T1,T2,T3) Parse that
	HRRZ T1,USEKEY(P3)	;Load address of data word
	MOVE T1,(T1)		;Load the data which is the byte pointer
	TXO T1,P2		;Address to store in is P2
	DPB T2,T1		;Store the value
	RET			;Return for more
	SUBTTL Commands -- Write Command

;WRITE (commands to) acjprofile.com.-1

DOWRIT:	NOISE (commands to)	;Mumble about this
	MOVE T1,[XWD WRIGTJ,GTJBLK] ;Make BLT pointer for source GTJFN
	BLT T1,GTJBLK+.GJF2	;Copy GTJFN block over there
	MOVEI T2,[FLDDB. .CMFIL,CM%SDH,,<filename to write profile to>]
	CALL COMANE		;(T1/T1-T3) Get filename
	MOVEM T2,PRSJFN		;Save JFN
	CALL CONFIR		;(/) Confirm that command
;Open the file and write a header to it.

	MOVE P2,PRSJFN		;Reload the JFN we parsed
	SETZM PRSJFN		;Don't let anyone else try to release it
	CALL WRIOPN		;(P2/) Open the file
	 CALLRET WRICLS		;(P2/) Error, return
	CALL WRIHDR		;(P2/) Construct header text in TEXTBU
	CALL WRITXT		;(P2/) Write that to the file

;Write program settings.

	MOVSI P1,-SETNUM	;Load -ive things to show,,0
	DO.			;Loop for all things to show
	  CALL WRISET		;(P1/) Send one line information to text buffer
	  CALL WRITXT		;(P2/) Send that to the file
	  AOBJN P1,TOP.		;Loop for all items
	OD.			;End of loop

;Write function settings.

	MOVE P1,FUNAOB		;Load number of functions to do
	DO.			;Loop for each function
	  CALL WRIFUN		;(P1/) Show this function to text buffer
	  CALL WRITXT		;(P2/) Send the text buffer to the file
	  AOBJN P1,TOP.		;Loop for all function
	OD.			;End of for each function loop

;Write user profiles.

	HLRZ P1,USRTBL		;Point to user table
	IFN. P1			;If there are userd defined today
	  IMUL P1,[XWD -1,0]	;Make -users,,0
	  DO.			;Loop for each user
	    CALL WRIUSR		;(P1/) Show user profile to buffer
	    CALL WRITXT		;(P2/) Send that text to the file
	    AOBJN P1,TOP.	;Loop for all of them
	  OD.			;End of short loop
	ENDIF.			;End of user write code

	CALLRET WRICLS		;(P2/) Close JFN and return
	SUBTTL Commands -- Write Command -- Write Settings

;Here to write all program settings.
;Returns +1 always with TEXTBU filled.

WRISET:	HRROI T1,TEXTBU		;Point to text buffer
	HRROI T2,[ASCIZ/Set /] ;Load initial text
	CALL ISOUT		;(T1,T2/T1) Send that
	HLRO T2,SETKEY(P1)	;Load text to print first
	CALL ISOUT		;(T1,T2/T1) Send that
	CALL OSPACE		;(T1/T1) Space it out
	HRRZ T3,SETSHT(P1)	;Load address of routine to call
	MOVE T2,@SETDAT(P1)	;Get the data itself to pass to show routine
	CALL (T3)		;(T1,T2/T1) Show this item
	CALLRET OCRLF		;(T1/T1) Append a CRLF to all of that
	SUBTTL Commands -- Write Command -- Write User Profiles

;Here to display information about a single user, P1/ offset into USRTBL.
;Returns +1 always with TEXTBU set up.

WRIUSR:	HRROI T1,TEXTBU		;Point to text buffer
	HRROI T2,[ASCIZ/User /]	;Label the next string
	CALL ISOUT		;(T1,T2/T1) Start off with this
	HLRO T2,USRKEY(P1)	;Load username string
	CALL ISOUT		;(T1,T2/T1) Append username string
	MOVE T4,USEAOB		;Load AOB pointer to user profile table (-n,,0)
	DO.			;Loop through elements in table
	  CALL @USEWRI(T4)	;(T1,T4,P1/T1,T4,P1) Call routine to write
	  AOBJN T4,TOP.		;Loop for all function profile bits
	OD.			;End of loop
	CALLRET OCRLF		;(T1/T1) Append in a crlf and return

;Here to write user profile that happens to be a bit.
;Call with T1/ string pointer, T4/ USEKEY offset, P1/ USRKEY offset
;Returns +1 always, T1/ updated

WRIBIT:	HRRZ T3,USEKEY(T4)	;Load address of the flags mask for this bit
	HRRZ T2,USRKEY(P1)	;Load offset into profile table
	MOVE T2,USRPRO(T2)	;Load user profile
	XOR T2,USEDEF		;Set non-default bit setting to 1
	TDNN T2,(T3)		;Is the bit not the default setting?
	RET			;Bit is default setting, say nothing
	CALL OSPACE		;(T1/T1) Output a space
	HRRZ T2,USRKEY(P1)	;Have to say something, load profile offset
	MOVE T2,USRPRO(T2)	;Load user profile bits
	TDNE T2,(T3)		;Skip if the bit is not lit
	IFSKP.			;If bit is off
	  HRROI T2,[ASCIZ/NO#/]	;Load NO keyword
	  CALL ISOUT		;(T1,T2/T1) Just say no
	ENDIF.			;End of no code
	HLRO T2,USEKEY(T4)	;Point to string containing keyword
	CALLRET ISOUT		;(T1,T2/T1) Append that keyword and return

;Here to write user profile that happens to be a decimal number.
;Call with T1/ string pointer, T4/ USEKEY offset, P1/ USRKEY offset
;Returns +1 always, T1/ updated

WRIDEC:	HRRZ T2,USEKEY(T4)	;Get address of the data
	MOVE T2,(T2)		;Get the byte pointer which is the data word
	HRRZ T3,USRKEY(P1)	;Load offset into profile table
	HRRI T2,USRPRO(T3)	;Load user profile address
	LDB T3,T2		;Get the data
	JUMPE T3,R		;Return if its zero
	CALL OSPACE		;(T1/T1) Space first
	HLRO T2,USEKEY(T4)	;Point to string containing keyword
	CALL ISOUT		;(T1,T2/T1) Append that keyword
	CALL OSPACE		;(T1/T1) Output a space next
	MOVE T2,T3		;Reload the value
	CALLRET ODEC		;(T1,T2/T1) Make it decimal and return
	SUBTTL Commands -- Write Command -- Write Function Profiles

;Here to show information about a single function, P1/ function offset
;Returns +1 always with TEXTBU set up.

WRIFUN:	HRROI T1,TEXTBU		;Point to text buffer
	MOVE T3,FUNCTB(P1)	;Load bits for this function
	HRROI T2,[ASCIZ/Enable /] ;Assume enabled
	TXNN T3,FU%ENA		;Skip if this is true
	HRROI T2,[ASCIZ/Disable /] ;The function is disabled
	CALL ISOUT		;(T1,T2/T1) Start off with this
	HLRO T2,FUNKEY(P1)	;Load function name string
	CALL ISOUT		;(T1,T2/T1) Append function name string
	TXNN T3,FU%ENA		;Is this function enabled?
	CALLRET OCRLF		;(T1/T1) Nope, output crlf and return now

	MOVE T4,ENAAOB		;Load -n,,0
	DO.			;Loop through elements in table
	  HRRZ T3,ENAKEY(T4)	;Point to flag word
	  MOVE T3,(T3)		;Get that word with the bits in it
	  MOVE T2,FUNCTB(P1)	;Load the profile word for this bit
	  XOR T2,ENADEF		;Set not equal bits to one
	  TDNN T2,T3		;Skip if the bit is not set to default value
	  IFSKP.		;Yes, need keyword output
	    CALL OSPACE		;(T1/T1) Output a space
	    HRROI T2,[ASCIZ/NO#/] ;Load NO keyword
	    TDNN T3,FUNCTB(P1)	;Skip if the bit is lit
	    CALL ISOUT		;(T1,T2/T1) Just say no
	    HLRO T2,ENAKEY(T4)	;Point to keyword string
	    CALL ISOUT		;(T1,T2/T1) Append that
	  ENDIF.		;OK, done with that one
	  AOBJN T4,TOP.		;Loop for all function profile bits
	OD.			;End of loop
	CALLRET OCRLF		;(T1/T1) Append in a crlf
	SUBTTL Commands -- Write Command -- File Header

;Here to write a header to the file for later use.
;Call with P2/ file jfn
;Returns +1 always, TEXTBU/ header

WRIHDR:	HRROI T1,TEXTBU		;Point to text buffer
	HRROI T2,[ASCIZ/! /]	;Start with header string
	CALL ISOUT		;(T1,T2/T1) Start with this please
	HRROI T2,[VERSIO]	;Point to version string
	CALL ISOUT		;(T1,T2/T1) Append that text next
	HRROI T2,[ASCIZ/ profile written by /] ;Label the user who did this
	CALL ISOUT		;(T1,T2/T1) Start with this please
	MOVE T2,OURUNO		;Load our user number
	CALL ODIRST		;(T1,T2/T1) Send that text next
	HRROI T2,[ASCIZ/ at /]	;Label the time
	CALL ISOUT		;(T1,T2/T1) Append that text next
	CALL OODTIN		;(T1/T1) Send current date and time
	CALLRET OCRLF		;(T1/T1) Output a crlf and return
	SUBTTL Commands -- Write Command -- Fill and Write Line to File

;Here to send command in text buffer to the file, makes 79 character lines.
;Changes "#" to spaces that are not broken across lines.
;Call with
;	P2/ JFN
;	TEXTBU/ ASCIZ text
;Returns +1 always.

;ACs:	T1/ destination pointer (HEADBU)
;	T2/ source pointer (TEXTBU)
;	T3/ current character
;	T4/ space available on this line
;	Q1/ copy of T1 at last space character
;	Q2/ copy of T2 at last space character

WRITXT:	SAVEAC <Q1,Q2>		;Get some more scratch storage
	MOVE T1,[POINT 7,HEADBU] ;Point to destination buffer
	MOVE T2,[POINT 7,TEXTBU] ;Point to source buffer

WRITX1:	MOVEI T4,WRICPL		;Load maximum characters per line
WRITX2:	ILDB T3,T2		;Load a source byte
	CAIE T3,"#"		;Nonbreakable space?
	SKIPA CX,T3		;Nope, use origional character
	MOVEI CX," "		;Yes it is, make it a space please
	IDPB CX,T1		;Store it in destination
	JUMPE T3,WRITX5		;Get out if a null seen

	CAIE T3,.CHCRT		;Is it a return
	CAIN T3,.CHLFD		; or linefeed?
	JRST WRITX1		;Yes, reset line counter and continue
	CAIN T3," "		;Is it a space?
	DMOVEM T1,Q1		;Yes, remember where the last space was
	SOJG T4,WRITX2		;Loop for all characters on the line

	MOVE T1,Q1		;Reload destination pointer after space char
	HRROI T2,[BYTE(7)"-",.CHCRT,.CHLFD,.CHTAB,0] ;Point to dash cr lf tab
	CALL ISOUT		;(T1.T2/T1) Break the line here
	MOVE T2,Q2		;Reload source pointer
	MOVEI T4,WRICPL-^D8	; and reload the character counter
	JRST WRITX2		;  and reenter the loop

WRITX5:	MOVE T1,P2		;Load JFN of the file
	HRROI T2,HEADBU		;Point to the text buffer
	SETZB T3,T4		;Terminate on a null please
	SOUT%			;Send that to the file
	 JSERRO (<Can't write file>,<CALL WRICLS>,COM1) ;Owie
	RET			;Return to caller
	SUBTTL Commands -- Write Command -- Open/Close File

;Here to open the file for writing all profile commands into.
;Call with P2/ JFN
;Returns +1 if error
;Returns +2 if success

WRIOPN:	MOVE T1,P2		;Load JFN 
	MOVX T2,<FLD(7,OF%BSZ)!OF%WR> ;Write 7-bit bytes
	OPENF%			;Pry it open
	 JSERRO (<Can't open file to write>,,R) ;Error, punt and return +1
	RETSKP			;Skip return

;Here to close the file we are writing
;Call with P2/ JFN
;Returns +1 always with file closed.

WRICLS:	MOVE T1,P2		;Load the JFN again
	CLOSF%			;Close it please
	 ERSKP.			;Skip if error
	RET			;Return
	MOVE T1,P2		;Load the JFN back
	RLJFN%			;Release it now
	 ERNOP.			;Well I tried
	RET			;Return
	SUBTTL Commands -- Command Subroutines 

;Here to parse something using COMND JSYS.
;Call with T2/ address of command function block chain
;Returns +1 if no parse
;Returns +2 if parsed OK

COMAND:	MOVEI T1,CSBLOK		;Point to command state block
	COMND%			;Parse that function please
	 ERJMP COMAN3		;Owie if error!
	TXNN T1,CM%NOP		;Error during confirm parse?
	AOS (P)			;Nope, give skip return
	RET			;Nope, return OK

COMAN3:	CALL GETERR		;(/T2) Get last error code
	CAIN T2,IOX4		;Is it "End of file reached"?
	JRST COM1		;Yes, handle it by going to COM1
	RET			;No, return

;Call CONFIR to parse a confirm, echo command if in take file.
;Returns +1 always, goes to COMERR if there is a problem.

CONFIR:	MOVEI T2,[FLDDB. .CMCFM] ;Point to confirm function
;	CALLRET COMANE		;(T2/T1-T3) Get the function done and return

;Here to perform a COMND JSYS function and go to COMERR if error.
;Call with T2/ function block
;Returns +1 always (goes to COMERR if there is a problem).

COMANE:	CALL COMAND		;(T2/T1-T3) Do the function
	 JRST COMERR		;Give error message
	RET			;Return to caller

;Here when some kind of command error.

COMERR:	OJSERR (<Command error>) ;Nope, an owie instead of EOF
	JRST COM1		;Reset stack and continue parsing commands
	SUBTTL Access Control -- Initialization

	LOWCD			;Switch back to low seg

ASTART:	RESET%			;Init the world again
	MOVX F,FL%ACJ!FL%NOI	;Running as the ACJ now, no ints for now
	MOVE P,[IOWD PLEN,STACK] ;Load stack pointer
	SETZM LOGJFN		;No log file because of reset above
	SETZM SPYFWZ		;Zero first word to zero
	MOVE T1,[SPYFWZ,,SPYFWZ+1] ;Load BLT pointer to clear
	BLT T1,SPYLWZ		;Clear storage (including old fork handles!)

;Call various initialization routines.

	CALL INICAP		;(/) Turn on capabilities
	CALL INICON		;(/) Get configuration information

	CALL NEWLOG		;(/) Get a new log file JFN and put stuff in it
	CALL INIMID		;(/) Set interrupt for midnight
	CALL INILFF		;(/) Set interrupt for log file cache sweeps

	CALL DEFFNC		;(/) Get defaults for all functions
	CALL ENAFNC		;(/) Enable the access control functions

	JRST MAIN		;Start processing access control requests 
	SUBTTL Access Control -- Initialization -- Capabilities and Interrupts

;Here to enable capabilities and PI system.

INICAP:	MOVEI T1,.FHSLF		;Read this fork's capabilities
	RPCAP%			;Read Process CAPabilities
	TRNN T2,SC%WHL!SC%OPR	;Must be able to set wheel or operator today
	BUG(HLT,NEP,<Not enough privs available>) ;Crash
	MOVE T3,T2		;Enable all capabilities
	EPCAP%			;Enable Process CAPabilities
	 ERJMP [BUG(HLT,CEP,<Can't enable privs>)] ;Crash

	MOVEI T1,.FHSLF		;For this fork
	MOVE T2,[LEVTAB,,CHNTAB] ;Point to level and channel table
	SIR%			;Set the interrupt table addresses
	MOVX T2,ONCHNS		;For these channels
	AIC%			;Activate Interrupt Channels
	EIR%			;Enable interrupt system
	MOVX T1,<.TICCC,,CCCHAN> ;Load code for control c and control c channel
	ATI%			;Attach terminal interrupt character
	 JSERRO (<Could not enable control-C trapping>)

	MOVEI T1,.MSIIC		;Load ignore increment mount count function
	MSTR%			;Now we don't have to mount structures
	 JSERRO (<Could not ignore increment mount counts>)
	RET			;Return
	SUBTTL Access Control -- Initialization -- Configuration

;Get configuration information today.

INICON:	GJINF%			;Get job information for us
	MOVEM T1,OURUNO		;Save our user number
	MOVEM T3,OURJOB		;Save our job number

	MOVEI T1,.NDGLN		;Function to read local node name
	MOVEI T2,T3		;Argument block address
	HRROI T3,OURNAM		;Point to storage
	NODE%			;Get our local node name
	 ERNOP.			;What?

	MOVX T1,RC%EMO		;Exact match only
	HRROI T2,[ASCIZ/OPERATOR/] ;For this user
	RCUSR%			;Get operator user number
	 ERSKP.			;[112] Skip if error
	MOVEM T3,OPRUNO		;Save operator user number

	MOVE T1,[SIXBIT/PTYPAR/] ;Name of table telling how many PTYs
	SYSGT%			;Get number of PTYs,, TTY number of first PTY
	HRRZM T1,TTYPTY		;Put TTY number of first PTY here
	HLRZM T1,MAXPTY		;Put number of PTYs here

	MOVX T1,<1,,.LOGDE>	;Get LOGDES+1
	GETAB%			; which is the designator for job 0 output
	IFNJE.			;If no error getting it
	  TXZ T1,.TTDES		;Make it just a line number
	  MOVEM T1,CTYLNO	; and save it as the CTY line number
	ENDIF.			;End of GETAB worked code

	RET			;Return for more work
	SUBTTL Access Control -- Initialization -- Access Control Functions

;Here to enable trapping of access control functions that are enabled by the
;access control profile phase.  All access control functions listed in our
;table are enabled (if FU%ENA) after disabling all functions.
;Returns +1 always.

ENAFNC:	CALL DISFNC		;(/) First clear all enabled functions
	MOVE T4,FUNAOB		;Load -ive count of functions,,0
	DO.			;Loop for all functions
	  MOVEI T1,.SFSOK	;Set GETOK function
	  MOVE T2,FUNTMO(T4)	;Load default for this 
	  TXO T2,SF%EOK		;Light the enable bit for this function
	  HRR T2,FUNKEY(T4)	;Get function code
	  TXNE T2,.GOUSR	;Is it a user function code?
	  HRRI T2,.GOUSR	;Yes, make it just 1B18 please
	  MOVE T3,FUNCTB(T4)	;Load enable bits
	  TXNE T3,FU%ENA	;Enable this function?
	  SMON%			;Yes, enable the function
	   IFNJE.		;If no JSYS error
	     TXO T3,FU%GOK	;Record we are now fully awake for the 1st time
	   ELSE.		;If a JSYS error
	     TXZ T3,FU%GOK	;Then we didn't enable GETOKs for this one
	     HRROI T1,TEXTBU	;Point to usual text place this rainy afternoon
	     HRROI T2,[ASCIZ/Can't enable /] ;Start out mess 
	     CALL ISOUT		;(T1,T2/T1) Start with that string
	     HLRO T2,FUNKEY(T4)	;Point to text describing function
	     CALL ISOUT		;Send that along next please
	     HRROI T2,[ASCIZ/: /] ;Start out mess 
	     CALL ISOUT		;(T1,T2/T1) Start with that string
	     CALL GETERR	;(/T2) Get last error
	     HRROI CX,TEXTBU	;Point to text buffer now
	     CAIE T2,SMONX2	;"Invalid SMON function" is OK
	     CALL JSERR1	;(CX/) Print the error message
	   ENDIF.		;End of that testing
	  MOVEM T3,FUNCTB(T4)	;Store the updated function bits
	  AOBJN T4,TOP.		;Loop for all functions in the table
	OD.			;End of function enable loop
	RET			;Return to caller with functions enabled
;Here to disable all access control functions we enabled.  Called when we crash
;and before enabling any functions.
;Returns +1 always.

DISFNC:	MOVE T4,FUNAOB		;Load -ive count of functions,,0
	DO.			;Loop for all functions we know about
	  MOVEI T1,.SFSOK	;Reload the SMON GETOK function code
	  HLL T2,FUNTMO(T4)	;Get the default action for this function
	  HRR T2,FUNKEY(T4)	;Get function code
	  TXNE T2,.GOUSR	;Is it a user function code?
	  HRRI T2,.GOUSR	;Yes, make it just 1B18 please
	  MOVE T3,FUNCTB(T4)	;Load enable bits for this function
	  TXZE T3,FU%GOK	;Were we enabled for this function?
	  SMON%			;Yes, disable the function
	   ERNOP.		;Ignore all errors for now
	  MOVEM T3,FUNCTB(T4)	;Store the bit back please
	  AOBJN T4,TOP.		;Loop for all functions in the table
	OD.			;End of loop
	RET			;Return to caller

;Here to remember the GETOK function settings for all functions on startup.
;Returns +1 always with FUNTMO set up

DEFFNC:	MOVE T4,FUNAOB		;Load the -n,,0 for the function table
	DO.			;For every function that we know today
	  MOVEI T1,.SFSOK	;Load the function for SMON
	  HRRZ T2,FUNKEY(T4)	;Load the function code
	  TXNE T2,.GOUSR	;Is it a user function code?
	  HRRI T2,.GOUSR	;Yes, make it just 1B18 please
	  TMON%			;Test MONitor
	   ERSKP.		;If error, function probably not in monitor
	  TDZA T2,[^-SF%DOK]	;Keep just the interesting bit for later use
	  MOVX T2,SF%DOK	;Allow whatever this is if TMON failed
	  MOVEM T2,FUNTMO(T4)	;Save the flag for resetting later
	  AOBJN T4,TOP.		;Do this for all of them
	OD.			;End of loop to get them
	RET			;Return now
	SUBTTL Access Control -- Processing Loop

;This is the main processing loop for access control.

MAIN:	TXZ F,FL%DEN!FL%UNU!FL%FAI!FL%NOI ;Clear flags set per request, OKINT
	SETZM ARGBLK		;Clear first word of argument block
	MOVE T1,[XWD ARGBLK,ARGBLK+1] ;Load BLT pointer to block
	BLT T1,ARGBLK+20	;Clear only first twenty words today

	MOVEI T1,ARGBLK		;Get address of answer block
	MOVEI T2,ARGLEN		;and length of block
	RCVOK%			;Get next function to check/log
	 ERJMP [BUG(HLT,NRA,<Could not receive access requests>)]
	TXO F,FL%NOI		;We got one, set noint flag

	TIME%			;[107] Get system uptime
	MOVEM T1,TODCLK		;[107] Save this for later use
	
	CALL FINDUS		;(/P3,P4) Try to find the job and user profile
	CALL FINDIT		;(/P1,P2,T2,T3) Try to find the request
	 CAIA			;Skip if illegal request with T2 and T3 setup
	CALL REQUES		;(P1,P2,P3,P4/T2,T3,Q1,P2) Perform the checking

	SKIPE T2		;Are we allowing the thing?
	AOSA NDENY		;Nope, count the deny
	AOS NALLOW		;Count the allow
	MOVE T1,ARGBLK+.RCRQN	;Get the request number
	GIVOK%			;Allow or deny request
	 ERJMP [BUG(HLT,FOK,<Failed to give OK>)] ;Hell is freezin' over 

	CALL WAITFO		;(Q1,P1,P2,P3,P4/) Wait only if needed today
	CALL LOGREQ		;(Q1,P1,P2,P3,P4/) Log this request or not

	TXZE F,FL%NLF		;Do we need a new log file?
	CALL NEWLOG		;(/) Yes, get a new log file
	SKIPLE LOGINT		;[113] Is the log file cache disabled?
	TXZE F,FL%SLF		;[107] Do we need to sweep log file cache?
	CALL SWPLOG		;[107] (/) Yes, sweep the log file cache now

	JRST MAIN		;Loop for more requests
	SUBTTL Access Control -- Processing Loop -- Find Function Profile

;Here to find the function offset for this request.
;Returns +1 if error, log text filled in and
;	T2/ error code
;	T3/ error string
;	P1/ 0 to indicate no profile found
;	P2/ contents of ENADEF (default bits for a function profile)
;Returns +2 if found and should be processed, with
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables

FINDIT:	HLRZ T1,ARGBLK+.RCFCJ	;Get function code to look for
	MOVE P1,FUNAOB		;Load number of functions built with
	DO.			;Looping to find the function code
	  MOVE P2,FUNCTB(P1)	;Load bits for this function
	  CAMN T1,FUNCOD(P1)	;Match this one
	  RETSKP		;Yes, return +2
	  AOBJN P1,TOP.		;Loop for all of them
	OD.			;Uh oh, it wasn't found

;Request is not found and is therefore illegal and will be denied.

	HRROI T2,[ASCIZ/illegal/] ;Load identification string
	CALL LOGSTA		;(T2/T1) Start a log file entry
	HRROI T2,[ASCIZ/, code /] ;Label for following number
	HLRZ T3,ARGBLK+.RCFCJ	;Get function code to report
	CALL OLOCT		;(T1,T2,T3/T1) Send that to logging text
	MOVEM T1,TEXTBP		;Save the pointer to to text buffer

	MOVEI T1,ERRILR		;Not found, illegal request
	HRROI T2,[ASCIZ/Unexpected request for access - denied/]
	SETZ P1,		;Indicate that none found, no logging
	MOVE P2,ENADEF		;Load default bits (hopefully logging)
	TXO F,FL%DEN		;Deny flag
	RET			;Deny whatever it was
	SUBTTL Access Control -- Processing Loop -- Find User Profile

;Try to find user profile for this request.
;Returns +1 always with USRSTR and JIBLK set up and
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user

FINDUS:	SETZ P3,		;Load default which is user not found in table
	MOVE P4,USEDEF		;Load default bits to allow logins at least

;Fill in JIBLK which contains all information about the job for later checking.

	HRRZ T1,ARGBLK+.RCFCJ	;Get the job number
	MOVEI T4,JIBLK		;Point to job info block
	CALL GETINF		;(T1,T4/T4) Get job information
	 BUG(HLT,GIJ,<Can't get information on job>)

	HLRZ T1,ARGBLK+.RCFCJ	;Load the function again
	MOVE T3,ARGBLK+.RCARA	;Point to the supplied argument block address
	MOVE T3,.GELUN(T3)	;Get user number for login
	CAIN T1,.GOLOG		;Is it the login function?
	MOVEM T3,JIBLK+.JIUNO	;Yes, fix up GETJI argument block

;Find out the username, returning default P2 and P3 if error or illegal.

	HRROI T1,USRSTR		;Point to user string storage area
	MOVE T2,JIBLK+.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?
	RET			;Yes, return +1 now with P3 and P4 defaulted

;Find user in our database, returning default P2 and P3 if not found.

	MOVEI T1,USRTBL		;Point to the usr keyword table
	HRROI T2,USRSTR		;Point to string to compare against
	CALL WTBLUK		;(T1,T2/T1,T2,T3) Do a wild TBLUK function
	TXNE T2,TL%NOM		;No match?
	RET			;Return P3 and P4 as defaults
	HRRZ P3,(T1)		;Return the offset into USRPRO and such tables
	MOVE P4,USRPRO(P3)	;Reload the profile bits
	RET			;Skip return with P1 through P4 set up
	SUBTTL Access Control -- Processing Loop -- Check Request

;Here to check on the request, called with
;	P1/ offset into function tables
;	P2/ FUNCTB bits from tables
;	P3/ offset for user profile tables
;	P4/ USRPRO profile bits for this user
;Returns +1 always, T2 and T3/ set up for GIVOK

REQUES:	HLRO T2,FUNLOG(P1)	;Point to name of this function
	CALL LOGSTA		;(T2/T1) Start filling in log information

	MOVE Q1,ARGBLK+.RCARA	;Point to argument block
	HRRZ T2,FUNLOG(P1)	;Load address of the routine
	CALL (T2)		;(T1,Q1,P1,P2,P3,P4/T1) Fill in the log text
	MOVEM T1,TEXTBP		;Store updated pointer

	TXNE P2,FU%POL		;Enforce policy for this function?
	IFSKP.			;No, just allow (or deny) always
	  SETZB T2,T3		;Assume we will allow this
	  MOVE T4,FUNTMO(P1)	;Load TMON bits for this function
	  TXNE T4,SF%DOK	;Should we allow this?
	  RET			;Yes, allow the function
	  TXO F,FL%DEN		;Light the deny bit please
	  MOVEI T2,400000	;Deny the request
	  HRROI T3,[ASCIZ/Denied by access control facility/]
	  RET			;Deny the request
	ENDIF.			;Otherwise call routine to test policy

	CALL @FUNTST(P1)	;(Q1,P1,P2,P3,P4/T2,T3) Should be allowed?
	IFSKP.			;Skip means yes
	  CALL USRPOL		;(Q1,P1,P2,P3,P4/T2,T3) Should be allowed?
	  ANSKP.		;Skip means yes
	    SETZB T2,T3		;Yes, allow the request
	    RET			; and return
	ENDIF.			;Deny the request, insure T2 and T3 are OK
	TRNE T2,400000		;Is this a legal error code?
	TLNE T2,-1		;Cannot have bits in left half
	MOVEI T2,ERRAEC		;Illegal access control code
	TLC T3,-1		;Check the left half
	TLCE T3,-1		;Is it -1,,address?
	HRROI T3,[ASCIZ/Denied by access control facility/] ;Generic message
	RET			;Return ready for GIVOK JSYS
	SUBTTL Access Control -- Processing Loop -- Wait for failure

;Here to perform special checks after a request has been disposed of.
;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 always.

WAITFO:	HLRZ T1,ARGBLK+.RCFCJ	;Get function code

;Check for login or attach complete.

	CAIE T1,.GOLOG		;Was it a login ?
	CAIN T1,.GOATJ		; or an attach?
	IFNSK.			;Yes
	  MOVEI T1,^D1000	;Wait a sec...
	  DISMS%		; for the job to LOGIN or not
	  HRRZ T1,ARGBLK+.RCFCJ	;Get this job number
	  HRROI T2,T4		;Want one word returned in T4
	  MOVEI T3,.JIUNO	;Job's user number
	  GETJI%		;Get it
	   ERNOP.		;Ignore error for now
	  TRNE T4,-1		;Did user get logged in?
	  RET			;So then return
	  TXO F,FL%FAI		;Nope, failed
	  AOS NFAIL		;Count the failed attempt
	  RET			; and then return
	ENDIF.			;It wasn't a login or attach

;[122] Check for functions that must cause a log file sweep.

	CAIN T1,.GOHSY		;[125] HSYS setting?
	CALLRET HSYLOG		;[125] (Q1/) Please set a timer interrupt then

	CAIN T1,.GOMDD		;[122] Is it a MDDT entry?
	TXO F,FL%SLF		;[122] Yes, sweep the log file

;Other special waits should go here.

	RET			;Return
	SUBTTL Access Control -- Processing Loop -- Log Request

;Here to possibly send the request to the log file.
;Call with P2/ function bits

LOGREQ:	MOVE T1,TEXTBP		;Point to text buffer today please
	HRROI T2,[ASCIZ/ [Denied]/] ;Load denied indicator
	TXNE F,FL%DEN		;Denied?
	CALL ISOUT		;(T1,T2/T1) Yes book 'em
	HRROI T2,[ASCIZ/ [Unusual]/] ;Load unusual indicator
	TXNE F,FL%UNU		;Unusual?
	CALL ISOUT		;(T1,T2/T1) Yes tell me so
	HRROI T2,[ASCIZ/ [Failed]/] ;Load failed indicator
	TXNE F,FL%FAI		;Failed?
	CALL ISOUT		;(T1,T2/T1) Yes the unfortunate consequences
	CALL OCRLF		;(T1/T1) Append a CRLF to all of that stuff
	CALLRET USRLOG		;(P1,P2,P3,P4/) Log if desired
	SUBTTL Access Control -- Subroutines -- Wild TBLUK Routine

;Routine to do a wild TBLUK function.
;Call with TBLUK% ACs:
;	T1/ address of table
;	T2/ byte pointer to string to be compared with strings in table
;Returns +1 always
;	T1/ address of entry that matches or would have
;	T2/ Recognition flags (TL%NOM and TL%EXM being the interesting ones)

WTBLUK:	SAVEAC <Q1,Q2,Q3>	;Save ACs to save calling arguments in
	DMOVE Q1,T1		;Copy the ACs over to the Qs
	TBLUK%			;Look this user up
	 ERNOP.			;Never ITRAPs, but be careful anyway
	TXNE T2,TL%EXM		;Exact match?
	RET			;Yes, return T1, T2, T3

	MOVEI Q3,(T1)		;Save address to be returned if no match
	MOVEI T4,(T1)		;Load address returned by TBLUK%
	DO.			;Start looping through the table backwards
	  MOVEI T1,.WLSTR	;Load wild string match function
	  HLRO T2,(T4)		;Point to the ASCIZ user argument
	  HRROI T3,USRSTR	;Point to username to compare against
	  WILD%			;Try and match this one
	   ERNOP.		;Never is supposed to ITRAP, but ya never know
	  IFN. T1		;If no match
	    CAIE T4,1(Q1)	;Was this the last entry in the table?
	    SOJA T4,TOP.	;Nope, keep looking
	    MOVEI T1,(Q3)	;Return address where the TBLUK wanted it to be
	    MOVX T2,TL%NOM	;Return no match bit 
	    RET			;Return +1 always
	  ENDIF.		;Otherwise it must have matched
	OD.			; so fall out of the loop
	MOVEI T1,(T4)		;Point to the entry that matched today
	MOVX T2,TL%EXM		;Return exact match flag for caller
	RET			;Return +1 always
	SUBTTL Access Control -- Subroutines -- Get User Information

;Here to find out all about a job.
;Call with T1/ job, T4/ address of our GETJI block
;Returns +1 always if GETJI% error
;Returns +2 if no error in the GETJI%, and with following:
;	GETJI block, NTINFB+.NWTTF, NTBLK, and MORSPW set up, T4 preserved

GETINF:	SAVEAC <Q1,Q2,Q3>	;Save the Qs
	MOVEI T2,(T4)		;Point to start of block
	HRLI T2,-<.JIMAX+1>	;Load size of this block
	SETZ T3,		;All info
	GETJI%			;Get info on this job
	 ERJMP R		;Return +1 if error here

;Got basic job info, now get job origin information.

	SETZM NTBLK(T4)		;Insure first work is zero for local lines
	MOVX T1,<NW%NNT>B17	;Load default which is non network terminal
	MOVEM T1,NTINFB+.NWTTF(T4) ;Save this in case NTINF JSYS fails
	SETZM MORSPW(T4)	;Clear returned speed word

;Danger Will Robinson!  Since NTINF% will give you a free null at the end of
;the origin string if it is a LAT terminal in older (6.1 and early 7.0)
;monitors, we cannot just write the string to our output pointer.  We have
;write to it NTBLK instead and copy it to the output pointer later.

	HRROI T1,NTBLK(T4)	;Point to place to store the string
	MOVEM T1,NTINFB+.NWNNP(T4) ;Save output pointer
	MOVE T2,.JIJNO(T4)	;Load job number
	MOVEM T2,NTINFB+.NWLIN(T4) ;Save job number for NTINF
	DMOVE T1,[EXP .NWNU1+1,.NWRRH] ;Load size of arg block and arg type
	DMOVEM T1,NTINFB+.NWABC(T4) ;Save size of the block and arg block type
	MOVEI T1,NTINFB(T4)	;Load address of information block
	NTINF%			;Get information on this user
	 ERJMP GETIN1		;If error, assume local terminal

;Check result, if non network terminal we say nothing.

	MOVE T2,NTINFB+.NWTTF(T4) ;Load returned type and flags
	LDB T3,[POINT 9,NTINFB+.NWTTF(T4),17] ;(no symbol for this field)
	CAIE T3,NW%NNT		;Non network terminal?
	JRST GETIN2		;Nope, a network terminal
;	JRST GETIN1		;Fall through if non network terminal
;Here if the line appears to be a non network (front end) terminal.

GETIN1:	SKIPGE .JICPJ(T4)	;Is this a PTY job?
	SKIPGE T1,.JITNO(T4)	; or is this a detached job?
	RETSKP			;Yes, return now
	TXO T1,.TTDES		;Make designator out of terminal number
	MOVEI T2,.MORSP		;Read terminal speed word
	MTOPR%			;Read terminal speed
	 ERJMP RSKP		;Return now if error
	MOVEM T3,MORSPW(T4)	;Return to the user for later
	RETSKP			;Now return

;Here if the line appears to be a network terminal.  If name found copy it to
;the output pointer.  If name not known, but network type is, return a properly
;formatted number.

GETIN2:	MOVEI T1,NTBLK(T4)	;Point to place where we stored the string
	HRLI T1,(POINT 7)	;Make a pointer to that please
	TXNE T2,NW%NNN		;No name known for this network terminal?
	JRST GETIN3		;Yes, print a number instead
	MOVE T3,T1		;Get current pointer
	DO.			;Find the end of that name string
	  ILDB T2,T3		;Load a character
	  JUMPN T2,TOP.		;Loop if not a null
	OD.			;End of null search loop
	MOVNI T1,1		;Load a -1
	ADJBP T1,T3		;Back up one so we can write over the null
	JRST GETIN7		;Nope, name known, add type next

;Here when network name not known.

GETIN3:	CAIN T3,NW%TCP		;Unknown TCP host connection?
	JRST GETIN4		;Yes, do it
	CAIN T3,NW%DNA		;Unknown DECnet host connection?
	JRST GETIN5		;Yes, handle it
	CAIN T3,NW%LAT		;Unknown LAT connection?
	JRST GETIN6		;Yes
	RET			;None of those return with T1 unchanged
	
;Here if its a TCP connection, output "0.0.0.0".

GETIN4: CALL OSPACE		;(T1/T1) Send a space along next
	MOVEI Q1,4		;Load number of octets to print
	MOVE Q2,[POINT 8,NTINFB+.NWNNU(T4),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 Q1,GETIN7	;(T1/T1) Output connection type
	  HRROI T2,[ASCIZ/./]	;Point to a dot
	  CALL ISOUT		;(T1,T2/T1) Append that to the string
	  JRST TOP.		;Loop for all octets
	OD.			;End of TCP loop

;Here if its a DECnet connection, output "0.0".

GETIN5: CALL OSPACE		;(T1/T1) Send a space along next
	LDB T2,[POINT 6,NTINFB+.NWNNU(T4),25] ;Get area of DECnet node number
	CALL ODEC		;(T1,T2/T1) Print it
	HRROI T2,[ASCIZ/./]	;Load a pointer to a dot
	CALL ISOUT		;(T1,T2/T1) Output the dot next
	LDB T2,[POINT 10,NTINFB+.NWNNU(T4),35] ;Get node number part
	CALL ODEC		;(T1,T2/T1) Output that and return
	CALLRET	GETIN7		;(T1/T1) Output connection type and return

;Here if it is a LAT connection, output "00-00-00-00-00-00".

GETIN6: CALL OSPACE		;(T1/T1) Send a space along next
	MOVEI Q1,6		;Load number of hex bytes to print
	MOVE Q2,[POINT 8,NTINFB+.NWNNU(T4)] ;Make ILDB pointer to data
	MOVX T3,NO%LFL!NO%ZRO!FLD(2,NO%COL)!FLD(^D16,NO%RDX) ;Hex output
	DO.			;For each octet
	  ILDB T2,Q2		;Load a TCP octet
	  NOUT%			;Output that hex digit
	   ERNOP.		;Ignore errors for now
	  SOJG Q1,GETIN7	;(T1/T1) Output connection type and retutn
	  HRROI T2,[ASCIZ/./]	;Point to a dot
	  CALL ISOUT		;(T1,T2/T1) Append that to the string
	  JRST TOP.		;Loop for all octets
	OD.			;End of TCP loop
;Here to output type of connection from the table.

GETIN7:	HRRZ T2,NTINFB+.NWTTF(T4) ;(no symbol for this field) Get line type 
	MOVSI Q1,-OORSIZ	;Load number of things in table,,0
	DO.			;Loop for things in table
	  HRRZ Q2,OORTAB(Q1)	;Load type of connection from table
	  CAMN Q2,T2		;Match the type we want to hear about?
	  EXIT.			;Yes
	  AOBJN Q1,TOP.		;Loop for all of them
	  RETSKP		;Unknown type
	OD.			;End of loop
	HLRO T2,OORTAB(Q1)	;Match, load address of text
	CALL ISOUT		;(T1,T2/T1) Add that in 
	RETSKP			; and then skip return

;Table of network connection types for above code.

OORTAB:	TENTRY (<(NRT)>,NW%MC)	;MCB (NRT) terminal
	TENTRY (<(TCP)>,NW%TV)	;TVT (TCP) terminal
	TENTRY (<(CTM)>,NW%CH)	;CTERM terminal
	TENTRY (<(LAT)>,NW%LH)	;LAT terminal
	OORSIZ==.-OORTAB	;Make size of table
	SUBTTL Logging Routines -- Midnight Timer Routines

;Here on a timer interrupt at midnight to start a new log file.  See if we can
;do it now and if so do it, otherwise set a flag and do it later.
;Returns +1 always.

MIDNIT:	CALL MIDHAN		;(/) Handle the midnight interrupt
	DEBRK%			;Dismiss from interrupt

MIDHAN:	SAVEAC <T1,T2,T3,T4,Q1,Q2,Q3> ;Save all of the suspect ACs
	TXNE F,FL%NOI		;Are we NOINT?
	TXOA F,FL%NLF		;Yes, remember to do log file stuff later
	CALL NEWLOG		;(/) OKINT, get a new log file now please
;	CALLRET INIMID		;(/) Get back here again please at midnight

;Here to set the timer interrupt that goes off each night at midnight.
;Returns +1 always, T1-T4 smashed.

INIMID:	SETO T2,		;The time is now
	SETZ T4,		;No flags for this please
	ODCNV%			;Get all seperate pieces of time
	 JSERRO (<ODCNV failure>,,R) ;This will never happen I hope 
	HRRI T4,0		;Load time of midnight today
	IDCNV%			;Convert midnight today back to internal format
	 JSERRO (<IDCNV failed>,,R) ;This should never happen
	ADD T2,[1,,0]		;Get midnight tomorrow
	MOVX T1,<.FHSLF,,.TIMDT> ;Set interrupt at particular time
	MOVEI T3,MDCHAN		;Load channel number to interrupt on
	TIMER%			;Set the interrupt
	 JSERRO (<Failed to set midnight timer>) ;Too many timer blocks?
	RET			;Just return +1 no matter what happens
	SUBTTL Logging Routines -- System Shutdown Time Routines

;[125] Here when ACJ is initializing to get any possible HSYS time.
;Sets a TIMER for the time specified that the system will go down.
;Returns +1 always.

INIHSY:	MOVEI T1,.DWNTI		;[125] Load GETAB table for down time
	GETAB%			;[125] Get this from the monitor
	 SETZ T1,		;[125] Assume no shutdown if that failed
	MOVE T2,T1		;[125] Copy time to T2
	CALLRET HSSLOG		;[125] (T2/) Set a timer for that time please

;[125] Here when a GOHSY GETOK function has been processed.
;Call with Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets).
;Returns +1 always.

HSYLOG:	MOVE T2,.GESDT(Q1)	;[125] Load the shutdown time specified
;	CALLRET HSSLOG		;[125] (T2/) Set a timer interrupt at that time

;[125] Here to set a timer because we think the system will be shutdown.
;Call with T2/ time that the system is expected to be shutdown
;Returns +1 always.

HSSLOG:	MOVEI T3,HFCHAN		;[125] Load channel number to interrupt on

	SKIPN LOGHSY		;[125] Do we have a timer set now?
	IFSKP.			;[125] Yes, we do in fact
	  EXCH T2,LOGHSY	;[125] Save new time, get old time
	  MOVX T1,<.FHSLF,,.TIMDD> ;[125] Get function for delete and this fork
	  TIMER%		;[125] Remove the old interrupt time
	   ERNOP.		;[125] Ignore error for now
	  MOVE T2,LOGHSY	;[125] Get new time in T2 again
	ENDIF.			;[125] End of timer set previously code

	MOVEM T2,LOGHSY		;[125] Save time of expected HSYS
	JUMPE T2,R		;[125] Return now if shutdown canceled
	GTAD%			;[125] Get current date time
	ADDI T1,<<2,,0>/^D<60*60*24>> ;[125] Get time two seconds from now
	CAMGE T1,T2		;[125] Shutdown time is in the next 2 seconds?
	IFSKP.			;[125] Yes, don't set a timer
	  SETZM LOGHSY		;[125] Not expecting an interrupt now
	  TXO F,FL%NLF		;[125] Get a new log file now
	  RET			;[125]  and then return
	ENDIF.			;[125] End of shutdown in the near future code
	MOVX T1,<.FHSLF,,.TIMDT> ;[125] Set interrupt at time in T2
	TIMER%			;[125] Yes, please set the interrupt
	 ERNOP.			;[125] Not that important today anyway
	RET			;[125] Just return +1 no matter what happens
;[125] Here when timer interrupt goes off to get a new log file.  Does not get
;a new log file if we get the timer interrupt when we don't expect to get one.
;Does the work now if OKINT, sets flag to do it later if NOINT.

INTHSY:	SKIPE LOGHSY		;[125] Expecting system to go down?
	CALL HSYINT		;[125] (/) Yes, call routine to do the work
	DEBRK%			;[125] Return from interrupt

HSYINT:	SAVEAC <T1,T2,T3,T4,Q1,Q2,Q3> ;[125] Save all of the suspect ACs
	TXNE F,FL%NOI		;[125] Are we NOINT?
	TXOA F,FL%NLF		;[125] Yes, remember to do log file stuff later
	CALL NEWLOG		;[125] (/) A new broom sweeps the best
	RET			;[125] Return from interrupt
	SUBTTL Logging Routines -- Initialization of Log File

;Routine to get a JFN on a new log file.
;Returns +1 always.

NEWLOG:	CALL CLOLOG		;(/) First try and close any old file
	CALL NAMLOG		;[124] (/) Get a new log file name	

;[107] Open a JFN up and then get the resulting filename for later use.

	MOVX T1,GJ%SHT!GJ%FOU	;Load new log file bits
	HRROI T2,LOGFNA		;[124] Point to log file spec
	GTJFN%			;Try getting new file JFN
	 JSERRO (<Can't get JFN for log file>,<SETZ T1,>) ;Owie, return T1/ 0
	MOVEM T1,LOGJFN		;[107] Save the JFN (zero if none)
	JUMPE T1,R		;[107] Return now if no log file JFN
	MOVE T2,T1		;[110] Copy JFN of the log file
	HRROI T1,LOGFNA		;[110] Point to log file area
	MOVX T3,JS%SPC		;[110] We want the entire filespec por favor
	JFNS%			;[110] Get the filename we are using
	 ERNOP.			;[110] Ignore errors for now

;[107] Open up the log file, set pointers to it, write header, and return.
	
	CALL OPNLOG		;[107] (/) Open up that log file now
	CALL NPTLOG		;[107] (/) Set up new log file cache pointers
	CALL SECLOG		;(T1/T1) Make the log file secure
	SETZM LOGLIN		;We have written no lines to this file
	SETZM LOGPAG		;We have written no pages to this file
	CALLRET HDRLOG		;[107] (/) Get a new header on the log file
;Local routine for NEWLOG to make a log file secure, call with T1/ JFN
;Returns +1 always.

SECLOG:	SKIPN T1,LOGJFN		;[124] Reload the JFN of the log file
	RET			;[124] Log file not open now
	TXO T1,CF%NUD!FLD(.FBCTL,CF%DSP) ;Load the FBCTL word
	MOVX T2,FB%SEC		;The secure bit mask
	MOVX T3,FB%SEC		;We want the secure bit to be set
	CHFDB%			;Set the file secure
	 ERNOP.			;Don't care about errors
	RET			;Return +1 always

;[124] Local routine for NEWLOG to create a new log file name.
;The log filename is made by by moving the LOGFIL string into LOGFNA,
;replacing the character "*" with a string to output the time.
;Returns +1 always, LOGFNA set up.

NAMLOG:	SETZM LOGFTI		;[124] Be sure to get a fresh time if needed
	MOVE T4,[POINT 7,LOGFIL] ;[124] Point to the log file name
	MOVE T1,[POINT 7,LOGFNA] ;[124] Point to place to build log file spec
	DO.			;[124] Loop for all characters in the filename
	  ILDB T3,T4		;[124] Load a character for the log file
	  CAIE T3,"*"		;[124] Is it the wild thing?
	  IFSKP.		;[124] Yes, substitute the time
	    SKIPN LOGFTI	;[124] Any time string set up?
	    CALL FNTLOG		;[124] (/) Make the time string
	    HRROI T2,LOGFTI	;[124] Point to formatted time
	    CALL ISOUT		;[124] (T1,T2/T1) Store the time
	  ELSE.			;[124] Otherwise it was not wild
	    IDPB T3,T1		;[124] Not wild, store that character
	  ENDIF.		;[124] End of wild/nonwild check
	  JUMPN T3,TOP.		;[124] Loop until input null seen
	OD.			;[124] End of loop for characters
	RET			;[124] Return to caller with LOGFNA set up
;[124] Local routine called only from NAMLOG.
;Call to create time string "year-month-day-hours-minutes-seconds" in LOGFTI.
;Returns +1 always with LOGFTI filled.

FNTLOG:	SAVEAC <T1,T2,T3,T4,Q1,Q2,Q3> ;[124] Save the Ts and Qs
	SETO T2,		;[124] Load time of now
	SETZ T4,		;[124] No particular options
	ODCNV%			;[124] Get seperate numbers for time and so on
	 ERJMP R		;[124] This will not fail today
	HRRZ Q3,T2		;[124] Copy month to Q3
	HLRZ Q2,T3		;[124] Copy day to Q2
	HRRZ Q1,T4		;[124] Copy seconds since midnight to Q1

	HRROI T1,LOGFTI		;[124] Point to place to build the time
	HLRZ T2,T2		;[124] Load the year
	CALL ODEC		;[124] (T1,T2/T1) Send the year first
	HRRZ T2,Q3		;[124] Load numeric month
	CALL FNTLON		;[124] (T1,T2/T1) Send hyphen and month
	HRRZ T2,Q2		;[124] Load the numeric day
	CALL FNTLON		;[124] (T1,T2/T1) Send hyphen and day
	IDIVI Q1,^D60*^D60	;[124] Get hours in Q1, 
	IDIVI Q2,^D60		;[124]  minutes in Q2, seconds in Q3
	MOVE T2,Q1		;[124] Load hours
	CALL FNTLON		;[124] (T1,T2/T1) Send hyphen and hours
	MOVE T2,Q2		;[124] Load the minutes
	CALL FNTLON		;[124] (T1,T2/T1) Send hyphen and minutes
	MOVE T2,Q3		;[124] Load the seconds
	CALL FNTLON		;[124] (T1,T2/T1) Send hyphen and seconds
	MOVEI T2,0		;[124] Load a null
	IDPB T2,T1		;[124]  and store it there
	RET			;[124] Return

;[124] Local routine called only from FNTLOG.
;Stores a hyphen followed by two ASCII digits from a binary number in T2.
;Returns +1 always.

FNTLON:	MOVEI T3,"-"		;[124] Load hyphen
	IDPB T3,T1		;[124]  store hyphen first
	IDIVI T2,^D10		;[124] Get the two digits
	ADDI T2,"0"		;[124] Convert tens digit to ASCIZ
	ADDI T3,"0"		;[124] And the ones digit to ASCIZ
	IDPB T2,T1		;[124] Store the tens digit
	IDPB T3,T1		;[124]  and the ones digit
	RET			;[124] Return to caller
	SUBTTL Logging Routines -- Send Text to Log File

;Routine to send text to the log file, used for all logging of GETOK functions.
;Call with T1/ pointer to ASCIZ text.
;Returns +1 always, string written

SENLOG:	SAVEAC Q1		;Save an AC
	MOVEM T1,Q1		;Save the pointer to the string please
	MOVE T1,LOGLIN		;[120] Skip if no lines printed on this page 
	CAIL T1,PAGLEN		;[120] Lines sent, over maximum number on page?
	CALL HDRLOG		;[120] (/) Send header to log file
	MOVE T1,Q1		;[107] Restore pointer to string
	CALLRET SOULOG		;[107] (T2/) Write that string to the log file

;[116] Here to write header and statistic information to the log file.
;Returns +1 always

HDRLOG:	HRROI T1,HEADBU		;[116] Point to the header buffer 
	CALL NPGLOG		;[116] (T1/T1) Output first line of header
	CALL STALOG		;[116] (T1/T1) Output second through nth lines
	CALL OCRLF		;[116] (T1/T1) Repeat myself
	HRROI T1,HEADBU		;[116] Point to text buffer
	CALLRET SOULOG		;[116] (T1/) Send all of that to log file 

;[120] Here to write summary information to the log file.
;Returns +1 always.

SUMLOG:	MOVE T1,LOGLIN		;[120] Load lines printed
	CAILE T1,PAGLEN-5	;[120] Is there enough room on this page?
	CALLRET HDRLOG		;[120] (/) Do a new header instead
	HRROI T1,HEADBU		;[120] Point to the header buffer
	CALL OCRLF		;[120] (/) First we want a CRLF output
	CALL STALOG		;[120] (T1/T1) Output second through nth lines
	HRROI T1,HEADBU		;[120] Point to text buffer
	CALLRET SOULOG		;[120] (T1/) Send all of that to log file 
	SUBTTL Logging Routines -- Log File Cached Write

;[107] Routine to set up for new log file buffer.
;Uses CX so that no real ACs are damaged.
;Returns +1 always with pointers and counts reset.

NPTLOG:	MOVEI CX,<<1+LOGBLP-LOGBFP>*5*1000>-1 ;[107] Load number of characters
	MOVEM CX,LOGCNT		;[107]  and save it here
	MOVE CX,[POINT 7,LOGBUF] ;[107] Point to the log buffer
	MOVEM CX,LOGPTR		;[107] Save that there
	SETZM LOGBUF		;[107] Insure first word zero for checks
	RET			;[107] Return always

;[107] Routine to do a SOUT to the log file.
;Note: this routine is called ONLY from SENLOG, HDRLOG, and SUMLOG.
;Call with T1/ pointer to ASCIZ text.
;Returns +1 always, string written (to cache or real file).

SOULOG:	TLC T1,-1		;[107] Complement left half
	TLCN T1,-1		;[107] Was the left half -1?
	HRLI T1,(Point 7)	;[107] Yes, make it a byte pointer
	DO.			;[107] Loop for entire string
	  ILDB T2,T1		;[107] Load a character from the file
	  CAIN T2,.CHLFD	;[116] Is it a line feed?
	  AOS LOGLIN		;[116] Count this line as sent to log
	  JUMPE T2,ENDLP.	;[107] Get out if a null seen
	  CALL CHRLOG		;[107] (T2/) Send character to log file
	  LOOP.			;[107] Loop for all of them
	OD.			;[107] End of copy loop
	MOVE T1,LOGPTR		;[107] Load the pointer
	IDPB T2,T1		;[107] Store null to bind off string
	RET			;[107]  and return

;[107] Routine to store a log file character in log file cache buffer.
;Call with T2/ character.
;Returns +1 always.

CHRLOG:	SOSLE LOGCNT		;[107] Is there space for that character?
	IFSKP.			;[107] Nope
	  SETZ CX,		;[107] Load a null
	  IDPB CX,LOGPTR	;[107]  and bind off the end of the buffer
	  CALL SWPLOG		;[107] (/) Sweep the log file out to disk
	  TXO F,FL%SLF		;[107] Perform another sweep later please
	  CALLRET CHRLOG	;[107] (/) Now output the character and return
	ENDIF.			;[107] End of no more room code
	IDPB T2,LOGPTR		;[107] Save the character in buffer
	RET			;[107]  and return to caller
	SUBTTL Logging Routines -- Log File Cache Sweep Interrupts

;[107] Here on a interrupt to log file sweep every LOGINT seconds.
;Returns +1 always with log file cache swept.

INTLFF:	CALL LFFHAN		;[107] (/) Handle the interrupt
	DEBRK%			;[107] Dismiss from interrupt

LFFHAN:	SAVEAC <T1,T2,T3,T4,Q1,Q2,Q3> ;[107] Save all of the suspect ACs
	TXNE F,FL%NOI		;[107] Are we NOINT?
	TXOA F,FL%SLF		;[107] Yes, remember to do log file stuff later
	CALL SWPLOG		;[107] (/) Sweep out the log file cache please
;	CALLRET INILFF		;[107] (/) Get back here again in LOGINT secs

;[107] Here to set the timer interrupt that goes off to sweep log file cache.
;Returns +1 always, T1-T4 smashed.

INILFF:	MOVX T1,<.FHSLF,,.TIMEL> ;[107] Set interrupt at elapsed time
	SKIPG T2,LOGINT		;[113] Load interval for log file updates
	RET			;[113] If zero cache is disabled
	IMULI T2,^D1000		;[107]  and convert it to milliseconds
	MOVEI T3,LFCHAN		;[107] Load channel number to interrupt on
	TIMER%			;[107] Set the interrupt
	 JSERRO (<Failed to set log file timer>) ;[107] Too many timer blocks?
	RET			;[107] Just return +1 no matter what happens
	SUBTTL Logging Routines -- Log File Cache Sweep

;[107] Routine to sweep contents of log file to disk.
;Returns +1 always with LOGBUF copied to log file.

SWPLOG:	SKIPE LOGBUF		;[107] Is there anything to write or
	SKIPN LOGJFN		;[107]  any JFN on the log file?
	RET			;[107] Nope, get out now

	SAVEAC <T1,T2,T3,T4>	;[107] Save the temps as they are really needed
	HRROI T2,LOGBUF		;[107] Point to the log buffer
	SETZB T3,T4		;[107] Terminate on a null
	SKIPE T1,LOGJFN		;[107] Load the JFN for the log file
	SOUT%			;[107] Send that text to the log file
	IFJER.			;[107] If there was a problem
	  OJSERR (<Error writing to log file>) ;[107] Mumble about the error
	  HRROI T1,LOGBUF	;[107] Reload pointer to string
	  PSOUT%		;[107] Send to console terminal
	ENDIF.			;[107] End of log file write problem code
	CALL NPTLOG		;[107] (/) Set up new pointers and so on
;	CALLRET CKPLOG		;[107] (/) Try closing and reopening log file
	SUBTTL Logging Routines -- Open/Close/Checkpoint Log File

;[107] Routine to checkpoint the log file.
;Called only from SWPLOG, closes and then reopens the log file.
;Returns +1 always

CKPLOG:	SKIPN T1,LOGJFN		;Get JFN, skip if there is one
	CALLRET NEWLOG		;[107] (/) None there, try for a new one

	TXO T1,CO%NRJ		;Keep the JFN but close the file
	CLOSF%			;Yes, close the log file
	 ERCAL NEWLOG		;(/T1) Oh no!  Holy OFN, something smells bad
;	CALLRET OPNLOG		;[107] (/) Reopen the log file

;[107] Routine to open the log file.
;Returns +1 always.

OPNLOG:	SKIPN T1,LOGJFN		;[107] Skip if a log file JFN assigned today
	RET			;[107] No log file to open
	MOVX T2,FLD(7,OF%BSZ)!OF%APP ;[107] 7 bit append mode
	OPENF%			;[107] Open the jfn for append
	 JSERRO (<Can't open log file>,<CALL CLOLOX>) ;[107] Report error
	RET			;[107] Return

;Here to close the log file JFN.
;Returns +1 always with log file closed.

CLOLOG:	SKIPN LOGJFN		;[120] Anything to do?
	RET			;[120] Nope, return now
	CALL SUMLOG		;[120] (/) Send summary to log file
	CALL SWPLOG		;[107] (/) Sweep log file cache
CLOLOX:	SKIPE T1,LOGJFN		;[107] Load the log file JFN, skip if none
	CLOSF%			;Shake rattle and roll
	 ERCAL RLSLOG		;Try to release the JFN if error
	SETZM LOGJFN		;No longer a JFN to worry about
	CALLRET NPTLOG		;[110] (/) Don't worry be happy 

RLSLOG:	MOVE T1,LOGJFN		;Load the JFN again
	RLJFN%			;Release it today
	 ERNOP.			;Really don't care if this fails
	RET			;In any case we tried to dump the JFN
	SUBTTL Logging Routines -- New Page for Log File

;[116] Local routine to output first line of new page header.
;Call with T1/ output pointer
;Returns+1 always, T1/ updated pointer

NPGLOG:	SETZM LOGLIN		;[116] Clear number of lines this page
	HRROI T2,[BYTE(7).CHFFD,.CHCRT,.CHLFD,.CHTAB,0] ;Form feed crlf tab
	CALL ISOUT		;(T1,T2/T1) Start with that
	HRROI T2,[VERSIO]	;Point to my name and version
	CALL ISOUT		;(T1,T2/T1) Send that out
	HRROI T2,[ASCIZ/ on /]	;Label the node
	CALL ISOUT		;(T1,T2/T1) Append that text next
	HRROI T2,OURNAM		;Point to this node's name
	CALL ISOUT		;(T1,T2/T1) Append that text next
	HRROI T2,[ASCIZ/, /]	;Load the little seperator
	CALL ISOUT		;(T1,T2/T1) Append that text next
	SETOB T2,T3		;The time is now, long format please
	CALL OODTI1		;(T1,T2,T3/T1) Do the ODTIM JSYS
	AOS T3,LOGPAG		;Get the page number we are writing today
	HRROI T2,[ASCIZ/, page /] ;Label for page number
	CALL OLDEC		;(T1,T2,T3/T1) Output that label and number
	CALLRET OCRLF		;[116] (T1/T1) Output a crlf and return
	SUBTTL Logging Routines -- Statistics Logging

;[116] Local routine to output statistics, second through nth header lines.
;Call with T1/ output pointer
;Returns+1 always, T1/ updated pointer

STALOG:	SKIPN NALLOW		;[116] [111] Any allowed?
	SKIPE NDENY		;[111] Any denied?
	IFNSK.			;[111] Yes to either
	  HRROI T2,[ASCIZ/	Allowed /] ;Space out for rest of text
	  CALL ISOUT		;Append that label
	  MOVE T2,NALLOW	;Load number allowed
	  HRROI T3,[ASCIZ/ request/] ;Label number
	  CALL OPLURA		;(T1,T2,T3/T1) Output number and label
	  HRROI T2,[ASCIZ/, denied /] ;Label for next number
	  CALL ISOUT		;Append that label
	  MOVE T2,NDENY		;Load number allowed
	  HRROI T3,[ASCIZ/ request/] ;Label number
	  CALL OPLURA		;(T1,T2,T3/T1) Output number and label
	  HRROI T2,[ASCIZ/, /]	;Label for next number
	  CALL ISOUT		;Append that label
	  MOVE T2,NFAIL		;Load number failed
	  HRROI T3,[ASCIZ/ request/] ;Label number
	  CALL OPLURA		;(T1,T2,T3/T1) Output number and label
	  HRROI T2,[ASCIZ/ failed
/]				;[111] 
	  CALL ISOUT		;[111] Append that label
	ENDIF.			;[111] That's all of the allow deny code
;[111] Output access control hit, misses, and ratio.

	SKIPN NMISS		;[111] We will always have at least 1 miss
	IFSKP.			;[111] Yes
	  MOVE T3,NHIT		;[113] Load (100*hits/hits+misses)
	  IMULI T3,^D100	;[113] Make into percentage (times millisecs)
	  MOVE T2,NMISS		;[113] Load misses
	  ADD T2,NHIT		;[113] Count hits
	  IDIV T3,T2		;[113] Compute percentage
	  HRROI T2,[ASCIZ/	Cache /] ;[113] What hit percentage
	  CALL OLDEC		;[113] (T1,T2/T1) Send hit percentage
	  HRROI T2,[ASCIZ/%, hit /] ;[113] Seperate hits
	  MOVE T3,NHIT		;[111] Load hits
	  CALL OLDEC		;[113] (T1,T2/T1) Send hits
	  HRROI T2,[ASCIZ/, missed /] ;[111] Seperate misses
	  MOVE T3,NMISS		;[111] Load misses
	  CALL OLDEC		;[111] (T1,T2/T1) Send misses along
	  HRROI T2,[ASCIZ/, flushed /] ;[113] Seperate flishes
	  MOVE T3,NFLUSH	;[113] Load flushes
	  CALL OLDEC		;[113] (T1,T2/T1) Send flushes
	  CALL OCRLF		;[111] (T1/T1) and a crlf
	ENDIF.			;[111] End of access control cache display
;Get and save elapsed runtime and connect time.

	SAVEAC <Q1,Q2>		;Save a couple of ACs today
	MOVEM T1,Q2		;[113] Save current pointer to text string
	MOVEI T1,.HPRNT		;Get our runtime
	HPTIM%			;In high precsion units
	 JSERRO (<HPTIM failure to get runtime>,<SETZ T1,>) ;Big owie
	SKIPN RUNTIM		;Is there any runtime set?
	MOVEM T1,RUNTIM		;Nope, set it now
	MOVE Q1,T1		;Copy that to T1
	SUB Q1,RUNTIM		;Get our elapsed runtime
	TIME%			;Get system uptime in milliseconds
	SKIPN PEOPLE		;Any elapsed people time
	MOVEM T1,PEOPLE		;Nope, store initial value
	EXCH Q2,T1		;[113] Swap uptime for saved pointer
	SUB Q2,PEOPLE		;Get our elapsed people time

	IFN. Q2			;If there has been elapsed connect time
	  HRROI T2,[ASCIZ/	Used /]	;[111] Label for next number
	  CALL ISOUT		;Append that label
	  MOVE T2,Q1		;Load run time
	  CALL OTIMEH		;(T1,T2/T1) Output time in HPTIM units
	  HRROI T2,[ASCIZ/ in /] ;In
	  CALL ISOUT		;Append that tiny string
	  MOVE T2,Q2		;Load people time in milliseconds
	  CALL OTIME		;(T1,T2/T1) Output elapsed people time
	  CALL OCRLF		;(T1/T1) Output a CRLF
	ELSE.			;Otherwise we are running for first time
	  HRROI T2,[ASCIZ/	ACJ restart
/]				;Load the pointer to message
	  CALL ISOUT		;(T1,T2/T1) Send that along please
	ENDIF.			;[111] Done with logging time
	RET			;[116] Done
	SUBTTL Logging Routines -- Start Logging a Request

;Here to start out the log file text which is kept in TEXTBU until sending it
;to the log file.  This routine should be called with
;	JIBLK/ info about job in question
;	USRSTR/ username string for the request
;	T2/ pointer to function description string
;Returns +1 always, TEXTBP and T1/ pointer to log buffer

LOGSTA:	SAVEAC <Q1>		;Place to keep text pointer
	HRROI T1,TEXTBU		;Point to text buffer first of all
	MOVEM T2,Q1		;Save the pointer to text

	SETO T2,		;Want current time
	MOVX T3,OT%NDA		;No date
	CALL OODTI1		;(T1,T2,T3/T1) Do the ODTIM JSYS

	CALL OSPACE		;(T1/T1) Append in a single space
	HRROI T2,USRSTR		;Point to the username in question
	CALL ISOUT		;(T1,T2/T1) Send username string to log file

	CALL OSPACE		;(T1/T1) Append in a single space
	MOVE T2,Q1		;Load pointer to entry type name
	CALL ISOUT		;(T1,T2/T1) Send name to log file

	MOVEI T4,JIBLK		;Point to the GETJI block we made for this job
	CALL OGETJ1		;(T1,T4/T1) Output non-username job information

	HRRZ T4,ARGBLK+.RCCAP	;Get capability mask enabled
	SKIPE JIBLK+.JIJNO	;Is it job 0?
	CALL OCAPAB		;(T1,T4/T1) Asciify caps if not job 0

	MOVEM T1,TEXTBP		;Store the byte pointer for later
	RET			;Return +1 with T1/ pointer
	SUBTTL Spy on Intruder

;In order to spy on intruders (an excellent technique to discover unwanted
;tourists) the SPYON routine was stolen from another ACJ.  This intruder spy
;facility puts the user's output to a file.  

;For each intruder there is a fork in a BIN%/BIN% loop between a PTY TLINKed to
;the intruder's terminal and the suspected intruder's job.  The fork runs in
;ACJ's address space so that it can be started quickly, and is started sharing
;adress space with the top level ACJ fork.  Each fork has its own acs of course
;but also its own private stack.  The private fork's stack and the ACs are the
;only storage the subfork writes into.  Every 10 seconds it takes a TIMER
;interrupt to see if the job has moved to another terminal, logged out, or
;typed BREAK (it always redoes the spy link in case the user typed BREAK).
;After the spy fork halts, the superior fork notices on a fork termination
;interrupt and kills any spy forks that smell bad (halt or error halt status).

;AC usage in the spy on intruder fork startup code and in the spy fork:
;	P1/  User number
;	P2/  Job number
;	P3/  Log file JFN
;	P4/  PTY designator
;	P5/  PTY's TTY I/O designator

;Define a little macro to catch spy fork errors and punt the spying session.
;This is done because the fork by design does not touch any memory that the
;superior ACJ main fork might be using.

DEFINE ERSPY(TEXT),<
	ERJMP [	JSP T1,SPYERR
		ASCIZ/ ACJ Spy: TEXT/]
>
DEFINE SPYER(TEXT),<
	JRST [	JSP T1,SPYERR
		ASCIZ/ ACJ Spy: TEXT/]
>
	SUBTTL Spy on Intruder -- Start a Spy Fork

;Here to start spying on a suspected attacker.
;Call with
;	T1/ user number to spy on
;	T2/ job number to spy on
;Returns +1 Already logging or can't log
;Returns +2 Spy fork started

;AC usage in this routine, all of which are passed to inferior fork:
;	Q1/ inferior fork's stack pointer
;	Q2/ inferior fork's offset in SPYxxx tables
;	P1/  User number
;	P2/  Job number
;	P3/  Log file JFN
;	P4/  PTY designator
;	P5/  PTY's TTY I/O designator

SPYON:	SAVEAC <P1,P2,P3,P4,P5,Q1,Q2> ;Save the perms
	DMOVE P1,T1		;Copy user number to P1, job number to P2
	SETZ Q2,		;Indicate no free slot found yet
	MOVSI T4,-NSPYS		;Get number of forks we can have
	DO.			;Search job/user table
	  CAME P2,SPYJOB(T4)	;Does the job match?
	  IFSKP.		;Yes
	    CAMN P1,SPYUSR(T4)	;Does the user match?
	    RET			;Yes, just return +1 for now
	    EXIT.		;Same job, not same user, start another spy
	  ENDIF.		;Job didn't match
	  SKIPE SPYFRK(T4)	;Is this slot used?
	  IFSKP.		;No, we have found a free slot then
	    SKIPN Q2		;Do we have a free slot yet?
	    MOVE Q2,T4		;Nope, we do now though
	  ENDIF.		;End of free slot code
	  AOBJN T4,TOP.		;Loop for all possible forks we are running 
	OD.			;End of search loop
	JUMPE Q2,R		;Return if no fork slot available in table
;Create stack pointer for inferior fork.

	MOVEI Q1,(Q2)		;Load which spy fork this is
	IMULI Q1,SPLEN		;Point to proper stack start address
	ADDI Q1,SPYPDL		;Make offset into address of stack
	HRLI Q1,-SPLEN		;Make -n,,0

;Open up the spy log file.

	CALL SPYGTJ		;(Q1,P2/P3) Get JFN on spy file
	 JRST SPYPNT		;(Q2/) Punt if error
	HRLM P3,SPYJFN(Q2)	;Save log file JFN

;Get a PTY and remember which one.

	CALL GETPTY		;(/T1,T2) Try to get a PTY
	 JRST SPYPNT		;(Q2/) Couldn't, punt JFN and return	
	DMOVE P4,T1		;Save PTY JFN and TTY designator for fork
	HRRM T1,SPYJFN(Q2)	;Save PTY JFN here too

;Create fork with our caps, our ACs, our map, starting it at SPYSTA.

	MOVX T1,CR%CAP!CR%ACS!CR%MAP!CR%ST!FLD(SPYSTA,CR%PCV) ;All implemented
	SETZ T2,		;Indicate that fork should get copy of our ACs
	CFORK%			;Create a fork
	 IFJER.			;If error
	   CAIE T1,CFRKX3	;No more forks?
	   OJSERR (<Can't create fork>,,SPYPNT)	;(Q2/) No, some other error
	   JRST SPYPNT		;(Q2/) Clean up and return
	 ENDIF.			;End of CFORK error recovery

;We have a bouncing baby fork, set up the SPYxxx tables for later use.

	HRRZM T1,SPYFRK(Q2)	;Remember fork handle
	MOVEM P1,SPYUSR(Q2)	;Save user number,
	MOVEM P2,SPYJOB(Q2)	; and job that the fork is spying

	RETSKP			;Spying fork running now
	
	SUBTTL Spy on Intruder -- Kill Spy Fork

;Here to kill off the spy fork.
;Call SPYKIL with T4/ spy fork table offset
;Call SPYPNT with Q2/ spy fork table offset
;Returns +1 always fork is gone, PTY JFN released, log file closed

SPYPNT:	MOVEI T4,(Q2)		;Load offset to tables
SPYKIL:	MOVE T1,SPYFRK(T4)	;Load the fork handle again
	KFORK%			;Kill it off now
	 ERNOP.			;Well at least I tried
	CALL SPYTRL		;(T4/) Perform finishing functions
	HLRZ T1,SPYJFN(T4)	;Load spy file JFN
	SKIPE T1		;Was there a JFN?
	CLOSF%			;Yes, close it
	 ERNOP.			;Well, not much we can do at this point
	HRRZ T1,SPYJFN(T4)	;Load PTY JFN
	SKIPE T1		;Was there a JFN?
	CLOSF%			;Close that too
	 ERNOP.			;Crunch?
	SETZM SPYFRK(T4)	;Clear table entry for fork
	SETZM SPYJOB(T4)	;Clear job being spyed on
	SETZM SPYUSR(T4)	;Clear user being spyed on
	SETZM SPYJFN(T4)	;Clear JFN words 
	RET			;Return with all cleaned up
	SUBTTL Spy on Intruder -- Start a Spy Fork -- Get a Spy File

;Here to get a JFN on the spy fork log file.
;Call with P2/ user number
;Returns +1 if error
;Returns +2 with spy log file open and header written, P3/ JFN

;First construct file name from "predefinedstring-OURNAM.USERNAME"

SPYGTJ:	HRROI T1,SPYFIL		;Point to destination area
	HRROI T2,SPYSLD		;Load initial text of filespec
	CALL ISOUT		;(T1,T2/T1) Copy that string
	HRROI T2,[ASCIZ/-/]	;Delimit the string
	CALL ISOUT		;(T1,T2/T1) Send the delimiter
	HRROI T2,OURNAM		;Point to our node name string
	CALL ISOUT		;(T1,T2/T1) Append node name to filespec
	HRROI T2,[ASCIZ/./]	;Point to a seperator character
	CALL ISOUT		;(T1,T2/T1) Append seperator to filespec
	MOVE T2,P1		;Get user number back
	CALL ODIRST		;(T1,T2/T1) Change it to up to 39 characters
	CALL ISOUT		;(T1,T2/T1) Append that string in there

;Get a JFN on the file.

	MOVX T1,GJ%FOU!GJ%SHT	;Load these flags
	HRROI T2,SPYFIL		;Use this string
	GTJFN%			;Get JFN for spying
	 JSERRO (<Unable to get JFN for spy file>,,SPYLFD)
	MOVEI P3,(T1)		;Copy JFN for handing down to fork
	TXO T1,CF%NUD!FLD(.FBCTL,CF%DSP) ;Load the FBCTL word, don't update
	MOVX T2,FB%INV!FB%SEC	;Load the invisible and secure bits for mask
	MOVX T3,FB%INV!FB%SEC	;Load the invisible and secure bits to set
	CHFDB%			;Change file descriptor block
	 JSERRO (<Can't make spy file secure and invisible>,<CALL SPYLFD>)
	MOVEI T1,(P3)		;Reload T1 incase previous CHFDB fails
	TXO T1,CF%NUD!FLD(.FBBYV,CF%DSP) ;Load the FBBYV word and no updates
	HRLI T1,.FBBYV		;We want to keep infinite generations
	MOVX T2,FB%RET		;Load set retention bit
	SETZ T3,		;Keep 0 generations
	CHFDB%			;Change file descriptor block
	 JSERRO (<Can't make spy file generation retention count 0>,<CALL SPYLFD>)
	CALL SPYOPN		;(P3/) Open up the file
	 OJSERR (<Can't open spy file>,,SPYLFD) ;Punt if errors

;Send header to spy file and then return.

	CALL SPYHDR		;(P3/) Construct header and send it to file
	CALL SPYCLS		;(P3/) Close spy file
	 OJSERR (<Can't close spy file>,,SPYLFD)
	CALL SPYOPN		;(P3/) Reopen the file
	 OJSERR (<Can't reopen spy file>,,SPYLFD) ;Owie!
	RETSKP			;Return OK
;Small local routine to append spy filename into log file.
;Called only from SPYGTJ because otherwise SPYFIL isn't set up.
;Returns +1 always with filename string sent to log file.

SPYLFD:	TXO F,FL%ERR		;Indicate we are in error processing
	HRROI T1,ERRBUF		;Point to error string buffer
	HRROI T2,[ASCIZ/    File /] ;Space over four
	CALL ISOUT		;(T1,T2/T1) Send some space along
	HRROI T2,SPYFIL		;Point to the spy filename
	CALL ISOUT		;(T1,T2/T1) Send that along 
	CALL OCRLF		;(T1/T1) and a crlf
	HRROI T1,ERRBUF		;Point to error buffer again
	CALL SENLOG		;(T1/) Send that to the usual log file
	TXZ F,FL%ERR		;No longer in error processing
	RET			;Return +1
	SUBTTL Spy on Intruder -- Start a Spy Fork -- Get a PTY

;Called to get a PTY assigned to spy on intruder.
;Returns +1 always, T1/ PTY JFN, T2/ TTY designator for that PTY

GETPTY:	MOVE T4,MAXPTY		;Load maximum number of PTYs on system
	IMUL T4,[XWD -1,0]	;Make -n,,0

GETPT1:	MOVSI T1,.DVDES!.DVPTY	;Load PTY designator value
	HRRI T1,(T4)		;Make designator for particular PTY
	DVCHR%			;Get characteristics of the device
	 ERJMP GETPT2		;Owie
	TXNN T2,DV%AV		;Is this PTY available?
	JRST GETPT2		;Nope, try next one

	MOVE T2,T1		;Load device designator
	HRROI T1,SPYFIL		;Point to tempoary area
	DEVST%			;Now convert the device to a string
	 JRST GETPT2		;Bad, well try the next one
	HRROI T2,[ASCIZ/:/]	;Point to the appropriate puctuation
	CALL ISOUT		;(T1,T2/T1) Append that and a null

	MOVX T1,GJ%SHT		;Load short form bit
	HRROI T2,SPYFIL		;Point to string we just built
	GTJFN%			;Now try to get a JFN on that PTY
	 ERJMP GETPT2		;Well, try the next one then

	MOVEI T3,(T1)		;Save JFN here for now
	MOVX T2,FLD(7,OF%BSZ)!OF%RD!OF%WR ;Load the open bits
	OPENF%			;Open the PTY for read/write
	 ERJMP GETPT3		;This is got to be a problem

	HRRZ T2,T4		;Load the PTY unit number
	ADD T2,TTYPTY		;Convert PTY unit to TTY unit
	TXO T2,.TTDES		; and then make it a device designator
	RETSKP			;Successful return with T1, T2 set up

;Here if some problem getting the PTY, release JFN and try again.

GETPT3:	MOVEI T1,(T3)		;Get the JFN back
	RLJFN%			;Give up the JFN
	 ERNOP.			;Ignore error here 

;Here to try next PTY unit number.

GETPT2:	AOBJN T4,GETPT1		;Try next PTY unit
	RET			;Out of units, return failure
	SUBTTL Spy on Intruder -- Spy Fork -- Initialization

;This is the start of the fork that spys on intruders.  It runs in ACJ's
;address space so that it can be started quickly.  

;DANGER Will Robinson: the code running in the inferior fork cannot use any
;storage other than its ACs and stack!  All private storage other than the ACs
;must be on the stack or in the big TRVAR at SPYSTA.

;AC usage:
;	Q1/  Initial stack pointer
;	P1/  User number
;	P2/  Job number
;	P3/  Spy file JFN
;	P4/  PTY designator
;	P5/  TTY designator (TTY end of PTY)

SPYSTA:	MOVE P,Q1		;Set up the stack for this fork
	TRVAR <<SPYBUF,^D200/5>,<FRKLEV,3>,FRK3PC>

	MOVEI T1,.FHSLF		;Load my own fork handle
	MOVX T2,JP%SYS		;We are a system fork
	SPRIW%			;Do this so we are fast and elude detection
	 ERNOP.			;Well, at least we tried today

	MOVEI T2,FRK3PC		;Load level 3 PC return address
	MOVEM T2,2+FRKLEV	;Save as return for level 3
	SETZM 0+FRKLEV		;Clear level 1 PC return
	SETZM 1+FRKLEV		;Clear level 1 PC return
	HRLI T2,FRKLEV		;Load that address
	HRRI T2,CHNTAB		;Make LEVTAB,,CHNTAB
	SIR%			;Setup our interrupt tables
	MOVX T2,1B<TICHAN>	;Load the bit for the timer channel
	AIC%			;Activate interrupt channel
	EIR%			;Enable interrupt system

	CALL INITIM		;(/) Start timer interrupt
	CALL SETSPY		;(P1,P2,P5/) Setup spy link
	 SPYER (<Cannot set up link to user>)
;	JRST SPYLOP		;Start up main loop
	SUBTTL Spy on Intruder -- Spy Fork -- Main Loop

;This is the loop that takes all of the output of the user's session to spy it.

SPYLOP:	MOVE T1,P4		;Load PTY JFN
	BIN%			;Get a byte from the PTY into T2
	 ERNOP.			;Ignore error for the present time
	MOVE T1,P3		;Load the spy file JFN
	BOUT%			;Put the character into the spy file
	 ERJMP SPYEND		;Punt everything if error writing to file
	TXO F,FL%SIO		;Indicate the characters have been sent
	JRST SPYLOP		;Loop for more characters to spy
	SUBTTL Spy on Intruder -- Spy Fork -- Spy File I/O Routines

;Here to open up the spy file, called with P3/ spy file JFN
;Returns +1 if error
;Returns +2 if success

SPYOPN:	MOVE T1,P3		;Get just the JFN again, this time, all right?
	MOVX T2,FLD(7,OF%BSZ)!OF%APP ;Load 7 bit append mode please today sir
	OPENF%			;Pry the spy file open
	 ERJMP R		;Return if error
	RETSKP			;Skip return, ok sir, that'll be all sir

;Here to close up the spy file, called with P3/ spy file JFN
;Returns +1 if error
;Returns +2 if success

SPYCLS:	MOVE T1,P3		;Load the JFN again
	TXO T1,CO%NRJ		;Close spy file to make it real
	CLOSF%			;Crunch
	 ERJMP R		;Return +1 if error
	RETSKP			;Skip return

;Here to send a string to the spy file.
;Call with T2/ pointer to text, P3/ JFN
;Returns +1 if error
;Returns +2 if OK

SENSPY:	MOVE T1,P3		;Load the JFN of the file
	SETZB T3,T4		;Clear this so terminate on null
	SOUT%			;Send that to the file
	 ERJMP R		;Return +1 if error
	RETSKP			;Return to caller
	SUBTTL Spy on Intruder -- Spy Fork -- Error Recovery and Termination

;Here to output an error message to the spy file, cleanup and halt.
;Call with T1/ address of ASCIZ text
;Kills the fork.

SPYERR:	PUSH P,T1		;Save message string
	HRROI T1,SPYBUF		;Point to spy buffer
	HRROI T2,[ASCIZ/
[/]				;Point to CRLF bracket
	CALL ISOUT		;(T1,T2/T1) Send that along first
	CALL OODTIN		;(T1/T1) Current date time
	POP P,T2		;Now send the message
	TLO T2,-1		;Make -1,,address
	CALL ISOUT		;(T1,T2/T1) Send message next
	HRROI T2,[ASCIZ/, /]	;Send some white space
	CALL ISOUT		;(T1,T2/T1) Make it look nice
	CALL OERSTR		;(T1/T1) Send last JSYS error
	HRROI T2,[ASCIZ/]
/]				;Send closing bracket
	CALL ISOUT		;Append all of that together
	HRROI T2,SPYBUF		;Point to buffer
	CALL SENSPY		;(T2,P3/) Send all of that to the log file
	 SKIPA T1,SPYBUF	;Uh oh
	JRST SPYEND		;Now end this spying session
	PSOUT%			;Send to terminal if nothing else possible

;Here when we want to end this spying session.  Halts the spy fork.

SPYEND:	HALTF%			;Halt the spy fork
	JRST .-1		;What?
	SUBTTL Spy on Intruder -- Spy Fork -- Timer Interrupts

;Here when the spy fork wants to do a periodic check to see if job has logged
;out, changed terminals (i.e. got detached, and re-attached), or maybe typed a
;BREAK.

TIMINT:	CALL SPYTIM		;(/) Handle the interrupt please
	DEBRK%			;Return from interrupt

;Routine to do the work of checking things out at timer interrupts.

SPYTIM:	SAVEAC <T1,T2,T3,T4>	;Save the temps for a second
	TXZN F,FL%SIO		;Spy file I/O happened?
	IFSKP.			;Yes
	  CALL SPYCLS		;(P3/) Close spy file
	   JRST SPYABT		;Abort this session if error
	  CALL SPYOPN		;(P3/) Reopen the spy file
	   JRST SPYABT		;Abort this session if error
	ENDIF.			;End of file checkpoint code
	CALL SETSPY		;(P1,P2,P5/) Fix the spy link if needed
	 JRST SPYABT		;Abort if failure
	CALLRET	INITIM		;(/) Start timer again and return

;Here to abort the spy fork by changing the interrupt return PC to SPYEND.

SPYABT:	MOVEI T1,SPYEND		;Victim is gone, done logging
	MOVEM T1,FRK3PC		;Save the return PC as where to return to
	RET			;Return to dismiss interrupt and so on

;Setup a timer interrupt for 10 seconds from now

INITIM:	MOVE T1,[.FHSLF,,.TIMEL] ;Set interrupt this fork, elapsed time
	MOVE T2,SPYINT		;Load interval for spying
	IMULI T2,^D1000		;Convert seconds to milliseconds
	MOVX T3,TICHAN		;Load channel for timer interrupts
	TIMER%			;Have the monitor do that for us
	 ERSPY (<TIMER% failed>);Punt this session
	RET			;Return as it all went well
	SUBTTL Spy on Intruder -- Spy Fork -- Setup Spy Link

;Routine to set up spy link between our PTY and the victim's job.
;Called with
; 	P1/  Victim's user number
;	P2/  Victim's job number
;	P5/  TTY designator for our PTY
;Returns +1 no such job
;Returns +2 spy link setup (unless detached)

SETSPY:	MOVE T1,P2		;Get victim's job number
	MOVE T2,[-2,,Q1]	;Get TTY and user number
	MOVEI T3,.JITNO		; from the monitor on the victim
	GETJI%			;Get Job Information
	 IFJER.			;If that failed
	   CAIN T1,GTJIX4	;Did she go away?
	   RET			;Yes, return +1
	   SPYER (<GETJI% failed>)
	 ENDIF.			;End of error 

	IFN. Q2			;If there is a user logged in
	  CAME P1,Q2		;Is it the user we expect?
	  RET			;Nope, return +1
	ENDIF.			;User not logged in or is who we expect

	MOVE T1,P5		;Get TTY end of the PTY
	TXO T1,TL%ERO		;Setup spy link
	SKIPGE T2,Q1		;Load terminal of user's job
	RETSKP			;Don't try TLINK if detached
	TXO T2,.TTDES		;Make terminal number into designator
	TLINK%			;Make link from user terminal to our PTY
	 ERSPY (<TLINK% failed>) ;Owie!
	RETSKP			;Give +2 return

	ENDTV.			;End of fork's private storage
	SUBTTL Spy on Intruder -- Spy File Header/Trailer

;Here to write header shortly after the file is opened as as file is closed.
;Call with Q1/ freespace pointer
;Returns +1 always.

SPYTRL:	SAVEAC <Q1,Q2,Q3>	;Need more ACs today
	HRROI Q1,[ASCIZ/ end spying/] ;Here for trailer
	HLRZ Q2,SPYJFN(T4)	;Load JFN to Q2
	SETZ Q3,		;No job information please
	JRST SPYMSG		;Send the message

SPYHDR:	SAVEAC <Q1,Q2,Q3>	;Need more ACs today again
	HRROI Q1,[ASCIZ/ spying on/] ;Here for header
	MOVE Q2,P3		;Copy the JFN to Q2
	MOVEI Q3,JIBLK		;Point to that job's GETJI block

;Here with Q1/ message pointer and Q2/ JFN

SPYMSG:	MOVE T1,TEXTBU		;Get current text pointer area
	HRROI T1,1(T1)		;Point to some free space
	HRROI T2,[ASCIZ/
[/]				;Point to crlf bracket
	CALL ISOUT		;(T1,T2/T1) Start off
	CALL OODTIN		;(T1/T1) Send time and date
	CALL OSPACE		;(T1/T1)  and a space
	HRROI T2,[VERSIO]	;Load our version text
	CALL ISOUT		;(T1,T2/T1) Send that to the line 
	HRROI T2,[ASCIZ/ on /]	;Label next little part
	CALL ISOUT		;(T1,T2/T1) Send that to the line 
	HRROI T2,OURNAM		;Point to our node name
	CALL ISOUT		;(T1,T2/T1) Send that to the line 
	MOVE T2,Q1		;Load the mumble string
	CALL ISOUT		;(T1,T2/T1) Send that
	SKIPE T4,Q3		;Telling about a job?
	CALL OGETJI		;(T1,T4/T1) Tell about this job
	HRROI T2,[ASCIZ/]

/]				;Load ending text
	CALL ISOUT		;(T1,T2/T1) Send that to the line last

	MOVE T1,Q2		;Load the JFN of the file
	MOVE T2,TEXTBU		;Get current text pointer area
	HRROI T2,1(T2)		;Point to some free space
	SETZB T3,T4		;Clear this so terminate on null
	SOUT%			;Send that to the file, don't use SENSPY
	 ERNOP.			;Return +1 if error
	RET			;Return +1 always as a matter of fact
	SUBTTL Spy on Intruder -- Inferior Fork Termination Interrupt

;Come here on fork termination interrupt to check for dead forks.

FRKTRM:	CALL SPYTRM		;(/) Call worker routine to do the work
	DEBRK%			;Return from interrupt

;Routine to look for spy forks that are halted and kill them off.
;Returns +1 always

SPYTRM:	SAVEAC <T1,T2,T3,T4>	;Save those ACs on the stack
	MOVSI T4,-NSPYS		;Get number of forks in table

SPYTR1:	SKIPN T1,SPYFRK(T4)	;Is there a fork handle for this fork?
	JRST SPYTR6		;Nope, check next one
	RFSTS%			;Get fork's status
	 ERJMP SPYTR2		;If error kill it
	HLRZ T2,T1		;Load the fork status code
	CAIE T2,.RFHLT		;Halted
	CAIN T2,.RFFPT		; or forced termination?
SPYTR2:	CALL SPYKIL		;(T4/) Yes, kill that fork please
SPYTR6:	AOBJN T4,SPYTR1		;Loop for all of forks in table
	RET			;Return to sender
	SUBTTL Secure Files

;This routine is called to determine if the user has access to a particular
;file that is set secure.  This routine is called with the following arguments

;The format of the ACCESS.CONTROL file is as follows:
;	filename access-keyword user user, access-keyword user user, ...
;The first entry that matches the filename (as determined by WILD%) is used.

;Call with:
;	Q1/ ARGBLK+.RCARA
;	Q2/ SF.xxx for the type of desired access 
;Returns +1 if access is not allowed
;Returns +2 if access is allowed (or access control file is not found)

;ACs used in these routines:
;	P1/ free
;	P2/ byte pointer to current line from that file
;	P3/ last character read from that file
;	P4/ CBX (cache block index)

SECFIL:	SAVEAC <P1,P2,P3,P4>	;Save the perms for our use today

;First try and find the file ACCESS.CONTROL in the same directory as the file
;in question.  If this file is not found or is damaged, then the all secure
;operations are allowed and are logged as unusual.  Change the "CALLRET SETUNU"
;to "RET" if all secure operations are to be denied if the access control file
;is not found.

	CALL SECOPN		;(Q1/Q1,P4) Open up ACCESS.CONTROL
	 CALLRET SETUNU		;Not there, allow access but log as unusual

;Try and locate the filename in the ACCESS.CONTROL file.

	CALL SECFND		;(Q1,P4/P2,P3) Locate this filename
	 CALLRET SECCLS		;(P4/) Not found, close the file and return +1

;Check desired access against listed allowed access.

	HRROI T1,SECUSR		;Point to username build block
	MOVE T2,JIBLK+.JIUNO	;Load user number in question
	CALL ODIRST		;(T1,T2/T1) Get username made into string

	CALL SECACC		;(Q2,P2,P3/) See if user has proper access
	 CALLRET SECCLS		;(P4/) Nope, close file and return +1

;Access is allowed, close the file and skip return.

	CALL SECCLS		;(P4/) Yes, close file
	CALL SECACT		;(Q1,Q2/) See if special action is needed
	RETSKP			;Return +1 indicating the access is allowed
	SUBTTL Secure Files -- Find File's Entry

;Here to try to locate an entry for the file in question in the ACCESS.CONTROL
;file.  We are called with SECFNA/ "file.type.gen" and P4/ CBX
;Returns +1 if entry not found
;Returns +2 if entry found, P2/ line pointer and P3/ last character read

SECFND:	CALL SECSIN		;(P4/P2,P3) Read a line in from file
	 RET			;If EOF return +1 (not found)

;We have a line read in, eat white space.  If comment line get another line.

	CALL SECSPN		;(P2/P2,P3) Eat until first non blank character
	 JRST SECFND		;None on that line, get another line
	CAIN P3,";"		;Comment character semicolon first nonblank?
	JRST SECFND		;Yes, this was a comment, get next line please

;Line has been read in, get the first field in it which should be the filename.

	CALL SECFLD		;(P2,P3/P2,P3) Read a field into the word area
	 RET			;If EOL before field read, return +1

;We have a field read in.  See if the file in question matches this entry.

	MOVX T1,.WLSTR		;Load wild string match function
	HRROI T2,SECWRD		;Point to the (possibly wild) entry from file
	HRROI T3,SECFNA		;Point to the "file.type.gen" requested by user
	WILD%			;Get the monitor's help here
	 ERJMP SECFND		;Should never ITRAP, but ya never know
	JUMPN T1,SECFND		;Continue looping if the string didn't match

;Filename matched!  Check terminator of field, it must be space or tab.

	CAIE P3,.CHTAB		;Was previous field terminator a tab
	CAIN P3," "		; or was it a space?
	RETSKP			;Return +2 since the entry matched
	JRST SECFND		;Look some more if illegal terminator
	SUBTTL Secure Files -- Check Desired Access

;Called here after the entry for this file has been found to check the
;desired access, with Q2/ access code, P2 and P3 set up from SECFND.
;Returns +1 if access not allowed (not found)
;Returns +2 if access is allowed (user found)

SECACC:	CALL SECFLD		;(P2,P3/P2,P3) Read in a field
	 RET			;If end of line return +1

;See if the keyword read is something we recognize.

	MOVEI T1,SECTBL		;Point to table of keywords
	HRROI T2,SECWRD		;Point to the word to match please
	TBLUK%			;Look it up in our keyword table
	 ERJMP SECAC2		;Shouldn't ITRAP, but if error check next one
	TXNE T2,TL%NOM!TL%AMB	;No match or ambig?
	JRST SECAC2		;Yes, eat until end of line or comma seen
	HRRZ T2,(T1)		;Get the value for this keyword
	TDNN Q2,T2		;Match the desired access?
	JRST SECAC2		;Nope, keep looking
	CAIE P3,.CHTAB		;Was previous field terminator a tab
	CAIN P3," "		; or was it a space?
	JRST SECAC5		;Yes, we have a winner on this particular entry

;The keyword didn't match or wasn't the desired access keyword, eat until ",".

SECAC2:	CALL SECCHR		;(P2/P2,P3) Get the next character
	 RET			;Return badly if end of line
	CAIE P3,","		;Looking for a comma
	JRST SECAC2		;Keep looking until comma or end of line seen
SECAC4:	CALL SECCHR		;(P2/P2,P3) Get the character after the comma
	 RET			;End of line?  Not here, not after all of this!
	JRST SECACC		;Char after comma loaded, examine next field

;We have reached the desired access keyword.  See if desired user is in list.

SECAC5:	CALL SECFLD		;(P2,P3/P2,P3) Read the next field in
	 RET			;Owie if end of line
	MOVX T1,.WLSTR		;Load wild string match function
	HRROI T2,SECWRD		;Point to the (possibly wild) entry from file
	HRROI T3,SECUSR		;Point to the username we are concerned about
	WILD%			;Get the monitor's help here
	 ERSKP.			;Should never ITRAP, but ya never know
	JUMPE T1,RSKP		;User can do this!  Our work is done
	CAIN P3,","		;Was terminator a comma?
	JRST SECAC4		;Yes keep looking on this line
	CAIE P3,.CHTAB		;Was previous field terminator a tab
	CAIN P3," "		; or was it a space?
	JRST SECAC5		;OK terminator, continue looping through users
	RET			;Return badly if illegal terminator
	SUBTTL Secure Files -- Access Keywords

;This is a TBLUK style table of access keywords and access keyword values.
;It is used when reading the keywords after the filenames in ACCESS.CONTROL.
;Lines commented out are ideas for future functions.  A priv scheme must be
;thought about before implementation.  There is also the possibility that the
;ACJ could cause quota or blocking problems with these same ideas.

SECTBL:	TBEGIN			;Plant the header here
	TENTRY (ALL,SF.ALL)	;All access (app, del, rea, ren, sec, wri)
	TENTRY (APPEND,SF.APP)	;Append access (OPENF)
;	TENTRY (ANNOUNCE,SF.ANN) ;Send message to user list specified (priv)
;	TENTRY (CONSOLE,SF.CON)	;TTMSG to CTY when file touched (priv)
	TENTRY (DELETE,SF.DEL)	;Delete access (DELF)
;	TENTRY (LOG,SF.LOG)	;Log access in samestr:<user>ACCESS.LOG (priv?)
	TENTRY (NOSECURE,SF.NOS) ;Clear secure access (CHFDB)
	TENTRY (READ,SF.REA)	;Read access (OPENF)
	TENTRY (RENAME,SF.REN)	;Rename access (RNAMF)
	TENTRY (SECURE,SF.SEC)	;Set secure access (CHFDB)
	TENTRY (WRITE,SF.WRI)	;Write access (OPENF)
	TEND			;End of table
	SUBTTL Secure Files -- Access Control Cache

;[111] The Access Control Cache maintains the last NCACHE files open read for
;secure files access control.

;The SECOPN routine is called to open an ACCESS.CONTROL file for parsing.  This
;routine tries to find an entry in the cache for the directory of the filename
;passed to this routine.  Routine SECOSF is called to split the given filename
;string apart into a string containing the structure and directory and other
;string containing just the file.type.version.

;Routine SECOCF is called to find a cache entry for the str:<directory> where
;the given file resides.  If there is no entry for this directory, an entry is
;found by searching the cache for the first free cache block.  If there is no
;free block the oldest referenced cache block which is then used for this
;opening of the file.

;The cache is organized into NCACHE non-contiguous fixed buffers in memory,
;each of SCACHE contiguous pages.  A table of CBXSIZ words is used for each
;fixed buffer and contains the address of the buffer as determined at assembly
;time as well as the ASCIZ directory for which the cache is a part.

;After the cache block is idenitified, SECOCS is called to check to see that
;the entry is not "stale".  Stale entries are determined by checking the time
;that the data pages were mapped.  If stale entries were not flushed, changes
;in the ACCESS.CONTROL files would never be picked up.  If the entry is
;considered stale the cache block is invalidated.  This invalidation causes the
;file to be remapped (as if it was a new entry in the cache).  This period
;should be fairly long to avoid overhead.

;Routine SECOCO is called after the stale check.  This routine opens and maps
;the file if the cache block indicates that the file is not currently mapped.
;Finally, routine SECOCI is called to set up the pointers and counts needed to
;for routines that scan the ACCESS.CONTROL file.  

;The cached paged are then read by the normal SECCIN routine.  If the scan of
;the file causes all cached pages to be looked at, and the file was larger than
;SCACHE pages, routine SECMAP is called to map the next page in the file into
;the "overflow" buffer.  Pages are then looked at one at a time until all pages
;in the file have been mapped.

;When SECCLS is called to close the file only the overflow buffer is unmapped.
;The file stays open along with its JFNs for possible future access.  Routine
;SECFLU is called to flush an entry from the cache, unmapping all pages and
;releasing the JFN.
	SUBTTL Secure Files -- Access Control Cache -- Open File

;Here to open the ACCESS.CONTROL file in the same directory as the secure file.
;	Sets up SECDIR/ "str:<directory>" and SECFNA/ "file.type.gen"
;	Finds cache entry for this file.
;	If file not in cache, open and map SCACHE pages from it.
;	Set up variables for reading the file.
;Called with Q1/ ARGBLK+.RCARA
;Returns +1 if file not found
;Returns +2 if file found, P4/ cache block

SECOPN:	CALL SECOSF		;[111] (Q1/) Split filespec first
	
;Find cache entry, and try to open the file.

	CALL SECOCF		;[111] (/P4) Find cache entry for this

	CALL SECOCS		;[111] (P4/) Flush stale entry if needed

	CALL SECOCO		;[111] (P4/) Open up the file if possible
	 RET 			;[111] Owie, return +1

	CALL SECOCI		;[111] (P4/) Setup for I/O

	RETSKP			;Give the +2 return please
	SUBTTL Secure Files -- Access Control Cache -- Open File -- Split Filename

;[111] Routine to split up filename strings.  Sets SECDIR "str:<directory>",
;SECFNA "file.type.gen" and SECFNV "file.type"
;Called with Q1/ ARGBLK+.RCARA
;Returns +1 always with SECDIR and SECFNA and SECFNV set up.

SECOSF:	MOVEI T2,.GEFIL(Q1)	;[111] Load address of the with the filename
	HRLI T2,(POINT 7)	;[111] Point to the thing with a byte pointer
	MOVE T1,[POINT 7,SECDIR] ;[111] Point to "str:<directory>" build area
	DO.			;[111] Loop to grab the str:<dir>
	  ILDB T3,T2		;[111] Load a source byte
	  IDPB T3,T1		;[111] Store a byte please
	  CAIN T3,76		;[111] Is it a close angly?
	  EXIT.			;[111] Yes, exit
	  JUMPN T3,TOP.		;[111] Continue looping if not end of string
	  RET			;[111] Return now if premature end of filename
	OD.			;[111] Now we have the "str:<dir>" done
	SETZ T3,		;[111] Load up a null
	IDPB T3,T1		;[111]  and store it there to bind off dir
	HRROI T1,SECFNA		;[111] Point to "file.type.gen" storage area
	CALL ISOUT		;[111] (T1,T2/T1) Copy rest of filename there

	HRROI T1,SECFNV		;[115] Point to filename area
	HRROI T2,SECFNA		;[111] Load address of "file.type.gen"
	CALL ISOUT		;[111] (T1,T2/T1) Copy string, ending bp in T1
	DO.			;[111] Loop back from end to find first dot
	  SETO T2,		;[111] Load a -1 in T2
	  ADJBP T2,T1		;[111] Back it up one
	  MOVEM T2,T1		;[111] Store it back
	  LDB T2,T1		;[111] Load character from there
	  CAIE T2,"."		;[111] Period?
	  JUMPN T2,TOP.		;[111] Not yet, go back another character
	OD.			;[111] Found start of version
	SETZ T2,		;[111] Load a null
	DPB T2,T1		;[111] Store it over period

	RET			;[111] Return
	SUBTTL Secure Files -- Access Control Cache -- Open File -- Cache Find

;[111] SECOPN routine to examine the cache and find entry for str:<directory>.
;It may return with
;	1) an existing valid cache block (cache hit)
;	2) a free cache entry (cache miss)
;	3) a reused cache entry (cache miss)
;Call with SECDIR set up.
;Returns +1 always with P4/ offset to cache block entry

SECOCF:	MOVE P4,[-NCACHE,,CBPOOL] ;[111] Load number of entries in the cache
	DO.			;[111] Loop for all cache blocks
	  SKIPN CBXJFN(P4)	;[111] Is this one free?
	  IFSKP.		;[111] Nope
	    HRROI T1,SECDIR	;[111] Point to "str:<directory>"
	    HRROI T2,CBXDIR(P4)	;[111] Point to filename for this entry
	    CALL ISTCMP		;[111] (T1,T2/T1) Compare the strings
	    IFE. T1		;[111] If a match
	      AOS NHIT		;[111] Count as a cache hit
	      RET		;[111] Return
	    ENDIF.		;[111] End of string match code
	  ENDIF.		;[111] End of check
	  ADDI P4,CBXSIZ-1	;[111] Point to next block -1
	  AOBJN P4,TOP.		;[111] Loop if more blocks to consider
	OD.			;[111] End of loop to check old entries
	AOS NMISS		;[111] Count a cache miss

;[111] Entry was not in the cache, locate a place for it and fill in the CB.

	MOVE P4,[-NCACHE,,CBPOOL] ;[111] Now we find an empty slot or oldest
	MOVX T1,.INFIN		;[111] Load a real log uptime about a year
	DO.			;[111] Loop to find a free spot
	  SKIPN CBXJFN(P4)	;[111] Is this one free?
	  EXIT.			;[111] Yes, we found one
	  CAMG T1,CBXRTI(P4)	;[111] Is this the oldest one yet?
	  IFSKP.		;[111] Yes, this entry is older than last one
	    MOVE T1,CBXRTI(P4)	;[111] Load the time of the oldest one
	    MOVEI T2,(P4)	;[111]  and remember which entry this was
	  ENDIF.		;[111] Continue
	  ADDI P4,CBXSIZ-1	;[111] Point to next block -1
	  AOBJN P4,TOP.		;[111] Loop for each one
	  MOVEI P4,(T2)		;[111] Load the address of the one matching
	  CALL SECFLU		;[111] (P4/) Remove this entry from cache
	OD.			;[111] End of loop

	HRROI T1,CBXDIR(P4)	;[111] Point to filename for this entry
	HRROI T2,SECDIR		;[111] Point to "str:<directory>"
	CALLRET ISOUT		;[111] (T1,T2/T1) Copy the str:<dir> to CBX
	SUBTTL Secure Files -- Access Control Cache -- Open File -- Cache Stale Check

;[111] SECOPN routine to check that cached entry found is not too stale to use.
;If the cache block entry specified is too old it is flushed before use.
;Call with P4/ CBX
;Returns +1 always.

SECOCS:	SKIPN CBXJFN(P4)	;[111] Is this entry in use now?
	RET			;[111] Nope, get out

;[111] Files are always kept in the cache we know when they change.

	MOVX T1,FB%SEC		;[111] Load secure bit
	TDNN T1,CBXCTL(P4)	;[111] Was this file secure when we looked?
	IFSKP.			;[111] Yes
	  MOVX T1,FU%GOK	;[111] Load we are doing GETOKs bit
	  TDNE T1,GOOPNB	;[111] Can we tell a secure OPENF on this file?
	  RET			;[111] Yes, do nothing to interfere
	ENDIF.			;[111] Let the timer take care of it

;[111] Non secure file, check for maximum map time.

	MOVE T1,TODCLK		;[111] Load the uptime at last RCVOK function
	SUB T1,CBXMTI(P4)	;[111] Get elapsed time that file mapped
	CAILE T1,SECDCI*^D1000	;[111] Is this entry too old?
	CALL SECFLU		;[111] (P4/) Yes, abort it now and remap it
	RET			;[111] Return
	SUBTTL Secure Files -- Access Control Cache -- Open File -- Cached Open

;[111] SECOPN routine to open up a file that is not currently in the cache.
;Call with P4/ cache block offset
;Returns +1 if error
;Returns +2 if already open or just opened and cached file set up for reading.

SECOCO:	SKIPE CBXJFN(P4)	;[111] Is there a cached entry?
	RETSKP			;[111] Yes, it is all set up

;[111] Construct filename to use.

	HRROI T1,CBXFIL(P4)	;[111] Point to filename area
	HRROI T2,CBXDIR(P4)	;[111] Point to str:<directory>
	CALL ISOUT		;[111] (T1,T2/T1) Copy that first
	HRROI T2,[ASCIZ/ACCESS.CONTROL/] ;[111] Point to the filename we desire
	CALL ISOUT		;[111] (T1,T2/T1) Append in the desired file

;[111] Get a JFN on the access.control file.

	MOVX T1,GJ%OLD!GJ%XTN	;[111] Load old file flags long form block
	MOVEM T1,SECGTJ+.GJGEN	;[111]  and set in long form block
	MOVX T1,G1%IIN		;[111] Include invisible files
	MOVEM T1,SECGTJ+.GJF2	;[111]  and set this in second flag word
	MOVEI T1,SECGTJ		;[111] Point to long form GTJFN block
	MOVX T1,GJ%OLD!GJ%SHT	;[111] Load short form and old file flags
	HRROI T2,CBXFIL(P4)	;[111] Point to the filename please
	GTJFN%			;[111] Try to find that file
	 ERJMP R		;[111] Return +1 if file not found

;[111] Open up the access control file.

	MOVEM T1,CBXJFN(P4)	;[111] Save the JFN
	MOVX T2,OF%PDT!OF%RD!FLD(7,OF%BSZ) ;[111] Preserve dates, 7 bit, read
	OPENF%			;[111] Pry that file open please
	 ERJMP SECFLU		;[111] (P4/) Close file and return +1 if errors
;[111] Get FBCTL word for this file and store it.

	SETZM CBXCTL(P4)	;[111] Default FBCTL work to zero
	MOVX T2,<1,,.FBCTL>	;[111] Just this word
	MOVEI T3,CBXCTL(P4)	;[111] Poimt to block for storing this
	GTFDB%			;[111] Get the file's FDB word
	 ERJMP SECFLU		;[111] (P4/) We must be able to get this word 

;[111] Get size of file and compute how many pages to map.

	MOVE T1,CBXJFN(P4)	;[111] Load the JFN for the file again
	SIZEF%			;[111] Get the size of the file
	 ERJMP SECFLU		;[111] (P4/) If error, close it now
	MOVEM T3,CBXPCT(P4)	;[111] Save file page count
	CAILE T3,SCACHE		;[111] Is it over the size of the cache buffer?
	MOVEI T3,SCACHE		;[111] Reduce pages to map to the size 
	MOVEM T3,CBXMAP(P4)	;[111] Save as mapped page count

;[111] We know all about the file, map the first SCACHE pages into cache.

	HRLZ T1,CBXJFN(P4)	;[111] Load JFN of that file please
	MOVE T2,CBXPAG(P4)	;[111] Load fork,,page number of cache buffer
	TXO T3,PM%RD!PM%CNT	;[111] We have to read and have a count please
	PMAP%			;[111] Map those pages into cache please
	 ERJMP SECFLU		;[111] (P4/) If error we are screwed now

;[111] Update the mapped time for this cache entry.

	MOVE T1,TODCLK		;[111] Load now
	MOVEM T1,CBXMTI(P4)	;[111]  and save it as time of mapping
	RETSKP			;[111] Return OK
	SUBTTL Secure Files -- Access Control Cache -- Open File -- Cached Input Setup

;[111] SECOPN routine to set up the pointers and counts to read cached pages.
;Call with P4/ CBX
;Returns +1 always with pointers and counts set up.

SECOCI:	MOVE T1,TODCLK		;[111] Load now
	MOVEM T1,CBXRTI(P4)	;[111]  and save it as time of reference

	MOVE T1,CBXPTR(P4)	;[111] Get byte pointer to cache buffer
	MOVEM T1,SECBPT		;[111] Save as byte pointer to data

	MOVE T1,CBXMAP(P4)	;[111] Load number of pages mapped today
	IMULI T1,PGSIZ*5	;[111] Compute possible bytes there
	MOVEM T1,SECBCT		;[111] Save as byte count

	MOVE T1,CBXMAP(P4)	;[111] Load number of pages mapped today
	SUBI T1,1		;[111] Get next page to map-1 for SECMAP
	MOVEM T1,SECPMP		;[111] Save the logical last page mapped

	MOVE T1,CBXPCT(P4)	;[111] Reload the total size of the file
	SUB T1,CBXMAP(P4)	;[111] Compute pages that are NOT cached
	SKIPGE T1		;[111] Did it fit in the cache?
	SETZ T1,		;[111] Yes, load zero non cached page count
	MOVEM T1,SECPCT		;[111] Save non cached page count

	RET			;[111] Return
	SUBTTL Secure Files -- Access Control Cache -- Close File -- Read Finished

;[111] Here when finished with ACCESS.CONTROL file.  This routine just returns
;after unmapping the page used when the entire file does not fit into one
;cache buffer (greater than SPAGES pages).  The cached part of the file will
;remain so it's JFN must remain as well.
;Call with P4/ CBX
;Returns +1 always

SECCLS:	SETO T1,		;Load a -1 for no mapping
	MOVX T2,<.FHSLF,,SECOPG> ;[111] This fork that page
	MOVEI T3,0		;Load no flags and junk
	TXZE F,FL%LAC		;[111] Long access control file mapped?
	PMAP%			;Unmap that stuff
	 ERNOP.			;[111] Ignore errors or nothing to unmap
	RET			;[111] Return, that's all there is to do
	SUBTTL Secure Files -- Access Control Cache -- Close File -- Flush Cache

;[111] Here when aborting use of ACCESS.CONTROL file.
;Unmaps all pages, closes JFN, frees cache block.
;Call with P4/ cache block address
;Returns +1 always.

SECFLU:	CALL SECCLS		;[111] (P4/) First unmap junk page if any
	SKIPN T3,CBXMAP(P4)	;[111] Load mapped page count, skip if some
	IFSKP.			;[111] Pages were in fact mapped today
	  SETO T1,		;[111] Get ready to unmap the cache paged
	  MOVE T2,CBXPAG(P4)	;[111] Load page number and this fork
	  TXO T3,PM%CNT		;[111] We have to have a count please
	  PMAP%			;[111] Unmap all of those pages 
	   ERNOP.		;[111] Forget errors
	  SETZM CBXMAP(P4)	;[111] Perform housekeeping
	ENDIF.			;[111] End of unmap code

	MOVE T1,CBXJFN(P4)	;[111] Load the JFN
	CLOSF%			;[111] Close and release the JFN
	 ERCAL SECABR		;[111] (P4/) If that failed, try releasing it
	SETZM CBXJFN(P4)	;[111] Clear this cache entry then now

	AOS NFLUSH		;[115] Count a flushed one
	RET			;[111] Return +1 please

SECABR:	MOVE T1,CBXJFN(P4)	;[111] JFN must not be open (OPENF failed!)
	RLJFN%			;[111] So release the JFN already
	 ERNOP.			;[111] Ignore errors this fine spring day
	RET			;[111] Return +1 always

;[111] Here when wanting to abort all cache entries.
;Called from the crash routine.
;Returns +1 always.

SECCLA:	MOVE P4,[-NCACHE,,CBPOOL] ;[111] For all entries in the cache
	DO.			;[111] Loop through eache entry
	  CALL SECFLU		;[111] (P4/) Flush this entry
	  ADDI P4,CBXSIZ-1	;[111] Count to next block address-1
	  AOBJN P4,TOP.		;[111] Loop for all cache entries
	OD.			;[111] End of that loop
	RET			;[111] Return to caller
	SUBTTL Secure Files -- Action for Successful Access

;[110] Here to check to see if the secure file being touched is our log file.
;If a read of the log file is requested, then we set the sweep cache flag.  If
;a rename of the log file is requested, then we get a new log file.  
;[111] Then if a rename or a write, check each access control block to see if
;it matches the filename of one of our cached files, and if so flush entry.
;
;Call only after determining that access is allowed with
;	Q1/ ARGBLK+.RCARA
;	Q2/ SF.xxx for the type of desired access 
;Returns +1 always.

SECACT:	TXNE Q2,SF.REN!SF.REA	;[121] Is it a rename or read function?
	CALL SECACL		;[121] (/) Yes, have to check log file spec

	TXNE Q2,SF.REN!SF.WRI!SF.DEL ;[121] Is it a rename, write, or delete?
	CALL SECACA		;[121] (/) Check for access.control file

	RET			;[121] Return to caller
;[121] Local routine for SECACT to check for access.control file.
;Called here if a rename or write function was specified.
;Returns +1 always, access.control cache entry flushed if a match.

SECACA:	HRROI T1,SECFNV		;[121] Point to "file.type" of the file
	HRROI T2,[ASCIZ/ACCESS.CONTROL/] ;[121] Point to the usual filename
	CALL ISTCMP		;[121] (T1,T2/T1) See if it is the magic one
	JUMPN T1,R		;[121] If no match return now
	SAVEAC <P4>		;[111] Save an AC
	MOVE P4,[-NCACHE,,CBPOOL] ;[111] For all entries in the cache
	DO.			;[111] Loop through eache entry
	  SKIPN CBXJFN(P4)	;[111] Is this entry active?
	  IFSKP.		;[111] Yes see if access.control file
	    HRROI T1,SECDIR	;[115] Load address of "str:<directory>"
	    HRROI T2,CBXDIR(P4) ;[115] Point to cache block str:<directory>
	    CALL ISTCMP		;[111] (T1,T2/T1) See if a match
	    SKIPN T1		;[111] Skip if no match
	    CALLRET SECFLU	;[121] (P4/) Flush if touching access.control
	  ENDIF.		;[111] End of check for entry to flush
	  ADDI P4,CBXSIZ-1	;[111] Count to next block address-1
	  AOBJN P4,TOP.		;[111] Loop for all cache entries
	OD.			;[111] End of that loop
	RET			;[121] Return to caller

;[121] Local routine for SECACT to check for manipulation of the log file.
;Called here if a rename or read function is being performed.
;Returns +1 always, with new log file or flush log file bit set.

SECACL:	SKIPN LOGJFN		;[121] Log file open now?
	RET			;[121] Nope, return now
	HRROI T1,.GEFIL(Q1)	;[111] Point to filename
	HRROI T2,LOGFNA		;[111] Point to log filename
	CALL ISTCMP		;[111] (T1,T2/T1) Compare those strings now
	JUMPN T1,R		;[121] Return now if not a match on filename
	CAIN Q2,SF.REA		;[110] Reading the log file?
	TXO F,FL%SLF		;[110] It was a match, we need to sweep
	CAIN Q2,SF.REN		;[110] Rename log file?
	CALL NEWLOG		;[110] (/) Yes, we need a new log file then
	RET			;[121] Return to caller
	SUBTTL Secure Files -- Read Line from File

;Here to read one non-comment line from ACCESS.CONTROL into the buffer.
;Called with P4/ CBX
;Returns +1 if EOF (or any other error)
;Returns +2 if line read, P2/ pointer to line, P3/ first nonblank character

SECSIN:	MOVE P2,[POINT 7,SECLIN] ;Point to the line first of all
	MOVEI P3,<SECCPL*5>-1	;Load maximum characters per line today
	DO.			;Loop to read in a line from the file
	  CALL SECCIN		;(P4/T1) Get a character from the file
	   EXIT.		;End the loop if not possible
	  CAIE T1,"-"		;Is it a hyphen?
	  IFSKP.		;Yes, possibly a line continuation character
	    CALL SECCIN		;(P4/T1) Get next character
	     EXIT.		;End loop if end of file
	    CAIE T1,.CHCRT	;Return after hyphen?
	    IFSKP.		;Yes, return after hyphen
	      CALL SECCIN	;(P4/T1) Get next character
	       EXIT.		;End loop if end of file
	      CAIN T1,.CHLFD	;Must be a line feed next
	      LOOP.		;Yes, it was, continue as if nothing happened
	      EXIT.		;Format error in file, lets get out of here now
	    ELSE.		;Otherwise hyphen not followed by a return
	      MOVEI T2,"-"	;Reload the hyphen
	      IDPB T2,P2	;Store it followed by character we just read
	      SOJLE P3,ENDLP.	;Count this character, fall thru to store T1
	    ENDIF.		;End of hyphen not followed by return case
	  ENDIF.		;End of hyphen seen case
	  IDPB T1,P2		;Store that byte please
	  CAIN T1,.CHLFD	;Is it a line feed?
	  EXIT.			;Yes, get out of here with a line read
	  SOJG P3,TOP.		;Loop for all possible characters
	OD.			;End of loop to read line of characters
	MOVEI T1,0		;Load zero also known as the null character
	IDPB T1,P2		;Store that there to insure null on end
	MOVE P2,[POINT 7,SECLIN] ;Point to line please
	RETSKP			;Skip return
	SUBTTL Secure Files -- Read Character from File

;Local routine to read a character from the file, call with P4/ CBX.
;Returns +1 if error
;Returns +2 if no error, T1/ character

SECCIN:	SOSL SECBCT		;See if any bytes left in buffer
	IFSKP.			;If none left there
	  CALL SECMAP		;(P4/) Map a page of the file
	   RET			;If no mapping possible return +1
	  JRST SECCIN		;Try again please
	ENDIF.			;Otherwise we do not need to get more bytes
	ILDB T1,SECBPT		;Load a byte from the file
	MOVE CX,SECBPT		;[123] Load the byte pointer
	MOVE CX,(CX)		;[123] Load the data word
	TRNE CX,1B35		;[123] Is this a LSN line?
	JRST SECCIN		;[123] Yes, ignore it now
	JUMPN T1,RSKP		;If a real character, skip return
	JRST SECCIN		;A null was seen, check next character

;Here to map another page of the access control file.  [111] We only get here
;when the cached page count is exhausted, that is the file is larger than
;SCACHE pages long, after thatn this routine is called for each remainting page
;in the file.  It is felt that files over SCACHE pages are unusual, and at
;least the first SCACHE pages are cached.
;Call with P4/ CBX and SECPCT/ count of pages left to map
;Returns +1 if end of file or other problem with mapping.
;Returns +2 if file mapped, SECBPT and SECPTR set up

SECMAP:	SOSGE SECPCT		;Count a page that is mapped
	RET			;End of file
	AOS T1,SECPMP		;Load the next page number
	HRL T1,CBXJFN(P4)	;Load the JFN into the proper place
	MOVX T2,<.FHSLF,,SECOPG> ;[111] This fork and this page
	MOVX T3,PM%RD		;Reading only the one page today
	PMAP%			;Map those pages in please
	 ERJMP R		;If error we are done
	TXO F,FL%LAC		;[111] Indicate long access control file
	MOVE T1,[POINT 7,SECOBU] ;[111] Point to proper place
	MOVEM T1,SECBPT		;Store this in the correct place
	MOVEI T1,PGSIZ*5	;Load byte count of the page
	MOVEM T1,SECBCT		;Save the byte count of this page
	RETSKP			;Skip return
	SUBTTL Secure Files -- Read Character from Line Buffer

;Here to read a character from the line.  Eats embedded comments.
;Call with P2/ pointer to the line
;Returns +1 if end of line seen
;Returns +2 if not end of line, P2/ updated pointer P3/ character

SECCHR:	CALL SECCH2		;(P2/P2,P3) Load a character
	 RET			;End of line!
	CAIE P3,"!"		;Is it a embedded comment character?
	RETSKP			;Nope, return +2 now

SECCH1:	CALL SECCH2		;(P2/P2,P3) Get next character
	 RET			;Returns +1 at end of line
	CAIE P3,"!"		;Is it the end of embedded comment?
	JRST SECCH1		;Nope, keep looking for end of comment 
;	CALLRET SECCH2		;(P2/P2,P3) Yes, get next character and return

SECCH2:	ILDB P3,P2		;Load a character please
	CAIE P3,.CHCRT		;Return?
	CAIN P3,.CHFFD		;Form feed?
	JRST SECCHR		;Yes, eat those
	CAIN P3,.CHLFD		;End of line?
	RET			;Yes, return +1
	CAIL P3,"a"		;Is it
	CAILE P3,"z"		; lowercase?
	RETSKP			;Nope, return +2
	SUBI P3,"a"-"A"		;Yes, convert to upper case
	RETSKP			; and return +2

;Here to eat characters from pointer in P2 until a nonblank character is found.
;Call SECSPA with P2/ pointer to the line, P3/ 0 or last character read
;Call SECSPN to ignore last character read, P2/ pointer to the line
;Returns +1 if end of line
;Returns +2 if not end of line with P2/ updated pointer and P3/ character

SECSPN:	CALL SECCHR		;(P2/P2,P3) Read a character
	 RET			;Return +1 if end of line
SECSPA:	CAIE P3," "		;Was the last character read a space?
	CAIN P3,.CHTAB		;Was the last character read a tab?
	JRST SECSPN		;Yes, get another character then please
	RETSKP			;Return +2, P3/ nonblank character
	SUBTTL Secure Files -- Read Field from Line Buffer

;Here to read in a field from the access control listing file.
;Legal field characters are alphanumerics, asterisk, dot, percent.
;Call with P2/ pointer to the line, P3/ last character read
;Returns +1 if blank field (EOL or field terminator detected before field read)
;Returns +2 if non-blank field, P2/ updated, P3/ field terminator

SECFLD:	CALL SECSPA		;(P2,P3/P2,P3) Eat any leading spaces
	 RET			;End of line
	MOVE T1,[POINT 7,SECWRD] ;Point to output area (word/field to match)
	SETZM SECWRD		;Make it easy to see blank fields

SECFL1:	CAIL P3,"0"		;OK, well is it a character we can consider
	CAILE P3,"9"		; a numeric character?
	CAIN P3,"."		;Is it a hot dot?  (dot is less than zero)
	JRST SECFL5		;Yes in fact this is a legal character
	CAIE P3,"*"		;Is it a going to be
	CAIN P3,"%"		; a wild character?
	JRST SECFL5		;Yes, proceed to store it and loop
	CAIN P3,"$"		;Is it money?
	JRST SECFL5		;Yes
	CAIE P3,"_"		;Is it a going to be underscore
	CAIN P3,"-"		; or a hyphen?
	JRST SECFL5		;Yes, proceed to store it and loop
	CAIL P3,"A"		;Is the character one that we consider
	CAILE P3,"Z"		; alphabetic?
	JRST SECFL6		;Nope, it is a field terminator

;Here if non-terminator character.  Store it, get next character, and loop.
	
SECFL5:	IDPB P3,T1		;It is a legal character, store the character
	CALL SECCHR		;(P2,P2/P3) Read a non blank character
	 JRST SECFL6		;End of line, check it out
	JRST SECFL1		; and loop for more of them today please sir

;Here if field terminator seen.  Store a null, return +2 if non-null word read.

SECFL6:	SETZ T2,		;Load a zero or null character to tie it off
	IDPB T2,T1		;Stick a null at end of the string 
	SKIPE SECWRD		;Here if end of line, did we store something?
	AOS (P)			;Yes, skip return
	RET			;Return +1 or +2
	SUBTTL Subroutines -- Simulate STCMP

;[111] Here to quickly/cheaply compare to ASCIZ strings.
;Call with T1 and T2 pointing to two ASCIZ strings.
;CAUTION!  This routine smashes T1 through T4!
;Returns +1 always, T1/0 if strings matched.

ISTCMP:	TLC T1,-1		;[111] Complement left half
	TLCN T1,-1		;[111] Was the left half -1?
	HRLI T1,(Point 7)	;[111] Yes, make it a byte pointer
	TLC T2,-1		;[111] Complement left half
	TLCN T2,-1		;[111] Was the left half -1?
	HRLI T2,(Point 7)	;[111] Yes, make it a byte pointer
	DMOVE T3,T1		;[111] Copy the pointers to T3 and T4
	DO.			;[111] Loop through the characters
	  ILDB T2,T4		;[111] Get character from user's filespec
	  ILDB T1,T3		;[111] Get character from log filespec
	  CAIN T1,(T2)		;[111] Do the characters match?
	  JUMPN T1,TOP.		;[111] Yes, continue to loop unless null seen
	OD.			;[111] End of loop, null in T1 if a match seen
	RET			;[111] Return with T1 set up
	SUBTTL Subroutines -- Simulate SOUT

;Here to quickly/cheaply copy ASCIZ string, insures null at end of string.
;Call with T1/ destination byte pointer, T2/ source byte pointer
;CAUTION!  This routine MUST preserve all ACs except T1 and T2.
;Returns +1 always, string copied, T1 and T2 updated

ISOUT:	TLC T1,-1		;Complement left half
	TLCN T1,-1		;Was the neft half -1?
	HRLI T1,(Point 7)	;Yes, make it a byte pointer
	TLC T2,-1		;Complement left half
	TLCN T2,-1		;Was the neft half -1?
	HRLI T2,(Point 7)	;Yes, make it a byte pointer

ISOUT1:	ILDB CX,T2		;Load a byte
	IDPB CX,T1		;Store it
	JUMPN CX,ISOUT1		;Jump if not done
	MOVNI CX,1		;Back up the byte pointer
	ADJBP CX,T1		; by one and
	MOVEM CX,T1		;  store back the byte pointer
	RET			;Return
	SUBTTL Output Subroutines -- Output Information about Job

;Here to output information about a particular job.
;Call with T1/ output pointer and T4/ address of GETJI block.
;Returns +1 always

OGETJI:	CALL OSPACE		;(T1/T1) Output a space next please

;Output username.

	MOVE T2,.JIUNO(T4)	;Load the user number
	CALL ODIRST		;(T1,T2/T1) Output directory name

;Output any controlling job information next.

OGETJ1:	HRROI T2,[ASCIZ/ job /]	;Label the job number, first part of data
	MOVE T3,.JIJNO(T4)	;Load the job number
	CALL OLDEC		;(T1,T2,T3/T1) Append in the job number
	SKIPGE .JICPJ(T4)	;Is there a controlling job ?
	IFSKP.			;Yes
	  SKIPL .JIBAT(T4)	;Is the controlling job BATCON?
	  IFSKP.		;Yes it is batch
	    HRROI T2,[ASCIZ/ batch/] ;Label it as such
	    CALL ISOUT		;(T1,T2/T1) Append that to the string
	  ELSE.			;Job is controllied and not batch
	    HRROI T2,[ASCIZ/ ctrl /] ;Label next field
	    MOVE T3,.JICPJ(T4)	;Load the controlling job again
	    CALL OLDEC		;(T1,T2,T3/T1) Output label and job in decimal
	  ENDIF.		;End of job not batch code
	ENDIF.			;End of controlling job check

;Output terminal number and origin.

	SKIPGE T3,.JITNO(T4)	;Have a terminal number?
	IFSKP.			;Yes
	  HRROI T2,[ASCIZ/ TTY/] ;Label the number
	  CALL OLOCT		;(T1,T2,T3/T1) Append the label and octal line
	  SKIPN NTBLK(T4)	;Have network terminal information?
	  IFSKP.		;Yes, output that
	    CALL OSPACE		;(T1/T1) First a space
	    HRROI T2,NTBLK(T4)	;Point to block with name in it
	    CALL ISOUT		;(T1,T2/T1) Send that along next
	  ENDIF.		;End of network org available code
	ELSE.			;We don't have a terminal number
	  HRROI T2,[ASCIZ/ Det/] ;Its detached
	  CALL ISOUT		;(T1,T2/T1) Append detached string
	ENDIF.			;End of terminal number output

;Output program name.

	CALL OSPACE		;(T1/T1) Output a space
	SKIPN T2,.JIPNM(T4)	;Get program name
	MOVE T2,.JISNM(T4)	;If none, use subsystem name
	CALLRET OSIXBI		;(T1,T2/T1) Output sixbit word
	SUBTTL Output Subroutines -- Output Username/Device/Filename

;Routine to do a DIRST.
;Call with T1/ output designator, T2/ user or directory number (5B2+n)
;Returns +1 always, T1/ updated pointer
;                   T2/ user or directory number if legal,
;			0,,error if unknown or 0,,0 if not logged in

ODIRST:	TRNE T2,-1		;Not logged in?
	IFSKP.			;If not logged in
	  HRROI T2,[ASCIZ/not-logged-in/] ;Indicate not logged in today
	  CALL ISOUT		;(T1,T2/T1) Send all of that to string and ret
	  SETZ T2,		;Indicate not logged in
	  RET			;Return with T1/ updated pointer and T2/ 0
	ENDIF.			;End of not logged in case
	MOVE T3,T1		;Copy pointer in case error
	DIRST%			;DIRectory number to STring
	 ERSKP.			;Skip if error
	RET			;Return to caller
	EXCH T1,T3		;Swap pointer with error code
	HRROI T2,[ASCIZ/unknown/] ;Say something if failure
	CALL ISOUT		;(T1,T2/T1) Return a string
	MOVE T2,T3		;Return error code in T2 
	RET			;Return pointer in T1

;Routine to do a DEVST.
;Call with T1/ output designator, T2/ directory number
;Returns +1 always

ODEVST:	MOVE T3,T1		;Copy designator to T3 in case of error
	DEVST%			;Convert to string
	 ERSKP.			;Skip if error
	RET			;Return if success
	MOVE T1,T3		;Reload the pointer
	HRROI T2,[ASCIZ/unknown/] ;Load unknown tag
	CALLRET ISOUT		;(T1,T2/T1) Send that and return

;Routine to do a JFNS.
;Call with T1/ output designator, T2/ JFN
;Returns +1 always

OJFNS:	SETZ T3,		;Default format today
	JFNS%			;JFN to String
	 JSERRO (<JFNS failure>) ;Owie
	RET			;Return +1
	SUBTTL Output Subroutines -- Output Capability Mask

;Here to output text for bits in capability mask
;Call with
;	T1/ output pointer
;	T4/ capability bits
;Returns +1 always, T1/ updated pointer, T2 and T3 smashed

OCAPAB:	MOVSI T3,-CAPNUM	;Load AOBJN pointer to capabilities
	DO.			;Loop for these capabilities
	  HLRO T2,CAPTBL(T3)	;Load ASCIZ string for this capability
	  TDNE T4,CAPTBL(T3)	;Is this one lit?
	  CALL ISOUT		;(T1,T2/T1) Yes, dump its string
	  AOBJN T3,TOP.		;Loop for all of them
	OD.			;End of loop
	RET			;Return to caller

;Table of interesting (right halfword) capabilities.

CAPTBL:	TENTRY (< whl>,SC%WHL)
	TENTRY (< opr>,SC%OPR)
	TENTRY (< cnf>,SC%CNF)
	TENTRY (< mnt>,SC%MNT)
	TENTRY (< enq>,SC%ENQ)
	TENTRY (< ipc>,SC%IPC)
	TENTRY (< nwz>,SC%NWZ)
	TENTRY (< nas>,SC%NAS)
	TENTRY (< dna>,SC%DNA)
	TENTRY (< ana>,SC%ANA)
	TENTRY (< sem>,SC%SEM)
	CAPNUM==.-CAPTBL	;Compute number in table
	SUBTTL Output Subroutines -- Small Output Routines

;Here to output CRLF (PCRLF) or text buffer (PTEXT).
;Returns +1 always.

PTEXT:	SKIPA T1,[XWD -1,TEXTBU] ;Point to text area and skip always
PCRLF:	HRROI T1,[BYTE(7).CHCRT,.CHLFD]	;Point to crlf
	PSOUT%			;Send to terminal
	RET			; and return

;Here to print error buffer as an error message.
;Returns +1 always.

PERRO:	HRROI T1,ERRBUF		;Point to the finished message
	ESOUT%			;Output that error string to terminal
	RET			;Return +1 always

;Here to append a CRLF to the string pointed to by T1.
;Returns +1 always, T1/ updated pointer.

OCRLF:	HRROI T2,[BYTE(7).CHCRT,.CHLFD]	;Point to crlf
	CALLRET ISOUT		;(T1,T2/T1) Append that to the string and ret

;Here to output a space or comma, insures a null after character of course.
;Call with T1/ output pointer
;Returns +1 always, T1/ updated pointer.

OCOMMA:	SKIPA T2,[XWD -1,[ASCIZ/,/]] ;Load pointer to a comma and skip
OSPACE:	HRROI T2,[ASCIZ/ /]	;Load pointer to a space
	CALLRET ISOUT		;Send that along and return

;Small routine to check on the byte pointer in T1.
;Call with T1/ suspected pointer
;Returns +1 always T1/ real byte pointer

PCHECK:	TLC T1,-1		;Complement left half
	TLCN T1,-1		;Was the neft half -1?
	HRLI T1,(Point 7)	;Yes, make it a byte pointer
	RET			;Return +1 always
	SUBTTL Output Subroutines -- Output Sixbit Word

;Here to output a SIXBIT word.
;Call with
;	T1/ output pointer
;	T2/ SIXBIT word
;Returns +1 always, T1/ updated, T2 smashed

OSIXBI:	SAVEAC <T3,T4>		;Save some ACs for scratch
	CALL PCHECK		;(T1/T1) Insure real byte pointer in T1
	MOVE T4,[POINT 6,T2]	;Load byte pointer to string

OSIXB3:	ILDB T3,T4		;Load character 
	JUMPE T3,OSIXB6		;Done if null (space) seen
	ADDI T3,"A"-'A'		;Convert to ASCII
	IDPB T3,T1		;Store character
	JRST OSIXB3		;Loop for all characters

OSIXB6:	MOVEM T1,T4		;Get a copy of the current byte pointer
	IDPB T3,T4		;Store a null past the last real character
	RET			; and then return
	SUBTTL Output Subroutines -- Output Numbers

;Here to prepend a text string and then output a number in decimal radix.
;	T1/ destination pointer
;	T2/ pointer to ASCIZ text
;	T3/ number to be output
;Returns +1 always, T1/ updated pointer

OLDEC:	CALL ISOUT		;(T1,T2/T1) Output string (preserves T3!)
	MOVE T2,T3		;Load number to print into T2
	CAME T2,[INFQUO]	;Is it +inf quota?
	CALLRET ODEC		;Nope, print the number
	HRROI T2,[ASCIZ/inf/]	;Load infinity string
	CALLRET ISOUT		;(T1,T2/T1) Output that and return

;Here to prepend a text string and then output a number in octal radix.
;	T1/ destination pointer
;	T2/ pointer to ASCIZ text
;	T3/ number to be output
;Returns +1 always, T1/ updated pointer

OLOCT:	CALL ISOUT		;(T1,T2/T1) Send label string first
	MOVE T2,T3		;Load number
;	CALLRET OOCT		;(T1,T2/T1) Send octal number and return

;Here to output number quickly (without using a JSYS to do so).
;	T1/ destination pointer
;	T2/ number to be output
;Returns +1 always, T1/ updated pointer, T2/ 0, T3/ smashed

OOCT:	SKIPA CX,[4+4]		;Radix 8
ODEC:	MOVEI CX,5+5		;Radix 10
	CALL PCHECK		;(T1/T1) Insure real byte pointer in T1
	CALL ONUMB		;(T1,T2,CX/T1,T2) Call local routine for output
	MOVE T3,T1		;Copy output pointer
	IDPB T2,T3		;Store that null after the useful text
	RET			; and quickly return to the caller

ONUMB:	IDIVI T2,(CX)		;Extract digit from the number in proper radix
	ADDI T3,"0"		;Convert that binary digit to ASCII
	PUSH P,T3		;Save this on the stack
	SKIPE T2		;Skip if we are all done
	CALL ONUMB		;(T1,T2/T1) Loop for all numbers
	POP P,T3		;Restore a digit from the stack
	IDPB T3,T1		;Store that in the output pointer
	RET			;Return to caller or to get another digit
;Here to output a label and number in octal halfword format such as a PPN.
;Call with
;	T1/ destination pointer
;	T2/ pointer to ASCIZ text
;	T3/ number to be output
;Returns +1 always, T1/ updated pointer

OLPPN:	CALL ISOUT		;(T1,T2/T1) Output string (preserves T3!)
	MOVE T2,T3		;Load number to print into T2
;	CALLRET OPPN		;(T1,T2/T1) Output number in halfword format

;Here to output a number in octal halfword format such as a PPN.
;Call with
;	T1/ destination pointer
;	T2/ number to be output
;Returns +1 always, T1/ updated pointer.

OPPN:	PUSH P,T2		;Save the number
	HLRZ T2,T2		;Load the project number into the right half
	CALL OOCT		;(T1,T2/T1) Send that project number out
	MOVEI T2,","		;Load a comma for the halfword seperator
	IDPB T2,T1		;Store that comma next please 
	POP P,T2		;Restore the project-programmer number
	ANDI T2,-1		;Clear the left half leaving programmer number
	CALLRET OOCT		;(T1,T2/T1) Output programmer and return

;Here to output number and name of it with "s" as appropriate.
;Call with
;	T1/ destination
;	T2/ number
;	T3/ pointer to ASCIZ text
;Returns +1 always, T1/ updated pointer.

OPLURA:	SAVEAC <Q1,Q2>		;Save a couple of ACs first
	DMOVEM T2,Q1		;Save the number and pointer to text
	CALL ODEC		;(T1/T1,T2) Output number
	MOVE T2,Q2		;Load pointer to the text
	CALL ISOUT		;(T1,T2/T1) Output that string next
	SOSN Q1			;Was the number just one?
	RET			;Yep, done
	HRROI T2,[ASCIZ/s/]	;Load your S up
	CALLRET ISOUT		;(T1,T2/T1) Output and insure a null on end
	SUBTTL Output Subroutines -- Output Floating Point Numbers

;Here to output floating point number
;	T1/ destination pointer
;	T2/ floating point number to be output
;Returns +1 always, T1/ updated

OFLOUT:	MOVX T3,FL%ONE!FL%PNT!FLD(4,FL%RND)!FLD(3,FL%SND) ;Format bits
	FLOUT%			;Output that
	 JSERRO (<FLOUT failure>) ;Snowballs exist in hell today
	RET			;Return to sender
	SUBTTL Output Subroutines -- Output Millisecond Times

;Routine to output time in the form "h:mm:ss.tt" or "n days hh:mm:ss".
;Call at OTIMEH with T1/ destination byte pointer, T2/ time in HPTIM units
;Call at OTIME with T1/ destination byte pointer, T2/ time in milliseconds
;Returns +1 always, T1/ updated pointer

OTIME:	IDIV T2,[^D<24*60*60*1000>] ;Milliseconds, get days in T2, time in T3
	IMULI T3,^D100		;Convert milliseconds to HPTIM units
	JRST OTIME1		; and enter the high precision units output

OTIMEH:	IDIV T2,[^D<24*60*60*1000*100>] ;HPTIM unit, get days in T2, time in T3
OTIME1:	SAVEAC <P1,P2,P3,P4,P5>	;Save the Ps

;Now T1/ output pointer, T2/ days, T3/ time in HPTIM units.

	MOVEM T3,P1		;Save the time in HPTIM units for later
	HRROI T3,[ASCIZ/ day/]	;Label the number as "day" or "days"
	SKIPN P5,T2		;Skip if days, load P5 with number of days
	JRST OTIME2		;No days to output today
	CALL OPLURA		;(T1,T2,T3/T1) Output that
	CALL OSPACE		;(T1/T1) followed by a space

;Now P1/ time, T1/ output pointer, breakup the time into its components.

OTIME2:	EXCH T1,P1		;Get time in T1, save output pointer
	ADDI T1,^D500		;Round up the hundredths of seconds
	IDIVI T1,^D1000		;Get units into hundredths of seconds
	IDIV T1,[^D<100*60*60>]	;Get hours from hundreths of seconds
	IDIVI T2,^D<100*60>	;Get minutes from fractional hours
	IDIVI T3,^D100		;Get seconds from fractional minutes
	DMOVEM T3,P3		;Save seconds in P3 and hundreths of secs in P4
	MOVEM T2,P2		;Save minutes in P2
	EXCH T1,P1		;Save hours in P1, get string pointer back
;Now P1/ hours, P2/ minutes, P3/ seconds, P4/ hundreths, P5/ days.  
;Output hours and colon if days output or if hours are not zero.

	MOVX T3,^D10		;Load radix 10 for the hours please
	MOVEI T4,":"		;Load a colon for a suffix
	SKIPN T2,P1		;Always output nonzero hours
	SKIPE P5		;If any days always output hours even if zero
	CALL OTIME3		;(T1,T2,T3,T4/T1,T3) Output hours and a colon

;Output minutes and a colon if hours output or if minutes is nonzero.

	SKIPN T2,P2		;Always output minutes if nonzero 
	TXNE T3,NO%LFL		;Mins zero, output mins if hours or days output
	CALL OTIME3		;(T1,T2,T3,T4/T1,T3) Output minutes and colon

;Output seconds always, suffix is a dot only if no hours output.

	MOVE T2,P3		;Load seconds as they are always output
	SKIPE P5		;If no hours were output
	TDZA T4,T4		; then no suffix will be printed
	MOVEI T4,"."		;Suffix after seconds should be a hot dot
	CALL OTIME3		;(T1,T2,T3,T4/T1,T3) Output seconds and a dot

;Output hundreths with no suffix only if no days have been output.

	JUMPN P5,R		;Return now if hours were output
	SETZ T4,		;No seperator now
	MOVE T2,P4		;Load hundredths of seconds and fall through

;Local routine called from above to output parts of the time and a suffix.

OTIME3:	NOUT%			;Output number
	 JSERRO (<NOUT failed>)	;Owie
	SKIPE T4		;Any seperator character?
	IDPB T4,T1		;Yes, store it now
	MOVX T3,NO%LFL!NO%ZRO!FLD(2,NO%COL)!FLD(^D10,NO%RDX) ;2 for the rest
	RET			;Return to above
	SUBTTL Output Subroutines -- Output Standard Date/Time

;Outputs time of day from internal format, call with T1/ output byte pointer.
;Call at OODTIN with T1/ pointer, current time, suppressing columnation.
;Call at OODTIM with T1/ pointer, T2/ time, suppressing columnation.
;Call at OODTI1 with T1/ pointer, T2/ time, and T3/ time format bits.
;Returns +1 always with T1/ updated pointer.

OODTIN:	SETO T2,		;The time is now
OODTIM:	MOVX T3,OT%SCL		;Suppress columnation 9 days of the month
OODTI1:	ODTIM%			;Zap it to terminal
	 JSERRO (<ODTIM failed>) ;Owie
	RET			;Return

;Routine to output time of day as expressed in seconds since midnight.
;Call with T1/ pointer, T2/ time as seconds since midnight.
;Returns +1 always T1/ updated.

OTOD:	SAVEAC <P1,P2>		;Save some space
	CALL PCHECK		;(T1/T1) Insure real byte pointer in T1
	IDIVI T2,^D60*^D60	;Get hours in T2 
	IDIVI T3,^D60		;Get minutes in T3 and seconds in T4
	DMOVEM T3,P1		;Put minutes in P1 and seconds in P2
	CALL OTOD2		;(T1,T2/T1) Use local routine for just numbers
	MOVE T2,P1		;Load the number of minutes
	CALL OTOD1		;(T1,T2/T1) Use routine sending colon and time
	SKIPE T2,P2		;Load the seconds, don't output if its zero
	CALL OTOD1		;(T1,T2/T1) Use routine sending colon and time
	MOVEI T2,0		;Load a null
	IDPB T2,T1		;Store it last
	MOVNI T2,1		;Back up the byte pointer
	ADJBP T2,T1		; by one and
	MOVEM T2,T1		;  store back the byte pointer
	RET			;Return

;Local routine to send time (OTOD2) or colon and time (OTOD1).
;Accepts T1/ output pointer, T2/ number.
;Returns +1 always, T1/ updated

OTOD1:	MOVEI T3,":"		;Load suffix character next
	IDPB T3,T1		;Store seperator
OTOD2:	IDIVI T2,^D10		;Get the two digits 
	ADDI T2,"0"		;Convert to ASCII
	IDPB T2,T1		;Send that first digit out
	ADDI T3,"0"		;Pump up another ASCII digit
	IDPB T3,T1		;Send that too
	RET			;Return
	SUBTTL Output Subroutines -- Output JSYS Error Message

;Subroutine to send along the last JSYS error
;Call with T1/ output designator
;Returns +1 always with T1/ updated

OERSTR:	MOVX T2,<.FHSLF,,-1>	;This fork's last error
	SETZ T3,		;No limit
	ERSTR%			;Get string to error
	 CALLRET OERSTE		;(T1/T1) Undefined error number
	 JFCL			;String size out of bounds or bad designator?
	RET			;Return to caller with T1 updated

OERSTE:	HRROI T2,[ASCIZ/Undefined error /] ;Output label for string
	CALL ISOUT		;(T1,T2/T1) Append that string too
	CALL GETERR		;(/T2) Get fork's last error
	MOVEI T3,4+4		;Radix 8
	NOUT%			;Don't use OOCT routine to output that number
	 ERNOP.			;Ignore error within error within error
	RET			;Return with T1 updated
	SUBTTL Error Handler -- Error Messages

;Subroutine to handle JSYS errors
;Call with CX/address of ASCIZ string
;Returns +1 always, message, error, and trailing CRLF printed

JSERR1:	TXOE F,FL%ERR		;Error within an error?
	RET			;Return before additional damage can occur
	HRROM CX,ERRADR		;Save address of string to print
	SAVEAC <T1,T2,T3,T4>	;Save some ACs today please
	HRROI T1,ERRBUF		;Point to text buffer
	TXNN F,FL%ACJ		;Acting like the ACJ?
	IFSKP.			;Yes
	  HRROI T2,[ASCIZ/Access Control Facility error detected at /] ;Label
	  CALL ISOUT		;(T1,T2/T1) Send that
	  CALL OODTIN		;(T1/T1) Output date time of now
	  HRROI T2,[ASCIZ/
    /]				;Label the next little bit
	  CALL ISOUT		;(T1,T2/T1) Send that and return
	ENDIF.			;End of acting like the ACJ code
	MOVE T2,ERRADR		;Load pointer to error text string
	CALL ISOUT		;(T1,T2/T1) Start off with that text
	CALL OERSTR		;(T1/T1) Append in the last error text please
	CALL OCRLF		;(T1/T1) Append a CRLF to all of that

	CALL PERRO		;(/) Send all of that to terminal as error mess
	HRROI T1,ERRBUF		;Point to text buffer again
	TXNE F,FL%ACJ		;[116] Acting like the ACJ?
	CALL SENLOG		;[116] (T1/) Send to log file if possible
	TXZ F,FL%ERR		;Clear error bit
	RET			; and return

;Small routine to return this fork's last error in T2
;Returns +1 always, T2/ error number, T1 preserved

GETERR:	PUSH P,T1		;Save T1
	MOVEI T1,.FHSLF		;Load this fork
	GETER%			;Get last error in T2
	TLZ T2,-1		;Zap junk in LH
	POP P,T1		;Restore T1
	RET			;Return
	SUBTTL Error Handler -- Panic and Control-C Interrupt

;Here when a panic interrupt hits us.  For now we just crash.

PANIC:	BUG(HLT,PAN,<Panic interrupt>) ;Just say crash

;Here when a control-C seen, terminate the world by crashing.

CNTRLC:	BUG(HLT,CCC,<Control-C Crash>) ;Boom
	SUBTTL Error Handler -- Crash Handler

;Here when we want to crash, save all of the ACs, save ourself, then crash.
;Called by JSR BUGHLT, following is ASCIZ/crash code/ and ASCIZ/crash reason/.

BUGHLT:	EXP 0			;Called by JSR BUGHLT

;Save all the ACs, get a new stack.

	MOVEM 17,BUGACS+17	;Save all of the ACs here please
	MOVEI 17,BUGACS		;Get source,,destination (0,,BUGACS)
	BLT 17,BUGACS+16	;Move all of the rest of them to memory please
	MOVE P,[IOWD BUGLEN,BUGPDL] ;Load a new stack pointer

;Save last TOPS-20 error, send message to terminal about this problem.

	CALL GETERR		;(/T2) Get last JSYS error code
	HRRZM T2,LASERR		;Save it here
	CALL FATALE		;(/) Let me tall ya sumthin ma ma ma ma mannn

;Save our image in a good place today.

	HRROI T2,[ASCIZ/DMP:ACJ-/] ;Load the initial part of filename
	CALL BUGSAV		;(T2/) Save ourselves
	IFNSK.			;If it failed
	  HRROI T2,[ASCIZ/SYSTEM:ACJ-/] ;Try SYSTEM: this time
	  CALL BUGSAV		;(T2/) Try again
	   OJSERR (<Can't save crash>) ;This will be interesting debugging
	ENDIF.			;We did all we could

;Kill inferiors, disable all GETOK functions, close log file.

	MOVX T1,.FHINF		;Load fork handle for all inferiors
	KFORK%			;Kill all of them
	 ERNOP.			;Ignore errors at this point
	TXO F,FL%ERR		;[110] Light error in progress bit please
	CALL DISFNC		;(/) Disable all functions before crashing
	CALL CLOLOG		;[110] (/) Sweep and close the log file
	CALL SECCLA		;[111] (/) Close all cached access.control

;Restore ACs.  Halt if not running as job 0.  Restart if running as job 0.

	MOVSI 17,BUGACS		;Get source,,destination (BUGACS,,0)
	BLT 17,16		;Move all but one of them back from memory
	MOVE 17,BUGACS+17	;Reload the last AC
	RESET%			;Dump all resources we might have
	SKIPN OURJOB		;Are we running under job 0?
	JRST ASTART		;For security reasons, restart ourselves
	HALTF%			;Halt
	JRST .-1		; and don't continue either
;Print a message on the console about this problem, only called from BUGHLT.
;Returns +1 always.

FATALE:	HRROI T1,ERRBUF		;Point to error buffer today
	HRROI T2,[ASCIZ/
 Access control program fatal error "/]
	CALL ISOUT		;(T1,T2/T1) Send that along first
	MOVE T2,BUGHLT		;Point to ASCIZ strings
	HRLI T2,(Point 7)	;Make a byte pointer to it
	CALL ISOUT		;(T1,T2/T1) Copy the reason code
	MOVE Q1,T2		;Save this for a little bit
	HRROI T2,[ASCIZ/" (/]	;Load the next little bit
	CALL ISOUT		;(T1,T2/T1) Copy the string
	MOVEI T2,1(Q1)		;Get next address after null
	HRLI T2,(Point 7)	;Point to rest of string
	CALL ISOUT		;(T1,T2/T1) Send that along
	HRROI T2,[ASCIZ/)
  Last TOPS-20 error: /]	;Label next string
	CALL ISOUT		;(T1,T2/T1) Send that along
	CALL OERSTR		;(T1/T1) Send last JSYS error next
	HRROI T2,[ASCIZ/
  Access control terminated at /] ;Start the next line
	CALL ISOUT		;(T1,T2/T1) Send that along also
	CALL OODTIN		;(T1/T1) Output the time of now
	CALL OCRLF		;(T1/T1) Append a crlf
	HRROI T1,ERRBUF		;Point to error buffer again
	PSOUT%			;Send to the console
	RET			;Return to caller
;Here to get a JFN on a crash filename and save ourselves.
;Call with T2/ pointer to initial part of crash filename
;Returns +1 if error.
;Returns +2 if crash saved.

BUGSAV:	HRROI T1,BUGFIL		;Point to place to store filename
	CALL ISOUT		;(T1,T2/T1) Copy first part of string
	HRRZ T2,EV+2		;Load the edit number of the ACJ
	CALL OOCT		;(T1,T2/T1) Send the OCTAL edit number next
	HRROI T2,[ASCIZ/-/]	;Delimit the string
	CALL ISOUT		;(T1,T2/T1) Send the delimiter
	MOVE T2,BUGHLT		;Load the stop address again
	HRLI T2,(Point 7)	;Make a byte pointer again
	CALL ISOUT		;(T1,T2/T1) Copy the crash code next
	HRROI T2,[ASCIZ/-CRASH.EXE/] ;Finish up the string
	CALL ISOUT		;(T1,T2/T1) Send the file type last

	MOVX T1,GJ%SHT!GJ%FOU	;Load short form and for output bits
	HRROI T2,BUGFIL		;Point to file we just made up
	GTJFN%			;Try to get a JFN on dump file
	 ERJMP R		;Return +1 for error
	MOVE T4,T1		;We got a JFN, copy it for a sec

	HRROI T1,ERRBUF		;Point back to error buffer again
	HRROI T2,[ASCIZ/  Access control crash saved as /] ;Load label
	CALL ISOUT		;(T1,T2/T1) Start the text right
	MOVE T2,T4		;Load the JFN
	CALL ISOUT		;(T1,T2/T1) Save initial text
	CALL OJFNS		;(T1,T2/T1) Send the filename next
	CALL OCRLF		;(T1/T1) Make it neat

	MOVE T1,T4		;Reload the JFN again
	HRLI T1,.FHSLF		;Make this fork,,jfn
	MOVX T2,SS%CPY!SS%RD!SS%EXE!FLD(-770,SS%NNP)!FLD(0,SS%FPN) ;Page 0-767
	SSAVE%			;Save our image, closes the JFN today
	 ERJMP R		;Return +1 if errors today

	HRROI T1,ERRBUF		;Point to error buffer
	PSOUT%			;Send to console
	RETSKP			;Return +2 for success
	SUBTTL End of ACJDEC

;Dump literals here

	LOWCD			;Get to low seg
DECLIT:	XLIST			;Remove literals from listing
	LIT			;Dump them here
	LIST			;Resume listing

;Get globular symbols

	GGLOBS

	END <EVLEN,,EV>