Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - mit/exec/execse.mac
There are 47 other files named execse.mac in the archive. Click here to see a list.
;[MIT-XX]SRC:<EXEC.TEST>EXECSE.MAC.14, 14-Mar-85 00:41:10, Edit by JTW
;131 SET [NO] LOGIN CHAOS and DECNET, and conditionalize this command
;    so that nonexistant net TTY types won't appear at all.
;[MIT-XX]SRC:<EXEC.TEST>EXECSE.MAC.10, 20-Aug-84 21:52:52, Edit by JTW
;114 Add SET FILE [NO] BACKUP
;112 Rewrite SET INTERUPT CHARACTER (For Command Editor)
;720 not logged in commands handled in seperate command tables
;716 add command-edit features
;715 add CMU 5(100) PCL features
;713 add literals label
;   use new configuration switches
;712 DEC release version
; UPD ID= 126, SNARK:<5.EXEC>EXECSE.MAC.5,  28-Dec-81 11:18:25 by CHALL
;TCO 5.1644 - UPDATE COPYRIGHT NOTICE
; UPD ID= 107, SNARK:<5.EXEC>EXECSE.MAC.4,   6-Nov-81 13:31:17 by CHALL
;TCO 5.1602 ALRDL7- FIX: "SET NO AL BEF" CLEARED ALL ALERTS
; UPD ID= 42, SNARK:<5.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:<5.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:<5.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:<5.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:<5.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:<5.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
;<5.EXEC>EXECSE.MAC.3, 12-Jun-81 14:18:33, EDIT BY HELLIWELL
;MAKE .KFRKC AND .NOLM INTERNAL (::)
; UPD ID= 1729, SNARK:<5.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
;<4.EXEC>EXECSE.MAC.127, 12-Sep-79 15:35:33, Edit by HESS
; Fix mail-watch timers init (XTND only)
;<4.EXEC>EXECSE.MAC.126, 10-Sep-79 17:56:01, Edit by HESS
; TIMER JSYS requires valid chl even if clearing (See .AUTO2 , XTND only)
;<4.EXEC>EXECSE.MAC.125,  5-Sep-79 13:37:45, EDIT BY OSMAN
;TCO 4.2443 - Fix SET DIRECTORY PASSWORD
;<4.EXEC>EXECSE.MAC.124,  5-Sep-79 09:34:58, EDIT BY OSMAN
;tco 4.2439 - Don't run QUENCH on SET DIRECTORY PASSWORD
;<4.EXEC>EXECSE.MAC.123,  4-Sep-79 14:31:13, Edit by HESS
; Have SET NO ALERT<CR> clear all alerts (XTND only)
; Always ring bell on alert / Fix help message.
;<4.EXEC>EXECSE.MAC.121, 31-Aug-79 16:02:48, EDIT BY OSMAN
;MORE 4.2404 - Don't prompt for password unless it was not given and that's
;what's wrong.
;<4.EXEC>EXECSE.MAC.120, 30-Aug-79 17:58:10, Edit by HESS
; Add "SET NO LOGIN-MAIL" under XTND
;<HESS.E>EXECSE.MAC.23, 21-Aug-79 12:51:42, Edit by HESS
; Add extended features
;<4.EXEC>EXECSE.MAC.117, 16-Aug-79 10:14:46, EDIT BY OSMAN
;tco 4.2404 - Don't ask for password on SET DIRECTORY unless it fails without
;   it 
;<4.EXEC>EXECSE.MAC.115, 10-Aug-79 15:21:28, EDIT BY OSMAN
;tco 4.2385 - Allow escape and filespec after SET FILE INVIS FOO
;<4.EXEC>EXECSE.MAC.113,  1-Aug-79 10:22:00, EDIT BY OSMAN
;CHANGE $SETNO TO $SETN SINCE TRVAR OF SETNOF GENERATES $SETNO
;<4.EXEC>EXECSE.MAC.111,  1-Aug-79 10:12:33, EDIT BY OSMAN
;tco 4.2361 - Disallow SET NO DEFAULT TAKE
;MAKE SETNOF BE LOCAL
;<4.EXEC>EXECSE.MAC.110,  1-Aug-79 09:43:29, EDIT BY OSMAN
;tco 4.2360 - Handle illegal instruction trap on SET PAGE-ACCESS 2000
;<4.EXEC>EXECSE.MAC.109,  9-Jul-79 13:20:00, EDIT BY EKLUND
;check valid values for SET TAPE RECORD-LENGTH command
;<4.EXEC>EXECSE.MAC.108, 21-Jun-79 13:31:07, EDIT BY OSMAN
;REMOVE EXTRANEOUS CALLS TO RLJFNS
;tco 4.2304 - remove TAPE-RECYCLE commands
;<4.EXEC>EXECSE.MAC.107, 21-Jun-79 13:20:54, EDIT BY OSMAN
;put SET RETRIEVAL WAIT back in
;<4.EXEC>EXECSE.MAC.106, 19-Jun-79 13:10:15, EDIT BY OSMAN
;really do TCO 4.2268!
;<4.EXEC>EXECSE.MAC.105,  1-Jun-79 14:51:37, EDIT BY OSMAN
;tco 4.2268 - remove ^Eset retrieval-wait and ^Eset bias-control
;<4.EXEC>EXECSE.MAC.103,  2-Apr-79 13:30:56, EDIT BY OSMAN
;tco 4.2223 - CATCH "^ESET TERMINAL 4000 ..."
;<4.EXEC>EXECSE.MAC.102, 13-Mar-79 16:19:44, EDIT BY OSMAN
;remove all ^ESET STR commands.  (They are being moved to OPR)
;<4.EXEC>EXECSE.MAC.101, 12-Mar-79 18:05:17, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.EXEC>EXECSE.MAC.100,  8-Feb-79 15:49:08, EDIT BY OSMAN
;ADD SET [NO] DEFAULTS (FOR) PLOT
;<4.EXEC>EXECSE.MAC.99,  8-Feb-79 13:31:00, EDIT BY OSMAN
;tco 4.2184 - Fix "^ESET NO RUNTIM-GUARANTEE" which used to work.
;<4.EXEC>EXECSE.MAC.97,  7-Feb-79 21:40:21, EDIT BY KIRSCHEN
;MAKE SET DEFAULT TAKE WORK AS PER EXEC.MEM SPEC
;<4.MONITOR>EXECSE.MAC.1,  7-Feb-79 10:40:06, EDIT BY OSMAN
;ON "SET LOCATION", MERELY DON'T HAVE A DEFAULT IF NO DECNET PRESENT
;<4.EXEC>EXECSE.MAC.94,  1-Feb-79 19:02:05, EDIT BY ACARLSON
;DELETE ^ESET DEBUG FUNCTION TO APPEASE BIG WIGS (CODE FREEZE)
;<4.EXEC>EXECSE.MAC.92,  1-Feb-79 14:20:29, EDIT BY HURLEY.CALVIN
; Clean up code in SET FILE PROHIBIT so nonx file doesn't blow up
;<4.EXEC>EXECSE.MAC.91, 31-Jan-79 20:29:02, EDIT BY ACARLSON
;Add ^ESET DEBUG (FOR PRIVATE GALAXY SYSTEM) ALSO 'NO DEBUG'
;<4.EXEC>EXECSE.MAC.89, 26-Jan-79 15:26:08, EDIT BY OSMAN
;put SET FILE INVISIBLE back in (take it out of XARC)
;<4.EXEC>EXECSE.MAC.88, 25-Jan-79 15:26:00, EDIT BY OSMAN
;AT PAC7, IT SHOULD BE ERCAL, NOT ERJMP
;<4.EXEC>EXECSE.MAC.87, 23-Jan-79 15:16:19, EDIT BY OSMAN
;ALLOW SET FILE [NO] PROHIBIT
;<4.EXEC>EXECSE.MAC.86, 22-Jan-79 10:07:51, EDIT BY OSMAN
;PUT XARC AROUND ONLINE-EXPIRED-FILES
;<4.EXEC>EXECSE.MAC.84, 18-Jan-79 18:06:14, EDIT BY OSMAN
;PUT XARC AROUND SET FILE EXPIRED/ON[OFF]LINE-EXPIRATION, SET DIR
;   ONLINE-EXPIRATION-DEFAULT 
;<4.EXEC>EXECSE.MAC.83, 18-Jan-79 17:57:26, EDIT BY OSMAN
;PUT XARC AROUND SET FILE [NO] RESIST/PROHIBIT/VISIBLE/INVISIBLE
;<4.EXEC>EXECSE.MAC.78, 16-Jan-79 18:22:35, EDIT BY OSMAN
;DEFAULT NODE NAME TO HOST NAME IN SET LOCATION
;<4.EXEC>EXECSE.MAC.77, 15-Jan-79 02:43:18, EDIT BY HEMPHILL
;MAKE "SET ADDRESS-BREAK" HANDLE LARGE ADDRESSES
;<4.EXEC>EXECSE.MAC.74,  5-Dec-78 11:26:26, EDIT BY OSMAN
;PUT IN ^ESET BIAS-CONTROL (FOR SCHEDULER)
;<4.EXEC>EXECSE.MAC.73,  1-Dec-78 11:41:04, EDIT BY KIRSCHEN
;<4.EXEC>EXECSE.MAC.72,  1-Dec-78 11:20:40, EDIT BY KIRSCHEN
;<4.EXEC>EXECSE.MAC.71,  1-Dec-78 10:41:01, EDIT BY KIRSCHEN
;ADD SET [NO] DEFAULT TAKE
;<4.EXEC>EXECSE.MAC.70, 29-Nov-78 14:54:06, EDIT BY OSMAN
;FIX ^ESET STRUCTURE DISMOUNTED (CHANGE ERCAL TO CALL)
;<4.EXEC>EXECSE.MAC.69, 17-Nov-78 18:44:40, EDIT BY HURLEY.CALVIN
; Fix SET FILE VISIBLE - MOVE A,@INIFH1 becomes HRRZ A,@INIFH1
;<4.EXEC>EXECSE.MAC.67, 10-Nov-78 09:10:49, EDIT BY OSMAN
;fix alphabetical order of set no defaults paper-tape/print, and remove garbage
;   from table 
;<4.EXEC>EXECSE.MAC.66,  7-Nov-78 05:18:00, Edit by CALVIN
; SAVE VIS/INVIS PARAMETER EARLIER SINCE SOMEONE NOW SEEMS TO CLOBBER IT
;<4.EXEC>EXECSE.MAC.65,  6-Nov-78 20:04:40, Edit by CALVIN
; CAUSE SET FILE VISIBLE TO PRINT ONLY FILES ACTUALLY BEING MADE VISIBLE
;<4.EXEC>EXECSE.MAC.64, 30-Oct-78 14:30:27, EDIT BY OSMAN
;FIX SET STR IGNORED (FORGOT TO CALL GOPID BEFORE SNDMSG)
;<4.EXEC>EXECSE.MAC.61, 26-Oct-78 15:56:39, EDIT BY OSMAN
;REMOVE REFS TO SSSBLK, GSSBLK, NAMBLK.  MAKE THESE LOCAL VARIABLES
;<4.EXEC>EXECSE.MAC.60, 25-Oct-78 17:09:46, EDIT BY OSMAN
;CHANGE NETOFF TO NETFF (WAS GETTING M FROM MACRO)
;<4.EXEC>EXECSE.MAC.59, 25-Oct-78 16:16:13, EDIT BY OSMAN
;ADD SET LOCATION
;<ARC-DEC>EXECSE.MAC.7, 23-Aug-78 10:15:54, EDIT BY CALVIN
; Add ^ESet TAPE-RECYCLE-PERIOD and ^ESet ARCHIVE-TAPE-RECYCLE-PERIOD
;<CALVIN>EXECSE.MAC.9, 11-Aug-78 15:23:16, EDIT BY CALVIN
; Install ^ESET [NO] RETRIEVAL-WAITS & SET DIR [NO] ARCHIVE-ONLINE...
;<CALVIN>EXECSE.MAC.7, 11-Aug-78 12:01:27, EDIT BY CALVIN
; Install Set file [no] prohibit/resist <files>, also fixup pagination
;<CALVIN>EXECSE.MAC.4,  9-Aug-78 15:54:20, EDIT BY CALVIN
; Install SET DIRECTORY OFF/ON-EXPIRATION-DEFAULT commands
;<CALVIN>EXECSE.MAC.3,  9-Aug-78 14:05:01, EDIT BY CALVIN
; Install SET FILE OFFLINE-EXP/ONLINE-EXP/EXPIRED commands
;[BBN-TEN; Add SET FILE VISIBLE/INVISIBLE <Files>
;<3-ARC-EXEC>EXECSE.MAC.2, 14-May-78 15:59:32, Edit by MTRAVERS
; Added SET [NO] RETRIEVAL-WAIT
;<3-ARC-EXEC>EXECSE.MAC.1, 14-May-78 15:38:30, Edit by MTRAVERS
; Added SET FILE VISIBLE/INVISIBLE to command tables
;<4.EXEC>EXECSE.MAC.52,  7-Oct-78 00:43:48, EDIT BY OSMAN
;TCO 4.2037 - Smarten up SET PAGE-ACCESS
;FIX SET PAGE-ACCESS
;<4.EXEC>EXECSE.MAC.48,  1-Oct-78 19:44:32, Edit by OSMAN
;REMOVE CALL GETPID AT SIG1+n
;GET RID OF B0 SYMBOLS
;<4.EXEC>EXECSE.MAC.46, 25-Sep-78 10:46:06, EDIT BY OSMAN
;REMOVE SET OLD/NEW-QUEUE-COMMANDS
;CHANGE ONEWD TO ONEWRD, NOLOG TO NOLG
;<4.EXEC>EXECSE.MAC.44, 17-Sep-78 16:49:58, EDIT BY OSMAN
;CHANGE $SET TO $SET0 ($SET IS A MACRO IN GLXMAC)
;<4.EXEC>EXECSE.MAC.43, 16-Sep-78 00:03:20, EDIT BY OSMAN
;REMOVE REFS TO CSBUFP
;<4.EXEC>EXECSE.MAC.42, 15-Sep-78 13:32:19, EDIT BY OSMAN
;Make tape densities global ($TDENS)
;<4.EXEC>EXECSE.MAC.41, 14-Sep-78 14:13:30, EDIT BY OSMAN
;ONLY SEARCH XDEF, TTITLE DOES REST
;<4.EXEC>EXECSE.MAC.40, 21-Aug-78 16:47:12, EDIT BY HELLIWELL
;REMOVE "SET EDITOR"
;<4.EXEC>EXECSE.MAC.39, 14-Aug-78 15:15:58, Edit by HELLIWELL
;ADD EMACS TO SET EDITOR UNDER NOSHIP
;<4.EXEC>EXECSE.MAC.38, 13-Aug-78 15:22:40, Edit by HELLIWELL
;<4.EXEC>EXECSE.MAC.37, 13-Aug-78 14:57:58, Edit by HELLIWELL
;<4.EXEC>EXECSE.MAC.36, 13-Aug-78 14:47:13, Edit by HELLIWELL
;<4.EXEC>EXECSE.MAC.35, 13-Aug-78 14:39:45, Edit by HELLIWELL
;<4.EXEC>EXECSE.MAC.34, 13-Aug-78 14:34:31, Edit by HELLIWELL
;<4.EXEC>EXECSE.MAC.33, 13-Aug-78 14:28:59, Edit by HELLIWELL
;<4.EXEC>EXECSE.MAC.32, 13-Aug-78 14:22:59, Edit by HELLIWELL
;<4.EXEC>EXECSE.MAC.31, 13-Aug-78 14:19:24, Edit by HELLIWELL
;<4.EXEC>EXECSE.MAC.30, 13-Aug-78 14:07:24, Edit by HELLIWELL
;ADD "SET EDITOR"
;<4.EXEC>EXECSE.MAC.29, 21-Jul-78 10:30:42, Edit by PORCHER
;FIX SET PAGE ACCESS ... NONEXISTENT WITH EX-ONLY PROCESSES
;<4.EXEC>EXECSE.MAC.25, 17-Jul-78 11:46:01, EDIT BY OSMAN
;REMOVE REFS TO GTBUF (USE LOCAL STORAGE INSTEAD)
;<4.EXEC>EXECSE.MAC.24, 13-Jul-78 14:16:48, EDIT BY OSMAN
;MAKE PASSP LOCAL
;<4.EXEC>EXECSE.MAC.23, 11-Jul-78 17:00:39, EDIT BY OSMAN
;USE LOCAL STORAGE FOR ^ESET TERMINAL
;<4.EXEC>EXECSE.MAC.22, 29-Jun-78 15:58:50, EDIT BY OSMAN
;make dirp local
;<4.EXEC>EXECSE.MAC.21, 29-Jun-78 15:35:42, EDIT BY OSMAN
;make cdrdev, cdrstr, cdrdck be trvar'd
;<4.EXEC>EXECSE.MAC.20, 23-Jun-78 21:21:12, EDIT BY OSMAN
;REMOVE UNREFERENCED SYMS: CRDINF, NOCDCK, STRCHK
;<4.EXEC>EXECSE.MAC.15, 22-Jun-78 14:28:49, EDIT BY OSMAN
;USE TIMER FOR MAIL-WATCH (AVOIDS DOING GTAD BEFORE EVERY COMMAND)
;<4.EXEC>EXECSE.MAC.13, 15-Jun-78 14:17:18, EDIT BY OSMAN
;ADD SET NO DEFAULT COMPILE-SWITCHES
;<4.EXEC>EXECSE.MAC.12, 13-Jun-78 14:20:28, EDIT BY OSMAN
;CHANGE COMPILER-SWITCHES TO COMPILE-SWITCHES
;<4.EXEC>EXECSE.MAC.11,  9-Jun-78 18:41:11, EDIT BY OSMAN
;ADD SET DEFAULT COMPILER-SWITCHES
;<4.EXEC>EXECSE.MAC.8,  9-Jun-78 18:08:52, EDIT BY OSMAN
;CHANGE CALLS TO FIELD TO FLDSKP
;<3-EXEC-SNARK>EXECSE.MAC.72, 20-Apr-78 11:14:50, Edit by FORTMILLER
;<3-EXEC-SNARK>EXECSE.MAC.71, 20-Apr-78 11:09:53, Edit by FORTMILLER
;<FORTMILLER>EXECSE.MAC.70, 14-Apr-78 09:07:46, Edit by FORTMILLER
;<4.EXEC>EXECSE.MAC.4, 31-May-78 16:47:36, EDIT BY OSMAN
;<4.EXEC>EXECSE.MAC.3, 31-May-78 16:45:19, EDIT BY OSMAN
;ADD SET DEFAULT CPUNCH AND SET DEFAULT TPUNCH
;<4.EXEC>EXECSE.MAC.2,  2-Mar-78 09:41:44, Edit by PORCHER
;Remove time used from SET ACCOUNT
;<4.EXEC>EXECSE.MAC.1,  1-Feb-78 09:51:20, Edit by PORCHER
;Add ERJMPs for execute-only
;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) 1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH EXECDE
	TTITLE EXECSE

