Google
 

Trailing-Edge - PDP-10 Archives - bb-m081u-sm_t20_v7_0_23_exec_src_mod - exec/execse.mac
There are 47 other files named execse.mac in the archive. Click here to see a list.
; Edit= 4417 to EXECSE.MAC on 12-Jan-89 by WONG, for SPR #22042
;Add code to support @SET DEFAULT PRINTER /REMOTE-PRINT: command and fix some
;bugs in routine SRPPTR: which deals with validating the arguments to the @SET
;REMOTE PRINTER command.
; Edit= 4416 to EXECSE.MAC on 10-Jan-89 by RASPUZZI
;Add commands and modify INFO SYS for password dictionary.
; Edit= 4412 to EXECSE.MAC on 13-Dec-88 by RASPUZZI
;Add new commands, features and support for security enhancements.
; Edit= 4409 to EXECSE.MAC on 12-Aug-88 by GSCOTT
;It's OK to have the second field of SET REMOTE-PRINTING PRINTER start with a
;mimeric character, remove code that checks for alphabetic only in SRPPTR. 
; Edit= 4402 to EXECSE.MAC on 5-Apr-88 by EVANS (TCO 7.1265)
;Make the EXEC accept non-alphanumeric characters $,_,-,and . in LAT-type
;names for remote printing. 
; UPD ID= 4128, RIP:<7.EXEC>EXECSE.MAC.21,   7-Mar-88 18:27:20 by GSCOTT
;TCO 7.1255 - Update copyright notice.
; UPD ID= 4103, RIP:<7.EXEC>EXECSE.MAC.20,  18-Feb-88 15:56:46 by RASPUZZI
;TCO 7.1232 - Make NO PRIVATE-QUASAR clear NEBULA's PID too.
; UPD ID= 4098, RIP:<7.EXEC>EXECSE.MAC.19,  18-Feb-88 15:46:59 by RASPUZZI
;TCO 7.1231 - Add ^ESET MINIMUM-PASSWORD-LENGTH command.
; UPD ID= 77, RIP:<7.EXEC>EXECSE.MAC.18,  24-Nov-87 15:59:33 by MCCOLLUM
;TCO 7.1147 - Change offline structures default to 5 seconds
; UPD ID= 68, RIP:<7.EXEC>EXECSE.MAC.17,  17-Nov-87 14:50:18 by EVANS
; TCO 7.1136 - Move check for defining alias to itself to DOSRPP: routine.
; UPD ID= 62, RIP:<7.EXEC>EXECSE.MAC.16,  10-Nov-87 15:00:47 by EVANS
; TCO 7.1118 - Remove an extraneous CALL PIOFF at SRPCH2:
; UPD ID= 56, RIP:<7.EXEC>EXECSE.MAC.14,  29-Oct-87 15:35:03 by EVANS
; TCO 7.1099 Change help message when parsing .CMCFM in second field
;		of SET REMOTE XXXX command. 
; UPD ID= 54, RIP:<7.EXEC>EXECSE.MAC.13,  28-Oct-87 22:40:52 by RASPUZZI
;More of TCO 7.1076 - This time, merge the right .RED file...
; UPD ID= 51, RIP:<7.EXEC>EXECSE.MAC.12,  28-Oct-87 14:03:36 by EVANS
; TCO 7.1091 Resolve symbol conflict with MONSYM (7.0 only) by renaming
;		routine .LATTY to .LTTTY.
; UPD ID= 46, RIP:<7.EXEC>EXECSE.MAC.11,  27-Oct-87 15:38:34 by EVANS
; More of TCO 7.1073 - Fix some bugs.
; UPD ID= 43, RIP:<7.EXEC>EXECSE.MAC.10,  22-Oct-87 11:04:27 by RASPUZZI
;TCO 7.1076 - Add ^ESET CLUSTER-INFO and ^ESET CLUSTER-SEND commands
; UPD ID= 32, RIP:<7.EXEC>EXECSE.MAC.9,  16-Oct-87 14:20:13 by EVANS
; TCO 7.1071 - More of TCO 7.1068 - fix some bugs.
; UPD ID= 31, RIP:<7.EXEC>EXECSE.MAC.8,  30-Sep-87 16:27:27 by EVANS
; More of TCO 7.1061 - Make user confirm if setting something to itself
; UPD ID= 29, RIP:<7.EXEC>EXECSE.MAC.7,  30-Sep-87 16:07:11 by EVANS
; TCO 7.1068 - Implement SET REMOTE-PRINTING PRINTER
; UPD ID= 28, RIP:<7.EXEC>EXECSE.MAC.6,  23-Sep-87 15:51:13 by MCCOLLUM
;TCO 7.1063 - Add ^ESET [NO] OFFLINE-STRUCTURES commands.
; UPD ID= 24, RIP:<7.EXEC>EXECSE.MAC.5,  22-Sep-87 11:46:48 by EVANS
; More TCO 7.1061 - Fill in TCO numbers around edits and add header line.
; UPD ID= 16, RIP:<7.EXEC>EXECSE.MAC.4,  22-Sep-87 10:47:51 by EVANS
; TCO 7.1061 - Implement SET REMOTE-PRINTING CHARACTERISTIC 
; UPD ID= 8, RIP:<7.EXEC>EXECSE.MAC.3,   4-Aug-87 17:00:02 by EVANS
; TCO 7.1031 - Add processing for SET REMOTE-PRINTING SYSTEM-DEFINITIONS
;              Also hooks and tables for other new SET REMOTE-PRINTING
;                   commands, CHARACTERISTIC and REMOTE-PRINTER.
; *** Edit 3064 to EXECSE.MAC by GSCOTT on 23-Apr-87, for SPR #19597
; Don't change the session remark if the user didn't change it in SET ACCOUNT. 
; *** Edit 3042 to EXECSE.MAC by MCCOLLUM on 26-Jun-86
; Add a call to .LATTY at .ANTTY for SET LOGINS ANY enables LAT logins. 
; *** Edit 3041 to EXECSE.MAC by MCCOLLUM on 24-Jun-86, for SPR #21297
; Add ^ESET [NO] LOGINS LAT-TERMINALS and fix up @INFO SYS to display status 
; *** Edit 3040 to EXECSE.MAC by EVANS on 24-Jun-86, for SPR #21170
; Implement MAIL-WATCHing based on directory number, as users can now send mail
; to non-username directories on POBOX:
; Edit 3012 to EXECSE.MAC by EVANS on 15-Aug-85 (TCO 6-1-1521 )
; Make user confirm SET NO TRAP PROCEED before setting the "NO" flag.
; Edit 3007 to EXECSE.MAC by EVANS on 9-Aug-85 (TCO 6-1-1507 )
; Tell the monitor what program we're running for the SET HOST command.
; UPD ID= 247, SNARK:<6.1.EXEC>EXECSE.MAC.24,  11-Jun-85 15:24:23 by SANTIAGO
;TCO 6.1.1441 - Require confirmation from SET STATUS-WATCH for subcommands
; UPD ID= 240, SNARK:<6.1.EXEC>EXECSE.MAC.23,  10-Jun-85 08:45:20 by DMCDANIEL
; UPD ID= 213, SNARK:<6.1.EXEC>EXECSE.MAC.22,   3-Jun-85 12:23:11 by PRATT
;TCO 6.1.1388 - Clear entry in REASON table after alert has gone off
; UPD ID= 212, SNARK:<6.1.EXEC>EXECSE.MAC.21,  31-May-85 10:41:25 by EVANS
;More TCO 6.1.1404 - Remove SETNOF from TRVAR, it's now global.
; UPD ID= 192, SNARK:<6.1.EXEC>EXECSE.MAC.19,  10-May-85 13:56:36 by EVANS
;TCO 6.1.1361 - Use ERROR macro if SET TRAP JSYS not confirmed properly.
; UPD ID= 189, SNARK:<6.1.EXEC>EXECSE.MAC.18,   6-May-85 23:14:33 by PRATT
;Again, more TCO 6.1.1243 - Changing LERROR to ETYPE screwed up crlfs
; UPD ID= 185, SNARK:<6.1.EXEC>EXECSE.MAC.17,   3-May-85 14:29:14 by PRATT
;TCO 6.1.1356 - Parse arbitrary string for node names in SET HOST
; UPD ID= 181, SNARK:<6.1.EXEC>EXECSE.MAC.16,   3-May-85 08:32:30 by DMCDANIEL
;Update copyrights for 6.1.
; UPD ID= 146, SNARK:<6.1.EXEC>EXECSE.MAC.15,  15-Mar-85 14:53:14 by EVANS
;TCO 6.1.1248 - Prevent user being left with null password. (RE: edits 925 & 2011)
; UPD ID= 143, SNARK:<6.1.EXEC>EXECSE.MAC.14,  15-Mar-85 13:07:18 by PRATT
;More TCO 6.1.1243 - Change the LERROR to an ETYPE
; UPD ID= 132, SNARK:<6.1.EXEC>EXECSE.MAC.13,   7-Mar-85 19:56:08 by PRATT
;TCO 6.1.1243 - Make error character for SET PAGE command be a percent
; UPD ID= 114, SNARK:<6.1.EXEC>EXECSE.MAC.10,  12-Dec-84 16:29:32 by PRATT
;TCO 6.1.1085 - Rename SET JFN-WATCH to SET STATUS-WATCH
; UPD ID= 109, SNARK:<6.1.EXEC>EXECSE.MAC.9,  12-Dec-84 13:51:11 by PRATT
;More TCO 6.1.1017 - Update to latest cterm-server, and bugfixes
;  Run CTERM-SERVER at offset 3 in entry vector
;  Always kill off server if NSPX20 error even if fork is kept
;  Fix problem with kept/continue status of fork
; UPD ID= 66, SNARK:<6.1.EXEC>EXECSE.MAC.7,  12-Nov-84 03:51:17 by MERRILL
;TCO 6.1.1042 - Update for latest PCL we have
;  Fix SET [NO] COMMAND-TRACE to not set/clear the trace flag until
;  the command has been confirmed.
; UPD ID= 29, SNARK:<6.1.EXEC>EXECSE.MAC.6,   2-Oct-84 14:15:47 by PRATT
;More TCO 6.1.1016 - LIST-PAR... needs confirm in the right place
; UPD ID= 22, SNARK:<6.1.EXEC>EXECSE.MAC.4,   1-Oct-84 17:12:56 by PRATT
;TCO 6.1.1017 - Add SET HOST command
; UPD ID= 19, SNARK:<6.1.EXEC>EXECSE.MAC.3,   1-Oct-84 12:01:42 by PRATT
;More TCO 6.1.1016 - Also type out the connected directory
; UPD ID= 9, SNARK:<6.1.EXEC>EXECSE.MAC.2,  29-Sep-84 16:08:28 by PRATT
;TCO 6.1.1016 - Add SET JFN-WATCH command
; UPD ID= 401, SNARK:<6.EXEC>EXECSE.MAC.42,  26-Apr-84 15:11:07 by PRATT
;TCO 6.2050 - Fix problem with arpa monitor / no host # set
; UPD ID= 398, SNARK:<6.EXEC>EXECSE.MAC.41,   3-Apr-84 09:19:11 by EVANS
;TCO 6.2012 - Replace FORTRAN ".LE." in message prompt for SET ALERT.
; UPD ID= 391, SNARK:<6.EXEC>EXECSE.MAC.40,  27-Feb-84 09:43:20 by PRATT
;TCO 6.1956 - Add ^Eset [no] FAST-LOGINS-ALLOWED
; UPD ID= 390, SNARK:<6.EXEC>EXECSE.MAC.38,  27-Feb-84 09:27:30 by PRATT
;TCO 6.1982 - Fix the ^ESET commands which aren't "confirm"ing
; UPD ID= 389, SNARK:<6.EXEC>EXECSE.MAC.37,  27-Feb-84 08:15:25 by PRATT
;More TCO 6.1956 - Fix typeo at CEASE3 code
; UPD ID= 388, SNARK:<6.EXEC>EXECSE.MAC.36,  27-Feb-84 07:35:55 by PRATT
;TCO 6.1967 - Do a confirm, and add the NOW arg for ^ECEASE
; UPD ID= 382, SNARK:<6.EXEC>EXECSE.MAC.35,  24-Jan-84 16:56:13 by PAETZOLD
;more TCO 6.1953 - Add some ^ESET commands.  Add entries to the no table.
; UPD ID= 381, SNARK:<6.EXEC>EXECSE.MAC.34,  24-Jan-84 16:46:27 by PAETZOLD
;more TCO 6.1953 - Add some ^ESET commands.  fix a typeo.
; UPD ID= 380, SNARK:<6.EXEC>EXECSE.MAC.33,  24-Jan-84 16:35:43 by PAETZOLD
;TCO 6.1953 - Add some ^ESET commands.
; UPD ID= 347, SNARK:<6.EXEC>EXECSE.MAC.32,  28-Nov-83 16:37:33 by LOMARTIRE
;More TCO 6.1676 - Improve error message "Invalid terminal range specified"
; UPD ID= 341, SNARK:<6.EXEC>EXECSE.MAC.31,  20-Nov-83 19:45:16 by PRATT
;TCO 6.1870 - Get rid of code which is under NONEWF. Remove NEWF's.
; UPD ID= 316, SNARK:<6.EXEC>EXECSE.MAC.30,  26-Oct-83 13:58:05 by PRATT
;TCO 6.1842 - No negative args and new error messages for SET TIME-LIMIT
; UPD ID= 287, SNARK:<6.EXEC>EXECSE.MAC.29,  14-Jun-83 11:56:25 by LOMARTIRE
;TCO 6.1676 - Allow range of terminal lines in ^ESET TERMINAL command
; UPD ID= 259, SNARK:<6.EXEC>EXECSE.MAC.28,  11-Feb-83 14:29:09 by TSANG
;TCO 6.1500 - Don't allow ESC to confirm SET LATE-CLEAR-TYPEAHEAD command
; UPD ID= 257, SNARK:<6.EXEC>EXECSE.MAC.27,   8-Feb-83 10:29:29 by TSANG
;TCO 6.1494 - Fix SET TRAP NO NO NO..... problem
; UPD ID= 249, SNARK:<6.EXEC>EXECSE.MAC.26,  15-Jan-83 19:27:15 by CHALL
;TCO 6.1464 - UPDATE COPYRIGHT NOTICE
; UPD ID= 220, SNARK:<6.EXEC>EXECSE.MAC.25,  11-Jan-83 13:51:56 by TSANG
;TCO 6.1116 - Fix SET TIME-LIMIT confusion
; UPD ID= 213, SNARK:<6.EXEC>EXECSE.MAC.24,   3-Jan-83 17:08:41 by LOMARTIRE
;TCO 6.1433 - Add code for ^ESET [NO] LOGINS-ALLOWED DECNET-LINES command
; UPD ID= 196, SNARK:<6.EXEC>EXECSE.MAC.23,  18-Nov-82 10:46:31 by PAETZOLD
;TCO 6.1384- Remove the ^ESET ARPANET commands
; UPD ID= 189, SNARK:<6.EXEC>EXECSE.MAC.22,   1-Nov-82 16:22:55 by WEETON
;TCO 6.1335 - Only ask for old password when nessesary
; UPD ID= 163, SNARK:<6.EXEC>EXECSE.MAC.21,  27-Sep-82 16:58:27 by ACARLSON
;Add USERID option to ^ESET PRIVATE-QUASAR (for GALAXY)
; UPD ID= 149, SNARK:<6.EXEC>EXECSE.MAC.20,   5-Aug-82 20:35:33 by LEACHE
;TCO 6.1215 Remove bogus JUMPN from JSYS trap code
; UPD ID= 142, SNARK:<6.EXEC>EXECSE.MAC.19,   4-Aug-82 17:28:57 by LEACHE
;TCO 6.1209 Fix JSYS trapping
; UPD ID= 100, SNARK:<6.EXEC>EXECSE.MAC.17,   8-Jan-82 15:59:45 by CHALL
;TCO 6.1052 - UPDATE COPYRIGHT NOTICE AND DELETE PRE-V4.1 EDIT HISTORY
; UPD ID= 80, SNARK:<6.EXEC>EXECSE.MAC.16,  20-Dec-81 18:10:18 by CHALL
;TCO 6.1049 .LOCAT- DON'T REQUIRE "::" IN NODE NAME (SET CM%NSF)
; UPD ID= 77, SNARK:<6.EXEC>EXECSE.MAC.15,   6-Nov-81 12:59:10 by CHALL
;TCO 5.1602 ALRDL7- FIX: "SET NO AL BEF" CLEARED ALL ALERTS
; UPD ID= 42, SNARK:<6.EXEC>EXECSE.MAC.12,  27-Aug-81 14:31:40 by GROUT
;TCO 5.1477 .PAXL- ADD ERJMP CJERRE AFTER SCVEC
; UPD ID= 41, SNARK:<6.EXEC>EXECSE.MAC.11,  21-Aug-81 14:31:40 by CHALL
;ADD DEFAULTS FOR THESE COMMANDS, WHICH TAKE A SINGLE KEYWORD:
;"SET DEF TAKE NO", "SET DIR NO", "^ESET TERM"
; UPD ID= 38, SNARK:<6.EXEC>EXECSE.MAC.9,  19-Aug-81 10:57:37 by CHALL
;TCO 5.1463 .NODEF: MOVE "SET NO DEFAULT" OPTIONS TABLE TO EXECCA
; UPD ID= 22, SNARK:<6.EXEC>EXECSE.MAC.8,  17-Aug-81 10:19:31 by CHALL
;TCO 5.1454 CHANGE NAME FROM XDEF TO EXECDE
;.TYPEO: MAKE "MODE" BE THE DEFAULT FOR SET TYPEOUT
;TCO 5.1443 - TJSYS: ALLOW SET TRAP JSYS TO TAKE OCTAL ARGUMENTS
; UPD ID= 3, SNARK:<6.EXEC>EXECSE.MAC.6,  14-Jul-81 12:54:32 by CHALL
;TCO 5.1411 - DMODE: NEED TO SET LENGTH IN GTDIR BLOCK
; UPD ID= 2257, SNARK:<6.EXEC>EXECSE.MAC.4,  26-Jun-81 09:12:33 by CHALL
;TCO 5.1388 - .ALERT: IF NEW ALERT IS AT SAME TIME AS AN OLD ONE, SUPERCEDE OLD
;<6.EXEC>EXECSE.MAC.3, 12-Jun-81 14:18:33, EDIT BY HELLIWELL
;MAKE .KFRKC AND .NOLM INTERNAL (::)
; UPD ID= 1729, SNARK:<6.EXEC>EXECSE.MAC.2,  18-Mar-81 16:34:40 by OSMAN
;tco 6.1007 - Fix "SET ALERT +0" to not set alert to be tomorrow.
;REMOVE MFRK CONDITIONALS
;<4.EXEC>EXECSE.MAC.1, 28-Jul-80 15:06:24, Edit by DK32
;Programmable Command Language
; UPD ID= 1439, SNARK:<5.EXEC>EXECSE.MAC.18,  15-Jan-81 10:52:03 by OSMAN
;Tco 5.1233 - Make FILE-OPENINGS and JSYS OPENF independent
; UPD ID= 1427, SNARK:<5.EXEC>EXECSE.MAC.17,   9-Jan-81 11:18:02 by OSMAN
;More 5.1225 - Make "SET TRAP NO" and "SET NO TRAP" equivalent.  Also,
;make "SET NO TRAP<cr>" get rid of all traps
; UPD ID= 1402, SNARK:<5.EXEC>EXECSE.MAC.16,   6-Jan-81 10:28:05 by OSMAN
;tco 5.1225 - Implement jsys trapping and file-opening trapping!
; UPD ID= 1386, SNARK:<5.EXEC>EXECSE.MAC.15,  29-Dec-80 09:12:09 by OSMAN
; Make SET NO ALERT take input the same as SET ALERT, so SET ALERT 300 followed
;immediately by SET NO ALERT 300 will usually work (not always since day may
;change!)
; UPD ID= 1338, SNARK:<5.EXEC>EXECSE.MAC.14,   8-Dec-80 10:07:54 by ACARLSON
;<GALAXY.DEVELOPMENT>EXECSE.MAC.2,  8-Dec-80 09:55:28, EDIT BY ACARLSON
;TCO 5.1210 - Add commands ^ESET (NO) PRIVATE-QUASAR for debugging GALAXY
; UPD ID= 1325, SNARK:<5.EXEC>EXECSE.MAC.13,   1-Dec-80 16:02:58 by OSMAN
; UPD ID= 1203, SNARK:<5.EXEC>EXECSE.MAC.12,  27-Oct-80 14:32:35 by OSMAN
;Fix SET NO ALERT
; UPD ID= 1132, SNARK:<5.EXEC>EXECSE.MAC.11,   6-Oct-80 10:44:10 by OSMAN
;tco 5.1167 - Remove "SET FILE [NO] AUTOKEEP"
; UPD ID= 1045, SNARK:<5.EXEC>EXECSE.MAC.10,  25-Sep-80 14:21:53 by OSMAN
;tco 5.1156
; UPD ID= 1027, SNARK:<5.EXEC>EXECSE.MAC.9,  22-Sep-80 10:38:01 by OSMAN
;tco 5.1150 - Add SET PROGRAM
; UPD ID= 859, SNARK:<5.EXEC>EXECSE.MAC.8,  10-Aug-80 15:20:23 by OSMAN
;tco 5.1129 - Add symbolic address and expression support
; UPD ID= 804, SNARK:<5.EXEC>EXECSE.MAC.7,  28-Jul-80 10:25:44 by OSMAN
;tco 5.1114 - Don't give error on SET NO ALERT if none to remove
;<5.EXEC>EXECSE.MAC.6, 30-May-80 16:49:20, EDIT BY MURPHY
;PUT NEW MAIL WATCH AND ALERT UNDER NEWF
; UPD ID= 539, SNARK:<5.EXEC>EXECSE.MAC.5,  20-May-80 15:46:45 by MURPHY
;CHANGE SOME XTND TO NEWF OR MFRK
; UPD ID= 520, SNARK:<5.EXEC>EXECSE.MAC.4,  14-May-80 13:20:26 by OSMAN
;Don't make past time mean tomorrow if date was typed
; UPD ID= 495, SNARK:<5.EXEC>EXECSE.MAC.3,  30-Apr-80 14:34:58 by OSMAN
;Fix confirmation on TAKE subcommands and SET DEFAULT TAKE
;<4.1.EXEC>EXECSE.MAC.6, 25-Mar-80 10:39:43, EDIT BY OSMAN
;More ONEWRD fixes on SET PAGE-ACCESS
;<4.1.EXEC>EXECSE.MAC.5, 17-Mar-80 14:07:49, EDIT BY OSMAN
;Get rid of ONEWRD checks
; UPD ID= 93, SNARK:<4.1.EXEC>EXECSE.MAC.4,   5-Dec-79 10:24:11 by OSMAN
;tco 4.2589 - Change $DEFAU to TDEFAU to not conflict with GLXLIB
;<4.1.EXEC>EXECSE.MAC.2, 20-Nov-79 14:01:16, EDIT BY OSMAN
;TCO 4.1.1023 - Fix TAKE stuff

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

	SEARCH EXECDE
	TTITLE EXECSE

;THIS FILE CONTAINS
;SET AND ^ESET COMMANDS

DEFINE SETSTG
<	TRVAR <ATIME,NOW,AHELP,<ARANGE,2>,ENTADR,WBITS,CDRDEV,CDRSTR,CDRDCK,DIRP,PASSP,<SEBLK,GTDLN>,SPERF,SPCNT,SPPAG,SPERR,ACDIR> ;KEEP DEV,STR,DCK IN ORDER FOR JSYS
>
;"ESET" AND "ESET NO"

ESET::	SETSTG			;ALLOCATE LOCAL STORAGE
	SETZM SETNOF		;CLEAR NO FLAG
	KEYWD $ESET
	 0
	 JRST CERR
	TXNN P3,NOLG		;NEED TO BE LOGGED IN?
	SKIPE CUSRNO		;YES, ARE WE?
	CAIA			;OK
	ERROR <LOGIN please>
	JRST (P3)		;DISPATCH TO COMMAND

;"SET" AND "SET NO"

.SET::	SETSTG			;ALLOCATE STORAGE
	SETZM SETNOF		;CLEAR NO FLAG
	KEYWD $SET0
	 0
	 JRST CERR
	TXNN P3,NOLG		;NEED TO BE LOGGED IN?
	SKIPE CUSRNO		;YES, ARE WE?
	CAIA			;OK
	ERROR <LOGIN please>
	JRST (P3)		;DISPATCH TO COMMAND
;SET ACCOUNT

.CHANG::STKVAR <SETSR,SETAC>	;[3064] Pointer session remark and account
	SETZM SETSR		;[3064] Clear any pointer to session remark
	NOISE (TO)		;[3064] Blurt out the noise word
	CALL ACCT		;[3064] (/A) Input, check, convert account
	MOVEM A,SETAC		;[3064] Save pointer to the account string
	NOISE (SESSION REMARK)	;[3064] Mumble out session remark noise words
	MOVEI B,[FLDDB. .CMCFM,,,,,[ ;[3064]
		 FLDDB. .CMTXT,,,<New session remark, one line of text>]] ;[3064]
	CALL FLDSKP		;[3064] (B/B,C) Get a confirm or session remark
	 CMERRX			;[3064] Didn't parse (?) give an error message
	LDB C,[POINT 9,(C),8]	;[3064] Get the function that parsed
	CAIE C,.CMTXT		;[3064] Was it the confirm?
	IFSKP.			;[3064] No, it was a session remark
	  CALL BUFFF		;[3064] (/A) Get a pointer to it into ac A
	  MOVEM A,SETSR		;[3064] Save pointer to session remark
	  CONFIRM		;[3064] Confirm that command please
	ENDIF.			;[3064]
	MOVE A,SETAC		;[3064] Load pointer to account string
	CACCT			;[3064] Change the account string
	 CALL CJERR		;[3064] Give an error if it didn't work
	SKIPE A,SETSR		;[3064] Is there a session remark to set?
	 CALL SSR		;[3064] (A/) Yes, set the session remark
	RET			;[3064] Return to CMDIN4
	ENDSV.			;[3064] End of .CHANG's STKVAR
;ACCOUNT (OF FILE) <NAME> (IS) <ACCOUNT # OR STRING>

.ACCOU::NOISE <OF FILES>
	CALL INFGNS		;* VERSION, NO SEARCH, GROUP OK
	MOVE B,INIFH1		;START HERE
	MOVEM B,OUTDSG
	CAIA
ACCOU3:	AOS B,OUTDSG
	CAMLE B,INIFH2		;ALL GONE YET?
	JRST [	MOVX A,1B1	;INDICATE STRING ACCOUNT
		JRST ACCOU4]
	HRRZ A,(B)
	CAIN A,-2		;FOUND REAL JFN YET?
	JRST ACCOU3		;NO, KEEP LOOKING
	DVCHR			;DEVICE CHARACTERISTICS
	LDB A,[POINT 9,B,17]	;DEVICE TYPE
	CAIE A,.DVDSK
	JRST ACCOU3		;LOOP TILL WE FIND ONE
;DETERMINE WHETHER SPECIFIED FILE TAKES STRING OR NUMERIC ACCOUNT

	STKVAR <<ABUF,FILWDS>>
	HRROI A,ABUF
	HRRZ B,@OUTDSG
	LDF C,1B2+1B5+JS%PAF	;GET STR:<DIR>
	JFNS			;GET STRING
	 ERCAL JERRE
	MOVSI A,(RC%EMO)	;NO RECOGNITION
	HRROI B,ABUF
	RCDIR			;CONVERT STRING BACK TO DIR # TO GET BITS
	TLNE A,(RC%NOM+RC%AMB)	;SKIP IF EXACT MATCH
	 JRST ACCOU3		;TRY TO FIND LEGAL ONE
ACCOU4:	NOISE <TO>
	CALL ACCT		;GET ACCOUNT # OR STRING, USING A.
	CONFIRM
	MOVEM A,ACDIR		;SAVE ACCT # OR STRING HERE
	SETOM TYPGRP		;TYPE FILES
	MOVE A,JBUFP		;GET POINTER TO JFN STACK
	MOVEM A,.JBUFP		;MARK HOW FAR BACK TO RELEASE JFNS
