Google
 

Trailing-Edge - PDP-10 Archives - BB-M081M-SM - exec/execse.mac
There are 47 other files named execse.mac in the archive. Click here to see a list.
; *** 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
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 1980,1985
;ALL RIGHTS RESERVED.

	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::NOISE <TO>		;OR STRING.
	CALL ACCT		;INPUT, CHECK, CONVERT ACCT INTO A (USES A B1)
	PUSH P,A		;SAVE POINTER TO ACCOUNT
	NOISE (SESSION REMARK)
	CALL GSR		;GET SESSION REMARK
	EXCH A,(P)		;GET ACCOUNT, SAVE REMARK
	CONFIRM
	CACCT			;JSYS TO CHANGE ACCOUNT #
	 CALL CJERR
	POP P,A			;GET SESSION REMARK POINTER
	CALL SSR		;SET SESSION REMARK
	JRST CMDIN4

;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
;**;[3007]Add four lines at PSPNAM+9L		DEE	8-AUG-85
	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.

;**;[3013]Rework code at TPROC:			DEE	15-AUG-85
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
;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

;**;[3040] Rework .MWATC::			DEE	23-Jun-86
.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
;"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
	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
	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
;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
;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		;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
$ESET:	TABLE
	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 NO,NOLG,ESETNO		;^ESET NO
	T OPERATOR-IN-ATTENDANCE,ONEWRD,SETOPR	;^ESET OPERATOR
	T PRIVATE-QUASAR,,.GDEBG	;^ESET PRIVATE-QUASAR
	T RUN-TIME-GUARANTEE,,.JRUNG	;^ESET JOB RUN-TIME
	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 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 OPERATOR-IN-ATTENDANCE,ONEWRD,SETOPR	;^ESET NO OPERATOR
	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
;**;[3041] Add 1 line at $LGTTY: + 5 L		JDM	24-Jun-86
	T LAT-TERMINALS,ONEWRD,.LATTY 		;[3041]
	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
;**;[3042] Add 1 line at .ANTTY: + 5 L		JDM	26-Jun-86
	CALL .LATTY
;	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

;**;[3041] Add 3 lines at .LCTTY: - 1 L		JDM	24-Jun-86
.LATTY:	MOVEI A,.SFLAT		;[3041]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


;"^ESET SYSTEM OPERATOR-IN-ATTENDANCE"

SETOPR:	MOVEI A,.SFOPR
	JRST SETMSS		;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
		 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