;THIS FILE CONTAINS SET AND ^ESET COMMANDS

DEFINE SETSTG
    <	TRVAR <ATIME,NOW,AHELP,<ARANGE,2>,ENTADR,WBITS,SETNOF,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::  MOVEI A,[ASCIZ/^ESET/]	;7 setup for program name setup
	HRROM A,COMAND		;7
	SETSTG			;ALLOCATE LOCAL STORAGE
	SETZM SETNOF		;CLEAR NO FLAG
	KEYWD $ESET
	 0
	 JRST CERR
				;720 none are accessible from not logged in
;720	TXNN P3,NOLG		;NEED TO BE LOGGED IN?
;720	 SKIPE CUSRNO		;YES, ARE WE?
;720	  ABSKP			;OK
;720	   ERROR <LOGIN please>
	JRST (P3)		;DISPATCH TO COMMAND

;"SET" AND "SET NO"

.SET::	SETSTG			;ALLOCATE STORAGE
	SETZM SETNOF		;CLEAR NO FLAG
	SKIPE CUSRNO		;720 logged in?
	 JRST SET1		;720 yes
	KEYWD $ST0		;720 no
	 0			;720
	 JRST CERR		;720
	JRST (P3)		;720 dispatch

SET1:	SKIPN SIMPLE		;7 simple command level?
	 JRST SET2		;7 no
	KEYWD $ST1S		;7 yes
	 0			;7
	 JRST CERR		;7
	JRST (P3)		;7 dispatch