ACCOU1:	CALL RLJFNS		;RELEASE TEMPORARY JFNS
	CALL NXFILE		;CHECK FOR NON-EX FILE TERM
	 JRST ACCOU2		;GO SEE IF ANY MORE TO DO
	CALL TYPIF		;TYPE NAME, GET JFN
	CALL MFINP		;GET A TEMP JFN AND STEP TO NEXT FILE
	 JRST ACCOU2		;FAILED
	MOVE B,ACDIR		;ACCT # OR STRING PTR
	SACTF			;SET ACCOUNT OF FILE
	 JRST [	TYPE <  >
		CALL $ERSTR
		ETYPE<%_>
		JRST ACCOU2]
	CALL TYPOK
ACCOU2:	SKIPE INIFH1		;ANYTHING LEFT TO BE DONE?
	JRST ACCOU1		;YES, LOOP BACK FOR REST OF FILES
	RET
;SET ADDRESS-BREAK

.ADDRE::SKIPGE SETNOF		;"NO" TYPED?
	JRST [	CONFIRM		;YES, CONFIRM IT
		SKIPG A,FORK	;FORK HANDLE
		ERROR <No program>
		HRLI A,.ABCLR	;FUNCTION TO REMOVE BREAKS
		ADBRK		;DO IT
		 ERJMP CJERRE	;FAILED-- TYPE ERROR STRING
		SETZM ABKCNT	;ZERO REPEAT COUNT
		RET]		;AND RETURN
	PUSH P,P1		;GET A SAFE REGISTER
	SETZ P1,		;CLEAR IT (HOLDS FLAG BITS)
	NOISE <AT>
	ADDRX <Location on which to break>
	 ERROR <Invalid address>
	TDNN B,[777776,,777760]	;CAN'T SET BREAK ON ANY ACS
	ERROR <Address break won't work on the ACs>
	TLNE B,777740		;CHECK FOR TOO LARGE AN ADDRESS
	ERROR <Break address not between 0 and 37,,777777>
	PUSH P,B		;SAVE ADDRESS
	CALL SPRTR		;CHECK FOR COMMA OR CONFIRM
	 SUBCOM $ADBK		;COMMA TYPED, GET SUBCOMMANDS
	TRZN P1,1		;ANY SUBCOMMANDS TYPED?
	TXO P1,AB%RED!AB%WRT!AB%XCT ;NO, TAKE DEFAULTS
	SKIPG A,FORK		;FORK HANDLE
	ERROR <No program>
	HRLI A,.ABSET		;FUNCTION TO SET BREAK
	POP P,B			;RECOVER ADDRESS
	MOVE C,P1		;PUT FLAGS IN RIGHT AC
	POP P,P1		;RESTORE P1
	ADBRK			;SET IT
	 ERJMP CJERRE		;FAILED-- SAY WHY
	RET			;AND RETURN
$ADBK:	TABLE
	T AFTER,,.AFT
	T ALL,,.ALL
	T EXECUTE,,.EXE
	T NONE,,.NON
	T READ,,.REA
	T WRITE,,.WRI
	TEND

.AFT:	DECX <Number of times to allow reference before trapping, in decimal>
	 CMERRX
	NOISE <REFERENCES>
	MOVEM B,ABKCNT		;REMEMBER IT
	CALLRET CONF		;CONFIRM AND RETURN

.ALL:	TXO P1,AB%RED!AB%WRT!AB%XCT!1
	NOISE <TYPES OF REFERENCES>
	CALLRET CONF		;CONFIRM AND RETURN

.EXE:	TXOA P1,AB%XCT!1
.REA:	TXO P1,AB%RED!1
	NOISE <REFERENCES>
	CALLRET CONF		;CONFIRM AND RETURN

.WRI:	TXOA P1,AB%WRT!1
.NON:	TXOA P1,1
	NOISE <REFERENCES>
	CALLRET CONF		;CONFIRM AND RETURN

.SETNO::SETOM SETNOF		;FLAG NO TYPED
	KEYWD $SETN
	 0
	 JRST CERR
	TXNN P3,NOLG		;NEED TO BE LOGGED IN?
	SKIPE CUSRNO		;YES, ARE WE?
	CAIA			;OK
	ERROR <LOGIN please>
	JRST (P3)		;DISPATCH TO COMMAND

;SET HOST FOR CONNECTING TO DECNET HOSTS USING THE CTERM-SERVER OR NRT:

.HOST::	TRVAR <NNAM,SWTNAM,SRVJFN,PNAMP,NAMFLG,PTBLP>
	SETZM NNAM		;CLEAR AWAY 1ST PART OF NODE NAME
	SETZM SWTNAM		;CLEAR SWITCH SEEN
	MOVEI B,[FLDDB. .CMSWI,,$HOST,<Node name>,,[
		 FLDDB. .CMCFM,,,,,[
		 FLDBK. .CMTXT,,,<Node name>,,[
   		 BRMSK. (EOLB0.,EOLB1.,EOLB2.,EOLB3.,,</>)],]]]
	CALL FLDSKP		;PARSE THE NEXT FIELD
	 CMERRX
	LDB C,[331100,,(C)]	;SEE WHICH WAS TYPED
	CAIN C,.CMCFM		;CONFIRMED ?
	JRST HOST1		;YES - INVOKE CTERM INTERACTIVELY
	CAIN C,.CMSWI		;GOT A SWITCH ?
	JRST HOST2		;YES - GO PROCESS IT
	CALL BUFFF		;BUFFER THE NODENAME
	MOVEM A,NNAM		;SAVE ADDRESS OF NODE NAME
	MOVEI B,[FLDDB. .CMSWI,,$HOST,,,[
		 FLDDB. .CMCFM]]
	CALL FLDSKP		;PARSE THE NEXT FIELD
	 CMERRX
	LDB C,[331100,,(C)]	;SEE WHICH WAS TYPED
	CAIN C,.CMCFM		;CONFIRMED ?
	JRST HOST1		;YES - INVOKE CTERM 
HOST2:	CALL GETKEY		;GOT A SWITCH, SEE WHICH ONE
	MOVEM P3,SWTNAM		;SAVE IT
	CONFIRM
HOST1:	HLRO B,.HCTRM		;BY DEFAULT USE CTERM
	SKIPE A,SWTNAM		;SWITCH SPECIFIED ?
	HLRZ B,A      		;YES - USE IT INSTEAD
	HRLI B,(POINT 7,0)	;MAKE POINTER IN LEFT
	MOVE A,[POINT 7,BUF0]	;USE TEMP PAGE FOR BUFFERING THE STRING
	SETZ C,			;TERMINATE ON NULL
	CALL ASOUT		;COPY THE STRING
	SKIPN B,NNAM		;HAVE NODENAME ?
	IFSKP.
	 HRLI B,(POINT 7,0)	;YES - MAKE POINTER TO IT
	 CALL ASOUT		;APPEND IT TO THE STRING
	ENDIF.
	MOVE B,[POINT 7,[BYTE (7) 15,12,0]] ;TERMINATE BUFFER WITH CRLF
	CALL ASOUT		;COPY IT
	HRROI A,BUF0		;POINT AT FULL STRING
	RSCAN			;BUILD RSCAN BUFFER FOR SERVICE PROGRAM
	 ERROR <RSCAN failed, cannot invoke protocol service program>
	HRRO B,.HCTRM		;BY DEFAULT USE CTERM
	SKIPE A,SWTNAM		;SWITCH SPECIFIED ?
	HRRO B,A     		;YES - USE IT INSTEAD
	CALL TRYGTJ
	 ERROR <Couldn't invoke protocol service program: %?>
	MOVEM A,SRVJFN		;SAVE SERVICE PROGRAM JFN AWAY
	MOVEI Q1,ETTYMD		;MAKE SURE NORMAL TTY MODE RESTORED
	CALL LTTYMD
	CALL PSPNAM		;SET UP THE NAME
	CALL PSPRUN		;GO RUN IT AND WAIT
	SKIPE B,SWTNAM		;WAS ANY SERVICE SPECIFIED
	IFSKP.	
	 SKIPGE A,FORK		;NO - DEFAULTED TO CTERM - GET FORK HANDLE
	 JRST HOST4 		;DON'T HAVE IT FOR SOME REASON
	 GETER			;SEE WHAT THE LAST ERROR WAS
	  ERJMP HOST4		;FORK GONE PROBABLY
	 HRRZS B		;SAVE ONLY THE ERROR CODE
	 CAIE B,NSPX20		;"DESTINATION PROC DOES NOT EXIST" ?
	 JRST HOST4		;NO - DON'T ATTEMPT TO USE NRT:
	 SKIPLE A,FORK		;GET FORK HANDLE AGAIN
	 CALL KEFORK		;NO - KILL IT
	 MOVE B,.HNRT		;POINT AT NRT:
	 MOVEM B,SWTNAM
	 JRST HOST1		;TRY TO RUN IT
	ENDIF.
HOST4:	TLZ Z,RUNF		;SAY PROG'S TTY MODES NOT IN EFFECT
	MOVEI Q1,ETTYMD		;RESTORE EXEC'S TTY MODES
	CALL LTTYMD		;..
	RET



$HOST:	TABLE
	[ASCIZ/CTERM/],,.HCTRM
	[ASCIZ/NRT/],,.HNRT
	TEND

.HCTRM:	[ASCIZ/CTERM-SERVER /],,[GETSAVE (SYS:CTERM-SERVER.)]
.HNRT:	[ASCIZ/NRT: /],,[ASCIZ/NRT:/]

;SET THE PROGRAM NAME FOR ^T AND FREINDS

PSPNAM:	MOVEI A,EXTSIZ		;GET ROOM FOR FILENAME
	CALL GETBUF		;GET BUFFER FOR IT
	HRRO A,A		;MAKE POINTER TO THE SPACE
	MOVEM A,PNAMP		;REMEMBER POINTER TO PROGRAM NAME
	HRLM A,PRGCEL		;SET UP POINTER TO PROG NAME FOR ^T
	MOVE B,SRVJFN		;GET PROGRAM NAME
	MOVX C,1B8		;WE WANT JUST THE NAME FIELD
	JFNS			;GET FILE NAME
	MOVEI B,PRGCEL
	MOVEM B,COMAND
	HLRO A, (B)		;[3007] POINT TO PROGRAM NAME STRING
	CALL GETSIX		;[3007] MAKE INTO SIXBIT
	 JFCL			;[3007] TRUNCATED IF RETURNS HERE
	SETNM			;[3007] TELL THE MONITOR ABOUT IT
	RET
;HERE TO RUN THE PROTOCOL SERVICE PROGRAM 

PSPRUN:	MOVEI A,FRKNMS		;POINT TO LIST OF KNOWN FORKS
	MOVE B,PNAMP		;POINT TO NAME OF PROTOCOL SERVICE
	TBLUK			;LOOK IT UP IN KNOWN NAMES
	TXNN B,TL%EXM		;IN LIST OF KNOWN FORKS?
	IFSKP.
	 HRRZ C,(A)		;YES, GET ADDRESS OF FORK BLOCK
	 LOAD D,FKHAN,(C)	;GET FORK HANDLE 
	 JUMPE D,PSPCK2		;IF NONE, GO START NEW COPY
	 MOVEM D,FORK		;STORE AS CURRENT FORK
	 SETZM SYMOKF		;FORCE SYMBOLS TO BE RECOMPUTED
	 MOVE A,SLFTAB(D)	;GET FLAGS FOR THIS FORK
	 TXNN A,FK%KPT		;IS FORK KEPT ALREADY?
	 IFSKP.
	  ETYPE <[Starting]%_>	;YES
	  JRST PSPCK3		;NO NEED TO "GET" A NEW COPY
	 ENDIF.
	ENDIF.
PSPCK2:	CALL ERESET		;PREPARE TO LOAD AND RUN PGM
	MOVE A,SRVJFN		;GET SERVICE PROGRAM JFN AWAY
	SETO C,			;FORCE OVERLAY
	CALL $GET0		;GET PROGRAM
PSPCK3:	TLO Z,RUNF
	MOVX B,FK%RUN		;FORK CAN BE CONTINUED LATER
	MOVE A,FORK		;SET UP AS RUNNING FORK
	IORM B,SLFTAB(A) 
	SKIPN C,SWTNAM		;SWITCH SPECIFIED ?
	MOVE C,.HCTRM		;NO - BY DEFAULT USE CTERM
	MOVEI B,3     		;DEFAULT IS CTERM'S "EXEC START" ADDRESS
	CAME C,.HCTRM		;REALLY HAVE CTERM ?
	SETZ B,			;NO - NORMAL START 
	SFRKV			;START FORK USING ENTRY VECTOR
	RFORK			;RESUME IT
	WFORK			;WAIT FOR IT
	RET
;SET TRAP IS FOR CONTROLLING JSYS AND UUO TRAPPING

.TRAP::	KEYWD TRAPT
	 0			;NO DEFAULT
	 CMERRX			;INVALID KEYWORD AFTER "TRAP" TYPED
	CALLRET (P3)		;DO WHAT WAS ASKED AND RETURN

;SET NO TRAP AND SET TRAP NO TURN OFF VARIOUS TRAPPING

TRAPN:	SETOM SETNOF		;REMEMBER THAT "NO" TYPED
NTRAP::	SKIPGE SETNOF		;IS "NO" ALREADY TYPED?
	SKIPA B,[[FLDDB. .CMCFM,CM%SDH,,<Carriage return to turn off all traps>,,[
		 FLDDB. .CMKEY,,TRAPT1]]] ;YES, USE TABLE TRAPT1
        MOVEI B,[FLDDB. .CMCFM,CM%SDH,,<Carriage return to turn off all traps>,,[
		 FLDDB. .CMKEY,,TRAPT]]	;NO, USE TABLE TRAPT
	CALL FLDSKP		;READ WHAT'S AFTER "SET NO TRAP" OR "SET TRAP NO"
	 CMERRX
	LOAD D,CM%FNC,.CMFNP(C)	;GET WHAT WAS TYPED
	CAIN D,.CMCFM		;JUST CARRIAGE RETURN?
	JRST UNTRAP		;YES, GO UNTRAP EVERYTHING
	CALL GETKEY		;KEYWORD TYPED, GET INFO
	CALLRET (P3)

TRAPT:	TABLE
	T FILE-OPENINGS,,FOPEN	;SET TRAP FILE-OPENINGS
	T JSYS,,TJSYS		;SET TRAP JSYS X
	T NO,,TRAPN		;SET TRAP NO
	T PROCEED,,TPROC	;SET TRAP PROCEED
	TEND

TRAPT1:	TABLE
	T FILE-OPENINGS,,FOPEN	;SET TRAP FILE-OPENINGS
	T JSYS,,TJSYS		;SET TRAP JSYS X
	T PROCEED,,TPROC	;SET TRAP PROCEED
	TEND
;SET [NO] TRAP PROCEED CONTROLS WHETHER A JSYS OR UUO TRAPPED PROGRAM
;SHOULD PROCEED AUTOMATICALLY FROM THE TRAP.  THIS COMMAND CONTROLS THE
;CURRENT FORK ONLY.

TPROC:	NOISE (AUTOMATICALLY AFTER TRAPS)
	CALL CONF		;[3013] REQUIRE CONFIRM BEFORE SETTING FLAGS
	SKIPN SETNOF		;DIFFERENT ACTION ACCORDING TO "NO" FLAG
	SETZM TSTOPF		;SET TRAP PROCEED
	SKIPE SETNOF
	SETOM TSTOPF		;SET NO TRAP PROCEED
	RET              	;[3013] AND RETURN

;SET TRAP JSYS X CAUSES AN ANNOUNCEMENT EVERY TIME JSYS X IS EXECUTED
;FOR ANY FORK

TJSYS:	MOVEM P,SAVSP		;SAVE STACK POINTER
	MOVEI A,RESP		;GET CLEANUP ROUTINE
	PUSH P,A		;PUT IT ON STACK
	SETZM Q3		;RESET FLAG
	NOISE (NAMED OR NUMBERED)
	MOVEI B,[FLDDB. .CMSWI,CM%DPP,JSWI,,</DEFINED>,[
		 FLDDB. .CMNUM,CM%SDH,10,<Octal JSYS number>,,[
		 FLDBK. .CMKEY,CM%SDH,JTAB,<JSYS name>,,[
		   BRMSK. (KEYB0.,KEYB1.,KEYB2.,KEYB3.,<%>)],]]]

	JRST PRSJ0		;GO PARSE INPUT

PRSJSY:	SETOM Q3		;INDICATE PAST FIRST FIELD
	MOVEI B,[FLDDB. .CMNUM,CM%SDH,10,<Octal JSYS number>,,[
		 FLDBK. .CMKEY,CM%SDH,JTAB,<JSYS name>,,[
		   BRMSK. (KEYB0.,KEYB1.,KEYB2.,KEYB3.,<%>)]]]
PRSJ0:	CALL SAVCM		;SAV COMND POINTERS
	CALL FLDSKP		;READ JSYS NAME OR NUMBER
PRSJ1:	JRST	[SKIPN Q3
		ETYPE <%@?JSYS name, JSYS number or switch required:  %b%%_>
		SKIPE Q3
		ETYPE <%@?JSYS name or JSYS number required:  %b%%_>
		MOVE P,SAVSP	;RESET STACK MANUALLY
		RET ]
PRSJ2:	LOAD D,CM%FNC,.CMFNP(C)	;SEE WHAT WAS TYPED
NAMTST:	CAIE D,.CMKEY		;NAME?
	JRST NUMTST		;NO
	HRRZI A,-JTAB(B)	;GET THE JTAB INDEX
	LDB A,[POINT 9,JTAB(A),26] ;GET THE JSYS NUMBER
	PUSH P,A		;STORE ON STACK
	JRST PRSCOM		;TRY FOR COMMA/CONFIRM
NUMTST:	CAIE D,.CMNUM		;AN OCTAL NUMBER?
	JRST SWTST		;NO
	SKIPLE B		;GREATER THAN ZERO?
	CAIL B,JLEN		;LESS THAN MAX JSYS?
	JRST [ETYPE <%@?Not a valid JSYS number:  %b%%_>
	     MOVE P,SAVSP	;RESET STACK
	      CALLRET RESCM]	;BACK UP TO PREVIOUS ATOM
	PUSH P,B		;SAVE VALUE
	JRST PRSCOM		;TRY FOR COMMA/CONFIRM
SWTST:	SKIPN Q3		;SKIP TEST 2- N'TH TIME
	CAIE D,.CMSWI		;A SWITCH?
	JRST PRSJ1		;NO, GO COMPLAIN
	JRST [	CALL GETKEY	;YES, SEE WHICH ONE
		JRST (P3)]	;GO EXECUTE THE SWITCH

PRSCOM:	MOVEI B,[FLDDB. .CMCMA,,,,,[
		 FLDDB. .CMCFM]]
	CALL FLDSKP
PRSCM1:	ERROR <Comma or confirmation required>

	LOAD D,CM%FNC,.CMFNP(C)	;SEE WHAT WAS TYPED
CMATST:	CAIN D,.CMCMA		;COMMA?
	JRST PRSJSY		;YES - BACK FOR MORE

CFMTST:	CAIE D,.CMCFM		;CONFIRMED?
	JRST PRSCM1		;NO - GO COMPLAIN, UNKNOWN ATOM
POPLP:	HRRZ A,(P)		;GET TOP OF STACK
	CAIN A,RESP		;DONE ALL?
	JRST SETBR		;YES, SET TRAP STATUS AND RETURN

	POP P,A			;GET THE JSYS NUMBER
	CAMN A,[FLD(OPENF,YFLD)];IS THIS OPENF?
	JRST [	SETCM C,SETNOF	;YES, GET CORRECT VALUE FOR TOPENF
		MOVEM C,TOPENF	;REMEMBER WHETHER WE'RE TRAPPING OPENF OR NOT
		JRST .+1]

	MOVE C,A		;GET THE JSYS NUMBER
	MOVE Q1,A		;ALSO GET IT HERE
	MOVE D,[POINT 1,JSBDEF]	;GET BYTE POINTER TO BIT MASK
	ADJBP C,D		;INCREMENT TO THE BIT FOR THAT JSYS
	ILDB D,C		;GET THE BIT
	MOVEI B,JSBDEF		;GET ADDRESS OF BREAK MASK
	SKIPN SETNOF		;CLEAR OR SET BIT ACCORDING TO YES OR NO
	JRST SETB		;SET IT

	JUMPE D,POPLP		;IT WAS ALREADY CLEAR, BACK FOR NEXT JSYS
	LDB D,[POINT 9,JTAB(Q1),35]  ;BIT WAS SET.  DEFINED JSYS?
	SKIPE D			; ...
	SOS TRAPD		;IT WAS DEFINED
	SKIPN D			;...
	SOS TRAPU		;IT WAS UNDEFINED
	CALL CLRBIT		;AND CLEAR THE BIT
	JRST POPLP		;BACK FOR NEXT JSYS

SETB:	JUMPN D,POPLP		;THE BIT WAS ALREADY SET, BACK FOR NEXT JSYS
	LDB D,[POINT 9,JTAB(Q1),35]  ;BIT WAS CLEAR.  DEFINED JSYS?
	SKIPE D			;...
	AOS TRAPD		;IT WAS DEFINED
	SKIPN D			;...
	AOS TRAPU		;IT WAS UNDEFINED
	CALL SETBIT		;SET IT
	JRST POPLP		;BACK FOR NEXT JSYS

SETBR:	CALL MRKTRP		;SET UP NEW TRAP STATUS
SJTRET:	RET			;RETURN

RESP:	MOVE P,SAVSP		;THIS IS A STACK CLEAN-UP ROUTINE
	RET
;JSWI IS TABLE OF SWITCHES FOR SET TRAP JSYS

JSWI:	TABLE
	T ALL,,JALL		;SET TRAP JSYS /ALL
	T DEFINED,,JDEF		;  /DEFINED
	T UNDEFINED,,JUND	;  /UNDEFINED
	TEND

;UNTRAP UNTRAPS EVERYTHING

UNTRAP:	SETZM TFILEF		;SAY WE'RE NOT TRAPPING FILE-OPENINGS
	CALLRET JALL3		;GO UNTRAP ALL JSYS'S TOO

;JALL CONFIRMS AND EXECUTES "SET (NO) TRAP JSYS /ALL"

JALL:	CONFIRM			;NOTE THAT SWITCH INTEAD OF KEYWORD ALLOWS A JSYS TO BE CALLED "ALL"
JALL3:	MOVEI A,JSBDEF		;SAY WHERE BLOCK IS
	SKIPE SETNOF		;CLEAR OR SET ALL BITS ACCORDING TO "NO"
	JRST JALNO		;GO HANDLE SET NO TRAP JSYS /ALL
	CALL SETALL
	SETOM TOPENF		;SAY OPENF SHOULD BE TRAPPED
	MOVEI B,SJLEN		;GET DEFINED COUNT
	MOVEM B,TRAPD		;SAVE IT
	MOVEI A,JLEN-1		;GET TOTAL COUNT
	SUB A,B			;GET UNDEFINED COUNT
	MOVEM A,TRAPU		;SAVE IT
	JRST JALL2

JALNO:	CALL CLRALL
	SETZM TRAPU		;CLEAR UNDEFINED COUNT
	SETZM TRAPD		;CLEAR DEFINED COUNT
	SETZM TOPENF		;SAY OPENF IS NOT BEING TRAPPED AS A JSYS
JALL2:	MOVE A,FORK		;SAY WHICH FORK
	CALLRET MRKTRP		;SET UP NEW TRAP STATUS
	;JDEF COMFIRMS AND EXECUTES SET (NO) JSYS TRAP /DEFINED

JDEF:	CONFIRM
	SETOM TOPENF		;ASSUME TRAPPING OPENF
	SKIPE SETNOF		;DID HE SAY NO?
	SETZM TOPENF		;YES, SAY OPENF SHOULD NOT BE TRAPPED

	MOVE Q1,[-SJLEN,,1]	;GET AOBJN POINTER
JDSLP:	LDB C,[POINT 9,JTAB(Q1),26] ;GET THE JSYS NUMBER
	MOVEM C,A		;KEEP A COPY IN A
	MOVE B,[POINT 1,JSBDEF]	;GET BYTE POINTER TO BIT MASK
	ADJBP C,B		;INCREMENT TO THE BIT FOR THAT JSYS
	ILDB C,C		;GET THE BIT
	MOVEI B,JSBDEF		;GET MASK ADDRESS
	SKIPN SETNOF		;CLEAR OR SET ALL BITS ACCORDING TO "NO"
	CALL SETBIT		;SET THE BIT
	SKIPE SETNOF		;...
	CALL CLRBIT		;CLEAR THE BIT
JDSN:	AOBJN Q1,JDSLP		;BACK FOR MORE
	MOVEI A,SJLEN		;GET NUMBER OF DEFINED JSYSES
	MOVEM A,TRAPD		;MAKE THAT THE COUNT
	SKIPE SETNOF		;DID HE SAY NO?
	SETZM TRAPD		;YES
	CALLRET MRKTRP		;SET UP NEW TRAP STATUS

	;JUND COMFIRMS AND EXECUTES SET (NO) JSYS TRAP /UNDEFINED

JUND:	CONFIRM
	MOVE Q1,[-JLEN+1,,1]	;GET INCREMENTED AOBJN POINTER
JUSLP:	LDB A,[POINT 9,JTAB(Q1),35] ;IS THIS AN UNDEFINED JSYS?
	JUMPN A,JUSN		;NO
	HRRZ D,Q1		;GET THE JSYS NUMBER
	MOVE B,[POINT 1,JSBDEF]	;GET BYTE POINTER TO BIT MASK
	ADJBP D,B		;INCREMENT TO THE BIT FOR THAT JSYS
	ILDB D,D		;GET THE BIT
	HRRZ A,Q1		;GET JSYS NUMBER
	MOVEI B,JSBDEF		;GET MASK ADDRESS
	SKIPN SETNOF		;CLEAR OR SET ALL BITS ACCORDING TO "NO"
	CALL SETBIT		;SET THE BIT
	SKIPE SETNOF		;...
	CALL CLRBIT		;CLEAR THE BIT
JUSN:	AOBJN Q1,JUSLP		;BACK FOR MORE
	MOVEI A,JLEN-1		;GET NUMBER OF ALL JSYS'S
	SUBI A,SJLEN		;SUBTRACT DEFINED JSYS'S
	MOVEM A,TRAPU		;MAKE THAT THE COUNT
	SKIPE SETNOF		;DID HE SAY NO?
	SETZM TRAPU		;YES
	CALLRET MRKTRP		;SET UP NEW TRAP STATUS
	;HERE WE BUILD A TBLUK-FORMAT TABLE THAT GETS SORTED IN THE
	;EXEC'S ONCE-ONLY CODE.