SET2:	KEYWD $ST1		;7 normal command level
	 0			;7
	 JRST CERR		;7
	JRST (P3)		;7 dispatch
;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
	RET			;7 style
;7	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
	ABSKP
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,[POINTR B,DV%TYP] ;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,FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!JS%PAF ;GET STR:<DIR>
	JFNS			;GET STRING
	 ERCAL JERRE
	MOVX A,RC%EMO		;NO RECOGNITION
	HRROI B,ABUF
	RCDIR			;CONVERT STRING BACK TO DIR # TO GET BITS
	TXNE 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
	MOVEM B,ABKCNT		;REMEMBER IT
	JRST ADBCNF		;7 make the code a little more compact

.ALL:	TXOA P1,AB%RED!AB%WRT!AB%XCT!1 ;7
.EXE:	 TXO P1,AB%XCT!1	;7
	JRST ADBCNF		;7

.REA:	TXOA P1,AB%RED!1	;7
.WRI:	 TXO P1,AB%WRT!1	;7
	ABSKP			;7
.NON:	 TXOA P1,1		;7
ADBCNF:	  NOISE <references>	;7 add local label
	CALLRET CONF		;CONFIRM AND RETURN
.SETNO::SETOM SETNOF		;FLAG NO TYPED
	SKIPE CUSRNO		;720 logged in?
	 JRST SETNO1		;720 yes
	KEYWD $ST0N		;720 no
	 0			;720
	 JRST CERR		;720
	JRST (P3)		;720 dispatch

SETNO1: SKIPN SIMPLE		;7 simple command level?
	 JRST SETNO2		;7 no
	KEYWD $ST1SN		;7 yes
	 0			;7
	 JRST CERR		;7
	JRST (P3)		;7 dispatch

SETNO2: KEYWD $ST1N		;7 normal command level
	 0			;7
	 JRST CERR		;7
	JRST (P3)		;7 dispatch
;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::	MOVEI B,[FLDDB. .CMCFM,CM%SDH,,<a carriage return to turn off all 
traps>,,[
		FLDDB. .CMKEY,,TRAPT]]
	CALL FLDSKP		;READ WHAT'S AFTER "SET NO TRAP" OR
				;   "SET TRAP NO" 
	 CMERRX
	GTFLDT D		;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

;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>
	SKIPN SETNOF		;DIFFERENT ACTION ACCORDING TO "NO" FLAG
	 SETZM TSTOPF		;SET TRAP PROCEED
	SKIPE SETNOF
	 SETOM TSTOPF		;SET NO TRAP PROCEED
	CALLRET CONF		;CONFIRM AND RETURN

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

TJSYS:	NOISE <named>
	MOVEI B,[FLDDB. .CMSWI,,JSWI,,,[
		FLDDB. .CMNUM,CM%SDH,10,<an octal JSYS value>,,[
		FLDDB. .CMFLD,CM%SDH,,<a JSYS name>,,]]]
	CALL FLDSKP		;READ JSYS NAME OR SWITCH
	 CMERRX <JSYS or switch required>
	GTFLDT D		;SEE WHAT WAS TYPED
	CAIN D,.CMNUM		;AN OCTAL NUMBER?
	 JRST  [MOVE Q1,B	;YES - SAVE THE JSYS VALUE
		JRST JGOOD1]	;AND GO PROCESS IT
	CAIN D,.CMSWI		;A SWITCH?
	 JRST  [CALL GETKEY	;YES, SEE WHICH ONE
		JRST (P3)]	;GO EXECUTE THE SWITCH
	MOVSI Q1,-JSLEN		;PREPARE TO SCAN LIST OF JSYS'S
JSCAN:	HRROI A,ATMBUF		;COMPARE ATOM BUFFER
	HRRO B,JTAB(Q1)		;WITH NAME FROM LIST
	STCMP			;COMPARE THEM
	JUMPE A,JGOOD		;GOT IT!
	AOBJN Q1,JSCAN		;KEEP LOOKING
	HRROI A,ATMBUF		;COULDN'T FIND IT
	ERROR <No such JSYS - %1M>

JGOOD:	MOVEI B,[FLDDB. .CMTOK,CM%SDH,TXTPTR <%>,<Optional "%">]
	CALL FLDSKP		;ALLOW % FOR ANY JSYS NAME
	 NOP			;NO SWEAT IF NO "%" TYPED
JGOOD1:	CONFIRM			;FINISH OFF THE TYPE-IN
	MOVEI B,JSBDEF		;USE DEFAULT BLOCK SINCE IT'S IMPOSSIBLE TO DO
				;   JUST ONE FORK CORRECTLY 
				;   (SEE COMMENT ON SETTRP)   
	HRRZ A,Q1		;SAY WHICH JSYS
	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]
	SKIPN SETNOF		;CLEAR OR SET BIT ACCORDING TO YES OR NO
	 CALL SETBIT		;SET APPROPRIATE BIT
	SKIPE SETNOF
	 CALL CLRBIT
	CALLRET MRKTRP		;SET UP NEW TRAP STATUS

;JTAB IS A TABLE OF JSYSES WITH EACH ENTRY OF THE FORM:
;
;	[ASCIZ/NAME/]
;
DEFINE DEFJS (NAME,VALUE,TRASH,TRASH,TRASH)
    <	RELOC JTAB+VALUE	;;ALLOW FOR GAPS IF SOME JSYSES UNDEFINED
	[ASCIZ/NAME/]
	IFG VALUE-LARGST,<LARGST==VALUE>>

	LARGST==0
JTAB::	JSLIST			;USE JSYS LISTER FROM MONSYM (CALLS DEFJS)
	JSLEN==.-JTAB		;LENGTH OF TABLE
	RELOC JTAB+LARGST+1	;ALLOW FOR JSYSES NOT BEING IN ORDER IN JSLIST

;JSWI IS TABLE OF SWITCHES FOR SET TRAP JSYS
JSWI:	TABLE
	T all,,JALL		;SET TRAP JSYS /ALL
	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
	JRST JALL2

JALNO:	CALL CLRALL
	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

;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
.CIDLY::NOISE <for commands>
	CONFIRM			;7 SPR #:20-18816 confirm before change 
	SETCM A,SETNOF
	MOVEM A,CIDLYF
;7	CALLRET CONF		;CONFIRM AND RETURN
	RET			;7

;SET LOCATION

DECN,<				;713
.LOCAT::NOISE <to>
	STKVAR <<NODFDB,.CMDEF+1>>
	MOVX A,FLD(.CMNOD,CM%FNC)!CM%PO!CM%DPP
	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
	SETO A,			;OURSELF
	MOVX B,.SJLLO		;SET LOGICAL LOCATION
	SETJB			;DO IT
	 ERCAL CJERRE		;FAILED, TELL USER WHY
	RET			;DONE
       >			;713 end DECN
NONEWF,<
.MWATC::SETCM C,SETNOF		;TURN ON OR OFF WATCHING OF MAIL FILE
	EXCH C,MWATCF		;FLAG FOR WATCHING IS 0 (DEFAULT) FOR NO
	CAMN C,MWATCF		;ANY CHANGE?
	 RET			;NO
	JUMPE C,MINT0		;IF WAS OFF, GO SET INTERRUPT AND RETURN
	MOVE A,[.FHSLF,,.TIMDD]	;REMOVE TIMER INTERRUPT
	MOVE B,MALWEN		;GET TIME AT WHICH INTERRUPT WAS TO OCCUR
	MOVX C,MALCHN		;6/23/78 TIMER REQUIRES CHANNEL BUT DOESN'T USE
				;   IT!!! 
	TIMER			;TURN OFF THE TIMER
	 ERNOP			;WILL FAIL IF TIMER ALREADY TIMED OUT
	RET
       >
;NOTE: THIS COULD CAUSE PROBLEMS IF THE EXEC IS USING TIMER TO TIME SOMETHING
;   ELSE, WHICH ALSO WANTS AN INTERRUPT AT THE SAME TIME. THIS TIMER HERE IN
;   THE MAIL CODE WOULD ERRONEOUSLY TURN OFF THE OTHER TIMER. WHAT IS NEEDED IS
;   FOR THE TIMER JSYS TO ALLOW US TO SPECIFY EXACTLY WHICH TIMER TO TURN OFF.
;   THIS WOULD PREVENT THIS PROBLEM. 
;ALSO, NOTE THAT IT IS INDEED NECESSARY TO TURN OFF THE TIMER HERE. IF WE
;   DIDN'T, THEN A USER TURNING MAIL OFF, ON, OFF, ON, OFF, ON ETC. WOULD PILE
;   UP TIMERS WHICH WOULD GIVE MORE INTERRUPTS THAN THEY'RE SUPPOSED TO, OR
;   WOULD HIT QUOTA CAUSING AN ERROR. 

NEWF,<		;MORE COMPREHENSIVE MAIL-WATCH AND ALERT FACILITY
.MWATC::NOISE <for user>
	CALL USRNAM		;INPUT USER NAME
	 ERROR <No such user>
	STKVAR <USRNUM>
	MOVEM C,USRNUM		;SAVE USER NUMBER
	SKIPE SETNOF		;SET NO?
	 JRST .MWAT0		;TURN WATCH OFF
	NOISE <message count>
	CALL DECIML		;7 also accepts "infinity"
;7	DEFX <10000>		;DEFAULT TO LOTS
;7	DECX <Number of times to tell of old "new" mail>
	 HRLOI B,377777		;+INF IF NONE TYPED
	MOVE Q1,A		;7 move to correct place