DEFINE DEFJS (NAME,VALUE,TRASH,NIM,OLDNEW)
<
	IFB <NIM>,<
	  RELOC JTAB+VALUE	;;ALLOW FOR GAPS IF SOME JSYSES UNDEFINED
	  IFB <OLDNEW>,<
		[1B7
		ASCIZ/NAME'%/],,VALUE_9
		>
	  IFIDN <OLDNEW><OLD>,<
		[1B7
		ASCIZ/NAME/],,VALUE_9
		>
		   SJLN=SJLN+1
	  >

	IFG VALUE-LARGST,<LARGST==VALUE>
>


	LARGST==0
JTAB::	SJLEN,,JLEN
	SJLN=0			;RESET COUNTER
	JSLIST			;USE JSYS LISTER FROM MONSYM (CALLS DEFJS)
	JLEN==:.-JTAB		;LENGTH OF TABLE
	RELOC JTAB+LARGST+1	;Allow for JSYSes not being in order in JSLIST
	SJLEN==:SJLN		;COUNT OF ALL DEFINED JSYS'S
	BLOCK 1			;[4412] Table is not big enough
;SET TRAP FILE-OPENINGS causes all forks' file-openings to be announced

FOPEN:	CONFIRM			;MAKE SURE HE MEANS IT
	SETCM A,SETNOF		;SET OR CLEAR TFILEF ACCORDING TO SETNOF
	MOVEM A,TFILEF
;	CALLRET MRKTRP		;GO UPDATE TRAP STATUS

;MRKTRP MARKS THAT TRAP STATUS HAS CHANGED AND HENCE HAS TO BE UPDATED.
;IT IS NOT UPDATED IMMEDIATELY, BECAUSE DOING SO CAN PREVENT EXECUTE-ONLY
;PROGRAMS FROM BEING LOADED WITH GET JSYS, SINCE SETTING TRAPS MAKES
;THE PROCESS NON-VIRGIN

MRKTRP::SETZM TRPOKF		;SAY TRAPS ARE NOT OK
	LOAD A,YFLD,[OPENF]	;GET BIT POSITION OF OPENF JSYS
	MOVEI B,JSBDEF		;POINT AT TRAP BITS
	CALL CLRBIT		;FIRST CLEAR THE BIT
	LOAD A,YFLD,[OPENF]	;GET BIT POSITION OF OPENF JSYS
	MOVEI B,JSBDEF		;POINT AT TRAP BITS
	SKIPN TOPENF		;TURN OPENF BIT ON IF TRAPPING OPENF JSYS
	SKIPE TFILEF		;OR IF TRAPPING FILE-OPENINGS
	JRST SETBIT
	RET

;SET [NO] JFN-WATCH

.JWAT::	SKIPE SETNOF		;[NO] FLAG TURNED ON ?
	 JRST .NJWT2		;YES
	TRVAR <TMPSEQ,<TMPPGS,JWPAGL>,LSTJWP,SUBMOD,CFMOK>
	SETZM SUBMOD		;NOT IN SUBCOMMAND MODE
	SETZM LSTJWP		;DON'T LIST PARAMETERS YET
	MOVE A,IJWSEQ		;GET CURRENT INT CHARS
	MOVEM A,TMPSEQ		;SAVE AWAY FOR LIST COMMAND
	CALL JWTPG		;FILL UP TEMP PAGE GROUP TABLE FROM PERM
	SETZM CFMOK		;CAN'T DO CONFIRM RIGHT AWAY
.JWAT1:	MOVEI B,[FLDDB. .CMKEY,,$JWAT,,,[
		 FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /,/]>,<comma and carriage return to enter subcommands>,,[
		 FLDDB. .CMCFM]]]
	SKIPN CFMOK		
	MOVEI B,[FLDDB. .CMKEY,,$JWAT,,,[
		 FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /,/]>,<comma and carriage return to enter subcommands>]]
	CALL FLDSKP		;GET SOME INPUT
	 CMERRX
	SETOM CFMOK		;OKAY TO DO CONFIRM NOW
	LDB C,[331100,,(C)]	;SEE WHICH WAS TYPED
	CAIN C,.CMCFM		;CONFIRMED ?
	JRST .JWAT2		;YES
	CAIE C,.CMKEY		;GOT KEYWORD ?
	IFSKP.
	 CALL GETKEY		;YES - GET DISPATCH
	 CALL (P3)		;GO DO IT
	 JRST .JWAT1		;AND TRY FOR ANOTHER
	ENDIF.
	CONFIRM			;IT'S A COMMA, MAKE SURE HE MEANS IT
.JWAT3:	SETOM SUBMOD		;SET SUBCOMMAND MODE FLAG
	SUBCOM $JWAT		;GO DO SUBCOMMANDS
.JWAT2:	CALL JWSIC		;GO SET INTERRUPT CHAR(S)
	SKIPE IJWSEQ		;YES - HAVE AN INTERRUPT SEQ ?
	IFSKP.
	 SKIPL SUBMOD		;WERE WE IN SUBCOMMAND MODE ?
	 IFSKP.
	  ETYPE <%%Interrupt sequence must be specified>
	  JRST .JWAT3
	 ENDIF.
	 SKIPN LSTJWP		;NEED TO LIST PARAMTERS ?
	 ERROR <Interrupt sequence must be specified> ;YES - DON'T GEN ERROR
	ENDIF.
	CALL JWUPG		;GO UPDATE PAGE GROUP TABLE
	SKIPE EXCBLK		;EXEC PAGES XRMAP ARG BLK ALREADY SET UP ?
	IFSKP.
	 HRLI A,[EXP 4,<JWEPGE+1-JWEPGS>,JWEPGS,EXCBLK+4] ;NO
	 HRRI A,EXCBLK		;FORM ARGS FOR BLT
	 BLT A,EXCBLK+3		;SET UP XRMAP ARG BLOCK
	ENDIF.
	SKIPE LSTJWP		;NEED TO LIST PARAMTERS ?
	CALL JWLST		;YES
	RET


$JWAT:	TABLE
	T INTERRUPT,,.JWINT	;INTERRUPT SEQUENCE
	T LIST-PARAMETERS,,.JWLST
	T NO,,.JWNO		;HANDLE "NO"
        T PAGES,,.JWPAG		;GO READ PAGES
	T TOPS-10-PAGES,,.JWT10
	TEND

;"NO" PROCESSOR

.JWNO:	KEYWD $NJWAT
	 0			;NO DEFAULT
	 CMERRX			;INVALID KEYWORD 
	CALLRET (P3)		;DO WHAT WAS ASKED AND RETURN


$NJWAT:	TABLE
	T INTERRUPT,,NJWAT 	;NO JFN-WATCHING
        T PAGES,,.NJWPG		;NO PAGES AT ALL
	TEND

;SET NO JFN-WATCH


NJWAT:	CALL .NJWAT 		;DISABLE THE INTERRUPTS
	SETZM TMPSEQ		;CLEAR THE INTERRUPT FLAG
	RET

.NJWT2:	SKIPA			;.NJWT2 IS SET NO STATUS-WATCH
.NJWAT:	SKIPE SUBMOD		;SUBCOMMAND MODE ?
	CONFIRM			;YES
.NJWT1:	SKIPG A,IJWSEQ		;HAVE A INTERRUPT SEQUENCE ?
	RET			;NO - THEN IT'S ALREADY DISABLED
	CAILE A,177		;HAVE 1 OR 2 CHARACTERS
	MOVEI A,.TITCE		;TWO 
	DTI			;DISABLE 
	 ERJMP CJERR
	SETOM IJWSEQ		;CLEAR THE REAL THING SINCE WE DID IT
	RET

;HERE TO HANDLE SUBCOMMAND MODE FOR SET JFN-WATCH

.JWLST:	SKIPE SUBMOD		;SUBCOMMAND MODE ?
	IFSKP.
	 SETOM LSTJWP		;NO - SET FLAG, LIST PARAMS LATERS
	 RET
	ENDIF.
	CONFIRM
JWLST:	SKIPG A,IJWSEQ		;GET INTERRUPT CHAR(S)
	IFSKP.
	 ETYPE < Enabled on ">
	 LDB B,[POINT 7,A,^D28]	;HAVE IT - GET 1ST
	 SKIPE B		;HAVE 1ST CHAR ?
	 CALL JWTYPI		;YES - TYPE IT
	 LDB B,[POINT 7,A,^D35]	;GET NEXT CHAR 
	 CALL JWTYPI		;TYPE IT
	 ETYPE <", >
	ELSE.
	 ETYPE < No interrrupt characters set, >
	ENDIF.
	SKIPE TMPPGS
	IFSKP.
	 ETYPE < No specified pages to check>
	 JRST JWSUB2
	ENDIF.
	ETYPE < Checking pages:>
	SETZ A,
JWSUB1:	CAML A,TMPPGS		;DONE ?
	JRST JWSUB2		;YES
	MOVEI D,1+TMPPGS	;GET ADR OF TEMP PAGE GROUP TABLE
	ADD D,A			;ADD IN THE OFFSET
	HLRZ B,(D)       	;GET 1ST PAGE IN GROUP
	HRRZ C,(D)        	;GET LAST PAGE IN GROUP
	ETYPE < %2O>
	CAME C,B		;SAME PAGE ?
	ETYPE <-%3O>		;YEP
	AOJA A,JWSUB1

JWSUB2:	ETYPE <%_>
	RET


;TYPE OUT THE CHARACTER IN B

JWTYPI:	CAIL B," "		;CONTROL CHAR ?
	IFSKP.
	 ADDI B,100		;YES - MAKE IT A REAL CHAR
	 ETYPE <^>		;BUT SAY THAT IT WAS A CONTROL CHAR
	ENDIF.
	ETYPE <%2\>		;TYPE IT
	RET

;INTERRUPT (USING)

.JWINT:	QUOTEX <Quoted character or two character sequence to invoke file information>
	 CMERRX
	SKIPE SUBMOD		;SUBCOMMAND MODE ?
	CONFIRM			;YES
	CALL .NJWT1		;CLEAR THE EXISTING INTERRUPT IF ONE
	MOVE B,[POINT 7,ATMBUF]	;POINT AT ATOM BUFFER FOR QUOTED STRING
	ILDB C,B		;GET 1ST CHARACTER, DON'T CARE WHAT IT IS
	JUMPE C,JWINT2		;DON'T ALLOW NULL 
	ILDB A,B		;GET THE SECOND CHARACTER IF PROVIDED
	JUMPE A,JWINT1		;IF NULL, SINGLE CHARACTER, VALIDATE IT
	LSH C,7			;SHOVE IT OVER TO GET READY FOR 2ND CHAR
	ADD C,A			;CONCATENATE THE 2ND CHARACTER 
	ILDB A,B		;SEE IF ANOTHER
	JUMPN A,[ERROR <No more than two characters are allowed>]
	CALLRET JWINT3		;FINISH UP

JWINT1:	CAIL C,^D27		;MONITOR WILL FILTER SOME, WE FILTER OTHERS
JWINT2:	ERROR <Not a valid interrupt character>
JWINT3:	MOVEM C,IJWSEQ		;SAVE THE CHARACTERS
	RET

;NO PAGES SUBCOMMAND

.NJWPG:	SKIPE SUBMOD		;SUBCOMMAND MODE ?
	CONFIRM			;YES
	MOVEI A,1+TMPPGS	;GET ADR OF TABLE + 1
	HRLI A,-1(A)		;GET ADR IN LH
	AOS B,TMPPGS		;GET NUMBER OF ENTRIES + 1
	ADDI B,TMPPGS		;GET LAST DEST ADR
	SETZM TMPPGS		;CLEAR THE PAGE LIST
	BLT A,(B)		;ZERO THE LIST
	RET


;PAGES SUBCOMMAND

.JWPAG:	CALL OCTLST		;GET THE LIST PAGES TO CHECK
	SKIPE SUBMOD		;SUBCOMMAND MODE ?
	CONFIRM			;YES
	CALL JWUPDL		;GO UPDATE THE LIST
	RET
;TOPS-10-PAGES SUBCOMMAND

PA10IO==730			;NEAR BEGINNING OF PA1050 IO PAGES
PA10X==767			;LAST POSSIBLE PAGE BEFORE DDT

.JWT10:	SKIPE SUBMOD		;SUBCOMMAND MODE ?
	CONFIRM			;YES
	MOVEI A,2		;SET RLIST COUNT TO 2 ENTRIES
	MOVEM A,RLIST
	DMOVE A,[EXP PA10IO,PA10X] ;APPROXIMATE RANGE OF PA1050 PAGES
	DMOVEM A,RLIST+1	;CREATE THE LIST
	CALL JWUPDL		;UPDATE THE REAL PAGE LIST
 	RET
 

;UPDATE THE "WATCHED PAGES" LIST

JWUPDL:	CALL JWPGCP		;CONVERT JWPAG LIST INTO BIT MAP
	SETZ B,			;INDEX INTO RLIST
JWSRT1:	CAML B,RLIST		;DONE ?
	JRST JWSRTD		;YES
	DMOVE C,RLIST+1(B)	;GET 1ST AND LAST PAGE
	CAIG C,37777		;1ST A LEGAL PAGE # ?
	CAILE D,37777		;YES - IS LAST LEGAL 
	ERROR <Invalid page number>
	CAMLE C,D		;IS LAST LESS THAN 1ST ?
	EXCH C,D		;YES, MAKE THE LAST BECOME THE 1ST
	CALL JWINS		;ADD THIS GROUP OF PAGES TO BIT MAP
	ADDI B,2		;POINT AT NEXT DATA GROUP
	JRST JWSRT1		;AND TRY AGAIN

JWSRTD:	CALL JWPGCM		;CONVERT BIT MAP BACK INTO JWPAG LIST
	CAILE Q1,1000		;HAVE MORE THAN 1 SECTIONS WORTH OF PAGES ?
	JRST [SKIPE SUBMOD	;YES - DON'T RE-INIT IF NOT IN SUBCOMMAND
	      CALL JWTPG	;GO RE-INIT TEMP PAGE GROUP TABLE
	      ERROR <No more than 512 pages can be checked>]
	RET
;HERE TO CONVERT THE JWPAG TO THE BITMAP

JWPGCP:	SETZ P1,
	SETZM XRMPAG		;USE XRMAP PAGE TO BUILD BIT MAP
	MOVE A,[XRMPAG,,XRMPAG+1] 
	BLT A,XRMPAG+<<40*^D512>/^D36>+1 ;ZERO BIT MAP TABLE
PGCP1:	CAML P1,TMPPGS		;THRU TABLE YET ?
	RET			;YES
	MOVEI B,1+TMPPGS	;GET ADDRESS OF TEMP PAGE GROUP TABLE 
	ADD B,P1		;ADD THE OFFSET
	HLRZ A,(B)        	;GET BEGINNING PAGE
	HRRZ C,(B)        	;GET ENDING PAGE
	CALL JWBIT		;TURN ON THE BIT IN THE MAP
	AOJA P1,PGCP1		;YES - GET NEXT TABLE ENTRY


;HERE TO UPDATE THE BITMAP

JWINS:	SAVEAC <A,B>
	MOVE A,C		;GET BEGINNING PAGE
	MOVE C,D		;AND ENDING PAGE
JWBIT:	CAMLE A,C		;THRU THIS RANGE OF PAGES ?
	RET			;DONE
	PUSH P,A
	IDIVI A,^D36		;GET BIT POSITION AND WORD OFFSET
	MOVX D,1B0		;GET A SINGLE BIT
	MOVNS B			;SHIFT IT RIGHT
	ROT D,(B)		;MOVE INTO CORRECT BIT POSITION
	IORM D,XRMPAG(A)	;UPDATE THE BITTABLE
	POP P,A
	AOJA A,JWBIT
;HERE TO CONVERT BITTABLE INTO JWPAG LIST

JWPGCM:	SETZ Q1,
	SETZB P1,P2
	SETZB P3,P4
	SETZM TMPPGS
PGCM1:	CAILE P1,<<40*^D512>/^D36>+1 ;THRU ENTIRE BITTABLE ?
	RET			;YES
	SKIPE B,XRMPAG(P1)	;ANYTHING IN THIS BITTABLE WORD ?
	IFSKP.
	 SKIPE P2		;HAVE A COUNT 
	 CALL PGCM1A		;YES - GO UPDATE TEMP PAGE GROUP TABLE
	 AOJA P1,PGCM1		;GO FOR MORE
	ENDIF.
	CAME B,[-1]		;ARE ALL BITS ON ?
	IFSKP.
	 ADDI Q1,^D36
	 ADDI P2,^D36		;YES - GOT 36 MORE 
	 AOJA P1,PGCM1		;TRY NEXT WORD
	ENDIF.
	SETZ C,
PGCM2:	CAIL C,^D36		;DONE FULL WORD ?
	AOJA P1,PGCM1		;YES - KEEP COUNTING
	JUMPE B,PGCM2A		;NO MORE ? UPDATE TMP PAGE GROUP TABLE
	SETZ A,
	LSHC A,1            	;SHIFT B'S HIGH BIT INTO A
	JUMPE A,PGCM2A		;ZERO BIT ? IF YES - SEE IF COUNT NEEDS UPDATING
	SKIPE P2 
	IFSKP.
	 MOVE P2,P1		;GET INDEX INTO BITTABLE
	 IMULI P2,^D36		;NOW HAVE BEGINNING COUNT (UPTO THIS WORD)
	 ADD P2,C		;ADD BEGINNING BIT POSITION
	 MOVE P3,P2		;SAVE AS BEGINNING ADDRESS
	ENDIF.
	AOS Q1			;BUMP TOTAL NUMBER OF PAGES COUNTER
	AOS P2			;BUMP CONSECUTIVE COUNT
	AOJA C,PGCM2		;BUMP COUNTER - TRY NEXT BIT
PGCM2A:	SKIPE P2		;HAVE A COUNT 
	CALL PGCM1A		;YES - GO UPDATE TEMP PAGE GROUP TABLE
	AOJA C,PGCM2		;NO - TRY THE NEXT BIT
	 

PGCM1A:	MOVEI A,1+TMPPGS	;POINT TO TEMPORARY PAGE GROUP TABLE
	ADD A,P4		;ADD IN THE OFFSET
	HRLM P3,(A)         	;UPDATE THE 1ST PAGE
	SOS P2			;COUNT IS ONE TOO HIGH
	HRRM P2,(A)		;UPDATE THE LAST PAGE
	AOS TMPPGS		;BUMP COUNT
	AOS P4			;POINT AT NEXT JWPAG SLOT
	CAIL P4,JWPAGL		;HAVE TOO MANY ?
	ERROR <Too many page groups>
	SETZ P2,		;CLEAR COUNT
	RET

;HERE TO SET THE INTERRUPT CHARACTER(S)

JWSIC:	SKIPL A,IJWSEQ		;HAS "NO INTERRUPT" BEEN SET ?
	SKIPN A,IJWSEQ		;NO - HAVE A INTERRUPT SEQUENCE ?
	RET	
	CAIG A,177		;HAVE 1 OR 2 CHARACTERS
	IFSKP.
 	 MOVE A,[XWD .TITCE,IJWCHN] ;HOOK UP SWITCH SEQUENCE
 	 ATI 
	 MOVEI A,.PRIIN		;INTERRUPT ON PRIMARY INPUT
	 MOVEI B,.MOTCE		;SET TWO CHARACTER ESCAPE SEQEUNCE
	 MOVE C,IJWSEQ		;GET THE CHARACTERS
	 MTOPR			;ENABLE IT
	  ERJMP CJERR		
	ELSE.
	 MOVS A,IJWSEQ		;GET THE INTERRUPT CODE
	 HRRI A,IJWCHN		;USE OUR INT CHANNEL
	 ATI			;ENABLE IT
	  ERJMP CJERR
	ENDIF.
	RET

;HERE TO UPDATE THE PAGE GROUP TABLE

JWUPG:	CALL JWPGT		;GO UPDATE JWPAG
	SETZB A,Q1		;INIT INDEX INTO JWPAG, INDEX INTO XRMPAG
	MOVEI B,1		;INIT INDEX INTO XRMAP ARG BLOCK
	MOVEM B,XRMBLK		;ALSO INIT ARG BLOCK 
JWUPD1:	CAML A,JWPAG		;THRU ENTIRE LIST YET ?
	JRST JWUPD2		;YES
	HLRZ C,JWPAG+1(A)	;GET THE 1ST PAGE
	MOVEM C,XRMBLK+1(B)	;STORE AS 1ST PAGE OF GROUP
	HRRZ D,JWPAG+1(A)	;GET THE 2ND PAGE
	SUBI D,-1(C)		;GET THE NUMBER OF PAGES TO RETURN
	HRRZM D,XRMBLK(B)	;STORE IT
	MOVEI C,XRMPAG(Q1)	;MAKE POINTER TO PLACE TO STORE DATA
	MOVEM C,XRMBLK+2(B)	;SAVE IT AWAY
	LSH D,1			;DATA AREA IS # OF PAGES * 2 WORDS 
	ADD Q1,D		;UPDATE INDEX INTO XRMPAG
	AOS A	 		;UPDATE INDEX INTO JWPAG
	MOVEI C,3    		;LENGTH OF ONE GROUP
	ADDM C,XRMBLK		;UPDATE ARG BLOCK COUNT
	ADDM C,B		;UPDATE POINTER TO END OF XRMBLK
	JRST JWUPD1		;NEXT
JWUPD2: RET


;HERE TO FILL UP THE PERMANENT GROUP TABLE FROM THE TEMPORARY ONE

JWPGT:	MOVSI A,TMPPGS		;GET ADDRESS OF TEMP
	HRRI A,JWPAG		;AND ADR OF REAL TABLE
	MOVE B,TMPPGS		;GET LENGTH OF TABLE
	AOS B			;PLUS 1
	BLT A,JWPAG(B)		;MOVE THE TABLE
	RET



;HERE TO FILL UP THE TEMP PAGE GROUP TABLE FROM THE PERMANENT ONE

JWTPG:	MOVEI A,TMPPGS		;GET ADDRESS OF TEMP
	HRLI A,JWPAG		;AND ADR OF REAL TABLE
	MOVE B,JWPAG		;GET LENGTH OF TABLE
	AOS B			;PLUS 1
	ADDI B,TMPPGS		;NOW HAVE LAST DESTINATION ADR
	BLT A,(B)		;MOVE THE TABLE
	RET

;GOT HERE FROM INTERRUPT TO TYPE OUT JFN INFORMATION

IJWPSI::CALL SAVACS		;SAVE ACS
	ETYPE <%_ Connected to %G >
	CALL WATPMP		;CHECK FOR PMAPD FILES 1ST
	SETZ P2,		;NOTHING TYPED 
	MOVEI P1,MAXJFN		;CHECK ALL JFNS
WATLUP:	SKIPN A,P1       	;ZERO JFN IS NOT REAL
	IFSKP.
	 GTSTS			;IN USE ?
	 TXNN B,GS%NAM		;FILE ASSOCIATED ?
	 IFSKP.
	  TXNE B,GS%XCF		;XCT ?
	  IFSKP.
	   TXNE B,GS%OPN	;NO - OPEN ?
	   CALL WATCHK		;YES - TYPE JFN IF OK
	  ENDIF.
	 ENDIF.
WATLP1:	 SOJG P1,WATLUP		;AND LOOK AGAIN
	ENDIF.
WATDUN:	SKIPN P2
	ETYPE < %_>
	CALL RESACS		;RESTORE THE ACS
	DEBRK
;TYPE OUT JFN INFO