;7	MOVE Q1,B		;SAVE COUNT
.MWAT0:	CONFIRM
	MOVE A,USRNUM		;USER NUMBER
	MOVX 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:				;7 make this command only affect user list
;7	SETOM MWATCF		;TURN ON WATCHING
;	SETZM MWATAT		;RESET TIMERS
;	SETZM MWATCT
	MOVEM Q1,MWATN(C)	;STASH REPEAT COUNTS
	MOVEM Q1,MWATN0(C)
	RET			;EXIT
;STILL IN NEWF

;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, not longer than 80 characters> ;7 different help
	 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
;STILL IN NEWF

;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 (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
;STILL IN NEWF

;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
	CAIE Q1,0		;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]
	CAIL C,0		;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
	MOVEM A,REASON
	RET			;DONE
;STILL IN NEWF

;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
	MOVX B,^D60000		;AT 1 MINUTE INTERVALS
	MOVX C,IITCHN		;GET CHANNEL
	TIMER
	 JRST CJERR		;JSYS LOSAGE
	SETOM IITSET		;INTERRUPT ARMED
	SETOM MWATCF		;7 turn on mail flag
	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
	MOVX C,IITCHN		;*** MONITOR CROCK REQUIRES CHL
	TIMER
	 NOP
	SETZM IITSET		;NO MORE INTERRUPTS
	SETZM MWATCF		;7 turn off mail flag
	RET
       >			;END NEWF
;SET (NO) UUO-SIMULATION

.PAXL::	NOISE <for program>
	CONFIRM
	MOVEI A,PAXLFL		;7 save some code
	CALL REVSNS		;7
;7	SKIPN SETNOF
;7	 TDZA A,A
;7	  SETO A,
;7	MOVEM A,PAXLFL		;PA1050 FLAG
	SKIPG A,FORK		;HANDLE OF CURRENT INFERIOR
	 RET			;NONE, LEAVE NOW
	GCVEC			;GET CURRENT VECTOR
	 ERJMP [SETO B,		;7 error, assume disabled
	        JRST .+1]	;7
	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>
	CONFIRM			;7 confirm before modification
	MOVEI A,CCKEEP		;7 save some code
	CALLRET SETFLG		;7
;7	SKIPE SETNOF		;SET NO?
;7	 TDZA A,A		;YES - CLEAR
;7	  SETO A,		;SET
;7	MOVEM A,CCKEEP		;CTRL-C KEEP FLAG
;7	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"
	SETZ Q3,		;Q3 NON-0 IF "NO" JUST TYPED
PAC2:	MOVEI B,[FLDDB. .CMCFM,,,,,[
		FLDDB. .CMKEY,,$ACCES,<an 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
	GTFLDT 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
	SETO A,			;SAY GET RID OF PAGE
	SETZ C,			;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
		MOVX 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?
	  ABSKP			;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  [LERROR <Couldn't set access of page %2O - %1?>
		RET]
	ADD C,B			;GET LAST PAGE THAT FAILED
	SOJ C,
	LERROR <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			;715
	MOVX A,PCFTRC		;TRACE BIT
	ANDCAM A,PCFLAG		;CLEAR IT
	SKIPN SETNOF		;WANT IT SET?
	 IORM A,PCFLAG		;SET IT
;715	CALLRET CONF		;CONFIRM AND RETURN
	RET			;715

.CTRLC::NOISE <of program>
	CONFIRM
	IFNBATCH (ILLBAT)
	MOVEI A,CCFLAG		;7 save some code
	CALL REVSNS		;7
;7	SKIPN SETNOF
;7	 TDZA A,A
;7	  SETO A,
;7	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
	CAIN P3,0		;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
;720 not accessible from not logged in
;720	TXNN P3,NOLG		;NEED TO BE LOGGED IN?
;720	 SKIPE CUSRNO		;YES, AND ARE WE?
;720	  ABSKP			;YES, GO AHEAD
;720	   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
	ABSKP
.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
	ABSKP
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
	MOVX 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
	ABSKP
.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,(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
	TLNN B,777777		;7 bigger than 18 bits?
	 TRNN B,<FP%DIR>B23	;7 no list access for owner?
	  JRST [HRROI C,[ASCIZ/Larger than 18 bits/] ;7 which one?
		TLNN B,777777	;7
		 HRROI C,[ASCIZ/No list access for owner/] ;7
		ETYPE <%_ %% %3M specified> ;7 warn
		CALL GOAHED	;7 do it anyway?
		TLO B,500000	;INDICATE THAT THERE'S 18-BIT PROTECTION IN RH
		JRST FILEV2]	;7
	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%_>
		MOVX A,GJ%DEV!GJ%UNT!GJ%DIR!GJ%NAM!GJ%EXT!GJ%VER
		ANDCAM A,@INIFH1 ;CLEAR * INDICATIONS TO FORCE STEPPING TO NEXT
				;   JFN 
		JRST PROTE2]
	TLNE Z,F2		;INV/VIS?
	 JRST  [SKIPE (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
	HRLOI B,0		;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  [ETYPE <   Access not allowed%_>
		JRST PROTE2]
	CALL TYPOK
PROTE2:	CALL GNFIL
	ABSKP
	 JRST PROTE1
	POP P,(P)		;FIX STACK
	RET
;7 SET FILE TEMPORARY
.TEMPO::MOVX A,FB%TMP		;7 load bit
	MOVX B,FB%TMP		;7 load mask
	JRST .EPHM0		;7 join common code

;7 SET FILE PERMANENT
.PERMA::MOVX A,FB%PRM		;7
	MOVX B,FB%PRM		;7
	JRST .EPHM0		;7

;7 SET FILE AUTOKEEP
.AUTOK::MOVSI A,.FBKEP		;7 
	MOVX B,FB%FCF		;7 
	JRST .EPHM0		;7 

;7 SET FILE PERPETUAL
.PERPE::MOVX A,FB%NDL		;7
	MOVX B,FB%NDL		;7
	JRST .EPHM0		;7

;114 ADD
.BACKU::NOISE <to tape during backup runs>
	AOS SETNOF		;114 INVERT LOGICAL SENSE!
	MOVX A,FB%NOD
	MOVX B,FB%NOD
	JRST .EPHM0

;SET FILE EPHEMERAL (ALSO SET NO ...)
.EPHM::	MOVSI A,.FBEPH		;CODE FOR EPHEMERAL
	MOVX B,FB%FCF		;7 load mask
.EPHM0:	STKVAR <FCODE,FMASK>	;7 add FMASK
	SETZM FCODE		;CLEAR CODE
	SKIPN SETNOF		;SET NO ...?
	 MOVEM A,FCODE		;STORE ACTUAL CODE TO SET
	MOVEM B,FMASK		;7 save mask 
	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
	MOVE B,FMASK		;7 get specified mask
;7	MOVX B,FB%FCF		;MASK FOR FILE TYPE CODE
	MOVE C,FCODE		;GET CODE OR 0
	CALL $CHFDB		;SET CODE IN FDB
	 JRST  [ETYPE <  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
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
	ABSKP
.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
	SETZM PASSP		;7 begin SPR #:20-15255 
	MOVX A,CD%PSW		;7 try it without password first
	CALL CREDIR		;7
	 ABSKP			;7
	  JRST DPASS1		;7
	MOVX A,.FHSLF		;7 didn't work
	GETER			;7
	HRRZ B,B		;7
	CAIE B,ACESX3		;7 need password?
	 CAIN B,CRDIX1		;7 WHEEL or OPERATOR required?
	  ABSKP			;7 then ask for password
	   CALL CJERRE		;7 end SPR #:20-15255 
	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: /] ;7 add local label
	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 #
	MOVX A,.CDMOD		;READ SOME OF THE DIRECTORY
	MOVEM A,.CDLEN+SEBLK
	MOVE A,C		;SET UP DIRECTORY NUMBER
	MOVX 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,F4		;7 default to connected directory
	CALL DIRNA0		;7 
;7	TLO Z,F1		;DON'T DEFAULT THE DIRECTORY NAME
;7	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
	MOVX B,.SJDEN		;SET DENSITY
SETJOB:	MOVEI C,(P3)		;GET VALUE
SETTAP:	SETO A,			;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
	MOVX 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
	MOVX 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
	MOVX B,.SJRS
	JRST SETTAP
;"SET SPOOLED-OUTPUT"

SPLSET::NOISE <to>
	KEYWD $SPSET
	 0
	 JRST CERR
	MOVX 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
	MOVX B,.SJDFR
	MOVX C,.SJRFA		;NO RETRIEVAL-WAIT
	SKIPN SETNOF
	 MOVX 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
	MOVX B,.SJSRM		;FUNCTION FOR SETTING SESSION REMARK
	SETO A,			;SPECIFY CURRENT JOB
	SETJB			;SET REMARK
	 ERSKP			;COULDN'T SET SESSION REMARK
	  RET			;DONE
	ETYPE <%%Couldn't set session remark%_>
	RET
;"SET CARD-READER-INPUT-SET"

CDRD,<				;713
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
	CAIN B,0
	 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
       >			;713
;720 NOLGs removed, table cannot be accessed from not logged in
$ESET:	TABLE
ARPA,<	T arpanet,,.NETWK>		;713^ESET ARPANET
CHA,<	T chaos-protection,,.ESCHP>	;7 ^ESET CHAOS-PROTECTION
	T date-and-time,,SETTAD		;^ESET SYSTEM DATE-AND-TIME
	T logins-allowed,,TTYLOG	;^ESET LOGINS-ALLOWED
	T no,,ESETNO			;^ESET NO 
	T operator-in-attendance,ONEWRD,SETOPR	;^ESET OPERATOR
MMON,<	T pause,,.ESPAU>		;7 ^ESET PAUSE
	T private-quasar,,.GDEBG	;^ESET PRIVATE-QUASAR
	T run-time-guarantee,,.JRUNG	;^ESET JOB RUN-TIME
MMON,<	T system,,.ESSYS>		;7 ^ESET SYSTEM
	T terminal,,ETERMI		;^ESET TERMINAL (NUMBER)
	TEND

ESETNO:	SETOM SETNOF		;FLAG NO TYPED
	KEYWD $ESETN
	 0
	 JRST CERR
;720 cannot be accessed while not logged in
;720	TXNE P3,NOLG		;NEED TO BE LOGGED IN?
;720	 SKIPE CUSRNO		;YES, ARE WE?
;720 	  ABSKP			;OK
;720	   ERROR <LOGIN please>
	JRST (P3)		;DISPATCH TO COMMAND

$ESETN:	TABLE
	T logins-allowed,,TTYLOG	;^ESET NO LOGINS-ALLOWED
	T operator-in-attendance,ONEWRD,SETOPR	;^ESET NO OPERATOR
MMON,<	T pause,,.ESPAU>		;7 ^ESET PAUSE
	T private-quasar,,.GDEBG	;^ESET NO PRIVATE-QUASAR
	T run-time-guarantee,,.JRUNG	;^ESET NO RUN-TIME
	TEND
;"^ESET TERMINAL (NUMBER)"

ETERMI::STKVAR <ETNM>		;7 make label global
	NOISE <number>
	OCTX <Octal terminal number>
	 CMERRX
	MOVEM B,ETNM
	MOVX B,WHLU!OPRU	;7 enabled wheel or operator?
	SKIPE PRVENF		;7
	 CALL PRVCK		;7
	  ABSKP			;7 
	   JRST ETRMI2		;7 yes, doesn't have to be availible
ETERM1:	MOVE B,ETNM		;7 no, check if terminal is availible
	MOVEI A,.TTDES(B)	;7 get terminal designator
	DVCHR			;7 
	TXNE B,DV%AV		;7 availible? 
	 JRST ETRMI2		;7 yes
	HLRZ C,C		;7 no, get job which has it
	TXNE B,DV%ASN		;7 print error msg
	 ERROR <%1H: already assigned to job %3Q> ;7
	ERROR <%1H: already open by job %3Q> ;7

ETRMI2:				;7 add local label
	MOVE A,CSBUFP		;GET SOME SCRATCH SPACE
	SETZ C,			;END STRING OUTPUT ON NULL
	HRROI B,[ASCIZ/TTY/]	;MAKE DEVICE NAME
	SOUT
	MOVE B,ETNM		;GET NUMBER HE TYPED
	MOVX C,FLD(10,NO%RDX)	;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 THAT TERMINAL DOESN'T EXIST
	MOVEM B,ETNM		;REMEMBER DESIGNATOR
	KEYWD $ETERM
	 T speed,,SPEEDA
	 JRST CERR
	MOVE A,ETNM		;GET TERMINAL DESIGNATOR
	JRST (P3)

$ETERM:	TABLE
	T speed,,SPEEDA
	TEND
;"^ESET [NO] SYSTEM LOGINS-ALLOWED"

TTYLOG:	NOISE <on>
	KEYWD $LGTTY
	 T any-terminal,ONEWRD,.ANTTY
	 JRST CERR
	JRST (P3)

;131 add chaos, decnet, change arpanet to internet
$LGTTY:	TABLE
	T any-terminal,ONEWRD,.ANTTY
CHA,<	T chaosnet-terminals,ONEWRD,.CHTTY>
	T console-terminal,ONEWRD,.CNTTY
DECN,<	T decnet-terminals,ONEWRD,.DCTTY>
ARPA,<	T internet-terminals,ONEWRD,.NVTTY>
	T local-terminals,ONEWRD,.LCTTY
	T pseudo-terminals,ONEWRD,.PSTTY
	T remote-terminals,ONEWRD,.RMTTY
	TEND

;DO SET FOR ALL TERMINALS

.ANTTY:	
CHA,<	CALL .CHTTY>		;130 add
	CALL .CNTTY
DECN,<	CALL .DCTTY>		;130 add
	CALL .LCTTY
ARPA,<	CALL .NVTTY>
	CALL .PSTTY
;	CALLRET .RMTTY

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

.CNTTY:	MOVX A,.SFCTY
	JRST DOSTTY

.LCTTY:	MOVX A,.SFLCL
	JRST DOSTTY

ARPA,<
.NVTTY:	MOVX A,.SFNVT
	JRST DOSTTY
>
.PSTTY:	MOVX A,.SFPTY
	JRST DOSTTY

;131 add .DCTTY, .CHTTY
DECN,<
.DCTTY:	MOVX A,.SFMCB
	JRST DOSTTY
>
CHA,<
.CHTTY:	MOVX A,.SFCVT
	JRST DOSTTY
>
;"^ESET ARPANET" ON OR OFF
 
ARPA,<				;713
.NETWK:	KEYWD $NETOO		;OFF OR ON
	 T on,,NETON
	 JRST CERR
	CONFIRM
	JRST (P3)

$NETOO:	TABLE
	T off,,NETFF
	T on,,NETON
	TEND

TCP,<				;713 MULTINET code
NETFF:	TDZA C,C		;7 off or on
NETON:	 SETO C,		;7
	MOVX A,SIXBIT/MNTSET/	;7 function code
	MOVX B,^D10		;7 net number for ARPAnet
	OPRFN			;7
	 JRST CJERR		;7
	RET			;7
      >				;713 end TCP
NOTCP,<				;713
NETFF:	TDZA B,B
NETON:	MOVX B,1
	MOVX A,.SFNTN		;SET ARPANET OFF OR ON
	SMON
	 ERCAL CJERRE		;SHOULD SUCCEED EVEN IN NON-NET SYSTEMS
	RET
       >>			;713 end ARPA, NOTCP
    
;"^ESET SYSTEM OPERATOR-IN-ATTENDANCE"

SETOPR:	MOVX A,.SFOPR
	SKIPE SETNOF
	 TDZA B,B		;NO OPERATOR
	  MOVX B,1		;OPERATOR IN ATTENDANCE
	SMON
	 ERCAL CJERRE
	RET
;^ESET PRIVATE-QUASAR ON OR OFF

.GDEBG:	NOISE <for private GALAXY>
	CONFIRM
	SKIPN SETNOF		;ON?
	 CALL GQSRPD		;YES - GET PRIVATE QUASAR PID
	SKIPE SETNOF		;OFF?
	 SETZM QSRPID		;YES - CLEAR QUASAR'S PID
	RET			;AND 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" command>]
	IMULI B,^D1000		;MAKE IT MILLISECONDS
	PUSH P,B
	MOVX A,.FHJOB
	RUNTM			;GET TIME IN MILLISECONDS
	POP P,B
	ADD B,A			;ADD TO GET FINAL RUNTIME
	MOVE A,[.FHJOB,,.TIMRT]	;SET TIME LIMIT CODE
	MOVX 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::MOVEI A,[ASCIZ/^ECEAS/]	;7 setup for program name setup
	HRROM A,COMAND		;7
	NOISE <timesharing at>
	DTX <Date and time or null to cancel shutdown>
	 JRST CEASE3
	PUSH P,B
	NOISE <resuming at>
	DTX <Date and time of restart or null if unknown>
	 JRST CEASE4		;NO DATE AND TIME TYPED
CEASE1:	CONFIRM
	SKIPN (P)
	 JRST CEASE2		;SKIP CHECK IF CANCELING
	GTAD
	CAML A,(P)
	 ERROR <Down time has already passed>
	JUMPE B,CEASE2
	CAMGE B,(P)
	 ERROR <Timesharing will resume before it ends!>
CEASE2:	POP P,A
	HSYS
	 JRST CJERR
	RET

CEASE3:	PUSH P,[0]
CEASE4:	SETZ B,
	JRST CEASE1

;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
;7 SET FLAG, generalized set flag location routine
;7 call with flag location in A

SETFLG:	SKIPE SETNOF		;7 is it "NO"?
	 TDZA B,B		;7 yes, clear		OFF: 0
	  SETO B,		;7 no, set to -1	ON:  -1
	MOVEM B,(A)		;7
	RET			;7

REVSNS: SKIPN SETNOF		;7 reverse sensing version
	 TDZA B,B		;7 OFF: -1
	  SETO B,		;7 ON:  0
	MOVEM B,(A)		;7
	RET			;7
;7 ^ESET additions

;7 ^ESET CHAOS-PROTECTION
 CHA,<				;7
.ESCHP:	KEYWD $CHAPR		;7 keyword 
	 T enabled,,CHPRON	;7 
	 JRST CERR		;7
	CONFIRM			;7
	JRST (P3)		;7 dispatch

$CHAPR:	TABLE			;7
	T disabled,,CHPRFF	;7
	T enabled,,CHPRON	;7
	TEND			;7

CHPRFF:	TDZA B,B		;7 off
CHPRON:	 MOVX B,1		;7 on
	MOVX A,.SFCHA		;7
	SMON			;7 
	 ERCAL CJERRE		;7 should succeed even in non-net systems
	RET			;7
       >			;7 end CHA

;7 ^ESET [NO] PAUSE (AT BUGCHKS)

MMON,<				;7
.ESPAU:	NOISE <at bugchks>	;7
	CONFIRM			;7
	SKIPE SETNOF		;7 is it "NO"?
	 TDZA B,B		;7 yes
	  MOVX B,1		;7 no
	MOVX A,SIXBIT/DCHKSW/	;7
	OPRFN			;7
	 JRST CJERR		;7 shouldn't happen
	RET			;7

;7 ^ESET SYSTEM (AS)

.ESSYS:	NOISE <as>		;7 set the debug switch
	KEYWD $DBGSW		;7
	 0			;7
	 JRST CERR		;7
	CONFIRM			;7
	MOVX A,SIXBIT/DBUGSW/	;7
	MOVEI B,(P3)		;7 get value
	OPRFN			;7
	 JRST CJERR		;7
	RET			;7

$DBGSW:	TABLE			;7 keyword table
	T normal,,0		;7
	T remedial,,1		;7
	T stand-alone,,2	;7
	TEND			;7
       >			;7 end MMON
;7 SET additions

;7 SET FDB-FORK-CONTROL (FOR)

.STFFC::NOISE <for>		;7 
	KEYWD $FDBFC		;7 get keyword
	 0			;7
	 JRST CERR		;7
	CONFIRM			;7
	MOVEI A,FDBAK		;7 autokeep
	TRNN P3,1		;7
	 JRST  [CALL REVSNS	;7
		JRST .+2]	;7
	CALL SETFLG		;7
	MOVEI A,FDBEPH		;7 ephemeral
	TRNN P3,2		;7
	 CALLRET REVSNS		;7
	CALLRET SETFLG		;7

$FDBFC:	TABLE			;7 keyword table
	t all,,3		;7
	t autokeep,,1		;7
	t ephemeral,,2		;7
	t none,,0		;7
	tend			;7

;7 SET [NO] LAZY-FEATURES

.STLZF::MOVEI A,LAZFEA		;7
	CALLRET SETFLG		;7

;7 SET [NO] NOISY-FORKS

.STNFK::MOVEI A,NOISY		;7
	CALLRET SETFLG		;7

;7 LAZY-RESTART (FOR) all forks or just the kept ones

.STLRS::NOISE <for>		;7
	KEYWD $LAZRS		;7 get type of restart option
	 T all-forks,,1		;7
	 JRST CERR		;7
	CONFIRM			;7
	MOVEM P3,LAZRES		;7 set up flag
	RET			;7

$LAZRS:	TABLE			;7 keyword tabe
	T all-forks,,1		;7
	T kept-forks,,0		;7
	TEND			;7

;7 SET [NO] PASS-CAPABILITIES (MASK) OR (TO INFERIOR FORKS) 

.STPCI::SKIPE SETNOF		;7 is it "NO"? 
	 JRST STNPCI		;7 yes
	NOISE <mask>		;7 get mask
	DEFX <-1>		;7
	MOVE A,[TXTPTR <octal number>] ;7
	MOVE B,[TXTPTR <or carriage return to confirm>] ;7
	CALL OCTCOM		;7
	CONFIRM			;7 confirm
	MOVEM A,CAPMSK		;7 save it
	RET			;7

STNPCI:	NOISE <to inferior forks> ;7
	CONFIRM			;7
	MOVE A,[SC%CTC!SC%GTB!SC%SCT!SC%FRZ!FLD(DECNSW,SC%DNA)!
FLD(ARPASW,SC%ANA)!FLD(CHASW,SC%CHA)] ;7 load std mask
	MOVEM A,CAPMSK		;7 save it
	RET			;7

;7 SET REGISTER

.STREG::TRVAR <OFFSET>		;7 register offset
	NOISE <number>		;7 get register number
	OCTX <octal number from 1 to 13> ;7
	 CMERRX			;7
	CAIL B,1		;7 check if okay
	 CAILE B,DSPRSZ		;7
	  ERROR <register out of range>	  
	SUBI B,1		;7 compute offset
	MOVEM B,OFFSET		;7 save it
	NOISE <contents>	;7 get contents
	MOVE A,[TXTPTR <octal number>] ;7
	MOVE B,[TXTPTR <carraige return to confirm>] ;7
	CALL OCTCOM		;7
	CONFIRM			;7 confirm
	MOVE B,OFFSET		;7 store value
	MOVEM A,DSPREG(B)	;7
	RET			;7

;7 SET RESTART (.STRES) is in P

;7 SET [NO] SIMPLE-COMMAND-LEVEL

.STSCL::MOVEI A,SIMPLE		;7
	CALLRET SETFLG		;7

;7 SET [NO] STICKY-FILE-DEFAULTING

.STSFD::SKIPE SETNOF		;7 no?
	 JRST  [SETZ A,		;7 yes, "no"
		JRST STSFD1]	;7
	KEYWD $STSFD		;7 no, parse type
	 T per-filespec,,1	;7 
	 JRST CERR		;7
	MOVE A,P3		;7
	CAIN A,0		;7 equal to zero?
	 SETO A,		;7  load -1
STSFD1: CONFIRM			;7
	MOVEM A,STICKY		;7 
	CAIE A,0		;7 is it "NO"?
	 CALL SFDINI		;7 no, so initialize
	RET			;7

$STSFD:	TABLE			;7
	T per-command,,0	;7
	T per-filespec,,1	;7 -1 interferes with ONEWRD
	TEND			;7

;7 SET [NO] WAKE-EVERY-FIELD

.STWEF::MOVEI A,WAKFLD		;7
	CALLRET SETFLG		;7
;716 SET additions for command edit

CEF,<				;716
;716 SET EDIT-MODE (FOR COMMAND EDITOR TO)

.STCEM::NOISE <for command editor to> ;716
	KEYWD $EDMOD		;716
	 T emacs,,0		;716
	 JRST CERR		;716
	CONFIRM			;716
	CAIE P3,0		;716 if value is one, load -1
	 SETO P3,		;716
	HRRZM P3,CEFLAG		;716
	RET			;716

$EDMOD: TABLE			;716 keyword table
	T alter,,1		;716 
	T emacs,,0		;716
	TEND			;716

;112 ;716 SET INTERRUPT-CHARACTER (FOR COMMAND EDITOR TO) 

.STICH::NOISE <for command editor to>
	MOVEI B,CEICFB
	CALL FLDSKP		;GET THE CHARACTER
	 JRST CERR		;OOPS.
	HRRZ A,C		;GET ADDRESS OF FDB USED
	CAIE A,CEICFB		;KEYWORD TABLE?
	 JRST STIC$1		;NO, TRY SOMETHING ELSE
	HRRZ A,(B)		;GET DATA IN TABLE ENTRY
	CAIE B,$CEIQS		;USER JUST TYPED "CONTROL"?
	IFSKP.			;YES, CHECK FOR QUOTED STRING
	  CALL @(A)		;BY CALLING ROUTINE FROM TABLE
	  CALL STICHK		;CHECK CHARACTER'S VALIDITY
	  SKIPGE B,A		;MOVE TO B, BUT
	   JRST STIC$E		;..PUNT IF NO GOOD
	ELSE.			;ELSE USER GAVE ENTIRE CHARACTER, SO..
	  HRRZ B,(A)		; ..JUST GET IT.
	ENDIF.
	JRST STIC$2		;GO SET CHARACTER

STIC$1:	CAIE A,CEICF1		;OCTAL DIGIT?
	 JRST STIC$E		;"CAN NEVER HAPPEN"
	MOVE A,B		;CHAR IN A
	CALL STICHK		;CHECK IT
	SKIPGE B,A		;PUNT IF NO GOOD
	 JRST STIC$E

STIC$2:	STKVAR <ICHAR>		;CHARACTER TO INTERRUPT ON
	MOVEM B,ICHAR		;SAVE IT
	CONFIRM			;CONFIRM THE COMMAND
	SKIPL A,CEPSIC		;GET THE OLD CHARACTER
	 DTI			;IF ONE WAS ASSIGNED THEN DEASSIGN IT
	HRLZ A,ICHAR		;GET THE NEW ONE
	HLRZM A,CEPSIC		;SAVE IT
	HRRI A,CECHN		;SET THINGS UP
	ATI			;ASSIGN NEW INTERRUPT CHARACTER
	RET			;DONE

STIC$E:	ERROR <Character not available>

;CHECK IF A VALID EDITOR INTERRUPT CHAR
;CHAR IN A, RETURNS CHAR IN A OR -1 IF NO GOOD. BASHES B
;ALLOWS CONTROL- @ A B D G H K N P Q S X Y ^ _

STICHK: CAIL A," "		;A CONTROL CHARACTER?
   	 JRST STICHE		;LOSE
	MOVEI B,^D35
	SUB B,A
	MOVE B,BITS(B)		;GET BIT CORRESPONDING TO CHAR CODE
	TDNN B,[1_.chcun!1_.chccf!1_.chcny!1_.chcnx!1_.chcns!
1_.chcnq!1_.chcnp!1_.chcnn!1_.chvtb!1_.chbsp!1_.chbel!1_.chcnd!1_.chcnb!
1_.chcna!1_.chnul]
STICHE:	SETO A,			;NO GOOD, RETURN ERROR
	RET


CEICFB:	FLDBK. (.CMKEY,,$CEICT,,,CEICBR,CEICF1)
CEICF1:	FLDDB. (.CMNUM,CM%SDH,^D8,<an octal ASCII code for a control 
character>)

;A BREAKMASK WHICH WILL ALLOW READING THE DAMN ^'S
CEICBR:	BRMSK. (KEYB0.,KEYB1.,KEYB2.,KEYB3.,<^>,)

$CEICT:	TABLE
$CEIQS:	IT control,,PCHCON
	T control-@,,"@"-100
	T control-A,,"A"-100
	T control-B,,"B"-100
	T control-D,,"D"-100
	T control-G,,"G"-100
	T control-H,,"H"-100
	T control-K,,"K"-100
	T control-N,,"N"-100
	T control-P,,"P"-100
	T control-Q,,"Q"-100
	T control-S,,"S"-100
	T control-X,,"X"-100
	T control-Y,,"Y"-100
	T control-^,,"^"-100
	T control-_,,"_"-100
	IT ^@,,"@"-100
	IT ^A,,"A"-100
	IT ^B,,"B"-100
	IT ^D,,"D"-100
	IT ^G,,"G"-100
	IT ^H,,"H"-100
	IT ^K,,"K"-100
	IT ^N,,"N"-100
	IT ^P,,"P"-100
	IT ^Q,,"Q"-100
	IT ^S,,"S"-100
	IT ^X,,"X"-100
	IT ^Y,,"Y"-100
	IT ^^,,"^"-100
	IT ^_,,"_"-100
	TEND
;112 End changes

.STNIC::NOISE <for command editor> ;716 original code
	CONFIRM			;COMFIRM "SET NO INTERRUPT-CHARACTER"
	SKIPGE A,CEPSIC		;DO WE HAVE ONE?
	 RET			;NO, QUIT
	DTI			;WE HAD ONE, DEASSIGN IT
	SETOM CEPSIC		;SAY WE DON'T HAVE ONE
	RET			;DONE

;716 SET [NO] RECORDING (OF COMMANDS FOR COMMAND EDITOR)

.STCER::NOISE <of commands for command editor>	;716
	CONFIRM			;716
	MOVEI A,CERECD		;716
	CALLRET SETFLG		;716
       >			;716 end CEF

LITSSE:				;713 debugging aid: literals label
	END