WATCHK:	SAVEAC <P1>
	STKVAR <FWJFN,FWSTS,FWBTIW,FWATBY,FWBSIZ>
	MOVEM A,FWJFN		;SAVE THE JFN
	MOVEM B,FWSTS		;SAVE THE FILE STATUS
	CALL WCKJFN		;SEE IF WE SHOULD TYPE THIS JFN
	IFNSK.
	 RFPTR			;NO PAGES MAPPED, GET CURRENT POSISTION
	  ERJMP R		;NO MAPPED PAGES, NO POSISTION, NO TYPE IT
	 JUMPE B,R		;DITTO IF ZERO
	 MOVEM B,FWATBY		;SAVE POSISTION
	ENDIF.
	SKIPN P2 		;ALREADY TYPED SOMETHING ?
	ETYPE <%_>
	SETO P2,		;NOW WE HAVE
	ETYPE < >
	MOVE A,COJFN
	HRRZ B,FWJFN		;GET THE JFN
	MOVE C,[XWD 4,10]
	NOUT			;JFN, LEFT ADJ IN 4 COLS
	 ERJMP .+1
	MOVE A,COJFN		;USE PROPER OUTPUT JFN
	HRRZ B,FWJFN
	SETZ C,			;DEFAULT FORMAT
	JFNS			;PRINT NAME
	 ERJMP [CALL JFNSIL	;ANALYZE ERROR
		 JRST [CALL DGETER ;GET THE REASON FOR THE FAILURE
		       CAIE A,DESX3 ;MAKE SURE IT'S "JFN IS NOT ASSIGNED"
		       CALL JERR ;STRANGE ERROR, SO FAIL
		       ETYPE < ...[JFN has just been released]>
		       JRST WSDUNE]
		JRST .+1]	;MESSAGE PRINTED, LIKE "RESTRICTED JFN"
	MOVE A,FWJFN
	RFBSZ
	 ERJMP WSDUNE
	MOVEM B,FWBSIZ		;SAVE BYTE SIZE
	MOVEI C,^D36
	IDIV C,B
	MOVEM C,FWBTIW		;PUSH NUMBER OF BYTES IN WORD
	RFPTR			;GET CURRENT POSISTION
	 ERJMP WSDUNE
	MOVEM B,FWATBY		;SAVE POSISTION
	SKIPN B			;GOT BYTE POSITION ?
	SKIPN WJPTAB		;NO, ANY PMAP'D PAGES ?
	IFNSK.
	 SKIPE B		;ANY POSITION
	 IFSKP.
	  SIZEF			;NO - JUST GET THE SIZE
	   ERJMP WSDUNE
	  JUMPE C,WSDUNE	;IF NO SIZE SET, TYPE NOTHING
	  ETYPE <  [%3Q page>
	  CAIE C,1		;ONE PAGE ?
	  ETYPE <s>    		;NO
	 ELSE.
	  IDIV B,FWBTIW		;NO - GET NUMBER OF WORDS
	  IDIVI B,^D512		;GET PAGE NUMBER
	  SKIPE C		;IF ANY IN C THEN PLUS 1 PAGE
	  AOS B
	  MOVE D,B		;SAVE IT TILL WE TYPE IT
	  SIZEF			;GET SIZE OF FILE
	   ERJMP WSDUNE
	  ETYPE <  [Page %4Q>	;TYPE PAGE WE'RE AT
	  SKIPE C		;HAVE LENGTH YET ?
	  ETYPE < of %3Q>	;YES
	 ENDIF.
	ELSE.
	 CALL TPMAPF		;TRY TO TYPE PMAPD FILES FOR THIS FORK
	  JRST WSDUNE
	ENDIF.
	MOVE A,FWATBY		;GET BYTE WERE AT
	MOVE B,FWBSIZ		;GET THE BYTE SIZE
	SKIPE A
	ETYPE <. Byte %1Q(%2Q)>
	TYPE <.>
	MOVE A,FWSTS
	TXNE A,GS%RDF		;READING ?
	ETYPE < Read>
	TXNE A,GS%WRF		;WRITING ?
	ETYPE < Write>
	TXNN A,GS%RND		;APPEND ?
	ETYPE < Append>
	ETYPE <]>
WSDUNE:	ETYPE < %_>
	RET
;HERE TO TYPE OUT PMAP'D PAGES FOR A FILE IF THEY EXSIST
;
; CALL WITH A/ JFN

TPMAPF:	SETZ D, 		;CLEAR WJPTAB INDEX 
	SETZ P1,		;CLEAR FLAG FOR NO PAGES PMAPED
TMPFLP:	CAMG D,WJPTAB	 	;DONE LOOKING ?
	IFSKP.
	 SIZEF			;GET SIZE OF FILE
	  ERJMP R		;ERROR, RETURN
	 SKIPE P1		;TYPED ANYTHING YET ?
	 IFSKP.
	  JUMPE C,R		;NO - IF NO SIZE SET, RETURN
	  ETYPE <  [>
	 ELSE.
	  JUMPE C,RSKP		;IF NO SIZE, DON'T REPORT IT
	  ETYPE < of >		
	 ENDIF.
	 ETYPE <%3Q page>
	 CAIE C,1		;ONE PAGE ?
	 ETYPE <s>    		;NO
	 RETSKP
	ENDIF.
	LDB B,[POINT 6,WJPTAB(D),5] ;GET THE JFN IN ENTRY
	CAME A,B		;DO THE JFNS AGREE ?
	AOJA D,TMPFLP		;NO, LOOK AT NEXT
	LDB B,[POINT 12,WJPTAB(D),17] ;GET 1ST PAGE IN GROUP
	SKIPN P1		;ALREADY TYPED THIS 
	TYPE <  [Mapped>	;NO
	TYPE < >
	SETO  P1,		;SAY WE FOUND A PAGE
	ETYPE <%2Q>
	LDB C,[POINT 12,WJPTAB(D),35] ;GET LAST PAGE IN GROUP
	CAME C,B		;SAME PAGE ?
	ETYPE <-%3Q>		;YEP
	AOJA D,TMPFLP		;GO DO NEXT
;HERE TO FIND OUT IN ADVANCE, IF THIS JFN HAS ANY MAPPED PAGES

WCKJFN:	SETZ D, 		;CLEAR WJPTAB INDEX 
	SETZ P1,		;CLEAR FLAG FOR NO PAGES PMAPED
WCK1:	CAMLE D,WJPTAB	 	;DONE LOOKING ?
	RET
	LDB B,[POINT 6,WJPTAB(D),5] ;GET THE JFN IN ENTRY
	CAME A,B		;DO THE JFNS AGREE ?
	AOJA D,WCK1		;NO, LOOK AT NEXT
	RETSKP			;LFOUND ATLEAST ONE,  THAT'S GOOD ENUF
WATPMP:	TRVAR <LOOKFK,LJFNG,LPG,NPG,LDATA>
	SETZM WJPTAB		;CLEAR CONDENSED LIST COUNT
	MOVEI A,.FHSLF		;BY DEFAULT - LOOK AT SELF
	MOVEI B,EXCBLK		;USE EXEC XRMAP BLOCK
	SKIPGE CIPF		;COMMAND IN PROGRESS ?
	IFSKP.
	 SKIPG A,FORK		;GET CURRENT FORK
	 RET			;NONE
	 MOVEI B,XRMBLK		;POINT AT NORMAL FORK XRMAP BLOCK
	ENDIF.
	MOVEM A,LOOKFK		;AND SAVE IT
	MOVEM B,XRMPNT		;MAKE POINTER POINT AT IT FOR LATER
	SKIPN @XRMPNT		;HAVE COUNT FOR XRMAP ARG BLOCK ?
	RET        		;NO - DONE
	MOVS A,LOOKFK		;GET FORK HANDLE IN LH:
	MOVE B,XRMPNT		;POINT AT XRMAP ARG BLOCK
	XRMAP%			;RETRIEVE ALL THE PAGE INFO WE WANT
	 ERJMP R		;IGNORE THE ERROR 
	MOVEI P3,1		;INDEX INTO XRMAP ARG BLOCK
	SETZM LJFNG		;CLEAR LAST JFN
WMAP2:	CAMGE P3,@XRMPNT	;DONE WITH ENTIRE ARG BLOCK
	IFSKP.
	 MOVE A,LDATA		;GET LAST DATA 
	 SKIPE B,LJFNG		;YES - GET THE LAST JFN WE HAD
	 CALL WMAP4		;HAD ONE - WRITE AN ENTRY FOR IT
	 RET
	ENDIF.
	SETZM LJFNG		;CLEAR LAST JFN IN GROUP
	SETZM NPG		;CLEAR THE PAGE COUNTER
	SETZM LPG		;CLEAR LAST PAGE
	SETZ P4,		;INDEX INTO THIS GROUP
	MOVE P5,XRMPNT		;GET POINTER TO XRMAP ARG BLOCK
	ADD P5,P3
	MOVE P2,(P5)       	;GET COUNT OF GROUP
	SKIPA P1,2(P5)      	;GET DATA ADDRESS OF GROUP
WMAP3:	ADDI P1,2		;POINT AT NEXT PAGES DATA
	CAMGE P4,(P5)		;DONE WITH THIS GROUP ?
	IFSKP.
	 ADDI P3,3 		;YES - POINT TO NEXT GROUP
	 JRST WMAP2		;DO THE NEXT GROUP
	ENDIF.
	AOS P4			;BUMP COUNTER NOW
	SKIPGE A,(P1)     	;IF B0 IS OFF, GOT A JFN,,PAGE #
	JRST WMAP3		;DIDN'T GET IT
	MOVEM A,LDATA		;SAVE AS THE LAST DATA ITEM
	LDB B,[POINT 9,A,17]	;JFN OR FORK #
	CAME B,LJFNG		;SAME AS LAST JFN IN GROUP ?
	IFSKP.
	 MOVEI C,-1(A)		;YES - GET THE PAGE # - 1 THATS MAPPED
	 CAME C,LPG		;SAME AS THE LAST ?
	 IFSKP.
	  AOS NPG		;YES - BUMP CONSECUTIVE PAGE COUNT
	  HRRZM A,LPG		;UPDATE LAST PAGE 
	  JRST WMAP3		;TRY THE NEXT
	 ENDIF.
	 CALL WMAP4		;NO - CREATE CONDENSED LIST ENTRY 
	 HRRZM A,LPG		;UPDATE THE LAST PAGE
	 JRST WMAP3		;TRY NEXT PAGE
	ENDIF.
	EXCH B,LJFNG		;SAVE NEW JFN, NOW USE OLD TO BUILD TABLE
	SKIPE B			;ZERO JFN ?
	IFSKP.
	 HRRZM A,LPG		;YES - 1ST TIME THRU, UPDATE THE LAST PAGE
	 JRST WMAP3		;TRY NEXT PAGE
	ENDIF.
	CALL WMAP4		;CREATE A CONDENSED TABLE ENTRY
	HRRZM A,LPG		;CLEAR LAST PAGE, NOT VALID ANYMORE
	JRST WMAP3		;TRY NEXT PAGE

WMAP4:	AOS D,WJPTAB  		;GET THE INDEX INTO CONDENSED TABLE
	DPB B,[POINT 6,WJPTAB(D),5] ;SAVE THE JFN
	MOVE B,LPG  		;GET THE LAST PAGE #
	DPB B,[POINT 12,WJPTAB(D),35] ;SAVE LAST PAGE
	SUB B,NPG		;GET BEGINNING PAGE
	DPB B,[POINT 12,WJPTAB(D),17] ;SAVE 1ST PAGE
	SETZM NPG		;CLEAR THE COUNT
	RET
.CIDLY::NOISE <FOR COMMANDS>
	CALL CONF		;CONFIRM
	SETCM A,SETNOF
	MOVEM A,CIDLYF
	RET

;SET LOCATION

.LOCAT::NOISE (TO)
	STKVAR <<NODFDB,.CMDEF+1>>
	MOVX A,FLD(.CMNOD,CM%FNC)!CM%PO!CM%DPP!CM%NSF
	MOVEM A,.CMFNP+NODFDB	;NODE FUNCTION, PARSE ONLY, DEFAULT PRESENT
	CALL GETNOD		;GET POINTER TO OUR NODE NAME
	 JRST [	MOVX A,CM%DPP	;FAILED, PROBABLY NO DECNET ON THIS SYSTEM
		ANDCAM A,.CMFNP+NODFDB	;SAY NO DEFAULT PRESENT
		JRST .+1]
	MOVEM A,.CMDEF+NODFDB	;STORE POINTER TO DEFAULT
	MOVEI B,NODFDB
	CALL FLDSKP		;READ NODE NAME, DEFAULT TO SYSTEM'S
	 CMERRX			;FAILED, TELL USER WHY
	CALL BUFFF		;REMEMBER NODE NAME TYPED BY USER
	CONFIRM			;WAIT FOR COMMAND CONFIRMATION
	MOVE C,A		;POINTER TO NODE NAME POINTER IN C
	HRROI A,-1		;OURSELF
	MOVEI B,.SJLLO		;SET LOGICAL LOCATION
	SETJB			;DO IT
	 ERCAL CJERRE		;FAILED, TELL USER WHY
	RET			;DONE
;MORE COMPREHENSIVE MAIL-WATCH AND ALERT FACILITY

.MWATC::NOISE <FOR MAILBOX>	;[3040]
	TRVAR <<USRDEF,EXTSIZ>,DEFPTR> ;[3040]
	SKIPN CUSRNO		;[3040] ALREADY LOGGED IN?
	 JRST .MWATX		;[3040] NO - NO DEFAULT
 	MOVEI A,USRDEF		;[3040]
	CALL DFUSER		;[3040](A/A)GET DEFAULT USER STRING
	MOVEM A,DEFPTR		;[3040] SAVE POINTER TO DEFAULT
.MWATX: USERX <Mailbox name (User name, or Directory name without brackets)>
	 CALL MBOX      	;[3040] MAYBE WE HAVE A MAILBOX NAME
	CALL BUFFF		;[3040]( /A)BUFFER THE NAME
	MOVE B,A		;[3040] GET POINTER IN AC2
	CALL POBCHK		;[3040] (B/C ) THIS DIR ON POBOX: AND HAVE MAIL.TXT.1?
	 ERROR <No mailbox>	;[3040] GUESS NOT
	STKVAR <PBDNUM>		;[3040] NUMBER OF DIRECTORY, WE NOW KNOW IT EXISTS ON POBOX:
 	MOVEM C,PBDNUM		;[3040]SAVE DIRECTORY NUMBER
	SKIPE SETNOF		;SET NO?
	 JRST .MWAT0		;TURN WATCH OFF
	NOISE <MESSAGE COUNT>
	DEFX <10000>		;DEFAULT TO LOTS
	DECX <Number of times to tell of old "new" mail>
	 HRLOI B,377777		;+INF IF NONE TYPED
	MOVE Q1,B		;SAVE COUNT
.MWAT0:	CONFIRM
	MOVE A,PBDNUM		;[3040] DIRECTORY NUMBER 
	MOVEI C,NMWAT-1		;INIT COUNT
	SETO D,
.MWAT1:	SKIPN B,MWATDR(C)	;LOOK FOR EMPTY SLOT
	 SKIPA D,C		;SAVE INDEX
	  CAME A,B		;MATCH USER?
	   JRST .MWAT2		;FOUND EMPTY SLOT
	SKIPN SETNOF		;FOUND USER - SET NO?
 	 JRST .MWAT3		;MATCH FOUND USE IT INSTEAD
	SETZM MWATDR(C)		;TURN OFF MAIL WATCH ON THIS ONE
	RET			;DONE

.MWAT2:	SOJGE C,.MWAT1		;LOOP OVER ALL SLOTS
	SKIPE SETNOF		;SET NO?
	 RET			;YES - ALREADY TURNED OFF
	SKIPGE C,D		;HAVE EMPTY SLOT?
	 ERROR <Maximum number of watches used up.>
	MOVEM A,MWATDR(C)	;SET TO WATCH THIS USER
.MWAT3:	SETOM MWATCF		;TURN ON WATCHING
;	SETZM MWATAT		;RESET TIMERS
;	SETZM MWATCT
	MOVEM Q1,MWATN(C)	;STASH REPEAT COUNTS
	MOVEM Q1,MWATN0(C)
	RET			;EXIT

;[3040] ROUTINE TO ACCEPT A WORD - WE KNOW IT ISN'T A USERNAME, BUT IT STILL MAY BE
;[3040] A MAILBOX NAME

MBOX:	WORDX		;[3040]GET INPUT
 	 CMERRX <User name or Mailbox name required> ;[3040]
	RET		;[3040]AND JOIN COMMON CODE

	ENDTV.
	ENDSV.
;SET ALERT (AT)

.ALERT::GTAD			;GET VALUE OF NOW FOR DATE DEFAULT IF NOT GIVEN
	MOVEM A,NOW
	SKIPE SETNOF		;SET NO?
	 JRST ALRDEL		;YES - GO DELETE AN ALERT
	NOISE <AT TIME>
	MOVEI A,[ASCIZ /Date and time, or time/]
	CALL REDALT		;READ THE ALERT TIME
	 CMERRX			;COULDN'T
	NOISE <MESSAGE>
	LINEX <Message, must be 80 characters or less>
	 CMERRX
	MOVE A,CMABP		;SAVE STRING IN PERMANENT FREE SPACE
	ILDB C,A		;SEE IF STRING GIVEN
	JUMPE C,.ALRT1		;IF NOT DON'T READ IT
	MOVE A,CMABP		;GET POINTER AGAIN
	CALL XBUFFS
	MOVE C,A		;GET STRING POINTER IN C
.ALRT1:	CONFIRM
	MOVE B,ATIME		;RESTORE TIME
	SKIPG ALRTIM		;ALERTS ON?
	 JRST [	MOVEM B,ALRTIM	;NO - SET UP TIMER
		MOVEM C,REASON	;SAVE THE FIRST ALERT
		RET]		;EXIT - CHECK ON COMMAND RETURN

	MOVSI D,-NALTS		;ALERTS ON - SEE IF THERE IS A DUPLICATE
.ALRT2:	CAMN B,ALRTIM(D)	;GOT AN ALERT AT THIS TIME?
	JRST [	EXCH C,REASON(D) ;YES - SWAP THE NEW MESSAGE FOR THE OLD
		SKIPE A,C	 ;WAS THERE AN OLD MESSAGE?
		 CALLRET STREM	 ;YES - REMOVE IT FROM THE FREE POOL; DONE
		RET]		 ;NO - DONE
	AOBJN D,.ALRT2		;LOOP LOOKING FOR DUPLICATES

	MOVSI D,-NALTS		;NOW SEARCH TABLE FOR AN EMPTY SLOT
	SKIPE ALRTMS(D)		;FIND EMPTY SLOT
	AOBJN D,.-1
	JUMPGE D,[ERROR <Alert table full>]
	CAMG B,ALRTIM		;IS NEW ONE EARLIER THAN CURRENT PENDING?
	 JRST [	EXCH B,ALRTIM	;YES - EXCHANGE TIMES
		EXCH C,REASON	; AND MESSAGE
		JRST .+1]	;AND GO RE-SAVE THE OLD PENDING MESSAGE
	MOVEM B,ALRTMS(D)	;FILL IN SLOT (ORDER LATER)
	MOVEM C,REASON+1(D)
	RET			;DONE
;REDALT READS IN THE INTERNAL TIME-AND-DATE OF AN ALERT.
;
;ACCEPTS:	A/	ADDRESS OF HELP STRING
;
;RETURNS+1:	USER TYPED SOMETHING ELSE
;	+2:	ATIME/	INTERNAL DATE AND TIME

REDALT:	MOVEM A,AHELP		;REMEMBER ADDRESS OF HELP STRING
	UDTR @AHELP
	 RET			;COULDN'T
	TXNE A,DATBIT		;WAS A DATE TYPED?
	JRST AL1		;YES, SO NEVER TRY TO CHANGE THE DAY
	CAMGE B,NOW		;DID HE SPECIFY A TIME BEFORE NOW?
	 ADD B,[1B17]		;YES - ASSUME TOMORROW
AL1:	MOVEM B,ATIME		;SAVE TIME
	RETSKP

;HERE TO REMOVE ONE OR MORE ALERTS

ALRDEL:	MOVEI A,[ASCIZ /Date and time or BEFORE or AFTER time
    at which to remove alert/]
	CALL REDALT		;READ THE TIME
	 JRST ALRDL5		;COULDN'T (MAYBE BEFORE, AFTER, CRLF)
	CONFIRM
	MOVSI D,-<NALTS+1>	;SCAN FULL TABLE AND PENDING
ALRDL2:	MOVE A,ATIME		;DATE/TIME REQUESTED
	SUB A,ALRTIM(D)		;GET DIFFERENCE FROM ENTRY
	MOVM A,A		;ABSOLUTE VALUE
	CAIL A,^D182		;WITHIN ONE MINUTE?
	 JRST ALRDL3		;NO - STEP TO NEXT
	TLO Z,F1		;SAY WE FOUND ONE
	SETZM ALRTIM(D)		;CLEAR ENTRY
	SKIPE A,REASON(D)	;REMOVE MESSAGE
	 CALL STREM		;FROM FREE POOL
	SETZM REASON(D)		;CLEAR POINTER
ALRDL3:	AOBJN D,ALRDL2		;LOOP
	TLNN Z,F1		;FOUND ANY?
	 ERROR <No alerts found>
ALRDL4:	SKIPE ALRTIM		;CLEARED CURRENT PENDING ALERT?
	 RET			;NO - DONE
	SETZ B,			;YES - SET UP FOR TABLE RE-ORDER
	HRLOI Q1,377777
	JRST ALRCH1		;AND GO FIND A NEW ONE
;COME HERE TO PARSE "BEFORE" & "AFTER"

ALRDL5:	SETZB C,Q1		;INIT RANGE VARIABLES
	HRLOI B,377777
	DMOVEM B,ARANGE		;SAVE
	KEYWD $ALERT
	 0			;NO DEFAULT
	 JRST [	CONFIRM		;HANDLE "SET NO ALERT<CR>"
		JRST ALRD5A]
	CALL 0(P3)		;INVOKE SUBR
ALRD5A:	DMOVE B,ARANGE		;GET RANGE TO CHECK
	MOVSI D,-<NALTS+1>	;CHECK ALL
ALRDL6:	CAMG C,ALRTIM(D)
	 CAMGE B,ALRTIM(D)	;THIS ONE?
	  JRST ALRDL7		;NOT IN RANGE
	SETZM ALRTIM(D)		;IN RANGE - DELETE
	SKIPE A,REASON(D)	;REMOVE MESSAGE IF ANY
	 CALL STREM
	SETZM REASON(D)
ALRDL7:	AOBJN D,ALRDL6		;LOOP
	JRST ALRDL4		;RE-ORDER THE TABLE AND FINISH OFF

$ALERT:	TABLE
	T AFTER,,ALRAFT
	T BEFORE,,ALRBEF
	TEND

ALRAFT:	TLOA Z,F2		;FLAG AFTER
ALRBEF:	TLZ Z,F2		;FLAG BEFORE
	NOISE <TIME>
	DTRX <Date and time>
	 CMERRX
	MOVE A,B		;SAVE USER INPUT IN A
	MOVE B,ARANGE		;PREVIOUS TOP RANGE
	TLNE Z,F2		;RE-ORDER DEPENDING ON BEFORE/AFTER
	 SKIPA C,A
	  MOVE B,A		;USER INPUT AT TOP OR BOTTOM
	DMOVEM B,ARANGE		;SAVE ARGS
	CALLRET CONF		;CONFIRM AND RETURN
;CHECK FOR ALERT AND RE-ORDER

ALRCHK::SKIPG B,ALRTIM		;ANY ALERTS PENDING?
	 RET			;NOPE - EXIT
	GTAD			;GET TIME NOW
	CAMGE A,B		;IS IT TIME FOR ALERT
	 RET			;NOPE - EXIT
	SUBI A,^D728		;4 MINUTES
	CAMG A,B		;LATER THAN 4 MINS?
	 TDZA Q1,Q1		;NO - OK
	HRROI Q1,[ASCIZ "%2D "]	;YES - SPECIAL MESSAGE
	MOVE A,COJFN
	DOBE			;WAIT FOR TYPEOUT TO STOP
	TYPE <>		;THEN RING THE CHIMES
	ETYPE <[%5\%%2E% alert>	;START THE MESSAGE
	SKIPE Q1		;IS THE ALERT COMING OUT LATE?
	 ETYPE < at %D %E>	;YES - APOLOGIZE
	SKIPE B,REASON		;GIVE MESSAGE SAVED
	 TYPE < - >
	ETYPE <%2\]%_>
	GTAD			;GET TIME NOW
	MOVE B,A		; INTO B
	HRLOI Q1,377777		; FOR RE-ORDER
ALRCH1:	MOVSI D,-NALTS
	SETO C,			;INIT FLAG
ALRCH2:	SKIPN A,ALRTMS(D)	;GOT AN ENTRY?
	 JRST ALRCH3		;NO - SKIP IT
	CAMG A,Q1		;YES - WITHIN RANGE
	 CAMG A,B
	  JRST [SETZM ALRTMS(D)	;OUT OF RANGE - REMOVE IT
		SKIPE A,REASON+1(D)
		 CALL STREM
		SETZM REASON+1(D)
		JRST ALRCH3]
	SKIPL C			;FOUND ONE YET?
	 CAMGE A,ALRTMS(C)	;YES - BETTER ONE NOW?
	  MOVEI C,(D)		;YES - REMEMBER THIS ENTRY
ALRCH3:	AOBJN D,ALRCH2		;LOOP
	MOVE A,ALRTMS(C)	;SET NEW ENTRY (OR CLEAR ALRTIM)
	MOVEM A,ALRTIM
	SETZM ALRTMS(C)		;...
	SKIPE A,REASON		;CLEAR OLD MESSAGE
	 CALL STREM
	SETZM REASON		;IN CASE IT WAS THE ONLY ONE
	MOVE A,REASON+1(C)	;MOVE MESSAGE ALSO
	SETZM REASON+1(C)	;MARK AS NO LONGER IN USE
	MOVEM A,REASON
	RET			;DONE

;SET AUTOMATIC MAIL-WATCH AND ALERTS

.AUTOM::NOISE <MAIL AND ALERT CHECKS>
	CONFIRM
	SKIPE SETNOF		;MAYBE SET NO
	 JRST .AUTO2		;YES
	SETZM MWATAT		;CLEAR AUTO TIME
	SKIPE IITSET		;TIMERS ON?
	 RET			;YES - EXIT
	MOVE A,[.FHSLF,,.TIMEL]	;NO - SET UP TIMER INTERRUPT
	MOVEI B,^D60000		;AT 1 MINUTE INTERVALS
	MOVEI C,IITCHN		;GET CHANNEL
	TIMER
	 JRST CJERR		;JSYS LOSAGE
	SETOM IITSET		;INTERRUPT ARMED
	RET			;EXIT

.AUTO2:	GTAD			;FLUSH TIMER IF
	ADDI A,^D182		; WITHIN ONE MINUTE
	MOVE B,A
	MOVE A,[.FHSLF,,.TIMBF]	;ALL TIMES BEFORE NOW + 1 MIN
	MOVEI C,IITCHN		;*** MONITOR CROCK REQUIRES CHL
	TIMER
	 JFCL
	SETZM IITSET		;NO MORE INTERRUPTS
	RET
;SET (NO) UUO-SIMULATION

.PAXL::	NOISE <FOR PROGRAM>
	CONFIRM
	SKIPN SETNOF
	TDZA A,A
	SETO A,
	MOVEM A,PAXLFL		;PA1050 FLAG
	SKIPG A,FORK		;HANDLE OF CURRENT INFERIOR
	RET			;NONE, LEAVE NOW
	GCVEC			;GET CURRENT VECTOR
	CAMN B,[-1]		;DISABLED?
	JRST [	SKIPE PAXLFL	;YES, IS THAT WHAT WE WANT?
		RET		;YES
		SETZ B,		;NO, ENABLE
		JRST PAXL1]
	SKIPN PAXLFL		;ENABLED, IS THAT WHAT WE WANT?
	RET			;YES
	SETO B,			;NO, DISABLE IT
PAXL1:	SETZ C,
	SCVEC			;SET COMPATIBILITY ENTRY
	 ERJMP CJERRE		;FAILED - SAY WHY
	RET

XTND,<
.KFRKC::NOISE <ON <CTRL-C>>
	SKIPE SETNOF		;SET NO?
	TDZA A,A		;YES - CLEAR
	SETO A,			;SET
	MOVEM A,CCKEEP		;CTRL-C KEEP FLAG
	CALLRET CONF		;CONFIRM AND RETURN

;SET NO LOGIN-MAIL
;DON'T DO ANY OF THE NORMAL MAIL PROCESSING ON LOGIN

.NOLM::	SETZM SYSMF		;THIS SHOULD BE SUFFICIENT
	SETZM MESMSF
	RET
>
;SET PAGE-ACCESS (OF PAGES) P1,P2:P3... (ACCESS) ACCESS-TYPES

.PAC::	SETZM SPCNT		;NO ERRORS YET
	SKIPGE FORK		;MAKE SURE THERE'S A PROCESS
	ERROR <No program>
	NOISE (OF PAGES)
	CALL OCTLST		;GET LIST OF OCTAL PAGE RANGES
	NOISE (ACCESS)
	SETZB Q1,Q2		;Q1 ARE "YESES" AND Q2 ARE "NOS"
	MOVEI Q3,0		;Q3 NON-0 IF "NO" JUST TYPED
PAC2:	MOVEI B,[FLDDB. .CMCFM,,,,,[
		 FLDDB. .CMKEY,,$ACCES,<Access type,>,,]]
	TRNE Q3,1		;WAS "NO" JUST TYPED?
	MOVE B,(B)		;YES, SO EOL ILLEGAL NOW
	CALL FLDSKP		;GET EOL OR ACCESS-TYPE
	 CMERRX			;NO
	LDB C,[331100,,(C)]	;FIND OUT WHAT TYPED
	CAIN C,.CMCFM		;END OF LINE?
	 JRST PAC3		;YES, GO EXECUTE COMMAND
	CALL GETKEY		;KEYWORD TYPED, GET DATA
	MOVE P3,(P3)		;GET CONTROL BITS
	CAIN P3,0		;IS KEYWORD "NO"?
	AOJA Q3,PAC2		;YES, REMEMBER AND GET NEXT KEYWORD
	TRNN Q3,1		;NO, DID "NO" PRECEDE THIS KEYWORD?
	IOR Q1,P3		;NO, ACCUMULATE TO "YES" LIST
	TRNE Q3,1
	IOR Q2,P3		;YES, ACCUMULATE TO "NO" LIST
	TRNN Q3,1
	TDZ Q2,P3		;IF "YES", CANCEL PREVIOUS "NO"
	TRNE Q3,1
	TDZ Q1,P3		;IF "NO", CANCEL PREVIOUS "YES"
	TRZ Q3,1		;CLEAR "NO"
	JRST PAC2		;GO GET MORE INPUT
PAC3:	SOSGE C,RLIST		;PREPARE TO GET NEXT SET OF PAGES FROM LIST
	JRST PAC4		;NO MORE PAGES
	MOVE D,RLIST(C)		;GET BEGINNING OF RANGE
	CAMLE D,RLIST+1(C)	;MAKE SURE RANGE GOES FROM SMALL TO LARGE
	JRST BADRAN		;NO
	HLR D,RLIST+1(C)	;MAKE SURE BOTH ENDS OF RANGE FIT IN 18 BITS
	JUMPN D,BADPAG		;JUMP IF THEY DON'T
	HRR A,RLIST(C)		;GET FIRST PAGE NUMBER OF RANGE TO SET
	HRRZM A,SPPAG		;REMEMBER PAGE
PAC5:	CAMN Q2,[-1]		;"NO NONEXISTENT"?
	JRST PAC6		;YES, DO NOTHING
	HRL A,FORK		;USE CURRENT FORK
	CAMN Q1,[-1]		;"NONEXISTENT"?
	JRST PAC7		;YES, GO REMOVE PAGE
	RPACS			;GET OLD PAGE ACCESS
	 ERJMP [CALL NOSPAC	;PRINT ERROR, RPACS FAILED.
		JRST PAC6]	;GO ON TO NEXT PAGE
	IOR B,Q1		;TURN ON ACCESS DESIRED
	TDZ B,Q2		;TURN OFF ACCESS NOT WANTED
	SPACS			;DO IT
	 ERCAL NOSPAC		;COULDN'T, TYPE ERROR MESSAGE
PAC6:	HRRZ D,SPPAG		;ISOLATE PAGE NUMBER JUST DONE
	AOS A,SPPAG		;STEP TO NEXT PAGE
	MOVE C,RLIST		;C GETS CLOBBERED BY NOSPAC
	CAMGE D,RLIST+1(C)	;HAVE WE DONE ENTIRE RANGE YET?
	JRST PAC5		;NOT YET
PAC8:	SOS RLIST		;YES, GO TO NEXT SET
	JRST PAC3
PAC4:	CALL SPREP		;PERHAPS LAST ERROR CHUNK TO REPORT
	CALLRET UNMAP		;ALL DONE, UNMAP PAGES AND RETURN

;HERE FOR THE CASE OF "SET PAGE N NONEXISTENT"

PAC7:	MOVE B,A		;PUT PAGE IDENTIFIER IN B
	HRROI A,-1		;SAY GET RID OF PAGE
	MOVEI C,0		;SAY NO REPEAT COUNT
	PMAP			;GET RID OF PAGE
	 ERCAL NOSPAC		;FAILED, GO PRINT ERROR
	JRST PAC6

;PAGE NUMBERS OUT OF RANGE 0-777777

BADPAG:	ETYPE <%%Page number negative or larger than 777777 - being skipped
>
	JRST PAC8		;SKIP THIS SET

;BEGINNING OF RANGE NOT LESS THAN OR EQUAL TO END

BADRAN:	ETYPE <%%Beginning of range larger than end - Range being skipped
>
	JRST PAC8
;GET HERE WHEN COULDN'T SET PAGE ACCESS.  JUST PRINT WARNING ABOUT
;THAT PAGE AND RETURN

NOSPAC:	CALL DGETER		;GET LATEST ERROR REASON
	MOVEM A,SPERR		;REMEMBER
NOSP1:	SKIPN SPCNT		;ANY ACCUMULATED ERRORS?
	JRST [	MOVE A,SPPAG	;NO, GET STARTING PAGE NUMBER
		HRRM A,SPERF	;REMEMBER WHERE NEW SET BEGINS
		MOVE A,SPERR	;SEE WHAT THE ERROR IS
		HRLM A,SPERF	;REMEMBER ERROR
		MOVEI A,1
		MOVEM A,SPCNT	;SAY ONE IN A ROW
		RET]		;DONE UNTIL NEXT ERROR
	HRRZ A,SPERF		;THERE'S ACCUMULATED ERRORS, GET STARTING PAGE
	ADD A,SPCNT		;GET NEXT PAGE IN GROUP
	HLRZ C,SPERF		;GET REASON WHY THIS GROUP FAILED
	CAMN A,SPPAG		;IS THIS PAGE NOT NEXT ONE IN GROUP?
	CAME C,SPERR		;OR IS REASON DIFFERENT THAT CURRENT GROUP?
	CAIA			;SOMETHING'S DIFFERENT
	JRST [	AOS SPCNT	;SAME ERROR AND CONSECUTIVE PAGE, JUST REMEMBER HOW MANY IN A ROW
		RET]
	CALL SPREP		;DIFFERENT REASON, REPORT PREVIOUS GROUP
	SETZM SPCNT		;CAUSE NEW GROUP TO START
	JRST NOSP1		;LOOP TO GRAB THIS LATEST ERROR
;ROUTINE TO PRINT ERROR. TAKES NUMBER OF CONSECUTIVE PAGES THAT FAILED IN SPCNT.
;TAKES REASON FOR FAILURE IN LEFT HALF OF SPERF AND STARTING PAGE NUMBER IN
;RIGHT HALF OF SPERF.

SPREP:	SKIPN C,SPCNT		;SEE HOW MANY FAILED IN A ROW
	RET			;NONE, SO NOTHING TO REPORT
	HLRZ A,SPERF		;GET REASON
	HRRZ B,SPERF		;GET FIRST PAGE THAT FAILED
	CAIN C,1		;1 IS SPECIAL CASE
	JRST [	ETYPE <%%Couldn't set access of page %2O - %1? %_>
		RET]
	ADD C,B			;GET LAST PAGE THAT FAILED
	SOJ C,
	ETYPE <%%Couldn't set access of pages %2O through %3O - %1? %_>
	RET

$ACCES:	TABLE			;OF ACCESS TYPES
	T COPY-ON-WRITE,,[PA%CPY]
	T EXECUTE,,[PA%EX]
	T NO,,[0]
	T NONEXISTENT,,[-1]
	T READ,,[PA%RD]
	T WRITE,,[PA%WT]
	TEND
.CTRAC::NOISE <OF GENERATED COMMANDS> ;PCL
	CONFIRM			;[PCL]
	MOVX A,PCFTRC		;TRACE BIT
	ANDCAM A,PCFLAG		;CLEAR IT
	SKIPN SETNOF		;WANT IT SET?
	IORM A,PCFLAG		;SET IT
	RET			;[PCL]

.CTRLC::NOISE <OF PROGRAM>
	CONFIRM
	IFNBATCH (ILLBAT)
	SKIPN SETNOF
	TDZA A,A
	SETO A,
	MOVEM A,CCFLAG		;CONTROL-C FLAG
	SKIPG A,FORK		;CURRENT FORK?
	RET			;NO, LEAVE NOW
	RPCAP			;YES, GET CAPS
	SKIPE CCFLAG		;ENABLE OR DISABLE?
	TXZA B,SC%CTC		;DISABLE
	TXO B,SC%CTC		;ENABLE
	SKIPE PRVENF		;IF NO CAPS ENABLED, CLEAR ^C
	SKIPE CCFLAG		;ENABLE OR DISABLE?
	TXZA C,SC%CTC		;DISABLE
	TXO C,SC%CTC		;ENABLE
	EPCAP			;YES, SET
	RET

ILLBAT:	ERROR	<Illegal under BATCH>
;SET DEFAULT (FOR)

.SEDEF::NOISE (FOR)
	KEYWD TDEFAU		;SEE WHICH COMMAND DEFAULT BEING SET FOR
	 0			;NO DEFAULT
	 CMERRX <Invalid command to set defaults for>
	JRST (P3)		;DISPATCH TO DEFAULTING ROUTINE

;SET NO DEFAULT (FOR)

.NODEF::NOISE (FOR)
	KEYWD $NODEF		;SEE WHICH COMMAND DEFAULT BEING CLEARED FOR
	 0			;NO DEFAULT
	 CMERRX <Invalid command to clear defaults for>
	JRST (P3)		;DISPATCH TO DEFAULTING ROUTINE

.TKD::	KEYWD $TKD		;PARSE NEXT KEYWORD ("ECHO" OR "NO")
	 0			;NO DEFAULT
	 CMERRX <invalid option for SET DEFAULT TAKE command>
	JRST (P3)		;DISPATCH TO DEFAULTING ROUTINE

$TKD:	TABLE
	T ALLOW
	T DISALLOW
	T ECHO,,.ECHO
	T NO,,.TKND
	TEND
.ECHO:	CALL ECHNOI		;FINISH COMMAND
	MOVX A,TKECOF		;GET BIT SAYING ECHOING WANTED
	IORM A,TAKDEF		;REMEMBER IN DEFAULTS WORD
	RET

.TKND:	KEYWD $NTKD		;PARSE NEXT KEYWORD ("ECHO")
	 T ECHO,,.NOECH
	 CMERRX <invalid option for SET DEFAULT TAKE command>
	JRST (P3)		;DISPATCH TO DEFAULTING ROUTINE

$NTKD:	TABLE
	T ECHO,,.NOECH
	TEND

.NOECH:	CALL ECHNOI
	MOVX A,TKECOF		;BIT SAYING WE WANT ECHOING
	ANDCAM A,TAKDEF		;TURN IT OFF IN DEFAULT WORD
	RET

.SDDCL::MOVEI B,[FLDDB. .CMSWI,,$SDEF,,,] ;PCL
	CALL FLDSKP		;SEE WHAT HE WANTS
	 CMERRX
	CALL GETKEY		;GET THE DATA WORD
	CONFIRM			;FINISH IT OFF
	MOVX B,PCFQDC		;GET THE QUIET-DECLARATION BIT
	ANDCAM B,PCFLAG		;CLEAR IT TO ASSUME NOISY DECLARATION
	SKIPN P3		;NOCONFIRM?
	IORM B,PCFLAG		;YES, USE QUIET DECLARATION
	RET			;PCL All done

.ALLOW:	CALL ALONOI		;FINISH COMMAND
	MOVX A,TKALEF
	IORM A,TAKDEF		;ALLOW ERRORS
	RET

.DISAL:	CALL ALONOI		;FINISH COMMAND
	MOVX A,TKALEF
	ANDCAM A,TAKDEF		;DISALLOW ERRORS DURING TAKE FILES
	RET

ALONOI::NOISE (ERRORS DURING "TAKE" FILE)	;THE "NOISE" CALL *MUST* STAY ON THIS TAG
	CALLRET CONF		;CONFIRM AND RETURN

ECHNOI::NOISE (COMMANDS FROM "TAKE" FILE)	;THE "NOISE" CALL *MUST* STAY ON THIS TAG
	CALLRET CONF		;CONFIRM AND RETURN
;[4412]
;SET PASSWORD command

SETPAS::NOISE <OF LOGIN DIRECTORY>
	CONFIRM			;Get EOL
	MOVE A,[POINT 7,BUF0]	;Put directory name here
	MOVEM A,DIRP		;Save byte pointer to where directory will be
	MOVE B,LIDNO		;This is the directory
	DIRST%			;Get name
	 ERCAL CJERRE		;Say what?
	CALLRET DPASS0		;And try this again
;"SET DIRECTORY"

.SDIR::	SETZM SETNOF		;ASSUME "NO" NOT TYPED
	SETZM PASSP		;TELL CRDIR THERE'S NO PASSWORD SUPPLIED YET
	KEYWD $SDIR
	 0
	 JRST CERR
	JRST (P3)

$SDIR:	TABLE
	T ACCOUNT-DEFAULT,,.DAD
XARC <
	T ARCHIVE-ONLINE-EXPIRED-FILES,WHLU,.DARF
   >
	T FILE-PROTECTION-DEFAULT,,.DFPD
	T GENERATION-RETENTION-COUNT-DEFAULT,,.DGRCD
XARC <
	T NO,,.SDNO
	T OFFLINE-EXPIRATION-DEFAULT,,.DOFXP
	T ONLINE-EXPIRATION-DEFAULT,,.DONXP
   >
	T PASSWORD,,.DPASS
	T PROTECTION,,.DPRO
	T SECURE,,DIRSEC	;[4412] SET DIRECTORY SECURE
	TEND

.SDNO:	SETOM SETNOF		;FLAG THAT NO WAS SAID
	KEYWD $SDNO
	 T ARCHIVE-ONLINE-EXPIRED-FILES,WHLU,.DARF
	 JRST CERR
	JRST (P3)

$SDNO:	TABLE
	T ARCHIVE-ONLINE-EXPIRED-FILES,WHLU,.DARF
	T SECURE,,DIRSEC	;[4412] SET DIRECTORY NO SECURE
	TEND
;SET PROGRAM ENTRY (VECTOR LOCATION) <OCTAL> (LENGTH) <OCTAL>

.ENTRY::SKIPGE FORK
	ERROR <No program>
	NOISE <LOCATION TO>
	ADDRX <Memory location of entry vector>
	 ERROR <Invalid location>
	MOVEM B,ENTADR		;REMEMBER ENTRY VECTOR LOCATION
	NOISE <LENGTH>
	DEFX <1>		;DEFAULT
	ADDRX <Value between 1 and 777 octal
or 254000 for TOPS10-compatible entry vector.>
	 ERROR <Invalid length>
	CAILE B,777		;TOO LONG?
	JRST [	CAIN B,254000	;ALLOW JRST FOR COMPATIBLE
		JRST .+1
		ERROR <Invalid length>]
	CONFIRM
	MOVE C,ENTADR		;GET LOCATION OF VECTOR
	MOVE A,FORK
	CALLRET SETENT		;SET ENTRY VECTOR AND RETURN
;"SET FILE"

.SFILE::SETZM SETNOF		;FLAG "NO" WAS NOT SAID YET
	KEYWD $SFILE
	 0
	 JRST CERR
	JRST (P3)

.SFNO::	SETOM SETNOF
	KEYWD $SFNO
	 0
	 JRST CERR
	TXNN P3,NOLG		;NEED TO BE LOGGED IN?
	SKIPE CUSRNO		;YES, AND ARE WE?
	CAIA			;YES, GO AHEAD
	ERROR <LOGIN please>
	JRST (P3)		;DO WHATEVER
;OFFLINE/ONLINE/EXPIRED CODE

.FLINX::SETZ A,			;NO EXPIRATION YET
	MOVX B,.RSFET		;OFFSET TO GUY WE'RE CHANING
	JRST DOEXPI		;JOIN OTHER CODE
.FEXP::	GTAD			;EXPIRE THE FILE, NOW WILL DO
	CAIA
.FLONX::SETZ A,			;SAY NO DATE/TIME OR INTERVAL
	MOVX B,.RSNET		;CELL WHERE THIS VALUE GOES
DOEXPI:	PUSH P,A		;SAVE THE VALUE
	PUSH P,B		;AND THE OFFSET
	CAIN A,0		;DOING FILE EXPIRED? (HAVE VALUE IF SO)
	NOISE <OF FILES>
	CAIE A,0		;HAVE A VALUE?
	NOISE <FILES>		;YES, "SET FILE EXPIRED (FILES) <FILES>"
	CALL INFGNS		;GET FILE GROUPS
	SKIPE -1(P)		;HAVE A VALUE YET?
	JRST DOEXI4		;YES
	NOISE <TO>
	DTIVX <Expiration date>
	 JRST CERR		;LOSES
	MOVEM B,-1(P)		;REMEMBER VALUE GIVEN US
	CAIA
DOEXI4:	CONFIRM
	SETOM FTDBLK
	MOVE A,[FTDBLK,,FTDBLK+1]
	BLT A,FTDBLK+.RSFET	;SET UP THE BLK
	POP P,A			;GET DESIRED OFFSET
	POP P,FTDBLK(A)		;VALUE REQUESTED
	SETOM TYPGRP		;TYPE FILE NAMES
	MOVE A,JBUFP		;SET UP JFN STACK FENCE
	MOVEM A,.JBUFP
DOEXI1:	CALL RLJFNS
	CALL NXFILE
	 JRST DOEXI2		;NO MORE FILES...
	CALL TYPIF		;DO FILE NAME
	CALL MFINP		;GET A TEMP JFN FOR THE FILE
	 JRST DOEXI2		;FAILED...
	MOVEI B,FTDBLK
	MOVEI C,.RSFET+1	;BLK LENGTH
	SFTAD			;SET
	 ERJMP DOEXI3		;FAILED, SAY WHY
	CALL TYPOK		;SAY IT WENT FINE
DOEXI2:	SKIPE INIFH1		;ANYTHING LEFT TO DO?
	JRST DOEXI1		;YES, KEEP GOING
	RET

DOEXI3:	ETYPE < %?
>
	JRST DOEXI2
;PROHIBIT/RESIST-MIGRATION

.FPROH::MOVX A,.AREXM
	CAIA
.FRESI::MOVX A,.ARNAR		;DO RESIST
	MOVX B,.ARSET		;ASSUME USER IS SETTING IT
	SKIPE SETNOF		;USER SAY "NO" ?
	MOVX B,.ARCLR		;YES, CLEAR THE BIT
	PUSH P,A		;SAVE FUNCTION CODE
	PUSH P,B		;AND SET/CLEAR CODE
	NOISE <MIGRATION OF FILES>
	CALL TYPFLS		;COLLECT FILE NAME GROUPS
	SETOM TYPGRP		;TYPE THE NAMES AS WE GO
	MOVE A,JBUFP
	MOVEM A,.JBUFP		;COVER JFN STACK
DOPRRS:	CALL RLJFNS		;RELEASE SPARE JFNS
	CALL NXFILE
	 JRST DOPRR1		;NO MORE
	CALL TYPIF
	CALL MFINP		;GET A SECOND JFN
	 JRST DOPRR1		;COULDN'T
	MOVE B,-1(P)		;GET DESIRED FUNCTION
	MOVE C,0(P)		;WHICH WAY TO SET IT
	ARCF			;DO IT
	 ERJMP [ETYPE < %?
>
		JRST DOPRR1]	;FAILED
	CALL TYPOK
DOPRR1:	SKIPE INIFH1		;ANYTHING LEFT?
	JRST DOPRRS		;NO
	ADJSP P,-2		;DITCH PARAMS
	RET
;PROTECTION (OF FILE) <EXISTING NAME> (IS) <18 BIT OCTAL>
;VERSION-RETENTION-COUNT ...
;INVISIBLE/VISIBLE

.VISIB::TXO Z,IGINV		;FIND INVISIBLE FILES
	TDZA B,B		;MAKE FILES VISIBLE
.INVIS::MOVX B,FB%INV		;MAKE FILES INVISIBLE
	TLO Z,F2		;FLAG DOING INV/VIS STUFF
	NOISE <FILES>
	PUSH P,B		;SAVE OUR PARAM NOW
	CALL TYPFLS		;NOT INFGNS, SINCE NO GUIDE WORD AFTER FILESPEC
	JRST FILEV2		;ENTER DOWN A LITTLE WAY
.FILEV::TLOA Z,F1		;FLAG VERSION-RET...
.PROTE::TLO Z,F3
	NOISE <OF FILES>
	CALL INFGNS
	NOISE <TO>
	TLNE Z,F1
	JRST [	DECX <Decimal generation retention count>
		 CMERRX
		CAILE B,^D63	;LEGAL?
		ERROR <Generation retention count must be 0-63>
		LSH B,^D36-^D6	;LEFTMOST 6 BITS
		JRST FILEV1]
	OCTX <Octal file protection value>
	 CMERRX
	TLO B,500000		;INDICATE THAT THERE'S 18-BIT PROTECTION IN RH
FILEV1:	CONFIRM
FILEV2:	SETOM TYPGRP		;PRINT ALL FILES
	TLNN Z,F2		;VIS/INVIS?
	PUSH P,B		;YES, ALREADY HAVE PARAM SAVED
PROTE1:	CALL NXFILE
	 JRST [	SKIPE INIFH1	;END OF TERMS?
		JRST PROTE1	;NO, DO ANOTHER
		POP P,(P)
		RET]
	HRRZ A,@INIFH1		;GET JFN
	DVCHR
	TXNN B,DV%MDD		;MULTIPLE DIRECTORY DEVICE?
	JRST [	TLNE Z,F1
		ETYPE <?%1H: Generation retention count not implemented for this device
>
		TLNE Z,F2
		ETYPE <?%1H: Invisible files not implemented for this device
>
		TLNE Z,F3
		ETYPE <?%1H: Protection not implemented for this device
>
		MOVSI A,(77B5)
		ANDCAM A,@INIFH1 ;CLEAR * INDICATIONS TO FORCE STEPPING TO NEXT JFN
		JRST PROTE2]
	TLNE Z,F2		;INV/VIS?
	JRST [	SKIPE 0(P)	;SET FILE VISIBLE?
		JRST .+1	;NO
		HRRZ A,@INIFH1	;YES, GET JFN
		MOVE B,[1,,.FBCTL] ;FIND OUT IF CURRENTLY INVISIBLE
		MOVEI C,C
		GTFDB
		 ERJMP PROTE2	;SKIP FILE IF WE CAN'T TELL
		TXNE C,FB%INV	;IS IT INVISIBLE NOW?
		JRST .+1	;YES, PRINT NAME & MAKE VISIBLE
		JRST PROTE2]
	CALL TYPIF		;TYPE NAME IF GROUP (RETURNS JFN IN A)
	TLNE Z,F2		;INV/VIS?
	JRST [	HRLI A,.FBCTL	;WHERE THE BIT BE CHANGED IS
		MOVX B,FB%INV	;BIT IN QUESTION
		JRST DOSFL1]
	HRLI A,.FBPRT		;PROTECTION WORD IN FDB
	TLNE Z,F1
	HRLI A,.FBBYV		;THIS IS VER RET WORD
	MOVEI	B,777777	;CHANGE RHS ONLY
	TLNE	Z,F1
	LDF	B,FB%RET	;RETENTION COUNT PART
DOSFL1:	MOVE	C,(P)		;GET PROTECTION OR VER RET COUNT
	CALL	$CHFDB
	 JRST [	TYPE <   Access not allowed
>
		JRST PROTE2]
	CALL TYPOK
PROTE2:	CALL GNFIL
	SKIPA
	JRST PROTE1
	POP P,(P)		;FIX STACK
	RET
;SET FILE EPHEMERAL (ALSO SET NO ...)

.EPHM::	MOVSI A,.FBEPH		;CODE FOR EPHEMERAL
.EPHM0:	STKVAR <FCODE>
	SETZM FCODE		;CLEAR CODE
	SKIPN SETNOF		;SET NO ...?
	 MOVEM A,FCODE		;STORE ACTUAL CODE TO SET
	CALL INFGNS		;COLLECT FILE NAME GROUPS
	CONFIRM
	SETOM TYPGRP		;TYPE THE NAMES AS WE GO
	MOVE A,JBUFP
	MOVEM A,.JBUFP		;COVER JFN STACK
EPHM1:	CALL RLJFNS		;RELEASE SPARE JFNS
	CALL NXFILE		;GET THE NEXT FILE
	 JRST EPHM2		;NO MORE - FINISH UP
	CALL TYPIF		;TYPE OUT THE FILE NAME
	CALL MFINP		;GET A SECOND JFN
	 JRST EPHM2		;COULDN'T - ON TO NEXT FILE
	HRLI A,.FBCTL		;WORD IN FDB TO CHANGE
	MOVX B,FB%FCF		;MASK FOR FILE TYPE CODE
	MOVE C,FCODE		;GET CODE OR 0
	CALL $CHFDB		;SET CODE IN FDB
	 JRST [	TYPE <  Access not allowed
>
		JRST EPHM2]
	CALL TYPOK		;SAY THE CHANGE SUCCEEDED
EPHM2:	SKIPE INIFH1		;ANYTHING LEFT?
	 JRST EPHM1		;YES - LOOP
	RET			;NO - DONE
;[4412]
;SET FILE SECURE (ALSO SET NO ...)

SECFIL::NOISE <OF FILES>	;Type out some semi-help
	CALL INFGNS		;Collect file name groups
	CONFIRM			;Now parse end of line
	SETOM TYPGRP		;Type the names as we go
	MOVE A,JBUFP		;Get JFN stack
	MOVEM A,.JBUFP		;Cover JFN stack
SECFL1:	CALL RLJFNS		;Release spare JFNs
	CALL NXFILE		;Get the next file
	 JRST SECFL2		;No more - finish up
	CALL TYPIF		;Type out the file name
	CALL MFINP		;Get a second JFN
	 JRST SECFL2		;Couldn't - on to next file
	HRLI A,.FBCTL		;Word in FDB to change
	MOVX B,FB%SEC		;Mask for file type code
	SETZ C,			;Clearing this bit maybe?
	SKIPN SETNOF		;Are we clearing this bit?
	MOVX C,FB%SEC		;No, make sure we set it
	CALL $CHFDB		;Set code in FDB
	IFNSK.			;If CHFDB failed,
	  TYPE <  Access not allowed
>
	ELSE.			;If it worked,
	  CALL TYPOK		;Say the change succeeded
	ENDIF.
SECFL2:	SKIPE INIFH1		;Anything left?
	JRST SECFL1		;Yes, do more
	RET			;No, done
;SET DIRECTORY [NO] ARCHIVE-ONLINE-EXPIRED-FILES (OF DIRECTORY)

.DARF:	CALL INPDIR		;GET THE DIRECTORY IN QUESTION
	MOVX A,CD%DAR		;BIT TO CHANGE
	CALLRET DMODE		;GO CHANGE A SINGLE MODE BIT

;SET DIRECTORY GENERATION-RETENTION-COUNT-DEFAULT

.DGRCD:	CALL INPDIR		;GET DIRECTORY NAME
	NOISE <TO>
	DECX <Decimal number of generations per file to be retained>
	 CMERRX
	MOVEM B,.CDRET+SEBLK	;REMEMBER NUMBER
	CAIE B,1		;DON'T SAY "1 (GENERATIONS...)"
	NOISE <GENERATIONS PER FILE>
	CAIN B,1
	NOISE <GENERATION PER FILE>
	LDF A,CD%RET		;SPECIFY WHICH PARAMETER TO CHANGE
;	CALLRET DWORK		;FALL TO DO THE WORK AND RETURN
;ROUTINE USED FOR SET DIRECTORY COMMANDS.  IT ATTEMPTS TO DO THE CRDIR
;JSYS, AND IF IT FAILS DUE TO A PASSWORD BEING REQUIRED, IT ASKS FOR ONE
;AND TRIES AGAIN.
;
;ACCEPTS:	A/	BITS SHOWING PARAMETER TO CHANGE (CRDIR AC2)
;
;RETURNS:	+1 ALWAYS

DWORK:	MOVEM A,WBITS		;REMEMBER WHICH BITS
	CONFIRM			;CONFIRM THE COMMAND
	MOVE A,WBITS		;GET BITS TO SET
	CALL CREDIR		;TRY TO CHANGE THE DIRECTORY
	 JRST DWORK1		;FAILED, SEE WHY
	RET			;SUCCEEDED WITHOUT PASSWORD

DWORK1:	CALL DGETER		;SEE WHY IT FAILED
	CAIE A,ACESX3		;PASSWORD REQUIRED AND NOT GIVEN?
	CALL CJERRE		;OTHER ERROR, FAIL NOW
	CALL GETPAS		;FAILED, ASK FOR A PASSWORD
	MOVE A,WBITS		;TRY AGAIN
	CALL CREDIR
	 CALL CJERRE		;FAILED AGAIN, TELL USER WHY AND DIE.
	RET			;SUCCEEDED, DONE

;ROUTINE TO GET PASSWORD FOR SET DIRECTORY COMMANDS.

GETPAS:	CALL PASLIN		;INPUT THE PASSWORD
	MOVEM A,PASSP		;SAVE POINTER TO IT IN PASSP
	RET

;ROUTINE TO EXECUTE CRDIR FOR USER-SETTABLE PARAMETERS.
;ACCEPTS:
;	A/	BITS DESIGNATING PARAMETERS BEING CHANGED
;RETURNS:	+1 ERROR
;		+2 SUCCESS

;NOTE:  THIS ROUTINE IS NOT GENERALLY CALLABLE, AS PASSP IS A LOCAL
;VARIABLE.  TO MAKE IT GENERAL, MAKE PASSP BE AN ARG.

CREDIR:	MOVE B,A		;PUT CONTROL BITS IN AC2 FOR JSYS
	MOVE A,DIRP		;GET DIRECTORY NUMBER
	MOVE C,PASSP		;AND POINTER TO PASSWORD
	HRRI B,SEBLK		;SPECIFY WHERE PARAMETER BLOCK IS.
	CRDIR			;MAKE THE DIRECTORY MODIFICATION
	 ERJMP R		;FAILED, PROBABLY BECAUSE PASSWORD REQUIRED OR WRONG
	RETSKP			;SUCCEEDED, SKIP

;SET DIRECTORY OFFLINE-EXPIRATION-DEFAULT

.DONXP:	MOVX A,.CDDNE
	CAIA
.DOFXP:	MOVX A,.CDDFE
	PUSH P,A		;SAVE WHAT WE'RE CHANGING
	CALL INPDIR		;GET A DIRECTORY NAME
	NOISE <TO>
	DTIVX <Expiration date>
	 CMERRX
	POP P,A			;WHAT WE'RE CHANGING
	CAIN A,.CDDNE		;GUESS WE'RE CHANGING ONLINE
	JRST [	MOVEM B,.CDDNE+SEBLK ;WE ARE
		MOVX B,CD%NED
		JRST DOFXP1]
	MOVEM B,.CDDFE+SEBLK	;WRONG, IS OFFLINE DEFAULT
	MOVX B,CD%FED
DOFXP1:	HRRI B,.CDDFE+1		;LENGTH OF THE BLK
	MOVEM B,.CDLEN+SEBLK
	MOVX A,CD%LEN		;SET THIS SO BITS IN CDLEN ARE NOTICED
	CALLRET DWORK		;DO IT & RETURN

;SET DIRECTORY FILE-PROTECTION-DEFAULT

.DFPD:	CALL INPDIR		;GET DIRECTORY NAME
	NOISE <TO>
	OCTX <Octal default file-protection value>
	 CMERRX
	MOVEM B,.CDFPT+SEBLK	;REMEMBER GIVEN VALUE
	LDF A,CD%FPT		;SPECIFY WHICH PARAMETER WE'RE CHANGING
	CALLRET DWORK		;GO DO THE WORK
;[4412]
;DIRSEC - SET DIRECTORY SECURE (Also SET DIRECTORY NO ...)

DIRSEC:	CALL INPDIR		;Get directory name
	MOVX A,CD%SEC		;Bit for secure directory
	CALLRET DMODE		;Do the work and return
;SET DIRECTORY PASSWORD

.DPASS:	NOISE <OF DIRECTORY>
	TLO Z,F1		;DON'T DEFAULT THE DIRECTORY NAME
	CALL DIRNAM		;READ THE DIRECTORY NAME
	 ERROR <Invalid directory name or syntax>
	CALL BUFFF		;GET POINTER TO DIRECTORY NAME
	MOVEM A,DIRP		;LEAVE DIRECTORY NAME IN DIRP
	CONFIRM			;INPUT PASSWORDS ON SEPARATE LINES
DPASS0:	MOVEI A,[ASCIZ /Old password: /]
	CALL PASSX		;INPUT THE CURRENT PASSWORD
	MOVEM A,PASSP		;SAVE POINTER TO IT IN PASSP
DPASS1:	MOVEI A,[ASCIZ /New password: /]
	CALL PASSX		;READ PASSWORD WITH NOISE WORDS "NEW PASSWORD"
	MOVEM A,.CDPSW+SEBLK	;SAVE POINTER TO NEW PASSWORD STRING
	MOVEI A,[ASCIZ /Retype new password: /]
	CALL PASSX		;READ NEW PASSWORD AGAIN
	MOVE B,.CDPSW+SEBLK	;GET FIRST ATTEMPT AT TYPING IT
	STCMP			;MAKE SURE THEY'RE THE SAME
	CAIE A,0		;ARE THEY?
	ERROR <The two copies of the new password weren't the same>
	LDF A,CD%PSW		;SPECIFY WHAT WE'RE CHANGING
	CALL CREDIR		;GO DO THE WORK
	 CALL CJERRE		;PRINT MONITOR'S ERROR MESSAGE IF FAILS
	RET			;SUCCESS

;SET DIRECTORY ACCOUNT-DEFAULT

.DAD:	CALL INPDIR		;GET NAME
	NOISE (TO)
	LINEX <Default account string for directory>
	 CMERRX
	CALL BUFFF
	MOVEM A,.CDDAC+SEBLK	;SAVE POINTER TO DEFAULT ACCOUNT STRING
	MOVX A,CD%DAC		;BIT FOR SETTING DEFAULT ACCOUNT STRING
	CALLRET DWORK		;DO THE WORK AND RETURN

;SET DIRECTORY PROTECTION

.DPRO:	CALL INPDIR		;INPUT DIRECTORY NAME
	NOISE <TO>
	OCTX <Octal directory protection value>
	 CMERRX
	MOVEM B,.CDDPT+SEBLK	;SAVE DESIRED DIRECTORY PROTECTION
	LDF A,CD%DPT		;BIT FOR CHANGING DIRECTORY PROTECTION
	CALLRET DWORK		;DO THE WORK AND RETURN
;ROUTINE TO CHANGE A SINGLE MODE BIT IN A DIRECTORY

DMODE:	MOVEM A,WBITS		;SAVE THE DESIRED MODE BIT
	MOVX A,RC%EMO		;TAKE AS IS ONLY
	MOVE B,DIRP		;DIRECTORY # IN QUESTION
	SETZ C,
	RCDIR			;GET THE DIRECTORY #
	MOVEI A,.CDMOD+1	;[4412] Read some of the directory
	MOVEM A,.CDLEN+SEBLK
	MOVE A,C		;SET UP DIRECTORY NUMBER
	MOVEI B,SEBLK		;READ WHAT THINGS ARE NOW
	SETZ C,			;DON'T WANT TO KNOW THE PASSWORD
	GTDIR
	 ERJMP [ETYPE <No access to directory>
		RET]
	MOVE A,WBITS		;GET THE BIT WE WANTED TO CHANGE
	IORM A,.CDMOD+SEBLK	;ASSUME WE WANTED TO SET IT
	SKIPE SETNOF		;DID COMMAND HAVE A "NO" IN IT?
	ANDCAM A,.CDMOD+SEBLK	;YES, CLEAR THE BIT
	LDF A,CD%MOD		;TELL DWORK WHAT TO CHANGE
	CALLRET DWORK		;GO DO IT

;THIS ROUTINE INPUTS THE DIRECTORY NAME FOR "SET DIRECTORY"
;COMMANDS.

INPDIR:	NOISE <OF DIRECTORY>
	TLO Z,F1		;DON'T DEFAULT THE DIRECTORY NAME
	CALL DIRNAM		;READ THE DIRECTORY NAME
	 ERROR <Invalid directory name or syntax>
	CALL BUFFF		;GET POINTER TO DIRECTORY NAME STRING
	MOVEM A,DIRP		;REMEMBER POINTER TO IT
	RET
;"SET TAPE"

.TAPE::	KEYWD $TAPE
	 0
	 JRST CERR
	JRST (P3)

$TAPE:	TABLE
	T DENSITY,,TDENSI	;"SET TAPE DENSITY (TO)"
	T FORMAT,,TFRMAT	;"SET TAPE FORMAT (TO)"
	T PARITY,,TPARIT	;"SET TAPE PARITY (TO)"
	T RECORD-LENGTH,,TRECLN	;"SET TAPE RECORD-LENGTH (TO)"
	TEND

TDENSI:	NOISE <TO>
	KEYWD $TDENS
	 T SYSTEM-DEFAULT,,.SJDDN
	 JRST CERR
	NOISE <BPI>
	CONFIRM
	MOVEI B,.SJDEN		;SET DENSITY
SETJOB:	MOVEI C,(P3)		;GET VALUE
SETTAP:	MOVNI A,1		;SET FOR OUR JOB
	SETJB
	 ERCAL CJERRE
	RET

;THIS TABLE MUST BE IN ALPHABETIC ORDER

$TDENS::TABLE
	T 1600,,.SJD16
	T 200,,.SJDN2
	T 556,,.SJDN5
	T 6250,,.SJD62
	T 800,,.SJDN8
	T SYSTEM-DEFAULT,,.SJDDN
	TEND
TFRMAT:	NOISE <TO>
	KEYWD $TFRMT
	 T SYSTEM-DEFAULT,,.SJDDM
	 JRST CERR
	CONFIRM
	MOVEI B,.SJDM
	JRST SETJOB

$TFRMT:	TABLE
	T ANSI-ASCII,,.SJDMA
	T CORE-DUMP,,.SJDMC
	T HIGH-DENSITY,,.SJDMH
	T INDUSTRY-COMPATIBLE,,.SJDM8
	T SIXBIT,,.SJDM6
	T SYSTEM-DEFAULT,,.SJDDM
	TEND

TPARIT:	NOISE <TO>
	KEYWD $TPARI
	 T ODD,,.SJPRO
	 JRST CERR
	CONFIRM
	MOVEI B,.SJPAR		;SET PARITY
	JRST SETJOB

$TPARI:	TABLE
	T EVEN,,.SJPRE
	T ODD,,.SJPRO
	TEND

TRECLN:	NOISE <TO>
	DECX <Number of bytes in decimal>
	 CMERRX
	NOISE <BYTES>
	CONFIRM
	TLNE B,777777
	 ERROR<Number of bytes must be 0-262143>
	MOVE C,B
	MOVEI B,.SJRS
	JRST SETTAP
;"SET SPOOLED-OUTPUT"

SPLSET::NOISE <TO>
	KEYWD $SPSET
	 0
	 JRST CERR
	MOVEI B,.SJDFS
	JRST SETJOB

$SPSET:	TABLE
	T DEFERRED,ONEWRD,.SJSPD
	T IMMEDIATE,ONEWRD,.SJSPI
	TEND

;SET [NO] RETRIEVAL-WAIT (FOR OFFLINE FILES)

.OFL::	NOISE	<For offline files>
	SETO A,			;OUR OWN JOB
	MOVEI B,.SJDFR
	MOVEI C,.SJRFA		;NO RETRIEVAL-WAIT
	SKIPN SETNOF
	 MOVEI C,.SJRWA		;YES, RETRIEVAL-WAIT
	SETJB
	CALLRET CONF		;CONFIRM AND RETURN
;SET SESSION-REMARK (TO) TEXT

SETSRM::NOISE (TO)
	CALL GSR		;GET SESSION REMARK
	CALL SSR		;TELL SYSTEM THE REMARK
	CALLRET CONF		;CONFIRM AND RETURN

;ROUTINE TO GET SESSION REMARK
;RETURNS POINTER IN A

GSR::	LINEX <Session remark, one line of text>
	 CMERRX
	CALLRET BUFFF		;ISOLATE SESSION REMARK AND RETURN

;ROUTINE TO SET SESSION REMARK.  GIVE IT POINTER IN A.

SSR::	MOVE C,A		;PUT POINTER TO REMARK IN C
	MOVEI B,.SJSRM		;FUNCTION FOR SETTING SESSION REMARK
	MOVNI A,1		;SPECIFY CURRENT JOB
	SETJB			;SET REMARK
	 ERJMP .+2		;COULDN'T SET SESSION REMARK
	RET			;DONE
	ETYPE <%%Couldn't set session remark
>
	RET
;"SET CARD-READER-INPUT-SET"

CRDSET::NOISE <TO>
	WORDX <Name of input set>
	 CMERRX
	CALL BUFFF		;BUFFER NAME
	MOVEM A,CDRSTR		;SET A CDR INPUT SET NAME
	NOISE <STARTING WITH DECK NUMBER>
	DEFX <1>		;DEFAULT TO DECK #1
	DECX <Deck number in decimal>
	 CMERRX
	SKIPN B
	ERROR <Zero is illegal for deck number>
	MOVEM B,CDRDCK
	CONFIRM
	HRLOI A,.DVDES+.DVCDR	;SET FOR ALL CDR'S
	MOVEM A,CDRDEV
	MOVE A,[3,,.SPLDI]
	MOVEI B,CDRDEV		;ARGUMENT BLOCK
	SPOOL
	 CALL CJERR
	RET
;DISPATCH USING TABLE OF COMMANDS FOR SET REMOTE-PRINTING


.RMPRT::SETZM SETNOF		;[7.1031] Flag "NO" was not said yet
	KEYWD $RMPRT		;[7.1031] Get command from table
	 0			;[7.1031]
	 JRST CERR		;[7.1031] Probably not there
	JRST (P3)		;[7.1031] Go process command
;[7.1031] SET REMOTE-PRINTING SYSTEM-DEFINITIONS
;THIS 'TAKES' SYSTEM:REMOTE-PRINTING.CMD, WHICH WILL HAVE "SET REMOTE-PRINTNG"
;COMMANDS FOR THE AVAILABLE PRINTERS AND CHARACTERISTICS

SRPDEF::CONFIRM			;[7.1031] Look for CR
        HRROI B,[ASCIZ /SYSTEM:REMOTE-PRINTING.CMD/] ;[7.1031]Use this file
	CALL TAKSYS		;[7.1031] (B/ )Do the TAKE
        IFNSK.			;[7.1031] Some error
          ETYPE <?Could not set definitions -  %?
>			        ;[7.1031] Tell last error
        ENDIF.
	RET			;[7.1031] Done

;[7.1061] 
;HERE TO PARSE "SET REMOTE-PRINTING CHARACTERISTIC"
;CALLS SUBROUTINES TO SET BITS IN A 128-BIT BIT-MASK FOR THE DESIRED
;CHARACTERISTICS, DELETE AN EXISTING ENTRY, OR MAKE A NEW ENTRY. IF
;THE USER IS ONLY RE-DEFINING AN EXISTING CHARACTERISTIC, THIS ROUTINE
;WILL OVER-WRITE THE OLD BIT-MASK WITH THE NEW.
;
; Dispatch here from $RMPRT table

;FIRST, SEE IF THE TABLE HAS BEEN SET UP IN FREESPACE YET.
;IF NOT, GET SOME FREESPACE FOR IT AND SET UP THE FIRST WORD
;WITH "LENGTH,,MAX SIZE OF TABLE"

SRPCHR::SKIPN CHRTAB		;Table set up yet?
	IFNSK.			;No
	  CALL PIOFF 		;Let's set one up
	  MOVEI A,CTBLEN        ;This many words
	  CALL GTBUFX		; A/A Gimme - permanent freespace
	  SKIPN A		; No freespace?
	  IFNSK.		; Guess not
	    ETYPE <?Cannot set up CHARACTERISTICs table
>
	    CALL PION
	    RET
	  ENDIF.
	  MOVEM A,CHRTAB     	; Got some - save address of table
	  HRRZI B,CTBLEN      	; Make 0,,length in AC2
	  MOVEM B,@CHRTAB	; Store in 1st table word
	ENDIF.			; OK - ready to proceed
	CALL PION		; Interrupts OK

;THE "EMPTY" TABLE HAS BEEN SET UP. NOW ADD THE TABLE ADDRESS INTO THE
;KEYWORD FDB WE ALREADY MADE IN EXECPR.MAC
 
	MOVE A,CHRTAB		; Get the address
	MOVEI B,CBKFDB
	MOVEM A,.CMDAT(B)	; Plug it in
	HRROI A,FDCHLP		; Now the help string *sigh*
	MOVEM A,.CMHLP(B)	; Stuff it in
                         	; Believe it or not, this works
;NOW BEGIN THE ACTUAL PARSING

	TRVAR <<KEYWORD,3>,KEYLOC>
				; NOTE: KEYWORD and KEYLOC must
				; be kept in order, and in the same
				; order in ALL TRVARs which use them.
	STKVAR <<KEYWD2,3>,DELFLG,CFMOK>		       
                                ; Now clear everything
	SETZM BTMSK1		; Start with the bit-mask
        MOVE A,[BTMSK1,,BTMSK1+1]
	BLT A,BTMSK1+3		; Don't want any stray bits in the mask
	SETZM KEYLOC		; Or the address of field-1 keyword
	SETOM DELFLG		; But we want to set the "delete" flag
	SETOM CFMOK		; And the "OK to confirm" flag
	NOISE <NAME>		; Now we get to parsing, finally
	
;HERE WE ARE PARSING KEYWORDS, OR AN ARBITRARY FIELD (NEW CHARACTERISTIC)

	MOVEI A,[FLDBK. .CMFLD,CM%BRK!CM%SDH,,<New characteristic name being created - 14 characters or less>,,[
			   BRMSK. FLDB0.,FLDB1.,FLDB2.,FLDB3.,<$_>]]
	HRRM A,CBKFDB+.CMFNP	; Link in the Keyword FDB
	MOVEI B,CBKFDB		; Get it into the correct AC
        CALL FLDSKP		; Parse characteristic
	 CMERRX
	LOAD C,CM%FNC,.CMFNP(C)	;GET WHAT WAS TYPED
	CAIN C,.CMKEY		; Keyword? 
	IFNSK.
	  MOVEM B,KEYLOC	; Save address
	  MOVSI A,(POINT 7,0)
          HRRI A,KEYWORD        ; Save keyword string here
	  MOVE B,CMABP          ; Pointer to ATMBUF
	  SETZ C,		; End on null byte
	  CALL ASOUT		; (A,B,C/A,B)Copy keyword
	ELSE.
	                       	; Gotta be an arbitrary string
	  MOVE A,CMABP		; Point to user's input
	  ILDB B,A		; Get first character
	  CAILE B,"Z"		; Lowercase char?
	  SUBI B,40		; Yes, uppercase-ize
	  CAIL B,"A"		; If not between "A"
	  CAILE B,"Z"		;  ...and "Z", it's not a letter.
	  ERROR <CHARACTERISTIC name must begin with alphabetic character>
	  MOVE A,CMABP		; point to ATMBUF
          CALL BCOUNT		; (A/A,B)How many characters?
	  CAILE B,CHRCHR	; More than allowed?
	  ERROR <Too many characters in name>

;UPPERCASE HERE

 	  MOVE A,CMABP		; Point to input
 	  CALL UPRCAS		; Make uppercase

	  SETZM KEYLOC		; No table address (not in table yet)
	  MOVSI A,(POINT 7,0)	; Point
          HRRI A,KEYWORD        ; Save string here
	  MOVE B,CMABP		; Take it from here
	  SETZ C,		; End on null
	  CALL ASOUT		; (A,B,C/A,B)Copy string
 	ENDIF.			; We should now have the user's input
	NOISE <IS>
;HERE WE ARE PARSING KEYWORDS, NUMBERS, OR CARRIAGE RETURN FOR SECOND FIELD
;OR LOOPING THROUGH TO PARSE KEYWORDS OR NUMBERS

SRPCH1:	MOVEI A,[FLDDB. .CMNUM,CM%SDH,12,<Bit number of CHARACTERISTIC (in decimal) 0 to 127>,,[
		 FLDDB. .CMCFM,CM%SDH,,<Carriage return to delete an existing Characteristic name>,,]] ;[7.1099]
	HRRM A,CBKFDB+.CMFNP	; Link in the Keyword FDB
	MOVEI B,CBKFDB		; Get it into the correct AC
	SKIPN CFMOK		; OK to confirm now?
        IFNSK.          	; No - ask for numbers or keywords
          MOVEI A,[FLDDB. .CMNUM,CM%SDH,12,<Bit number of CHARACTERISTIC (in decimal) 0 to 127>]
          HRRM A,CBKFDB+.CMFNP	; Link in the Keyword FDB
          MOVEI B,CBKFDB       	; Get it into the correct AC
	ENDIF.
        CALL FLDSKP		; Parse 
	 CMERRX
	LOAD C,CM%FNC,.CMFNP(C)	;GET WHAT WAS TYPED
	CAIN C,.CMCFM		; Carriage return?
        IFNSK.
	  SKIPE DELFLG		; No input to second field, just CR?
          JRST SPCDEL		; Yes, go delete this CHARACTERISTIC
	  JRST SRPCH2		; Must be real end-of-command
	ENDIF.
	CAIN C,.CMKEY		; Keyword?
	IFNSK.			; Yes.
	  MOVE A,B              ; Save the address
	  CAMN A,KEYLOC		; Trying to define X as X? Silly.
	  IFNSK.
	    CONFIRM		; So get confirm, and
            RET            	; .... leave it alone
	  ENDIF.
          CALL KBTMSK		; (A/ ) No, go set bit(s)
	ELSE.			; Must've been a number
	  SKIPGE B		; Zero or more?
	  SKIPA  		; No - error
	  CAILE B,CHRNUM
	  ERROR <Number must be in range 0-127> ; Nope, silly.
	  MOVE A,B		; Get number into AC1
	  CALL NBTMSK		; (A/ )Set the bit
	ENDIF.
;AT THIS POINT THE USER MAY TYPE A COMMA SO THAT ADDITIONAL CHARACTERISTICS
;CAN BE INCLUDED IN THIS NEW CHARACTERISTIC, OR A CARRIAGE RETURN MAY BE
;TYPED TO END THE COMMAND AT THIS POINT

        MOVEI B,[FLDDB. .CMCMA,,,,,[
		 FLDDB. .CMCFM]]
	CALL FLDSKP
       	ERROR <Comma or confirmation required>
	LOAD C,CM%FNC,.CMFNP(C)	;GET WHAT WAS TYPED
	CAIN C,.CMCMA		; Comma? If so, more stuff to parse
        IFNSK.	                ; Yes.
	  SETZM CFMOK		; Say "Not OK to confirm now"
          JRST SRPCH1		; Yes, continue parsing
	ENDIF.	
;	JRST SRPCH2		; We have a CR - go store the bit-mask

;HERE TO STORE THE COMPLETED BIT-MASK


SRPCH2:	SKIPN KEYLOC		; [7.1118] New entry? Or already there?
	IFNSK.
	  HLRZ A,@CHRTAB     	; New. How many entries?
	  CAIGE A,CTBLEN        ; [7.1073] More than allowed?
	  IFSKP.		; [7.1073] Yes.
            CALL PION
	    ERROR <Table out of room> ; Sorry
	  ENDIF.
	  JRST NEWCHR		; Make new entry
	ENDIF.

;HERE FOR RE-DEFINITION OF EXISTING ENTRY

	HRRZ A,@KEYLOC        	; Entry already there - get data address
	HRRZ B,A		; Need it in RH for BLT
        HRLI B,BTMSK1		; Here's the bit-mask
	BLT B,3(A)		; Store it in freespace
	CALL PION
	RET			; Done
;[7.1061]
;HERE TO CREATE A NEW CHARACTERISTIC
;WE FIRST GET FREESPACE TO STORE THE DATA, THEN BLT THE BIT-MASK  FROM
;MEMORY LOCATIONS "BTMSK*" INTO FREESPACE.
;
;NEXT GET THE NAME FROM TRVAR "KEYWORD" AND STORE IT IN ASCIZ FORMAT.
;
;FINALLY,MAKE THE TBLUK TABLE ENTRY USING THE TWO FREESPACE ADDRESSES AT
;WHICH WE BEGAN STORING THE DATA.

NEWCHR: STKVAR <MSKLOC>
	CALL PIOFF   		; No interrupts
	MOVEI A,CHARAC		; Get 7 words...
	CALL GTBUFX		; (A/A) ...of permanent freespace
	SKIPN A         	; Wasn't enough?
	IFNSK.
	  CALL PION		; You can interrupt me, now
	  ERROR <Cannot create new CHARACTERISTIC> ; Sorry
	ENDIF.
	MOVEM A,MSKLOC        	; AC1 has address returned
	HRRZ B,MSKLOC		; Destination beginning
	HRLI B,BTMSK1		; Source beginning
	MOVE C,MSKLOC		; Destination end
	BLT B,4(C)		; Move it
 	
;BIT-MASK IS NOW STORED IN FREESPACE. STORE THE NEW CHARACTERISTIC NAME,
;OR ALIAS, IN THE NEXT THREE WORDS

	MOVSI B,(POINT 7,0)
	HRRI B,KEYWORD
        MOVSI A,(POINT 7,0)
        HRR A,MSKLOC            ; Beginning of 7-word block
	ADDI A,4		; Store string 4 words into block
	MOVE Q2,A		; Save this address
        SETZ C,	                ; End on null byte
        CALL ASOUT		; (A,B,C/A,B) Copy String
	HRLZ B,Q2               ; Get address of name string 
	HRR  B,MSKLOC		; Now address of mask into RH
	HRRZ A,CHRTAB		; Here's where to find the table
	TBADD
         ERJMP BADADD		; Some problem
	CALL PION
	RET

BADADD:	MOVEI A,CHARAC		; This many words
        MOVE B,MSKLOC		; Here's the freespace
	CALL RETBUF		; Give it back
	CALL PION
	ERROR <Could not add CHARACTERISTIC to table> ; Sorry
;[7.1061]
;HERE TO DELETE AN EXISTING ENTRY IN THE CHARACTERISTICS TABLE
	
SPCDEL: STKVAR <DELADR>
        SETZM DELFLG		; Reset flag now
	SKIPN KEYLOC		; Any address saved?
        ERROR <No such CHARACTERISTIC> ; No - wasn't in table
	HRRZ A,@KEYLOC		; RH of entry (beginning of 7-word data block)
	MOVEM A,DELADR		; Save address for return of freespace
	CALL PIOFF		; Yes, OK to delete 
	MOVE A,CHRTAB		; Table lives here
	MOVE B,KEYLOC		; Entry to delete lives here
	TBDEL			; Do it
         ERJMP BADDEL		; Some problem - not expected
	MOVEI A,CHARAC		; Return this many words
	MOVE B,DELADR		;   ...starting here
	CALL RETBUF		; (A,B/) Return the freespace
	CALL PION
	RET

;HERE IF TBDEL FAILS, WHICH IS HIGHLY UNLIKELY

BADDEL: CALL PION
        ERROR <Could not delete characteristic - %?> ; Tell last error
	ENDSV.
	ENDTV.
;[7.1068]
;HERE TO PARSE "SET REMOTE-PRINTING PRINTER"
;
; Dispatch here from $RMPRT table

;FIRST, SEE IF THE TABLE HAS BEEN SET UP IN FREESPACE YET.
;IF NOT, GET SOME FREESPACE FOR IT AND SET UP THE FIRST WORD
;WITH "LENGTH,,MAX SIZE OF TABLE"

SRPPTR::SKIPE PTRTAB		;Table set up yet?
	IFSKP.			;No
	  CALL PIOFF 		;Let's set one up
	  MOVEI A,CTBLEN        ;This many words
	  CALL GTBUFX		;(A/A) Gimme - permanent freespace
	  SKIPE A		; No freespace?
          IFSKP.               ; Guess not
            ETYPE <?Cannot set up REMOTE PRINTER table
>
	    CALL PION
	    RET
	  ENDIF.
	  MOVEM A,PTRTAB     	; Got some - save address of table
	  HRRZI B,PTBLEN      	; Make 0,,length in AC2
	  MOVEM B,@PTRTAB	; Store in 1st table word
	  CALL PION
	ENDIF.			; OK - ready to proceed

;THE "EMPTY" TABLE HAS BEEN SET UP. NOW ADD THE TABLE ADDRESS INTO THE
;KEYWORD FDB WE ALREADY MADE IN EXECPR.MAC
 
	MOVE A,PTRTAB		; Get the address
	MOVEI B,PBKFDB
	MOVEM A,.CMDAT(B)	; Plug it in
	HRROI A,FDPHLP		; [7.1071] Now the help string *sigh*
	MOVEM A,.CMHLP(B)	; Stuff it in
                         	; Believe it or not, this works
;NOW BEGIN THE ACTUAL PARSING

	TRVAR <<ALINAM,7>,ALILOC,<PTRNAM,7>,PTRLOC,<NODNAM,2>,FLDSZ1,FLDSZ2>
				; NOTE: PT*KEY, PT*LOC, & NODNAM must
				; be kept in order, and in the same
				; order in ALL TRVARs which use them.
				; Clear out some things
	SETZM ALILOC		; Address of field 1 string (if in table)
	SETZM PTRLOC		; Address of field 2 string (if in table)
	SETZM NODNAM		; (You guessed it) Node name
	SETZM FLDSZ1		; Size of field 1 string
	SETZM FLDSZ2		; Size of field 2 string

	NOISE <NAME>		; Guideword

;HERE WE ARE PARSING KEYWORDS, OR AN ARBITRARY FIELD (NEW PRINTER NAME)

 	MOVEI A,[FLDBK. .CMFLD,CM%BRK!CM%SDH,,<New remote printer name being created - 31 characters or less>,,[
			   BRMSK. FLDB0.,FLDB1.,FLDB2.,FLDB3.,<$_>]]
	HRRM A,PBKFDB+.CMFNP	; Link in the Keyword FDB
	MOVEI B,PBKFDB		; Get it into the correct AC
        CALL FLDSKP		; Parse printer name
	 CMERRX
	LOAD C,CM%FNC,.CMFNP(C)	;GET WHAT WAS TYPED
	CAIN C,.CMKEY		; Keyword? 
	IFNSK.			; Yes
	  MOVEM B,ALILOC	; Save address
	  MOVSI A,(POINT 7,0)
          HRRI A,ALINAM         ; Save keyword string here
	  MOVSI B,(POINT 7,0)
	  HLR B,@ALILOC		; Take from where stored
	  SETZ C,		; End on null byte
	  CALL ASOUT		; (A,B,C/A,B)Copy keyword
	ELSE.			; Gotta be an arbitrary string
	  MOVE A,CMABP		; Point to user's input
	  ILDB B,A		; Get first character
	  CAILE B,"Z"		; Lowercase char?
	  SUBI B,40		; Yes, uppercase-ize
	  CAIL B,"A"		;	If not between "A"
	  CAILE B,"Z"		;     and "Z", it's not a letter.
	  ERROR <Printer alias name must begin with alphabetic character>
	  MOVE A,CMABP		; point to ATMBUF
          CALL BCOUNT		; (A/A,B)How many characters?
	  CAILE B,PTRCHR	; More than allowed?
	  ERROR <Too many characters in printer alias name>
	  MOVEM B,FLDSZ1	; Save number of characters
;UPPERCASE HERE

 	  MOVE A,CMABP		; Point to input
 	  CALL UPRCAS		; (A/A) Make uppercase
	  SETZM ALILOC		; No table address (not in table yet)
	  MOVSI A,(POINT 7,0)	; Point
          HRRI A,ALINAM         ; Save string here
	  MOVE B, CMABP		; Take it from here
	  SETZ C,		; End on null
	  CALL ASOUT		; (A,B,C/A,B)Copy string
 	ENDIF.			; We should now have the user's input
	NOISE <IS>

;HERE WE ARE PARSING KEYWORD, ARBITRARY FIELD, OR CARRIAGE RETURN FOR 
;SECOND FIELD

 	MOVEI A,[FLDDB. .CMCFM,CM%SDH,,<Carriage return to delete an existing Remote Printer name>,,[
                 FLDBK. .CMFLD,CM%BRK!CM%SDH,,<DQS Queue - 31 characters or less
  or LAT Port/Service - 16 characters or less>,,[
			   BRMSK. FLDB0.,FLDB1.,FLDB2.,FLDB3.,<$_-.>]]] ;[7.1099][4402][****]
	HRRM A,PBKFDB+.CMFNP	; Link in the Keyword FDB
	MOVEI B,PBKFDB		; Get it into the correct AC
        CALL FLDSKP		; Parse printer name
	 CMERRX
 	LOAD C,CM%FNC,.CMFNP(C)	;GET WHAT WAS TYPED
	CAIN C,.CMCFM		; Carriage return?
        JRST SRPDEL		; Yes, go delete this REMOTE-PRINTER
	CAIE C,.CMKEY		; Keyword?
	IFSKP.			; Yes.
	  MOVEM B,PTRLOC	; [7.1136]  Save the address.
	ELSE.			; Must've been arbitrary field
	  MOVE A,CMABP		; point to ATMBUF
          CALL BCOUNT		; (A/A,B)How many characters?
	  CAILE B,PTRCHR	; More than allowed?
	  ERROR <Too many characters in DQS Queue, or LAT Port/Service name> ;[4409]
	  MOVEM B,FLDSZ2	; Save number of characters
	ENDIF.
;
;WHETHER WE HAVE KEYWORD OR ARBITRARY STRING, UPPERCASE IT, AND COPY INTO TRVAR
;
		    
 	  MOVE A,CMABP		; Point to input
 	  CALL UPRCAS		; (A/A) Make uppercase
	  MOVSI A,(POINT 7,0)	; Point
          HRRI A,PTRNAM         ; Save string here
	  MOVE B,CMABP		; Take it from here
	  SETZ C,		; End on null
	  CALL ASOUT		; (A,B,C/A,B)Copy string
          NOISE <ON>

;
;INPUT TO FIELDS ONE AND TWO ARE NOW SAVED, PROCEED TO PARSE THIRD FIELD
;
;IF LAST FIELD WAS AN ARBITRARY FIELD, THIS FIELD HAD BETTER BE A NODENAME
;
				
 	SKIPN PTRLOC		; Was last field a keyword?
	IFSKP.			; Yes
          MOVE Q3,[ASCIZ /LAT/]	;[4402] Set flag in Q3
          WORDX <Node name, LAT Server name, or confirm with carriage return> ;[4402]
	   CMERRX		;[4417]Handle the error return
	ELSE.
          MOVE Q3,[ASCIZ /LAT/]	;[4402] Set flag in Q3
          WORDX <Node name or LAT Server name>  ;[4402]
           CMERRX <Node name or LAT Server name required> ;[7.1071]
	ENDIF.			; So we have to get a node name
	
;[4402] Check node/LAT Server name length

	MOVE A,CMABP		;[4402] Point to input
	CALL BCOUNT		;[4402] (A/A,B) How many characters?
	CAILE B,NODSIZ		;[4402] More than allowed in node name (6)?
	IFSKP.			;[4417]No
	  IFE. B		;[4417]No, but
	    SKIPN PTRLOC	;[4417]Was last field a keyword?
	    ERROR <Missing node name in SET REMOTE-PRINTER command> ;[4417]No
	    JRST RPPEND		;[4417]Yes, try confirm
	  ENDIF.
	ELSE.
	  ERROR <Too many characters in node or LAT Server name> ;[4402]
	ENDIF.
	
;UPPERCASE THE NODE NAME

        MOVE A,CMABP		; Point to input
        CALL UPRCAS		; (A/A) Make uppercase
	
;NOW SAVE IT AWAY

        MOVSI A,(POINT 7,0)	; Point
        HRRI A,NODNAM           ; Save string here
        MOVE B,CMABP		; Take it from here
        SETZ C,	                ; End on null
        CALL ASOUT		; (A,B,C/A,B)Copy string
;	JRST RPPEND
	
;WE NOW HAVE THE INPUT TO ALL FIELDS SAVED IN TRVARs, SO CONFIRM AND
;PROCESS THE COMMAND.

;HERE FOR CONFIRM 

RPPEND: CONFIRM	  		; That's all you can do
	JRST DOSRPP   		; Now process the command
;[7.1068]
;HERE TO PROCESS THE SET REMOTE-PRINTING PRINTER COMMAND
;KEYWORD AND ADDRESSES, ARBITRARY FIELD AND SIZE, AND NODENAME ARE ALL
;IN TRVARS WHICH WERE CREATED IN SRPPTR: .
;
;  ALINAM,ALILOC - Alias name from field 1 of command; table address if
;			name is in table, zero if new name being created
;
;  PTRNAM,PTRLOC - Printer (or alias) name from field 2 of command; 
;                       table address if name is in table, zero if new 
;                       name being created
;
;  NODNAM - Nodename, or zero if no nodename given
;
;  FLDSZ1 - Number of characters in arbitrary field from field 1 of command
;
;  FLDSZ2 - Number of characters in arbitrary field from field 2 of command
;
;
;COME HERE FROM SRPPTR
;

DOSRPP:	SKIPE NODNAM  		; Do we have a nodename?
	JRST SRPNOD   		; Yes, process 
	MOVE A,ALILOC		;[7.1136] Get address of field 1
	CAMN A,PTRLOC		;[7.1136] Same as field 2? (setting it to itself?)
        RET                     ;[7.1136] Yes. Leave it alone and go away quietly
	STKVAR <ALILEN,TMPLC1,TMPLC2,BLKSIZ,ALIAD,PNTRAD,DLNTRY,OLDDAT>	;[7.1071]
	SETZM DLNTRY		; [7.1071]
        SKIPN ALILOC		; Field 1 string already in table?
	IFSKP.			; Yes.
	  HRRZ C,@ALILOC	; [7.1071] Address of data word
	  SKIPE C		; [7.1071] If zero, this is a deleted entry
	  IFSKP.                ; [7.1071] Deleted.
	    SETOM DLNTRY	; [7.1071] Indicate field 1 was a deleted entry
	    JRST DLORPP		; [7.1071]
	  ENDIF.
	  HLRZ D,(C)		; Does this alias point to phys printer? (LH not= 0)
	  SKIPN D		; Well?
          IFSKP.		; Yes
DLORPP:     MOVE A,@ALILOC	; [7.1073] Get table data
	    MOVEM A,OLDDAT	; [7.1071] ...and save it
	    CALL PIOFF
	    HLRZ D,@ALILOC	; [7.1071] Get string addr someplace safe
            HRRZ A,PTRTAB	; Table addr
            HRRZ B,ALILOC	; This entry
            TBDEL		; Delete now, release freespace later
             ERJMP BADPDL
	    MOVEM C,TMPLC2 	; Save AC3 - TBLUK stomps on it
            MOVE A,PTRTAB	; Now we have to find out where field 2 is
            MOVSI B,(POINT 7,0) ; Cuz TBDEL'ing will have re-ordered the table
            HRRI B,PTRNAM	; Point to Field 2 string
            TBLUK		; Where?
             ERJMP BADLUK	
	    MOVEM A,PTRLOC	; Here.
	    MOVE C,TMPLC2	; Restore AC3

;WE'VE DELETED THE OLD ENTRY, AND LOOKED-UP THE LOCATION OF THE NEW
;SO IT'S SAFE TO RELEASE THE OLD FREESPACE DATA

            MOVSI A,(POINT 7,0)
            HRR A,D       	; [7.1071] Point to string
            MOVEM C,TMPLC1	; Save these - BCOUNT gorches 'em
            MOVEM D,TMPLC2
            CALL BCOUNT	        ; What size is the string only?
            MOVEM B,ALILEN	; Save for later
            MOVE C,TMPLC1	; Restore
            MOVE D,TMPLC2
;RELEASE THE FREESPACE FOR THE STRING

	    HRR B,D		; [7.1071] String addr into AC2
	    SOS B		; Decrement to block size
	    MOVE A,(B)		; Get the size
	    CALL RETBUF		; (A,B/ ) Return the string block
	    SKIPN DLNTRY	; [7.1071] Was this entry deleted?
	    IFSKP.		; [7.1071] Yes.
	      CALL PION
	      JRST ALDEF	; [7.1071] So we have TBDEL'd and released freespace
	    ENDIF.		; [7.1071] ...proceed as if this was a new entry

;THIS HAD BEEN A PHYSICAL PRINTER ENTRY, SO RELEASE THE BLOCK FOR THAT DATA

	
	    HRRZ B,OLDDAT	; [7.1073] Get addr of data
	    SOS B 		; Back up to block size
	    MOVE A,(B)		; Get size in AC1
            CALL RETBUF	        ; (A,B/ )Return it
	    CALL PION
            JRST ALDEF	        ; Now proceed as if new alias for existing entry
          ENDIF.		; This alias points to another alias
	  CALL PIOFF
          HLRZ A,@PTRLOC	; Field string 2 already in table (or COMND% would've barfed)
          HRRZ B,@ALILOC        ; So get pointer to data
          MOVEM A,(B)		; Over-write old data (pointer to other alias)
	  CALL PION
	  RET
        ENDIF.	                                                             
;THIS CREATES A NEW ALIAS FOR AN EXISTING ENTRY. (FIELD 1 STRING NOT IN TABLE)

ALDEF:	HLRZ A,@PTRTAB     	; See if enough room in table
	CAIL A,PTBLEN           ; [7.1073]Well?
        ERROR <Table out of room> ; Sorry
	MOVE A,FLDSZ1 		; Try here for size - assume not in table
	SKIPN A     		; Re-defining something already in table?
	MOVE A,ALILEN		; Not in table yet, so size is here
	IDIVI A,5		; How many words?
	SKIPE B			; Any partial word needed?
	AOS A			; Yes, add one
        ADDI A,3          	; [7.1073] ...3 more for block size,addr of old
                                ; ... alias, and null
	CALL PIOFF
	CALL STORAL		; (A/ ) Store alias name
        ERROR <Could not store new REMOTE-PRINTER data>
	MOVEM A,ALIAD		; Remember where alias stored
	MOVEM B,PNTRAD		; ....and pointer to existing alias
	HRRZ A,PTRTAB		; Address of table
	HRL B,ALIAD		; Address of new alias
	HRR B,PNTRAD		; Address of pointer to old string
	TBADD
         ERJMP BADADA
	CALL PION
	RET			; Done

BADADA: MOVE B,@ALIAD		; Address of new alias string
	SOJ B,     		; Decrement to top of block
	MOVE A,(B)		; Size lives here
	CALL RETBUF		; (A,B/ ) Return the freespace 
	CALL PION
	ERROR <Could not add new Printer alias to table - %?> ; Sorry
;HERE WHEN TBDEL HAS OCCURRED ON THE OLD ENTRY, AND WE NEED TO FIND WHERE
;THE ALIAS WE NOW WANT TO POINT AT LIVES. HOWEVER, THE TBLUK TO FIND THE
;SUCKER HAS FAILED. TRY TO TBADD THE OLD ENTRY BACK.
;WE ARE PIOFF ON ENTRY TO  EITHER OF THESE ROUTINES

BADLUK:	MOVE A,PTRTAB		; Table addr
	MOVE B,DLNTRY		; Old entry
	TBADD
	 ERJMP TBOHNO		; Weird - this shouldn't fail
	CALL PION
        ETYPE <?Unexpected error in making new entry. Previous data restored - %?
>
	RET

;COULDN'T TBADD THE OLD ENTRY BACK. DEEP-6 THE OLD FREESPACE DATA AND TELL
;THE USER THERE'S A PROBLEM

TBOHNO:	MOVSI A,(POINT 7,0)
        HLR A,@ALILOC           ; Point to string
        MOVEM C,TMPLC1          ; Save these - BCOUNT gorches 'em
        MOVEM D,TMPLC2
        CALL BCOUNT             ; What size is the string only?
        MOVEM B,ALILEN          ; Save for later
        MOVE C,TMPLC1           ; Restore
        MOVE D,TMPLC2
        SOS B,C	                ; Decrement to address of block length
        MOVE A,(C)              ; Get block size into AC1
        CALL RETBUF             ; (A,B/ )Return the block
        HLRZ B,@ALILOC          ; Get address of string
        SOS B	                ; Back up to block size
        MOVE A,(B)              ; Get size in AC1
	CALL RETBUF             ; (A,B/ ) Return the freespace
	CALL PION
	ETYPE <?Unexpected error. Could not make new entry, nor restore previous - %?
>
	RET

BADPDL: CALL PION
        ETYPE <?Unexpected error in changing table entry - %?>
	RET
;[7.1068]
;HERE IF NODENAME TYPED

SRPNOD: STKVAR <BLKSIZ,ALIAD,PPRINT,TMPLOC>
	SETZM TMPLOC		; Clear temp holder for table data
        SKIPE ALILOC		; Alias name already in table?
        IFSKP.
          HLRZ A, @PTRTAB	; New name. Have room in table?
          CAILE A,PTBLEN         ; Well?
          ERROR <Table out of room> ; Sorry
	ENDIF.
;	
;IF THIS IS A NEW ENTRY, WE HAVE ROOM FOR IT IN THE TABLE. THIS MAY ALSO
;BE A REDEFINITION OF AN EXISTING ALIAS. IN ANY CASE, STORE THE PHYSICAL 
;PRINTER DATA IN FREESPACE FIRST
;	
;FOR REDEFINITIONS -
;IF THIS ALIAS *WAS* POINTING TO A PHYSICAL PRINTER, ALL WE NEED DO
;IS CHANGE THE DATA ADDRESS OF THE TABLE ENTRY TO POINT TO THE NEW QUEUE/
;NODENAME BLOCK. IF, HOWEVER, THIS ALIAS USED TO POINT TO ANOTHER ALIAS,
;AND NOW POINTS TO A PHYSICAL PRINTER, WE NEED TO GET RID OF ALL THE OLD
;DATA, BECAUSE THE BLOCK FORMAT(S) WILL BE DIFFERENT. THEN, WE WILL
;TBADD THE ENTRY AS IF IT WERE ENTIRELY NEW.

	CALL PIOFF
	CALL PHYPRT		; ( /A) Store "physical printer" data in freespace
	MOVEM A,PPRINT		; And save where we put it
	SKIPN ALILOC		; New entry? Or re-definition?
	IFSKP.			; Re-definition.                    
	  HRRZ B,@ALILOC	; Address of "old" data word
	  SKIPN B		; Is this deleted?
          JRST ALIAS		; Yes. Proceed to process as new entry
       	  HLRZ C,(B)		; Was this pointing to an alias? (LH=0)
	  SKIPN C		; Well?
	  IFSKP.		; No, physical printer - so the block format stays the same
	    HRRZ B,@ALILOC	; Find old physical printer data
	    SOS B		; Block size here
	    MOVE A,(B)		; Get it into AC1
	    CALL RETBUF		; Return the old space
	    MOVE A,PPRINT	; Address of new pointers
	    HRRM A,@ALILOC	; We just store new address in table.
	    RET			; And done
	  ENDIF.		; This WAS pointing to another alias and is NOW
       	ENDIF.			; ...going to point to a physical printer, so the
                                ; ...block format changes
;
;WE NOW HAVE THE "PHYSICAL PRINTER" (NAME, NODENAME) SAVED, SAVE THE ALIAS
;
ALIAS:	MOVE B,FLDSZ1		; Size of alias name
	SKIPE B			; No size? This is already in table, then.
	IFSKP.			; And had been pointing to another alias
	  MOVSI A,(POINT 7,0)	; Point
	  HLR A,@ALILOC		; To the string
	  CALL BCOUNT		; How long?
	ENDIF.	  
	IDIVI B,5		; How many words do we need for this block?
	SKIPLE B	        ; Less than 5 chars?
 	SKIPE C			; Or need a partial word?
	AOS B			; Yes, add one to number of words
	ADDI B,2		; [7.1073] Add one for block size and one for null
	MOVE A,B		; [7.1073] Now put in AC1
        CALL STORAL    		; (A/ )Store alias name in freespace
	IFNSK.
	  MOVE B,PPRINT		; Address of pointers
	  SOS B     		; Decrement to top of block
	  MOVE A,B		; Size lives here
	  CALL RETBUF		; (A,B/ ) Return the freespace we got before
	  CALL PION		; You can interrupt me, now
          ERROR <Could not store new printer data>
	ENDIF.
       	MOVEM A,ALIAD		; Remember where alias stored
;FIRST, TBDEL THE ENTRY JUST IN CASE THE TBADD FAILS 
;NEXT, TRY THE TBADD WITH THE NEW DATA. IF IT FAILS, TRY TO RESTORE THE OLD DATA
;THEN, RETURN FREESPACE FOR "OLD" PHYSICAL PRINTER DATA
;IF TBADD'S FOR BOTH NEW AND OLD DATA FAIL, THIS USER IS A BIG LOSER
;
	SKIPN ALILOC		; Well, IS there anything to delete?
	IFSKP.			; Yes, do it now
	  MOVE D,@ALILOC	; So save the actual data in case we need it
	  MOVEM D,TMPLOC	; ....and have to restore it later
          HRRZ A,PTRTAB         ; Table addr
          HRRZ B,ALILOC         ; This entry
          TBDEL			; Wipe it out
           ERJMP BADADL		; Couldn't. How strange.
	ENDIF.
;
;TRY TO MAKE THE NEW TABLE ENTRY
;
   	HRRZ A,PTRTAB		; Address of table
	HRLZ B,ALIAD		; Address of alias
	HRR B,PPRINT		; Address of physical printer (name, nodename)
	TBADD
         ERJMP TRYOLD		; Uh-oh. See if we can put the old stuff back
				; Success. New table entry is now in place
;Save addr of alias in PTRTAB in case it is the alias is the default queue
;name.
	HRLM A,DEFADR		;[4417]Save alias addr in left half BUT
				;  remember to clear it after we check to see
				; if we are changing the default printer.
;Since the table just got updated we better check to see if the address of
;the default printer is still pointing at the correct alias.
	CALL UPDFPR		;[4417]Check to see if we have to update
				;default printer alias
	 AOS DEFADR		;[4417]Entry comes before default printer
	SKIPN TMPLOC		; Was there "old" data?
	IFSKP.			; Yes, wipe it out
          HRRZ B,TMPLOC         ; Address of data word
          SUBI B,2              ; So decrement to loc holding block size
          MOVE A,(B)		; And get block size
          CALL RETBUF		; (A,B/ )Return the freespace
	ENDIF.			; 
	SKIPN DEFQUE		;[4417]Do we have default to just queue name
	IFSKP.			;[4417]yes
	  MOVE A,ALIAD		;[4417]Get alias
	  HRLI A,(POINT 7,0)	;[4417]pointer to alias
	  MOVE B,[POINT 7,DEFQUE] ;[4417]pointer to default just queue name
	  CALL RPEQUE		;[4417](A,B/)Check to see if they are the same
	ENDIF.			;[4417]
	HRRZS DEFADR		;[4417]Clear the left half of default printer
				; address
	CALL PION
	RET			; There wasn't any old data, so..Done

;RPEQUE - Check to see whether the alias in remote printer is a default queue
;name. If so, change the default printer to what the alias is pointing to and
;tell the user.  If not the caller of RPEQUE should clear the left half of
;DEFADR.

;ACCEPTS A/POINTER OF ASCIZ STRING
;	 B/POINTER OF ASCIZ STRING
;RETURNS +1 ALWAYS

RPEQUE:	CALL MATCH		;[4417]Do they match?
	 RET			;[4417]No
	HLRZ B,DEFADR		;[4417]Get addr of alias
	CALL RESLV1		;[4417](B/B)Resolve alias
	HLRZS B,DEFADR		;[4417]Save the new addr
	HLRZ A,(B)		;[jw[Get address of alias string
	MOVSI B,(POINT 7,0)	;[4417]Pointer
        HRR B,A			;[4417]Take it from here
        MOVSI A,(POINT 7,0)	;[4417]Pointer
        HRRI A,DEFREM		;[4417]Save input arg from SET DEF /REMOTE
        SETZ C,	        	;[4417]End on null
        CALL ASOUT		;[4417](A,B,C/A,B)Copy string
	HRROI A,DEFREM		;[4417]Get default remote printer name
	HRROI B,RPQUE		;[4417]Get default Que/Port/Service name
	MOVE C,RPNODE		;[4417]Get default node name
	ETYPE <Default printer is %1M --- %2M on node %3' %_>
	SETONE PR%RDF,PRIFLG 	;[4417]Default /REMOTE takes precedent
	SETZRO PR%DDF,PRIFLG 	;[4417]Default /DESTINATION take a back seat
	SETZRO PR%LFT,PRIFLG 	;[4417]Clear the left half
	RET			;[4417]
;Match two ASICZ strings
;Returns +1 on no match
;	 +2 on match

MATCH:	ILDB C,A		;[4417]Get a byte
	ILDB D,B		;[4417]Get a byte
	CAILE C,"Z"		;[4417]Lower case?
	SUBI C,40		;[4417]Make it uppercase
	CAILE D,"Z"		;[4417]Lower case?
	SUBI D,40		;[4417]Make it uppercase
	CAME C,D		;[4417]Are they the same?
	RET			;[4417]No, all done
	JUMPN C,MATCH		;[4417]If nul then we have a match
	RETSKP			;[4417]

;UPDFPR - Since routine ALIAS: or SRPDEL just modified PTRTAB, DEFADR might
;be off be one.  Check to see if the new entry is alphabetically before the
;default alias.  If so, ALIAS: should add 1 to DEFADR and SRPDEL: should
;subtract 1 to DEFADR.
;Accepts DEFADR/addr of entry in question (add/delete),,addr of default printer
;entry
;Returns +1/if entry comes alphabetically before default printer
;	 +2/If entry doesn't comes alphabetically before default printer

UPDFPR:	HRRZ A,DEFADR		;[4417]Get the address of default printer
	JUMPE A,RSKP		;[4417]No address, no default printer
	HLRZ B,DEFADR		;[4417]Get the address of entry
	CAMLE B,A		;[4417]Entry comes before default printer
	RETSKP			;[4417]Yes
	RET			;[4417]No,
;ERROR ROUTINES FOR TBADD AND TBDEL FAILURES
;THESE ROUTINES ASSUME: CALLED FROM SRPNOD, AND CALLED PIOFF

;HERE FOR GARDEN-VARIETY FAILURE TO MAKE NEW ENTRY

BADADP:	MOVE B,PPRINT		; Address of pointers
	SOS B      		; Decrement to top of block
	MOVE A,(B)		; Size lives here
	CALL RETBUF		; (A,B/ ) Return the freespace 
	MOVE B,ALIAD		; Address of alias
	SOS B	
	MOVE A,(B)		; Get size
	CALL RETBUF		; (A,B/ ) Return the freespace 
	CALL PION
	ERROR <Could not add REMOTE PRINTER to table - %?> ; Sorry

;HERE IF DELETION OF OLD ALIAS FAILS

BADADL: MOVE B,PPRINT		; Address of pointers
	SOS B      		; Decrement to top of block
	MOVE A,(B)		; Size lives here
	CALL RETBUF		; (A,B/ ) Return the freespace 
	MOVE B,ALIAD		; Address of alias
	SOS B	
	MOVE A,(B)		; Get size
	CALL RETBUF		; (A,B/ ) Return the freespace 
	ETYPE <?Could not change entry  - %?>
	CALL PION
	RET
;HERE IF OLD ENTRY DELETED, BUT TBADD FAILED ON NEW ONE

TRYOLD: SKIPN TMPLOC		; Was there any old data?
	JRST BADADP		; No, so we can't restore anything. Just bomb out.
        HRRZ A,PTRTAB		; Address of table
	MOVE B,TMPLOC		; Old data - addr of string,,addr of data
	TBADD
         ERJMP BADOLD
	CALL PION
	RET


;WELL, ISN'T THIS A MESS. THE OLD ENTRY IS DELETED, TBADD FOR THE NEW ENTRY
;FAILED, AND TRYING TO TBADD BACK THE OLD STUFF FAILED, TOO.
;JUST RELEASE THE "OLD" DATA AND THE "NEW" DATA AND TELL THE USER THE BAD NEWS

BADOLD: MOVE B,PPRINT		; Address of pointers
	SOS B      		; Decrement to top of block
	MOVE A,(B)		; Size lives here
	CALL RETBUF		; (A,B/ ) Return the freespace 
	MOVE B,ALIAD		; Address of alias
	SOS B	
	MOVE A,(B)		; Get size
	CALL RETBUF		; (A,B/ ) Return the freespace 

;NOW RELEASE THE OLD DATA, IT'S USELESS ANYWAY

       HRRZ B,@TMPLOC        ; Address of data word
        SUBI B,2              ; So decrement to loc holding block size
        MOVE A,(B)	      ; And get block size
        CALL RETBUF	      ; (A,B/ )Return the freespace
	ETYPE <?Fatal error encountered. State of REMOTE-PRINTER data is indeterminate
%?>
	CALL PION
  	RET
	ENDSV.
;[7.1068]
;HERE TO STORE AN ALIAS NAME IN FREESPACE.
;THIS WILL ACCEPT BLOCK SIZE NEEDED FROM THE CALLER, GET THAT MANY WORDS
;FROM THE FREESPACE HANDLER, AND STORE THE ALIAS NAME AND ANY ASSOCIATED
;POINTERS (ADDRESSES).
;
; A/ NUMBER OF WORDS OF FREESPACE NEEDED
;
;	CALL STORAL
;
; RETURNS +1 ON FAILURE
; RETURNS +2 ON SUCCESS: ADDRESS OF STORED ALIAS IN AC1
;			 ADDRESS OF STORED POINTER (IF ANY) IN AC2
;
STORAL:	STKVAR <BLSIZ,ALADD>
        MOVEM A,BLSIZ		; Save the number of words wanted
	CALL GTBUFX		; (A/A) Get permanent freespace
	SKIPN A         	; Wasn't enough?
        RET			; 
	MOVEM A,ALADD		; Save the address
	CALL PIOFF
	MOVE A,BLSIZ		; Get the block size
	MOVEM A,@ALADD          ; Stuff into first word
	AOS ALADD		; Now increment to where name will live
	MOVE D,ALADD		; Save current address
	MOVSI B,(POINT 7,0)	; Source
	HRRI B,ALINAM		; Field 1 - the new alias name
        MOVSI A,(POINT 7,0)
        HRR A,ALADD             ; Where to store it
        SETZ C,	                ; End on null byte
        CALL ASOUT		; (A,B,C/A,B) Copy String
	IDPB C,A		; [7.1073] Tie off with null
	SKIPN NODNAM		; Defining physical printer?
	IFSKP.			; Yes, so no pointer stored with alias
          MOVE A,ALADD		; Get back address where alias stored
	  SETZM B		; Indicate no additional pointer word
	  CALL PION
	  RETSKP
	ENDIF.			; Not physical printer - make pointer to existing alias
        AOS D		        ; Store some data in next word - get addr in AC4
        HLRZ B,@PTRLOC	        ;  of table entry for field 2
        MOVEM B,(D)		; Store 0,,addr of old alias
	MOVE A,ALADD		; Tell caller where alias stored
	MOVE B,D		; ....and where pointer to existing alias is
	CALL PION
	RETSKP			;
	ENDSV.
;[7.1068]
;HERE TO STORE THE PHYSICAL PRINTER DATA
;THIS ROUTINE GETS FREESPACE FOR THE PHYSICAL PRINTER/NODENAME STORAGE
;ALSO A WORD AT THE TOP OF THE BLOCK TO HOLD BLOCK SIZE, AND A WORD
;TO HOLD THE ADDRESSES OF THE PRINTER NAME AND NODE NAME. THE TABLE ENTRY
;RIGHT HALF POINTS TO THIS LATTER WORD.
;
;RETURNS +1 ALWAYS, UNLESS AN ERROR CONDITION IS ENCOUNTERED, IN WHICH
;CASE, THE USER IS RETURNED TO EXEC PROMPT LEVEL.
;	
;	CALL PHYPRT

PHYPRT:	STKVAR <BLOKSZ,PTRWRD,PNTRZ>
	MOVE A,FLDSZ2		; Size of Printer name
	IDIVI A,5		; How many words?
 	SKIPG A	                ; Less than 5 chars in string?
	AOS A			; Yes, so add 1 to number of words
	AOS A			; Add one for final null
	ADDI A,4		; Plus 2 words for node name and ...
                     		; ...another 2 for pointers and block size
	MOVEM A,BLOKSZ		; Save the number
	CALL PIOFF
	CALL GTBUFX		; (A/A) Get permanent freespace
	SKIPE A         	; Wasn't enough?
	IFSKP.
	  CALL PION		; Guess not
          ERROR <Cannot store new REMOTE PRINTER data> ; Sorry
	ENDIF.
	MOVEM A,PTRWRD		; Save the address
	MOVE A,BLOKSZ
	MOVEM A,@PTRWRD         ; Stuff the size in the first word
	MOVE B,PTRWRD
	AOS B       		; Increment the address and put in AC2
	MOVEM B,PNTRZ		; Store - this loc holds the pointers
	AOS D,B			; Increment again - point to printer name spot
	MOVSI B,(POINT 7,0)	; Source
	HRRI B,PTRNAM		; Field 2 - the printer name
        MOVSI A,(POINT 7,0)
        HRR A,D                 ; Where to store printer name
	HRLZM A,@PNTRZ 		; Put the address in the pointer word
        SETZ C,	                ; End on null byte
        CALL ASOUT		; (A,B,C/A,B) Copy String
	IDPB C,A		; Tie off with null
	AOS A			; Start nodename in next word
	HRRM A,@PNTRZ 		; Put nodename address in pointer word
	HRLI A,(POINT 7,0)	; Make pointer to next full word
	MOVSI B,(POINT 7,0)	; Now make source pointer
	HRRI B,NODNAM		; Now copy nodename
	SETZ C,			; Using updated pointer for destination
	CALL ASOUT		; (A,B,C/A,B)
	CALL PION
	MOVE A,PNTRZ 		; Pass the address back
	RET
	ENDSV.
;[7.1068]
;HERE TO DELETE AN ENTRY IN THE TABLE

SRPDEL:	STKVAR <COMPAD,COUNTP>	; To hold string addr for compare and
				;  Counter for number of pointers to this alias
	SETZM COUNTP		; Prevent strays in our count
	SKIPE ALILOC		; Is it in the table?
	IFSKP.			; 
          ETYPE <?No such REMOTE-PRINTER
>                               ;           No, silly.
	  RET
	ENDIF.
	CALL PIOFF		; No interrupts
	HLRZ A,@ALILOC		; Get the address of the data for this string
	MOVEM A,COMPAD		; Save it to compare - see if anybody else points to it
	MOVE A,PTRTAB		; Table address
SRPDL1:	AOS A			; Step
	HLRZ B,(A)		; Get address of string
	JUMPE B,SRPDL2		; When we hit a zero, end of table
	HRRZ B,(A)		; Get address of data
	SKIPN B			; Already zero?
	JRST SRPDL1		; Yes, no data to find here. Move along.
	HLRZ C,(B)		; Get LH of data word
	JUMPN C,SRPDL1		; If not zero, this isn't an alias, so keep going
	HRRZ C,(B)		; LH=0. This is an alias. Points to whom?
	CAMN C,COMPAD		; Is it me?
	AOS COUNTP		; Yes, somebody pointing here
	JRST SRPDL1		; No, keep looking
SRPDL2:	SKIPN COUNTP		; Anybody pointing to me?
	IFSKP.			; Yes, release my data if I'm a physical printer
          HRRZ A,@ALILOC	; Data address  for this entry
          SKIPE A		; Already zero?
	  IFSKP.  
	    CALL PION
            ERROR <There are aliases pointing to this deleted entry> ;Yes, nothing more to do
	  ENDIF.
          ETYPE <%%There are aliases pointing to this entry
>				; Give 'em a warning
          HRRZ B,@ALILOC	;   .."physical printer"
	  HLRZ C,(B)		; Was I a "p.p"?
	  SKIPN C		; Well?
	  JRST SRPDL3		; No
;SOMEBODY WAS POINTING TO THIS ENTRY, SO WE DON'T TBDEL - WE JUST RELEASE
;ANY PHYSICAL PRINTER INFO (THE RH OF THIS ENTRY WILL BECOME 0 ANYWAY)

          SOS B			; Yes, so release my "p.p" data - starting here
	  MOVE A,(B)		; Block size
	  CALL RETBUF		; (A,B/ ) Give back the freespace
	  JRST SRPDL3
	ENDIF.
	
;NOBODY WAS POINTING TO THIS ENTRY - GO AHEAD AND WIPE IT OUT

        HRRZ A,PTRTAB           ; Table addr
        HRRZ B,ALILOC           ; This entry
        TBDEL			; Wipe it out
         IFJER.
	   CALL PION
           ETYPE <Could not delete REMOTE-PRINTER - %?
>                               ; Failed - this is unlikely
	   RET
	 ENDIF.
	CAME B,DEFADR		;[4417]Did we just deleted our default printer
	IFSKP.			;[4417]Yes,
	  CALL SRPDL4		;[4417]Tell the user
	ELSE.			;[4417]No
	  HRLM B,DEFADR		;[4417]Setup DEFADR for UPDFPR
	  CALL UPDFPR		;[4417]See if we have to adjust the entry in
				;[4417] PTRTAB so that the default printer is
				;[4417] still pointing at the right entry
	   SOS DEFADR		;[4417]Adjust the pointer
	  HRRZS DEFADR		;[4417]Clear the left half
	ENDIF.
	CALL PION		;[4417]
	RET

;HERE WHEN SOMEBODY WAS POINTING TO THE ENTRY TO DELETE

SRPDL3:	SETZ A,			; Get a zero
	HRRM A,@ALILOC		; Put in RH of table entry for this string
	MOVE A,DEFADR		;[4417]Get default printer addr
	CAMN A,ALILOC		;[4417]Are we deleting it
	CALL SRPDL4		;[4417]Yes,
	CALL PION
	RET			; Done
	ENDSV.
	ENDTV.

SRPDL4:	HRROI A,DEFREM		;[4417]Get default remote printer name
	ETYPE <Default printer %1M no longer applies to the PRINT command>
	SETZM DEFADR		;[4417]Clear default addr
	SETZM DEFQUE		;[4417]Clear just queue name
	SETZM DEFREM		;[4417]Clear default alias name
	SETZRO PR%RDF,PRIFLG	;[4417]Clear default /REMOTE seen
	SKIPE DEFDST		;[4417]Any default /DEST
	SETONE PR%DDF,PRIFLG	;[4417]Yes,
	RET			;[4417]
$ESET:	TABLE
	T CLUSTER-INFORMATION,ONEWRD,SETINF ;[7.1076] ^ESET CLUSTER-INFO
	T CLUSTER-SENDALLS,ONEWRD,SETTMG ;[7.1076] ^ESET CLUSTER-SENDs
	T DATE-AND-TIME,,SETTAD		;^ESET SYSTEM DATE-AND-TIME
	T FAST-LOGINS-ALLOWED,ONEWRD,SETFST ;^ESET FAST-LOGINS-ALLOWED
	T LEVEL-ONE-MESSAGE,ONEWRD,SETMS1 ;^ESET LEVEL-ONE-MESSAGES
	T LEVEL-ZERO-MESSAGES,ONEWRD,SETMS0 ;^ESET LEVEL-ZERO-MESSAGES
	T LOGINS-ALLOWED,,TTYLOG	;^ESET LOGINS-ALLOWED
	T MINIMUM-PASSWORD-LENGTH,,SETMPL ;[7.1231] ^ESET MINIMUM-PASSWORD-LENGTH
	T NO,NOLG,ESETNO		;^ESET NO
	T OFFLINE-STRUCTURES,,ENAOFS 	;[7.1063] ^ESET OFFLINE-STRUCTURES
	T OPERATOR-IN-ATTENDANCE,ONEWRD,SETOPR	;^ESET OPERATOR
	T PASSWORD-DICTIONARY,ONEWRD,SETPWD ;[4416] ^ESET Password dictionary
	T PASSWORD-EXPIRATION,,STPEXP	;[4412] ^ESET PASS-EXP
	T PRIVATE-QUASAR,,.GDEBG	;^ESET PRIVATE-QUASAR
	T RUN-TIME-GUARANTEE,,.JRUNG	;^ESET JOB RUN-TIME
	T SYSTEM-ACCESS-CONTROL-JOB,,SETACJ ;[4412] ^ESET SYSTEM-ACJ
	T TERMINAL,,ETERMI		;^ESET TERMINAL (NUMBER)
	T WORKING-SET-PRELOADING,ONEWRD,SETWSP ;^ESET WORKING-SET-PRELOADING
	TEND

ESETNO:	SETOM SETNOF		;FLAG NO TYPED
	KEYWD $ESETN
	 0
	 JRST CERR
	TXNE P3,NOLG		;NEED TO BE LOGGED IN?
	SKIPE CUSRNO		;YES, ARE WE?
	CAIA			;OK
	ERROR <LOGIN please>
	JRST (P3)		;DISPATCH TO COMMAND

$ESETN:	TABLE
	T CLUSTER-INFORMATION,ONEWRD,SETINF ;[7.1076] ^ESET NO CLUSTER-INFO
	T CLUSTER-SENDALLS,ONEWRD,SETTMG ;[7.1076] ^ESET NO CLUSTER-SENDs
	T FAST-LOGINS-ALLOWED,ONEWRD,SETFST ;^ESET FAST-LOGINS-ALLOWED
	T LEVEL-ONE-MESSAGE,ONEWRD,SETMS1 ;^ESET NO LEVEL-ONE-MESSAGES
	T LEVEL-ZERO-MESSAGES,ONEWRD,SETMS0 ;^ESET NO LEVEL-ZERO-MESSAGES
	T LOGINS-ALLOWED,,TTYLOG	;^ESET NO LOGINS-ALLOWED
	T MINIMUM-PASSWORD-LENGTH,ONEWRD,DISMPL ;[7.1231] ^ESET NO MINIMUM-PASSWORD-LENGTH
	T OFFLINE-STRUCTURES,ONEWRD,DISOFS ;[7.1063] ^ESET NO OFFLINE-STRUCTURES
	T OPERATOR-IN-ATTENDANCE,ONEWRD,SETOPR	;^ESET NO OPERATOR
	T PASSWORD-DICTIONARY,ONEWRD,SETPWD ;[4416] ^ESET Password Dictionary
	T PASSWORD-EXPIRATION,ONEWRD,DISEXP ;[4412] ^ESET NO PASS-EXP
	T PRIVATE-QUASAR,,.GDEBG	;^ESET NO PRIVATE-QUASAR
	T RUN-TIME-GUARANTEE,,.JRUNG	;^ESET NO RUN-TIME
	T WORKING-SET-PRELOADING,ONEWRD,SETWSP ;^ESET NO WORKING-SET-PRELOADING
	TEND
;"^ESET TERMINAL (NUMBER)"

ETERMI:	TRVAR <ETNM,ETRG,ETTN>
	NOISE <NUMBER>
	OCTX <Octal terminal number>
	 CMERRX
	MOVEM B,ETTN		;SAVE TERMINAL NUMBER
	CALL ETSET		;OBTAIN TERMINAL DESIGNATOR
	MOVEM B,ETNM		;SAVE DESIGNATOR
	MOVEM B,ETRG		;ASSUME THIS IS THE HIGHEST
	MOVEI B,$ETRM		;GET FIELDS TO PARSE
	CALL FLDSKP		;PARSE TERMINAL NUMBER OR KEYWORD
	 CMERRX			;PARSING ERROR
	HRRZ C,C		;ISOLATE FIELD PARSED
	HRRZ P3,(B)		;GET TABLE ADDRESS IF KEYWORD
	MOVE P3,(P3)		;ISOLATE ROUTINE
	CAIE C,$ETRM		;JUST TYPED KEYWORD?
	 JRST ETKEY		;YES - SKIP RANGE PROCESSING
	MOVEM B,ETTN		;SAVE TERMINAL NUMBER
	CALL ETSET		;OBTAIN TERMINAL DESIGNATOR
	MOVEM B,ETRG		;SAVE DESIGNATOR
	MOVE A,ETNM		;GET STARTING TERMINAL DESIGNATOR
	CAMGE B,A		;VALID RANGE?
	 ERROR <Invalid terminal range>  ;NO, ERROR
	KEYWD $ETERM
	 T SPEED,,SPEEDA
	 JRST CERR
ETKEY:	MOVE A,ETNM		;GET STARTING TERMINAL DESIGNATOR
	MOVE B,ETRG		;GET HIGHEST RANGE DESIGNATOR
	JRST (P3)		;SET SPEEDS
ETSET:	MOVE A,CSBUFP		;GET SOME SCRATCH SPACE
	MOVEI C,0		;END STRING ON NULL
	HRROI B,[ASCIZ /TTY/]	;MAKE DEVICE NAME
	SOUT
	MOVE B,ETTN		;GET NUMBER HE TYPED
	MOVEI C,8		;OCTAL
	NOUT			;MAKE "TTYnnn"
	 ERCAL JERRE		;SHOULD NEVER FAIL
	MOVE A,CSBUFP		;POINT AT THE NAME
	STDEV			;GET DESIGNATOR FOR IT
	 ERCAL CJERRE		;FAILED, TELL USER TERMINAL DOESN'T EXIST
	RET			;RETURN WITH DESIGNATOR

$ETERM:	TABLE
	T SPEED,,SPEEDA
	TEND

$ETRM:	FLDDB. .CMNUM,CM%SDH,8,<Highest octal terminal number if specifing range>,SPEED,[FLDDB. .CMKEY,CM%DPP,$ETERM]
;"^ESET [NO] SYSTEM LOGINS-ALLOWED"

TTYLOG:	NOISE <ON>
	KEYWD $LGTTY
	 T ANY-TERMINAL,ONEWRD,.ANTTY
	 JRST CERR
	JRST (P3)

$LGTTY:	TABLE
	T ANY-TERMINAL,ONEWRD,.ANTTY
	T ARPANET-TERMINALS,ONEWRD,.NVTTY
	T CONSOLE-TERMINAL,ONEWRD,.CNTTY
	T DECNET-TERMINALS,ONEWRD,.MCTTY
	T LAT-TERMINALS,ONEWRD,.LTTTY 		;[3041][7.1091]
	T LOCAL-TERMINALS,ONEWRD,.LCTTY
	T PSEUDO-TERMINALS,ONEWRD,.PSTTY
	T REMOTE-TERMINALS,ONEWRD,.RMTTY
	TEND
;DO SET FOR ALL TERMINALS

.ANTTY:	CALL .CNTTY
	CALL .LCTTY
	CALL .NVTTY
	CALL .PSTTY
	CALL .MCTTY
	CALL .LTTTY				;[7.1091
;	CALLRET .RMTTY

.RMTTY:	MOVEI A,.SFRMT
DOSTTY:	SKIPE SETNOF		;NO?
	TDZA B,B		;DISALLOW LOGINS
	MOVEI B,1		;ALLOW LOGINS
	SMON
	 ERCAL CJERRE
	RET

.CNTTY:	MOVEI A,.SFCTY
	JRST DOSTTY

.LTTTY:	MOVEI A,.SFLAT		;[3041][7.1091] LAT terminals
	JRST DOSTTY		;[3041]Do SMON

.LCTTY:	MOVEI A,.SFLCL
	JRST DOSTTY

.NVTTY:	MOVEI A,.SFNVT
	JRST DOSTTY

.PSTTY:	MOVEI A,.SFPTY
	JRST DOSTTY

.MCTTY:	MOVEI A,.SFMCB		;GET DECNET CODE
	JRST DOSTTY		;CONTINUE AT LOGIN TEST

;^ESET FAST-LOGINS-ALLOWED

SETFST:	MOVX A,.SFXEC		;GET THE EXEC FLAGS WORD
	TMON
	 ERCAL CJERRE		
	TXO B,XC%FST		;SET THE NO FAST LOGINS FLAG BY DEFAULT
	SKIPN SETNOF		;^ESET NO FAST-LOGINS-ALLOWED ?
	 TXZ B,XC%FST		;NO.  ALLOW IT
	SMON			;SET THE FLAGS WORD
	 ERCAL CJERRE
	RET

;[7.1231] ^ESET MINIMUM-PASSWORD-LENGTH character-count

SETMPL:	STKVAR <MINLEN>		;Place to save parsed number
	MOVEI B,[FLDDB. .CMNUX,<CM%SDH>,^D10,<minimum number of characters a password must be>]		;Get a number
	CALL FLDSKP		;(A,B/) Get length
	 CMERRX			;User made a mistake
	CAIL B,1		;Is it at least this?
	CAILE B,^D39		;But not more than this?
	JRST SETMP1		;It's bad, say error
	MOVEM B,MINLEN		;Save for now
	CONFIRM			;Tie off the input
	MOVEI A,.SFMPL		;Say setting min password length
	MOVE B,MINLEN		;Get count
	SMON%			;Set it
	 ERJMP CJERRE		;Report any failure
	RET			;And done

SETMP1:	ERROR <Must be between 1 and 39>
	RET

	ENDSV.

;[4412] ^ESET SYSTEM-ACJ gets here
SETACJ:	CONFIRM			;Parse a CRLF
	MOVEI A,.SFACJ		;Get function
	SETZ B,			;Say we want to enable
	SMON%			;Try it
	 ERJMP CJERRE		;Couldn't do it, tell user why
	RET			;Done, back to command level

;[4412] ^ESET PASS-EXP does work here
STPEXP:	STKVAR <EXPDAY>		;Place to save parsed number
	MOVEI B,[FLDDB. .CMNUX,<CM%SDH>,^D10,<number of days a password remains valid>] ;Get a number
	CALL FLDSKP		;(A,B/) Get days
	 CMERRX			;User made a mistake
	CAIL B,1		;Is it at least this?
	CAILE B,^D366		;But not more than this?
	JRST STPXP1		;It's bad, say error
	MOVEM B,EXPDAY		;Save for now
	CONFIRM			;Tie off the input
	MOVEI A,.SFPEX		;Say setting min password length
	MOVE B,EXPDAY		;Get count
	SMON%			;Set it
	 ERJMP CJERRE		;Report any failure
	RET			;And done

STPXP1:	ERROR <Must be between 1 and 366 days>
	RET

	ENDSV.

;^ESET NO PASS-EXP
DISEXP:	MOVEI A,.SFPEX		;Get function
	JRST SETMSS		;And disable it
;[7.1063]"^ESET OFFLINE STRUCTURES mm:ss"

ENAOFS:	STKVAR <MINUTE,SECOND>	;Reserve some storage
	NOISE <timeout interval> ;Some guide words
	MOVEI B,[FLDDB. .CMCFM,<CM%SDH>,,<return to set to 5 seconds>,,[
		 FLDDB. .CMNUX,<CM%SDH>,^D10,<timeout interval in the form mm:ss>,,]] ;[7.1147]
	CALL FLDSKP		;Get minutes or confirm
	 CMERRX			;Couldn't parse it
	LDB C,[POINTR ((C),CM%FNC)] ;[7.1147]Get COMND% function parsed
	CAIE C,.CMCFM		;End of line?
	IFSKP.			;If yes...
	 MOVEI B,^D5		;[7.1147]Load up default timeout
	 JRST OFS1		;And go do SMON%
	ENDIF.			;
	MOVEM B,MINUTE		;Save the minutes
	MOVE A,[POINT 7,[ASCIZ/:/]] ;Get default
	MOVEM A,CMDEF		;Save in FDB
	COLONX <timeout interval in the form mm:ss> ;Parse a colon
	 CMERRX			;COMND% failed
	DECX <timeout interval in the form mm:ss> ;Get a decimal number
	 CMERRX			;COMND% failed
	MOVEM B,SECOND		;Save the seconds
	CONFIRM			;Confirm the command
	SKIPL A,MINUTE		;Get the minutes given
	CAIL A,^D60		;And range check it
	JRST BADTIM		;Must be >= 0 and < 60
	IMULI A,^D60		;And convert this to seconds
	SKIPL B,SECOND		;Get the seconds given
	CAIL B,^D60		;And range check it
	JRST BADTIM		;Must be >= 0 and < 60
	ADD B,A			;Get the total number of seconds
	JUMPE B,BADTIM		;Must be non-zero to enable
OFS1:	MOVEI A,.SFOFS		;Get the SMON% function code
	SMON%			;And try to set the interval
	 ERJMP CJERRE		;Go complain about it
	RET			;Done

	ENDSV.
;[7.1063]
; Here if the minutes or seconds specified above are bogus
;
BADTIM:	ERROR <Invalid time specified> ;Display error message
	RET			;Done

;[7.1063]"^ESET NO OFFLINE-STRUCTURES"

DISOFS:	MOVEI A,.SFOFS		;Get SMON% function code
	JRST SETMSS		;Join common code

;[7.1231] ^ESET NO MINIMUM-PASSWORD-LENGTH

DISMPL:	MOVEI A,.SFMPL		;Get SMON% function code
	JRST SETMSS		;Join common code

;[7.1076] ^ESET [NO] CLUSTER-INFORMATION

SETINF:	MOVEI A,.SFCLU		;Here's the SMON% function
	JRST SETMSS		;Do the setting

;[7.1076] ^ESET [NO] CLUSTER-SENDALLS

SETTMG:	MOVEI A,.SFTMG		;Here's the SMON% function
	JRST SETMSS		;Join the common code

;"^ESET SYSTEM OPERATOR-IN-ATTENDANCE"

SETOPR:	MOVEI A,.SFOPR
	JRST SETMSS		;JOIN COMMON CODE
;[4416]
SETPWD:	MOVEI A,.SFPWD		;[4416] Get password dictionary
	JRST SETMSS		;[4416] And join common code
;"^ESET LEVEL-ZERO-MESSAGES"

SETMS0:	MOVEI A,.SFMS0		;GET THE SMON FUNCTION
SETMSS:	SETO B,			;ASSUME WE ARE SETTING
	SKIPE SETNOF		;IS IT A NO COMMAND?
	 SETZ B,		;YES OF COURSE
	SMON			;SET THE WORD FOR THE MONITOR
	 ERCAL CJERRE
	RET			;AND GET ANOTHER COMMAND

;"^ESET LEVEL-ONE-MESSAGES"

SETMS1:	MOVEI A,.SFMS1		;GET THE SMON FUNCTION
	JRST SETMSS		;JOIN COMMON CODE

;"^ESET WORKING-SET-PRELOADING"

SETWSP:	MOVEI A,.SFWSP		;GET THE SMON FUNCTION
	JRST SETMSS		;JOIN COMMON CODE
;^ESET PRIVATE-QUASAR ON OR OFF

GQFDB:	FLDDB. .CMUSR,,,,,[		;USER ID ONE POSSIBILITY
	FLDDB. .CMCFM     ]		;END OF LINE ANOTHER POSSIBILITY

.GDEBG:	NOISE <for private GALAXY>
	SKIPE	SETNOF		;OFF?
	JRST	[CONFIRM	;YES - GET CONFIRMATION
		 SETZM QSRPID	;GET IT, CLEAR QUASAR'S PID
		 SETZM NEBPID	;[7.1232] Clear NEBULA's PID too
		 RET    ]	;AND RETURN
	MOVEI B,GQFDB		;POINT TO FDB ADDRESS
	CALL FLDSKP		;SEE WHAT THE USER TYPED
	 ERROR	<Invalid userid specified>
	LDB A,[331100,,.CMFNP(C)] ;FIND OUT WHAT GOT TYPED
	CAIN A,.CMCFM		;END OF LINE?
	TDZA B,B		;YES - ZERO AC 2 AND SKIP
	CONFIRM			;NO - GET CONFIRM
	MOVE A,B		;GET THE USERID IN A
	CALL GQSRPD		;GET PRIVATE QUASAR PID
	RET			;RETURN
.JRUNG:	NOISE <FOR JOB>
	DECX <Job number in decimal>
	 CMERRX
	PUSH P,B		;SAVE JOB NUMBER
	SKIPE SETNOF		;NO?
	JRST	[SETZ B,	;YES, 0 PERCENTAGE
		JRST .JRUN1]
	NOISE <TO>
	DECX <Percentage>
	 CMERRX
	NOISE <PERCENT>
	CAIL B,1
	CAILE B,^D100
	ERROR <Run time guarantee percentage must be from 1-100>
.JRUN1:	CONFIRM
	HRLZ B,B		;MAKE LEFT HALF NUMBER
	POP P,A			;GET JOB NUMBER BACK
	SJPRI			;SET IT
	 ERJMP CJERRE
	RET
;SET TIME-LIMIT (TO) N

.STMLM::NOISE <TO>
	DECX <Number of seconds>
	 CMERRX
	NOISE <SECONDS>
	CONFIRM
	JUMPE B,[ERROR <Use "SET NO TIME-LIMIT">]
	JUMPL B,[ERROR <Negative number not allowed>]
	IMULI B,^D1000		;MAKE IT MILLISECONDS
	PUSH P,B
	MOVEI A,.FHJOB
	RUNTM			;GET TIME IN MILLISECONDS
	POP P,B
	ADD B,A			;ADD TO GET FINAL RUNTIME
	CAIGE B,^D1000		;IS IT LESS THAN 1 SECOND?
	MOVEI B,^D1000		;OK, MAKE IT 1 SECOND INSTEAD
	MOVE A,[.FHJOB,,.TIMRT]	;SET TIME LIMIT CODE
	MOVEI C,4		;CHANNEL
	TIMER
	 CALL CJERR
	RET

.NOTIM::CONFIRM
	IFNBATCH NOTIM1
	MOVE A,[.FHJOB,,.TIMRT]	;SET TIME LIMIT CODE
	SETZB B,C		;NO TIME, (HENCE NO CHANNEL)
	TIMER
	 CALL CJERR
	RET

NOTIM1:	ERROR <Attempt to clear time limit during BATCH process>

;^ESET SYSTEM TIME-AND-DATE (TO)

SETTAD::NOISE <TO>
	DTX <Date and time>
	 CMERRX
	CONFIRM			;CHECK TERMINATOR, INPUT CR IF NECESSARY
	MOVE A,B		;PUT TIME AND DATE INTO AC1
	STAD			;SET TIME AND DATE
	 CALL CJERR
	RET
ECEASE::TRVAR <DWNAT>
	NOISE <TIMESHARING AT>
	DTX <Date/time, or NOW for immediately, or null to cancel shutdown>
	 JRST CEASE3
DT1:	MOVEM B,DWNAT		;SAVE CURRENT DOWN TIME
	NOISE <RESUMING AT>
	DTX <Date and time of restart or null if unknown>
	 JRST CEASE4		;NO DATE AND TIME TYPED
CEASE1:	CONFIRM
	SKIPN A,DWNAT
	JRST CEASE2		;SKIP CHECK IF CANCELING
	CALL ECCNFM		;REALLY CONFIRM THE CEASE
	GTAD
	SETO C,			;CHECK FOR IMMEDIATE FLAG
	CAMN C,DWNAT		;MATCH ?
	 JRST [MOVEM A,DWNAT	;YES.  NOW CHECK "DOWN AT" TIME
	       JRST EC1A]	;CHECK "RESUME AT" TIME
	CAML A,DWNAT
	ERROR <Down time has already passed>
EC1A:	JUMPE B,CEASE2
	CAMGE B,DWNAT
	ERROR <Timesharing will resume before it ends!>
CEASE2:	MOVE A,DWNAT		;GET TIME TO GO DOWN
	HSYS			;DO THE SHUTDOWN
	 JRST CJERR
	RET

CEASE3:	KEYWD $ECNOW		;SEE IF USER TYPED A KEYWD
	 0			;NO DEFAULT
	 JRST EC3A     		;NO. NULL RESPONSE
	MOVE B,[-1]		;FLAG THE "NOW"
	JRST DT1		;SEE IF ANY RESUME AT TIME

EC3A:	SETZM DWNAT		;FLAG FOR CANCEL
CEASE4:	SETZ B,			;NO RESUME AT TIME
	JRST CEASE1

$ECNOW:	TABLE			;ARG TABLE FOR "NOW"
	T NOW,,0
	TEND
;Here to re-confirm the ^Ecease. Lots of systems are on networks now,
;and people have more than once ^Ecease'd the wrong system.
ECCNFM:	SAVEAC <B>
	CALL GETNOD		;TRY TO GET THE DECNET 
	 JRST ECARPA		;PROBABLY NO DECNET.  TRY ARPA
	ETYPE < %1M>		;TYPE OUT DECNET NAME
	JRST ECNAMD		;NAME HAS BEEN TYPED. DON'T TRY ARPA.
ECARPA:	ETYPE < >
	MOVEI A,.GTHSZ		;NOW TRY ARPANET 
	GTHST			;GET LOCAL HOST NUMBER
	 ERJMP ECNAMD		;PROBABLY NO ARPA
	MOVEI A,.GTHNS		;RETURN HOST STRING TO THE
	MOVE B,COJFN		; OUTPUT DESIGNATOR
	MOVE C,D		;PICK UP LOCAL HOST NUMBER 
	GTHST			;TYPE THE HOST NUMBER OUT
	 ERJMP .+1		;FAILS IF NO HOST # ON ARPA MONITOR
ECNAMD:	MOVE A,DWNAT		;GET DOWNTIME BACK
	CAME A,[-1]		;IS IT IMMEDIATELY
	 ETYPE < Shut down scheduled for %1D %1E> ;NO
	CAMN A,[-1]
	 ETYPE < Will be shut down IMMEDIATELY > ;YES
	CALL FCONF
	RET
;SET TYPEOUT CONTROLS HOW MEMORY ADDRESSES AND CONTENTS ARE DISPLAYED.

.TYPEO::KEYWD TYTAB
	 T MODE
	 CMERRX
	CALLRET (P3)		;EXIT THROUGH SPECIFIED KEYWORD ROUTINE

TYTAB:	TABLE
	T MODE
;	T RADIX		;ETC.
	TEND

.MODE:	NOISE (to)
	KEYWD MODTAB
	 0
	 CMERRX
	CALLRET (P3)

MODTAB:	TABLE
;	T ASCII
	T NUMERIC,ONEWRD
	T SYMBOLIC,ONEWRD
	TEND

.NUMER:	SETZM SYMF		;SAY NOT SYMBOLIC
	RET

.SYMBO:	SETOM SYMF		;SAY SYMBOLIC
	RET
END