Google
 

Trailing-Edge - PDP-10 Archives - BB-M781A-SM - exec/exec1.mac
There are 47 other files named exec1.mac in the archive. Click here to see a list.
;<5.EXEC>EXEC1.MAC.17, 18-Mar-82 10:09:20, Edit by CHALL
; UPD ID= 134, SNARK:<5.EXEC>EXEC1.MAC.15,  22-Jan-82 14:49:11 by CHALL
;TCO 5.1698 .TKLOG- ADD NEW SUBCOMMAND TO TAKE: LOG-FILE
; UPD ID= 132, SNARK:<5.EXEC>EXEC1.MAC.14,  15-Jan-82 16:26:55 by CHALL
;TCO 5.1668 .CLOSE- ADD HELP MESSAGE TO OCTX LUUO
; UPD ID= 120, SNARK:<5.EXEC>EXECIN.MAC.21,  28-Dec-81 11:14:01 by CHALL
;TCO 5.1644 - UPDATE COPYRIGHT NOTICE
; UPD ID= 82, SNARK:<5.EXEC>EXEC1.MAC.12,  10-Oct-81 19:40:43 by CHALL
;TCO 5.1563 .CONNE- ADD "STRUCTURE NOT MOUNTED" TO CONNECT ERROR MESSAGE
; UPD ID= 32, SNARK:<5.EXEC>EXEC1.MAC.9,  14-Aug-81 19:11:58 by CHALL
;TCO 5.1454 CHANGE NAME FROM XDEF TO EXECDE
; UPD ID= 19, SNARK:<5.EXEC>EXEC1.MAC.8,  21-Jul-81 12:29:01 by MURPHY
;TCO 5.1427 - GET RID OF SYSTEM MAIL BEFORE PUSH
; UPD ID= 15, SNARK:<5.EXEC>EXEC1.MAC.6,  17-Jul-81 15:42:41 by CHALL
;TCO 5.1420 DETSND- HAVE SEND * SAY IT'S GOING TO ALL
; UPD ID= 4, SNARK:<5.EXEC>EXEC1.MAC.5,  10-Jul-81 17:07:35 by TILLSON
;Remove TCO 5.1400 - this code was already added!
; UPD ID= 2310, SNARK:<5.EXEC>EXEC1.MAC.4,   8-Jul-81 14:22:45 by TILLSON
;TCO 5.1400 - Fix CTRL/C out of LOGIN
; UPD ID= 2247, SNARK:<5.EXEC>EXEC1.MAC.3,  23-Jun-81 15:36:48 by LEACHE
;TCO 5.1379
;Make CANCEL ARCHIVE fail if FB%ARC set (collection run-1 started)
;<HELLIWELL.EXEC.5>EXEC1.MAC.1, 13-May-81 19:58:46, EDIT BY HELLIWELL
;REMOVE .CLEAR ROUTINE (NOW UNUSED)
;<4.EXEC>EXEC1.MAC.1, 10-May-80 16:42:52, Edit by DK32
;Programmable Command Language, SPR 13716
; UPD ID= 1511, SNARK:<5.EXEC>EXEC1.MAC.16,   2-Feb-81 18:10:30 by ELFSTROM
;change stroage to storage in error message for KEEPOV:
; UPD ID= 1321, SNARK:<5.EXEC>EXEC1.MAC.15,   1-Dec-80 16:00:47 by OSMAN
;Use SETENT instead of SEVEC
; UPD ID= 1307, SNARK:<5.EXEC>EXEC1.MAC.14,  24-Nov-80 12:13:52 by DONAHUE
;TCO 5.1191 - Allow UNDELETE to see invisible files (in case one got deleted)
; UPD ID= 1305, SNARK:<5.EXEC>EXEC1.MAC.13,  21-Nov-80 14:22:52 by DONAHUE
;TCO 5.1201 - Set GJ%ACC when getting JFN on LOGIN.CMD
; UPD ID= 1106, SNARK:<5.EXEC>EXEC1.MAC.12,   2-Oct-80 09:55:40 by OSMAN
;tco 5.1163 - Put CONFIRM in ^ESEND command
; UPD ID= 1024, SNARK:<5.EXEC>EXEC1.MAC.11,  17-Sep-80 10:35:57 by OSMAN
;tco 5.1148 - Make DISABLE/RUN equivalent capwise to RUN/DISABLE/START
; UPD ID= 853, SNARK:<5.EXEC>EXEC1.MAC.10,  10-Aug-80 15:20:07 by OSMAN
;tco 5.1129 - Add symbolic address and expression support
;tco 5.1128 - More correct error on "SET ENTRY 2000 2000"
; UPD ID= 832, SNARK:<5.EXEC>EXEC1.MAC.9,   4-Aug-80 12:57:35 by LYONS
; Fix typo in last fix
; UPD ID= 830, SNARK:<5.EXEC>EXEC1.MAC.8,   4-Aug-80 12:37:05 by LYONS
; Allow BLANK command to work for tty types over 18
; UPD ID= 592, SNARK:<5.EXEC>EXEC1.MAC.7,   3-Jun-80 09:33:31 by OSMAN
;tco 5.1057 - Allow ENABLE, DISABLE, and PUSH under BUILD
;<5.EXEC>EXEC1.MAC.6, 30-May-80 16:44:41, EDIT BY MURPHY
;PUT NEW ALERT AND MAIL WATCH UNDER NEWF
; UPD ID= 531, SNARK:<5.EXEC>EXEC1.MAC.5,  20-May-80 14:55:12 by MURPHY
;CHANGE SOME XTND TO NEWF OR MFRK
; UPD ID= 493, SNARK:<5.EXEC>EXEC1.MAC.4,  30-Apr-80 14:34:40 by OSMAN
; UPD ID= 492, SNARK:<4.1.EXEC>EXEC1.MAC.19,  30-Apr-80 09:55:25 by OSMAN
;Fix confirmation on TAKE subcommands
; UPD ID= 458, SNARK:<4.1.EXEC>EXEC1.MAC.13,  22-Apr-80 16:42:22 by OSMAN
;tco 4.1.1146 - Make CTRL/Q during advice work.
;tco 4.1.1145 - Make ADVISE smarter about "line not active"
;<4.1.EXEC>EXEC1.MAC.12,  8-Apr-80 14:18:46, EDIT BY OSMAN
;tco 4.1.1140 - Remove "(MESSAGE)" guidewords on ^ESEND
; UPD ID= 342, SNARK:<4.1.EXEC>EXEC1.MAC.11,  19-Mar-80 14:59:24 by TOMCZAK
;TCO# 4.1.1117 Clean up some password parsing problems (add PASFLD and a flag)
;<4.1.EXEC>EXEC1.MAC.3, 20-Nov-79 10:02:38, EDIT BY OSMAN
;TCO 4.1.1023 - Fix TAKE stuff
;<4.1.EXEC>EXEC1.MAC.2,  9-Nov-79 09:22:17, EDIT BY OSMAN
;tco 4.1.1011 - Don't allow ^C between LOGIN jsys and setting up CUSRNO
;<4.EXEC>EXEC1.MAC.151, 24-Oct-79 15:40:39, EDIT BY TOMCZAK
;TCO# 4.2544 - Make TAKE file command echoing work right
;<OSMAN.EXEC>EXEC1.MAC.1, 12-Oct-79 16:16:01, EDIT BY OSMAN
;TCO 4.2500 - USE THE CBACK AND CCHKPT LOGIC IN PASSWORD STUFF ONLY
;<4.EXEC>EXEC1.MAC.149,  8-Oct-79 16:13:03, EDIT BY OSMAN
;tco 4.2520 - Get confirmation after password
;<4.EXEC>EXEC1.MAC.147, 15-Sep-79 16:07:25, EDIT BY TOMCZAK
;TCO#4.2471 - Add GJ%ACC bit for getting JFNs on command and log files in TAKE
;<4.EXEC>EXEC1.MAC.146, 12-Sep-79 15:43:01, Edit by HESS
; Re-arrange invocation of MESMES for "set no login-mail" (XTND only)
;<4.EXEC>EXEC1.MAC.144,  5-Sep-79 10:22:16, EDIT BY OSMAN
;tco 4.2440 - Avoid "?JFN is not assigned" in TV (Don't close jfns after GET
;jsys
;<4.EXEC>EXEC1.MAC.141, 28-Aug-79 15:21:50, EDIT BY OSMAN
;tco 4.2427 - Print [n pages freed] message for all appropriate directories.
;<4.EXEC>EXEC1.MAC.141, 28-Aug-79 15:55:01, Edit by HESS
;<4.EXEC>EXEC1.MAC.140, 22-Aug-79 16:14:01, EDIT BY DBELL
;TCO 4.2415 - SKIP OUR OWN JOB WHEN SEARCHING JOBS IN ADVISE OR TALK
;<HESS.E>EXEC1.MAC.15, 19-Aug-79 23:03:39, Edit by HESS
; Add extended features
;<4.EXEC>EXEC1.MAC.138, 14-Aug-79 13:45:57, EDIT BY DBELL
;TCO 4.2396 - STOP PDL OVERFLOWS IN PUSHIO (REPLACE ERJMP WITH MANUAL CHECK)
;<4.EXEC>EXEC1.MAC.137, 10-Aug-79 14:50:41, EDIT BY OSMAN
;tco 4.2384 - Give warning, if nothing retrieved
;<4.EXEC>EXEC1.MAC.135, 10-Aug-79 08:18:18, EDIT BY OSMAN
;tco 4.2380 - Use standard error message if RNAMF jsys fails
;<4.EXEC>EXEC1.MAC.134,  2-Aug-79 09:07:28, EDIT BY OSMAN
;tco 4.2368 - Don't allow NO NO NO NO NO in TAKE subcommands
;<4.UTILITIES>FOO.BAR.8, 26-Jul-79 13:08:06, EDIT BY OSMAN
;tco 4.2347 - Check BATCHF instead of CHKPTY for whether to calculate
;"You have a message"
;<4.EXEC>EXEC1.MAC.125, 26-Jun-79 08:54:45, EDIT BY OSMAN
;tco 4.2310 - Fix prompt "[Attached to TTY67, confirm]"
;<4.EXEC>EXEC1.MAC.124, 21-Jun-79 14:35:56, EDIT BY OSMAN
;<4.EXEC>EXEC1.MAC.123, 21-Jun-79 13:34:10, EDIT BY OSMAN
;REMOVE EXTRANEOUS REFS TO RLJFNS
;<4.EXEC>EXEC1.MAC.122, 20-Jun-79 16:33:29, EDIT BY OSMAN
;tco 4.2301 - Don't type "garbage  [No pages freed]" on "DELETE nonxfile"
;and EXP subcommand
;<4.EXEC>EXEC1.MAC.121,  6-Jun-79 09:23:14, EDIT BY HELLIWELL
;DELETE CODE FOR UNMOUNT COMMAND (WAS NOSHIP)
;<4.EXEC>EXEC1.MAC.120,  4-May-79 10:51:28, EDIT BY OSMAN
;DOATI INSTEAD OF BLECCH
;<4.EXEC>EXEC1.MAC.119,  4-May-79 09:16:26, EDIT BY OSMAN
;REMOVE EPCAP AFTER LOGIN (IT'S USELESS, SINCE USER CAN ^C BEFORE IT ANYWAY)
;<4.EXEC>EXEC1.MAC.117,  1-May-79 11:16:39, EDIT BY OSMAN
;CHANGE GTJFN TO GTJFS IN KEEP
;<4.EXEC>EXEC1.MAC.116,  1-May-79 10:17:56, EDIT BY OSMAN
;FOR ADVICE, ATI ^E.  SEND ALL OTHER CHARACTERS (INCLUDING ^O!) TO REMOTE JOB
;<4.EXEC>EXEC1.MAC.115,  1-May-79 09:48:21, EDIT BY OSMAN
;try not doing process STIW for ADVISE, just job-wide STIW
;<4.EXEC>EXEC1.MAC.114, 30-Apr-79 16:55:02, EDIT BY OSMAN
;CALL BLECCH AT END OF ADVISE SO STIW ISN'T NEEDED AFTER EVERY ERROR
;<4.EXEC>EXEC1.MAC.113, 30-Apr-79 14:34:46, EDIT BY OSMAN
;DON'T DTI ^C IN ^EEDDT, SINCE WARM START NO LONGER DOES ATI
;<4.EXEC>EXEC1.MAC.112, 30-Apr-79 13:54:03, EDIT BY OSMAN
;DON'T DTI ^C AND ^T ON ^EQUIT OR POP, SINCE WARM START NO LONGER ATI'S THEM!
;<4.EXEC>EXEC1.MAC.111, 12-Mar-79 17:48:08, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<HURLEY.CALVIN>EXEC1.MAC.1, 12-Mar-79 16:04:43, EDIT BY HURLEY.CALVIN
; FIX RETRIEVE - USE ETYPE < %1S> INSTEAD OF TYPIF SINCE USING IT
; WITH NXFILE DOESN'T QUITE WIN FOR THINGS LIKE RETRIEVE AND UNDELETE
; THAT IS, BY THE TIME YOU CALL TYPIF, NXFILE MAY HAVE STEPPED OFF
; THE END CAUSING TYPIF TO LOSE BIG
;<4.EXEC>EXEC1.MAC.109, 12-Mar-79 14:51:15, EDIT BY HURLEY.CALVIN
; CAUSE ARCHIVE, RETAIN NOT TO MAKE FILE INVISIBLE
;<4.EXEC>EXEC1.MAC.106,  9-Mar-79 15:45:51, EDIT BY OSMAN
;CALL MFINP BEFORE DOING GTFDB IN RETRIEVE
;<4.EXEC>EXEC1.MAC.105,  6-Mar-79 09:58:07, EDIT BY OSMAN
;USE GTJFS INSTEAD OF $GTJFN IN ^EEDDT
;<4.EXEC>EXEC1.MAC.104,  5-Mar-79 16:27:02, EDIT BY HURLEY.CALVIN
; don't try to retrieve files that aren't offline
;<4.EXEC>EXEC1.MAC.103,  1-Mar-79 16:27:37, EDIT BY OSMAN
;NOECHO BEFORE (PASSWORD) IN LOGIN
;<4.EXEC>EXEC1.MAC.102, 28-Feb-79 09:53:49, EDIT BY OSMAN
;REMOVE REFS TO CTYPE (USE ETYPE INSTEAD)
;<4.EXEC>EXEC1.MAC.100, 21-Feb-79 16:32:34, EDIT BY OSMAN
;tco 4.2195 - Don't write-enable exec when doing ^EEDDT
;<4.EXEC>EXEC1.MAC.99, 21-Feb-79 09:35:18, EDIT BY OSMAN
;TCO 4.2189 - CONTINUED
;<4.EXEC>EXEC1.MAC.97, 14-Feb-79 14:23:57, EDIT BY OSMAN
;<4.EXEC>EXEC1.MAC.96, 14-Feb-79 13:59:08, EDIT BY OSMAN
;TCO 4.2189 - ASSUME NULL PASSWORD IF USER TYPES CR AT "PASSWORD:"
;<4.EXEC>EXEC1.MAC.94,  9-Feb-79 10:27:56, EDIT BY OSMAN
;MOVE ASSIGN AND DEASSIGN INTO EXECMT
;<4.EXEC>EXEC1.MAC.93,  9-Feb-79 10:17:44, EDIT BY OSMAN
;Make JFNRLA global
;<4.EXEC>EXEC1.MAC.91,  9-Feb-79 09:47:45, EDIT BY OSMAN
;Move tape stuff from here into EXECMT
;<4.EXEC>EXEC1.MAC.89,  6-Feb-79 16:55:23, EDIT BY HURLEY.CALVIN
;<4.EXEC>EXEC1.MAC.86,  6-Feb-79 16:19:16, EDIT BY HURLEY.CALVIN
; Remove XARC around making visible again on CANCEL ARCHIVE, also, ok
; cancel the request for files pending archive
;<4.EXEC>EXEC1.MAC.85,  6-Feb-79 15:44:32, EDIT BY HURLEY.CALVIN
; Cause CANCEL ARCHIVE to find invisible files
;<4.EXEC>EXEC1.MAC.84, 29-Jan-79 09:13:09, EDIT BY OSMAN
;fix call to SPECFN in DISCARD so user doesn't think there's subcommands
;<4.EXEC>EXEC1.MAC.83, 26-Jan-79 15:24:18, EDIT BY OSMAN
;take INVISIBLE feature out of XARC (i.e. make feature always available)
;<4.EXEC>EXEC1.MAC.82, 24-Jan-79 12:44:47, EDIT BY HURLEY.CALVIN
; Also make CANCEL ARCHIVE make 'em visible again (under XARC)
;<4.EXEC>EXEC1.MAC.81, 24-Jan-79 12:37:04, EDIT BY HURLEY.CALVIN
; Cause ARCHIVE request to make files invisible right away (under XARC)
;<4.EXEC>EXEC1.MAC.80, 10-Jan-79 10:56:14, EDIT BY R.ACE
;TAKE OUT "UNAVAILABLE, USE TMOUNT COMMAND" MSG IN ASSIGN COMMAND CODE
;<4.EXEC>EXEC1.MAC.79,  7-Jan-79 16:18:39, EDIT BY DBELL
;CHANGE ^ESEND MESSAGE FORMATS FROM "TTY1" TO "LINE 1"
;<4.EXEC>EXEC1.MAC.76, 20-Dec-78 15:50:42, EDIT BY HURLEY.CALVIN
; Add 1B17 to SPECFN bits in .RETRI
;<4.EXEC>EXEC1.MAC.75,  6-Dec-78 09:29:36, EDIT BY R.ACE
;CREATE CJDEV SUBROUTINE TO CLOSE JFN FOR A GIVEN DEVICE
;<4.EXEC>EXEC1.MAC.74, 19-Nov-78 17:55:11, EDIT BY DBELL
;TCO 4.2092 - GIVE TERMINAL NAME IN ^ESEND TEXTS SO REPLIES ARE EASIER
;<HURLEY.CALVIN>EXEC1.MAC.1,  8-Nov-78 22:09:25, EDIT BY HURLEY.CALVIN
; Change some GUIDE words to upper case only
;<4.EXEC>EXEC1.MAC.72, 27-Oct-78 18:28:19, EDIT BY OSMAN
;DON'T REFERENCE ACTBUF IN LOGIN
;<CALVIN>EXEC1.MAC.2,  8-Aug-78 13:59:05, EDIT BY CALVIN
; Install DISCARD
;[BBN-TENEXD]<CALVIN>EXEC1.MAC.1,  8-Aug-78 11:01:45, Ed: CALVIN
; Install ARCHIVE and RETRIEVE commands in this module (from EXECAR)
;<3-ARC-EXEC>EXEC1.MAC.4,  4-Aug-78 10:00:21, EDIT BY CALVIN
; Bugfixes from BBN sources into DEC archive sources
;<3-ARC-EXEC>EXEC1.MAC.3, 14-May-78 18:56:41, Edit by MTRAVERS
; TYPFRE made external for FLUSH to use.
;<3-ARC-EXEC>EXEC1.MAC.2, 14-May-78 18:02:05, Edit by MTRAVERS
;<3-ARC-EXEC>EXEC1.MAC.1, 14-May-78; Added stuff for DELETE, ARCHIVE.
;<4.EXEC>EXEC1.MAC.68, 22-Oct-78 07:51:42, EDIT BY HEMPHILL
;TCO 4.2059  ADD WARNING MESSAGE IF USER TRIES TO TALK TO SELF
;<4.EXEC>EXEC1.MAC.66,  8-Oct-78 18:49:14, EDIT BY OSMAN
;CALL ICLEAR INSTEAD OF CIS IN ADVISE CODE
;<4.EXEC>EXEC1.MAC.65,  7-Oct-78 00:48:07, EDIT BY OSMAN
;FIX ADVISE HEADER MESSAGE
;<4.EXEC>EXEC1.MAC.64, 28-Sep-78 15:44:33, EDIT BY HELLIWELL
;CHANGE B7 TO DV%MDV AT UNMOUNT
;<4.EXEC>EXEC1.MAC.63, 28-Sep-78 11:38:18, EDIT BY R.ACE
;IF RELD FAILS IN DEASSIGN COMMAND, CALL CJERRE INSTEAD OF JERR
;<4.EXEC>EXEC1.MAC.61, 27-Sep-78 16:15:23, EDIT BY OSMAN
;GET RID OF ALL REFS TO "B3" ETC. (EXCEPT FOR B7 UNDER NOSHIP???)
;TCO 4.2024 - WAIT FOR END OF LOGIN BEFORE PRINTING ERROR (SO PASSWORD DOESN'T ECHO)
;<4.EXEC>EXEC1.MAC.55, 26-Sep-78 13:24:57, EDIT BY OSMAN
;PUT BACK SINGLE-LINE LOGIN
;<4.EXEC>EXEC1.MAC.54, 21-Sep-78 15:21:19, EDIT BY OSMAN
;CHANGE WHLUO ETC. TO WHLU (SEE EXECDE)
;TCO 4.2012 - PRINT SENSIBLE ERROR ON DELETE COMMAND FAILING
;<4.EXEC>EXEC1.MAC.50, 15-Sep-78 22:24:34, EDIT BY OSMAN
;REMOVE ALL REFS TO CSBUF, CSBUFP
;<4.EXEC>EXEC1.MAC.49, 15-Sep-78 11:55:03, EDIT BY OSMAN
;Tco 4.2009 - Remove extra "PASSWORD)" in password routine
;<4.EXEC>EXEC1.MAC.48, 14-Sep-78 14:06:13, EDIT BY OSMAN
;DO SETNM IF ^EEDDT
;<4.EXEC>EXEC1.MAC.46, 14-Sep-78 11:37:41, EDIT BY OSMAN
;REMOVE SEARCH
;Remove mounting stuff.  Move to new module, EXECMT
;<4.EXEC>NEW1.MAC.1, 12-Sep-78 15:14:07, EDIT BY OSMAN
;MAKE LOGIN BE ON TWO LINES
;<4.EXEC>EXEC1.MAC.42,  6-Sep-78 13:43:52, EDIT BY R.ACE
;TCO 4.2002 - CHANGE HELP MESSAGE OF "TAKE" COMMAND
;<4.EXEC>EXEC1.MAC.41,  1-Sep-78 17:43:16, EDIT BY OSMAN
;REMOVE PASSWORD-ON-SAME-LINE OPTION OF CONNECT
;<4.EXEC>EXEC1.MAC.40, 30-Aug-78 23:52:07, EDIT BY DBELL
;TCO 4.2001 - MAKE SENDS TO PARTICULAR TTY NUMBER WORK AGAIN
;<4.EXEC>EXEC1.MAC.39, 21-Aug-78 20:06:23, EDIT BY OSMAN
;TCO 4.1988 - FIX "DEFINE" COMMAND HELP MESSAGE
;<4.EXEC>EXEC1.MAC.38, 10-Aug-78 10:11:38, EDIT BY OSMAN
;TCO 1977 DON'T ADVERTISE SUBCOMMANDS FOR UNDELETE
;<4.EXEC>EXEC1.MAC.37,  1-Aug-78 14:31:58, Edit by HEMPHILL
;TCO 1963 -- CORRECT FIX
;<4.EXEC>EXEC1.MAC.35,  1-Aug-78 10:02:06, EDIT BY OSMAN
;FIX SDISMOUNT, PUT ERROR RETURN ON STRX CALL, AND USE LOCAL CELL TO HOLD ALIAS NAME
;<4.EXEC>EXEC1.MAC.34, 31-Jul-78 11:08:42, Edit by HEMPHILL
;TCO 1963 -- MAKE TMOUNT WARN USER ABOUT OPERATOR NOT IN ATTENDANCE
;<4.EXEC>EXEC1.MAC.33, 27-Jul-78 15:43:39, EDIT BY OSMAN
;FIX "DEFINE" HELP MESSAGE
;<4.EXEC>EXEC1.MAC.32, 25-Jul-78 14:01:12, EDIT BY OSMAN
;TCO 1954
;DON'T PRINT OVER QUOTA MESSAGE ON ACCESS, OR IF NOT CHANGING CONNECTED DIRECTORY DURING CONNECT
;<4.EXEC>EXEC1.MAC.30, 21-Jul-78 15:31:19, EDIT BY OSMAN
;RESTORE NAME WHEN POP
;<4.EXEC>EXEC1.MAC.29, 21-Jul-78 10:34:41, Edit by PORCHER
;FIX SET ENTRY VECTOR FOR EX-ONLY
;<4.EXEC>EXEC1.MAC.28, 20-Jul-78 15:40:07, EDIT BY OSMAN
;RESTORE .SJT20 UPON EXITING (.POP)
;<4.EXEC>EXEC1.MAC.26, 17-Jul-78 11:30:43, EDIT BY OSMAN
;GET RID OF GTBUF, USE LOCAL STORAGE, ALSO REMOVE PUS/POP'S IN LOGIN
;<4.EXEC>EXEC1.MAC.23, 13-Jul-78 14:56:47, EDIT BY OSMAN
;CHANGE KEEPNM TO KEPNUM AND MAKE IT LOCAL
;<4.EXEC>EXEC1.MAC.22, 13-Jul-78 13:32:22, EDIT BY OSMAN
;MAKE TALK'S USE OF FRAME BE LOCAL (TFRAME)
;<4.EXEC>EXEC1.MAC.20, 11-Jul-78 15:44:28, EDIT BY OSMAN
;MAKE ADVISE, ATTACH, TALK USE LOCAL VARIABLES
;<4.EXEC>EXEC1.MAC.18, 10-Jul-78 20:50:23, EDIT BY OSMAN
;CHANGE REMARK'S USE OF TEXTIB TO BE LOCAL, AND RENAME IT TO CMTXTB
;<4.EXEC>EXEC1.MAC.17, 29-Jun-78 15:49:43, EDIT BY OSMAN
;make talk's dirno be local
;<4.EXEC>EXEC1.MAC.14, 29-Jun-78 14:56:48, EDIT BY OSMAN
;USE GTJFS, AND MAKE ADVJFN BE TRVAR.  ALSO TRVAR FOR CONNECT/ACCESS, STRNAM TOO
;<4.EXEC>EXEC1.MAC.13, 27-Jun-78 16:09:12, EDIT BY OSMAN
;CHANGE ALL THE GTB'S TO BE IMMEDIATE
;<4.EXEC>EXEC1.MAC.12, 26-Jun-78 09:55:49, EDIT BY OSMAN
;MAKE SURE LOGIN BANNER NOT ON SAME LINE AS LOGIN COMMAND
;(BROKE WHEN COMND CHANGED TO PUT CRLF'S IN BUFFER INSTEAD OF LF)
;<4.EXEC>EXEC1.MAC.11, 23-Jun-78 18:20:08, EDIT BY OSMAN
;REMOVE SYMBOLS: CONN2-3-4, ENTRY5, KEEP1A, LOGIN6, RECRF2, SMOUN1
;STRSIX, TAKIN1, TMOUN1, TRYGTP, .ASSO3, .CONN1, .SKIP0-1 (NOT REFERENCED!)
;<4.EXEC>EXEC1.MAC.10, 23-Jun-78 18:00:05, EDIT BY OSMAN
;REMOVE ADVLP0 (UNREFERENCED)
;<4.EXEC>EXECGL.MAC.25, 22-Jun-78 15:14:15, EDIT BY OSMAN
;IN MESMES, REMOVE HACK WITH MWATCT
;<4.EXEC>EXEC1.MAC.8, 19-Jun-78 14:48:55, EDIT BY OSMAN
;CALL SETIOF IN PUSHIO, INSTEAD OF DOING DVCHR AT READ1 (AVOIDS DOING DVCHR BEFORE EVERY COMMAND!)
;<4.EXEC>EXEC1.MAC.7,  9-Jun-78 18:03:56, EDIT BY OSMAN
;CHANGE CALLS TO FIELD TO FLDSKP
;<4.EXEC>EXEC1.MAC.6, 31-Jan-78 14:00:04, Edit by PORCHER
;<4.EXEC>EXEC1.MAC.5, 31-Jan-78 11:52:40, Edit by PORCHER
;Add "TAKE,ECHO"
;<4.EXEC>EXEC1.MAC.2, 19-Jan-78 14:53:42, EDIT BY HELLIWELL
;FIX STACK FOR NON-MTA (NOSHIP) AT DOMTOP
;<4.EXEC>EXEC1.MAC.1,  6-Jan-78 11:46:01, EDIT BY HELLIWELL
;TEST FOR DEVICE MTA BEFORE GDSTS AT DOMTOP
;FIX ERCAL .+2 AT DOACC
;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 EXEC1

;THIS FILE CONTAINS
;LOTS OF COMMANDS...

;ARCHIVE <Files>
;F2 - DON'T FLUSH FILE CONTENTS

.ARCHI::NOISE <FILES>
	TLZ Z,F2		;DEFAULT IS NOT TO RETAIN CONTENTS
	MOVE A,[XWD -1,0]	;NO DEFAULT NAMES
	HRLI B,-3		;DEFAULT VERSION IS *
	HRRI B,(GJ%OLD+GJ%IFG+GJ%PHY+GJ%XTN+GJ%FNS)
	CALL SPECFN
	 JRST ARCHI1
	JRST ARCHI2		;DO IT

ARCHI1:	SUBCOM $ARCHI

ARCHI2:	SETOM TYPGRP		;ALWAYS TYPE NAME
	MOVE A,COJFN
	MOVEM A,OUTDSG
	MOVE A,JBUFP
	MOVEM A,.JBUFP
	MOVX C,.ARSET		;WITH NO FLAGS
	TLNE Z,F2		;WANT TO RETAIN FILE CONTENTS?
	TXO C,AR%NDL		;RIGHT, FLAG THAT ON THE CALL
	PUSH P,C		;SAVE DISPOSITION BITS ETC
ARCHI3:	CALL RLJFNS
	CALL NXFILE
	 JRST ARCHI9
	CALL TYPIF
	CALL MFINP		;GET 2ND JFN
	 JRST ARCHI9		;FAILED
	MOVX B,.ARRAR		;FUNCTION CODE TO USE (PLS ARCHIVE)
	MOVE C,0(P)		;AND BITS
	ARCF
	 ERJMP [ETYPE < %?%%_>
		JRST ARCHI9]
	HRLI A,.FBCTL
	MOVX B,FB%INV		;MAKE THE FILE INVISIBLE TOO
	MOVX C,FB%INV
	TLNN Z,F2		;RETAIN CONTENTS?
	CHFDB
	 ERJMP [ETYPE < %?%%_>
		JRST .+1]
	TYPE < [Requested]
>
ARCHI9:	SKIPE INIFH1		;DONE THEM ALL?
	 JRST ARCHI3		;NO, LOOP
	SETZM .JBUFP
	ADJSP P,-1		;FLAGS NO LONGER USEFUL
	RET

;TABLES ETC. TO ARCHIVE

$ARCHI:	TABLE
	T RETAIN,,.ARFL
	TEND

.ARFL:	NOISE <DISK CONTENTS>
	CONFIRM
	TLO Z,F2
	RET
;LET (LOGICAL NAME) -- (AS) --

EDEFIN::TLO Z,F2
	NOISE <SYSTEM LOGICAL NAME>
	JRST .ASSO

.DEFIN::TLZ Z,F2
	NOISE <LOGICAL NAME>
.ASSO:	STARX <
 Logical name to define or delete,
 or "*" to delete all>
	JRST .ASSO1		;NOT "DEFINE *"
	PUSH P,[0]		;PUSH 0 TO INDICATE ALL
	JRST .ASSO2		;AND EAT TERMINATOR

.ASSO1:	STRX <Logical name to define or delete>	;READ LOGICAL NAME
	 CMERRX
	CALL BUFFF		;GET POINTER TO NAME
	PUSH P,A		;SAVE PNTR
.ASSO2:	SKIPN (P)		;ALL?
	JRST .ASS3B		;YES, SEPARATE ROUTINE
	NOISE <AS>
	CRRX <Definition list or null to delete>
	 CAIA			;NOT JUST "DEFINE FOO<CR>"
	JRST .ASSO9		;YES, JUST "DEFINE FOO<CR>"
	LINEX <Definition list>	;READ DEFINITION LINE
	 CMERRX			;NOT ANYTHING LEGAL AFTER "DEFINE" !
	CALL BUFFF		;GET POINTER TO DEFINITION STRING
	CONFIRM
	MOVE C,A		;NEW NAME IN C
	MOVEI A,.CLNJB
	TLNE Z,F2		;SYSTEM?
	MOVEI A,.CLNSY		;YES
.ASSO4:	TLNE Z,F2		;SYSTEM?
	CALL FCONF		;YES, FORCE FURTHER CONFIRMATION
	MOVE B,(P)		;GET LOGICAL NAME
	PUSH P,A		;REMEMBER ATTEMPTED FUNCTION IN CASE ERROR
	CRLNM
	 JRST ASSONO		;COULDN'T DO IT
	POP P,(P)
	POP P,(P)		;FIX STACK
	RET

;HERE WHEN LOGICAL NAME MANIPULATION FAILED

ASSONO:	CAIE A,CRLNX1
	 CALL CJERRE		;UNKNOWN ERROR
	POP P,A			;NOW WE KNOW "NAME UNDEFINED"
	CAIE A,.clnj1		;TRYING TO DELETE ONE JOB NAME?
	CAIN A,.clns1		;OR TRYING TO DELETE ONE SYSTEM NAME?
	CAIA			;YES
	 CALL CJERRE		;NO, TYPE MONITOR MESSAGE
	POP P,A			;GET POINTER TO NAME WE COULDN'T DELETE
	ETYPE <%%Logical name %1M: was not defined
>
	RET			;NON-FATAL ERROR IF DELETING NON-EXISTENT LOGICAL NAME

.ASSO9:	MOVEI A,.CLNJ1		;DELETE
	TLNE Z,F2
	MOVEI A,.CLNS1
	JRST .ASSO4

.ASS3B:	CRRX <Confirm to delete all logical names>
	 CMERRX
	MOVEI A,.CLNJA		;DELETE ALL
	TLNE Z,F2		;SYSTEM?
	MOVEI A,.CLNSA
	TLNE Z,F2		;SYSTEM?
	PROMPT <[Confirm to delete all SYSTEM logical names]>
	TLNN Z,F2
	PROMPT <[Confirm to delete ALL logical names]>
	CALL FCONFA
	CRLNM
	 CALL CJERR
	POP P,B
	RET
;ATTACH (USER) <NAME> (PASSWORD) -- (TSS JOB #) <#>

;LIKE LOGIN, THIS COMMAND ALSO ACCEPTS THE FORM:
;ATTACH
;(USER) <NAME>
;(PASSWORD) ----
;(TSS JOB #) <#>

;PASSWORD IS NOT ECHOED IN FULL DUPLEX, TYPED OVER MASK ON
;FOLLOWING LINE IN HALF DUPLEX.
;TSS JOB # CAN BE OMITTED IF THERE IS ONLY ONE JOB FOR GIVEN USER.
;IF NOT LOGGED IN, CURRENT JOB GOES AWAY (HANDLED BY MONITOR),
;IF LOGGED IN IT IS DETACHED.

;IN ORDER TO NOT HAVE TO HAVE THE EXEC WAKING UP AFTER EVERY FIELD
;OF INPUT TO SEE IF WE'RE DOING SOME SORT OF PASSWORD COMMAND, THE
;FORMAT OF THE "ATTACH" AND "UNATTACH" COMMANDS HAVE BEEN CHANGED TO
;PROMPT FOR THEIR PASSWORD ON THE SECOND LINE.  SINCE THE CR AT END
;OF FIRST LINE CAUSES WAKEUP, THIS GUARANTEES THAT ECHOING WILL HAVE
;A CHANCE TO BE TURNED OFF BEFORE USER TYPES PASSWORD.E.O. JUL-8-77

.ATTAC::			;ENTRY FOR COMMAND, NEXT TAG IS FROM UNATTACH
	IFNBATCH <[ERROR <ATTACH illegal from BATCH job>]>
ATTAU1:

;DECODE ARGUMENTS

	TRVAR <ATTNM,<APBUF,20>,AT1,AT2> ;HOLDS ATACH ARGS
	NOISE <USER>
	CALL USERN		;INPUT USER (DIRECTORY) NAME
	 CMERRX			;FAILED, PRINT REASON
	TXNE A,RC%DIR
	ERROR <That's a FILES-ONLY directory name>
	PUSH P,C		;SAVE DIR #
	SETOM ATTNM		;CLEAR ATTACHED TERMINAL # HERE
	NOISE <JOB #>
	DECX < Number if more than one job under that name>
	 CAIA			;NON-DECIMAL NUMBER TYPED
	JRST ATTNUM		;NUMBER TYPED, GO PROCESS IT
	CONFIRM			;REQUIRE CONFIRMATION OF COMMAND
	JRST ATTAC5		;GO DEFAULT A VALUE
ATTNUM:	CONFIRM
	PUSH P,B		;SAVE JOB # INPUT BY USER
;ATTACH...
;CHECK THAT USER-GIVEN JOB # IS IN LEGAL RANGE

	SETO D,
	GTB .JOBRT		;GET MAX JOB # AS LENGTH OF SYSTEM TABLE
	MOVN A,A		;LENGTH COMES BACK NEGATIVE
	SUBI A,1		;SO VALUE COMES OUT RIGHT IN ERR MSG
	CAML A,(P)		;LENGTH MUST BE > GIVEN #
	SKIPGE D,(P)		;GIVEN JOB # TO D
	ERROR <Job # must be between 0 and %1Q>

;MAKE SURE GIVEN JOB # IS LOGGED IN W MATCHING USER # AND IS ATTACHED

	GTB .JOBRT		;ENTRY NEG IF NO SUCH JOB
	JUMPL A,[UERR[ASCIZ /No job %4Q/]]
	GTB .JOBTT		;LINE # OR NEGATIVE FOR DETACHED IN LH
	HLREM A,ATTNM		;STORE ATTACHED LINE NUMBER FOR LATER
	CALL USERNO		;GET USER OWNING JOB BEING ATTACHED
	JUMPE A,[UERR [ASCIZ /Job %4Q not logged in/]]
	MOVE Q1,-1(P)		;DESIRED USER #, FOR USE IN ERR MSG
	CAME A,Q1
	ERROR <Job %4Q not logged in under %5R>
	JRST ATTAC7		;GO CONFIRM AND EXECUTE
;ATTACH...
;NO JOB # GIVEN, SEE IF THERE IS A UNIQUE ONE FOR GIVEN NAME.

ATTAC5:				;SEARCH JOBDIR TABLE FOR A MATCH
	GJINF			;GET JOB # INTO C FOR TEST LATER
	MOVE Q1,(P)		;DIR # TO SEARCH FOR (USED IN ERR MSGS!)
	SETO D,
	GTB .JOBRT		;JOBRT TABLE BY JOB #, LOGIN DIR # IN RH.
	HRLZ D,A		;SET UP XWD LENGTH, INDEX FOR AOBJN & GTB.
	TLZ Z,F2		;FLAG NO DETACHED JOBS SEEN YET
	PUSH P,[-1]		;INIT JOB TO UNKNOWN
ATA5A:	CAIN C,(D)		;ALWAYS SKIP US
	JRST ATA5L
	CALL USERNO
	CAME A,Q1		;IS THIS THE CORRECT USER?
	JRST ATA5L		;NO
	GTB .JOBTT		;YES - GET TTY WORD
	TLNN Z,F1		;ATTACH OR UNATTACH?
	JRST ATA5B		;ATTACH
	JUMPL A,ATA5L		;JUMP IF DETACHED
	SKIPL (P)		;ATTACHED JOB, SEEN ONE ALREADY?
	JRST ATA5E1		;YES, ERROR
	HRRZM D,(P)		;SAVE JOB #
	SETOM ATTNM		; AND SET TERM AS DETACHED
	JRST ATA5L

ATA5B:	JUMPL A,ATA5C		;JUMP IF DETACHED
	TLNE Z,F2		;ALREADY SEEN DETACHED JOB?
	JRST ATA5L		;YES, DON'T LOOK AT ATTACHED ONES
	SKIPL (P)		;FIRST ATTACHED ONE?
	JRST ATA5D		;NO, STOP LOOKING AT ATTACHED ONES
	HRRZM D,(P)		;SAVE JOB #
	HLREM A,ATTNM		; AND TERMINAL #
	JRST ATA5L

ATA5D:	SETOM (P)		;RESET JOB # TO UNKNOWN
	SETOM ATTNM		; AND TERMINAL # ALSO
	TLO Z,F2		;SET FLAG TO LOOK ONLY AT DETACHED JOBS
	JRST ATA5L

ATA5C:	TLON Z,F2		;FLAG DETACHED JOB FOUND
	SETOM (P)		;FORGET ANY ATTACHED JOB
	SKIPL (P)		;MORE THAN ONE?
	ERROR <Job # required - %5R has more than one detached job>
	HRRZM D,(P)		;NO, SAVE JOB #
	SETOM ATTNM		; AND MARK TERMINAL DETACHED
ATA5L:	AOBJN D,ATA5A		;LOOP THROUGH ALL JOBS
	SKIPL (P)		;DID WE FIND A JOB?
	JRST ATTAC7		;YES, GO DO IT
	TLNE Z,F2		;.GT. 1 ATTACHED, BUT 0 DETACHED?
	JRST ATA5E1		;YES, SAME ERROR MESSAGE AS UNATTACH
	TLNE Z,F1		;ATTACH OF UNATTACH?
	JRST ATA5E2		;UNATTACH
	CAMN Q1,CUSRNO
	ERROR <No other jobs logged in under %5R>
	ERROR <No jobs logged in under %5R>

ATA5E2:	CAMN Q1,CUSRNO
	ERROR <No other attached jobs logged in under %5R>
	ERROR <No attached jobs logged in under %5R>

ATA5E1:	CAMN Q1,CUSRNO
	ERROR <Job # required - %5R has more than one other attached job>
	ERROR <Job # required - %5R has more than one attached job>
;ATTACH...

;CHECK FOR SELF

ATTAC7:	GJINF			;GET JOB NUMBER IN C
	CAMN C,(P)		;IS IT US?
	 JRST [	TLNN Z,F1	;ATTACH OR UNATTACH?
		ERROR <Cannot ATTACH to self>
		ERROR <Cannot UNATTACH self>]

;CHECK FOR ALREADY ATTACHED

	SKIPGE A,ATTNM		;TTY #
	JRST ATAC4B
	HRROI B,APBUF		;REDIRECT OUTPUT TO OUR BUFFER
	MOVEM B,COJFN
	ETYPE < [Attached to TTY%1O, confirm]>
	CALL FIXIO		;RESUME NORMAL OUTPUT
	UPROMP APBUF		;PROMPT USER FOR CONFIRMATION
	CALL FCONFA

;EXECUTE THE COMMAND

ATAC4B:	POP P,A			;TSS JOB # TO ATTACH TO
	MOVEI C,0		;NO PASSWORD POINTER
	POP P,B			;USER TO ATTACH TO
	TLNN Z,F1		;IF NOT LOSING THIS JOB
	SKIPN CUSRNO		;OR NOT LOGGED IN,
	CAIA			;THEN SAY NOTHING
	ETYPE < Detaching job # %J
>
	TLNE Z,F1		;UNATTACH?
	TLO A,(1B1)		;YES, TELL ATACH
	DMOVEM A,AT1		;SAVE ARGS IN CASE REDO NECESSARY
	ATACH			;TRY TO DO IT
	 ERJMP .+2		;FAILED
	JRST ATGOOD		;SUCCEEDED
	CAIE A,ATACX4		;PASSWORD PROBLEM?
	JRST ATNG		;NO, SOME OTHER ERROR
	CALL PASLIN		;PASSWORD NOT GIVEN BUT REQUIRED, GET IT
	MOVE C,A		;STORE NEW PASSWORD POINTER
	DMOVE A,AT1		;GET OTHER ARGS
	ATACH
ATNG:	 CALL [	TLNN Z,F1	;DIDN'T SAY DETACHING JOB IF UNATTACH
		ETYPE <?ATTACH failure, still attached to job # %J
>
		CALL CJERRE]
ATGOOD:	JRST CMDIN4		;ATACH RETURNS +2 IF LOGGED IN--THIS JOB
				; STILL ATTACHED IF 'UNATTACH' JUST DONE.
;BREAK (LINKS)

NONEWF,<
.BREAK::NOISE <LINKS>
>
BREAK0:	CONFIRM
BREK0A:	MOVEI B,-1		;SET TO BREAK ALL LINKS
				;(FALL INTO BREAK1)

;BREAK1 breaks links from specific terminal.
;
;Accepts:	B/	terminal number or 777777 for all

BREAK1::MOVE A,[TL%CRO!TL%COR+.CTTRM] ;BREAK TO AND FROM LINKS
	TLINK
	 CALL JERR
	RET

NEWF,<
;BREAK (LINKS WITH) - FANCIER FORM OF BREAK COMMAND

.BREAK::NOISE <LINKS WITH>
	STKVAR <BYUNO>
	MOVEI B,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ "*"]>,<User name, line number, or CR for all>,<*>,[
		 FLDDB. .CMUSR,CM%SDH,,,,[
		 FLDDB. .CMNUM,CM%SDH,10,,,[
		 FLDDB. .CMCFM,CM%SDH,,,,]]]]
	CALL FLDSKP		;PARSE THIS MESS
	 CMERRX
	LDB C,[POINT 9,0(C),8]	;FIGURE OUT WHAT WAS TYPED
	CAIN C,.CMCFM		;JUST CR?
	 JRST BREK0A		;YES - DO ALL
	CAIN C,.CMTOK		;WAS IT "*"
	 JRST BREAK0		;YES - CONFIRM AND DO ALL
	CONFIRM			;MUST BE USER NAME OR LINE #
	CAIN C,.CMNUM		;LINE NUMBER?
	 JRST .BYEBY		;YES - CONFIRM, BREAK, AND RETURN
	MOVEM B,BYUNO		;SAVE USER #
	TLZ Z,F1!F2		;INIT FLAGS
	HLLZ D,JOBRT		;-# OF JOBS AS AOBJN CNTR
.BYE2:	CALL USERNO		;GET USER # OF JOB IN D
	CAME A,BYUNO		;IS IT THE ONE WE WANT?
	 JRST .BYE3		;NO
	TLO Z,F2		;FOUND ONE
	GTB .JOBTT		;GET TTY # FOR JOB
	JUMPL A,.BYE3		;JUMP IF DETACHED
	TLO Z,F1		;ACTUALLY OK TO BREAK LINK
	HLRZ B,A		;LINE # TO RHS
	CALL .BYEBY		;BREAK A LINK
.BYE3:	AOBJN D,.BYE2		;LOOP THRU ALL JOBS
	TLNE Z,F1		;DID ANY?
	 RET			;YUP - DONE
	TLNE Z,F2		;WHAT KIND OF LOSAGE?
	 ERROR <User has detached jobs only>
	ERROR <User not logged in>

.BYEBY:	TXO B,.TTDES		;MAKE INTO TERMINAL DESC.
	CALLRET BREAK1		;BREAK THE LINK AND RETURN
>
;CANCEL (Request type) ARCHIVE - arrive here from EXECQU

CANARC::NOISE <FOR FILES>
	MOVE A,[XWD -1,0]
	HRLI B,-3		;ALL GENERATIONS
	HRRI B,(GJ%OLD+GJ%IFG+GJ%PHY+GJ%XTN+GJ%FNS)
	TXO Z,IGINV		;FIND INVISIBLE FILES
	CALL SPECFN
	 JRST CERR		;NO "STUFF,"
	SETOM TYPGRP
	MOVE A,COJFN
	MOVEM A,OUTDSG
	MOVE A,JBUFP
	MOVEM A,.JBUFP		;SET JFN STACK FENCE
CANAR1:	CALL RLJFNS		;RELEASE UNNEEDED JFNS
	CALL NXFILE		;STEP TO NEXT FILE
	 JRST CANAR2
	HRRZ A,@INIFH1		;GET THE JFN WITH NO BITS
	MOVE B,[1,,.FBBBT]	;GET WORD WITH REQUEST BIT
	MOVEI C,C
	GTFDB			;GET IT NOW
	 ERJMP CANAR3		;SKIP THIS ONE
	TXNN C,AR%RAR		;REQUESTED?
	 JRST CANAR3		;NO, SKIP THIS FILE

	HRRZ A,@INIFH1		;GET THE JFN WITH NO BITS
	MOVE B,[1,,.FBCTL]	;GET FDB FLAG WORD
	MOVEI C,C
	GTFDB			;GET IT NOW
	 ERJMP CANAR3		;SKIP THIS ONE
	TXNE C,FB%ARC		;DOES THE FILE CURRENTLY HAVE ARCHIVE STATUS?
				;EG, HAS COLLECTION RUN-1 ALREADY STARTED?
	JRST	[TYPE <?File has archive status: >
		CALL TYPIF	;DISPLAY OFFENDING FILE
		TYPE <
>
		JRST CANAR3]	;TRY FOR NEXT FILE

	CALL TYPIF		;TYPE NAME OF FILE
	CALL MFINP		;GET A SECOND JFN
	 JRST [ETYPE < %?
>
		JRST CANAR2]	;FAILED FOR SOME REASON
	MOVEI B,.ARRAR		;REQUEST ARCHIVE
	MOVEI C,.ARCLR		;CLEAR THE REQUEST
	ARCF
	 ERJMP [ETYPE < %?
>
		JRST CANAR2]
	HRLI A,.FBCTL
	MOVX B,FB%INV
	SETZ C,			;MAKE FILE VISIBLE AGAIN
	CHFDB
	 ERJMP [ETYPE < %?
>
		JRST .+1]	;SAY OK IF JUST MAKING VISIBLE FAILED
	CALL TYPOK
CANAR2:	SKIPE INIFH1
	JRST CANAR1
	RET

CANAR3:	CALL GNFIL		;ADVANCE TO NEXT GUY
	 SETZM INIFH1		;NONE LEFT
	JRST CANAR2		;AND GO ON
;END-ACCESS (DIRECTORY) <NAME> --

.ENDAC::TLO Z,F2+F3		;F2 MEANS ACCESS OR END-ACCESS, F3 MEANS END-ACCESS
	JRST CONNX		;JOIN COMMON CODE

;ACCESS (DIRECTORY) <NAME> --

.ACCES::TLO Z,F2		;F2 ON MEANS "ACCESS", OFF MEANS "CONNECT"
	TLZ Z,F3		;F2 MEANS ACCESS
	JRST CONNX		;JOIN COMMON CODE

;CONNECT (TO DIRECTORY) <NAME> --

.CONNE::TLZ Z,F2+F3		;OFF MEANS "CONNECT", ON MEANS "ACCESS"
CONNX:	TRVAR <ACDNUM,ACPASS,ACJNUM,OLDCON> ;KEEP ACDNUM,ACPASS,ACJNUM CONSECUTIVE AND IN ORDER!!
	SETZM ACPASS		;NO PASSWORD ASSUMED THIS TIME
	SETOM ACJNUM		;USE OUR OWN JOB NUMBER
	NOISE <TO DIRECTORY>
	TLNE Z,F2		;WANT DEFAULTING?
	TLOA Z,F1		;NO (ACCESS, END ACCESS)
	TLZ Z,F1		;YES (CONNECT)
	CALL DIRNAM		;INPUT & CHECK DIRECTORY NAME
	 ERROR <No such directory or structure not mounted>
	MOVEM C,ACDNUM		;REMEMBER DIRECTORY NUMBER
	CONFIRM
	TLNE Z,F2		;CONNECT?
	JRST NOCONN		;NO, SO NO OVER QUOTA REPORTING
	GJINF			;GET CONNECTED DIRECTORY
	MOVEM B,OLDCON		;REMEMBER OLD ONE
	CALL CHKDAL		;CHECK CURRENT DIRECTORY BEFORE LEAVING
NOCONN:	SETZM ACPASS		;FIRST TRY WITHOUT PASSWORD
	CALL DOACC		;DO THE JSYS
	TLNE Z,F2		;CONNECT?
	JRST CMDIN4		;NO, ACCESS, SO NO OVER QUOTA REPORT
	GJINF			;GET CONNECTED DIRECTORY NOW
	CAME B,OLDCON		;DON'T GIVE SAME REPORT TWICE!
	CALL CHKDAL		;CHECK NEW DIRECTORY
	JRST CMDIN4

;ROUTINE TO DO JSYS FOR ACCESS, END-ACCESS, CONNECT

DOACC:	MOVE A,[AC%CON+3]	;SAY "CONNECT"+"3 WORDS IN INFO BLOCK"
	TLNE Z,F2		;"ACCESS"?
	TXC A,AC%CON+AC%OWN	;YES, TURN OFF CONNECT AND ON ACCESS
	TLNE Z,F3		;END-ACCESS?
	TXC A,AC%OWN+AC%REM	;YES, TURN OFF "ACCESS", TURN ON "END-ACCESS"
	MOVEI B,ACDNUM		;WHERE THE BLOCK IS.
	ACCES
	 ERCAL ACCHK		;FAILED
	RET			;SUCCEEDED

;CHECK FOR FAILING END-ACCESS AND USER WASN'T ACCESSING THE DIRECTORY

ACCHK:	CALL %GETER		;GET ERROR CODE FOR FAILING ACCES JSYS
	MOVE A,ERCOD
	CAIE A,ACESX6		;"DIRECTORY ISN'T BEING ACCESSED" ERROR?
	 JRST ACNOP		;NO, MAYBE PASSWORD NOT GIVEN BUT REQUIRED
	MOVE A,ACDNUM		;GET DIRECTORY NUMBER REFERRED TO
	ETYPE <%%Directory %1R wasn't being ACCESSed
>
	JRST CMDIN4		;GIVE SUCCESS RETURN FOR COMMAND

;CONNECT OR ACCESS FAILED.  SEE IF PASSWORD NOT GIVEN, BUT REQUIRED.
;IF SO, PROMPT FOR IT AND TRY AGAIN.  IF NOT, PRINT SYSTEM ERROR.

ACNOP:	CAIE A,ACESX3		;"?PASSWORD IS REQUIRED"?
	 JRST CJERRE		;NO, OTHER ERROR.  PRINT ERROR MESSAGE.
	CALL PASLIN		;YES, GET PASSWORD ON NEW LINE.
	MOVEM A,ACPASS		;STORE NEW PASSWORD POINTER
	JRST DOACC		;TRY THE JSYS AGAIN
;"COPY" IS IN X2CMD.MAC.

;DAYTIME
;THIS AND ALL ONE-WORD COMMANDS ARE CONFIRMED BEFORE DISPATCH.

.DAYTI::PRINT " "
	MOVE A,COJFN		;DESTINATION
	SETOB B,C		;SAY CURRENT DATE AND TIME, SUPER-VERBOSE FORMAT
	ODTIM
	ETYPE<%_>
	RET

;DELETE <FILE GROUP>

.DELET::TRVAR <EXMFLG,NEWDIR,INIFHO,<DELBUF,FILWDS>,KEPNUM,KEPJNM,DELDIR,DELPGS,DELJFN>
	SETZM KEPNUM		;ASSUME NOT KEEP
	NOISE <FILES>
	MOVE A,[XWD -1,0]	;NO DEFAULT NAMES
	HRLI B,-3		;DEFAULT VERSION IS *
	HRRI B,(GJ%OLD!GJ%NS!GJ%IFG!1B14!1B15!1B16) ;OLD FILE, NO SEARCH, *'S AND COMMA OK
	CALL SPECFN		;INPUT FILE GROUP DESCRIPTOR
	JRST DELET1
	TDZ Z,[F5!F2!F3!F4!1B18] ;CAN'T BE EXPUNGE IF NO SUBCOMMAND
	JRST DELET2

DELET1:	TDZ Z,[F5!F2!F3!F4!1B18] ;CLEAR FLAGS
	SUBCOM $DELET
DELET2:	SETOM TYPGRP		;ALWAYS TYPE NAME
	MOVE A,COJFN
	MOVEM A,OUTDSG		;FOR NXFILE TYPEOUT
	MOVE A,JBUFP		;SAVE THESE JFNS
	MOVEM A,.JBUFP
	SETZM DELDIR		;NO DIRECTORY INITIALIZED YET
	SETOM EXMFLG		;FORCE DIRECTORY TO BE EXAMINED
	SKIPE KEPNUM		;DELETING ALL VERSIONS?
	JRST KEEPDL		;NO, SPECIAL CODE
DELET3:	CALL RLJFNS		;RELEASE ALL TEMPORARY JFNS
	CALL NXFILE		;CHECK FOR SPECIAL TERM
	JRST [	SETOM EXMFLG	;BAD JFN STEPPED TO NEXT, REMEMBER TO EXAMINE IT
		JRST DTDEL2]
	SKIPE EXMFLG		;ARE WE SUPPOSED TO EXAMINE THIS DIRECTORY?
	JRST [	CALL GETDNM	;YES, SEE WHAT NUMBER IT IS
		CALL DELINI	;ESTABLISH THIS DIRECTORY AS CURRENT
		SETZM EXMFLG	;SAY NO MORE EXAMINATION NEEDED YET
		JRST .+1]
	CALL TYPIF		;TYPE FILENAME (RETURNS JFN IN A)
	MOVE A,INIFH1		;BEFORE STEPPING TO NEXT FILE
	MOVEM A,INIFHO		;REMEMBER WHICH JFN WE'RE ON
	CALL MFINP0		;GET SECOND JFN ON CURRENT FILE, RETURN IN A
	 JRST DTDEL2		;ERROR, MESSAGE ALREADY PRINTED
	MOVEM A,DELJFN		;SAVE JFN
	HRRZ A,A		;GET JFN
	TLNE Z,F5
	TXO A,DF%ARC		;ALLOW ARCHIVED FILES
	TLNE Z,F2
	TXO A,DF%EXP		;EXPUNGE FILE
	TLNE Z,F3
	TXO A,DF%FGT		;FORGET FILE
	TLNE Z,F4
	TXO A,DF%DIR		;ZAP DIRECTORY
	TRNE Z,1B18		;CONTENTS ONLY?
	TXO A,DF%CNO
	DELF
	 JRST [	TYPE <  >
		CALL $ERSTR	;PRINT ERROR MESSAGE
		ETYPE<%_>
		JRST DTDEL2]
	CALL TYPOK
	MOVE A,DELJFN		;GET FLAGS
	MOVE B,INIFHO		;GET OLD JFN POINTER
	CAMN B,INIFH1		;IF DIFFERENT JFN NOW, REPORT MIGHT BE DUE
	TXNE A,GN%STR!GN%DIR	;DID DIRECTORY JUST CHANGE?
	SETOM EXMFLG		;NEW JFN OR DIRECTORY CHANGED, REMEMBER TO EXAMINE DIRECTORY
DTDEL2:	SKIPE INIFH1		;DID WE USE UP ALL THE JFNS?
	JRST DELET3		;NO, GO CHECK NEXT JFN
	CALLRET PDLFRE		;REPORT ABOUT FINAL DIRECTORY AND RETURN

;ROUTINE USED BY DELETE TO PRINT NUMBER OF PAGES FREED IF EXPUNGE SUBCOMMAND
;WAS USED, OR IF SOME PAGES HAVE BEEN FREED

PDLFRE:	SKIPN A,DELDIR		;GET CURRENT DIRECTORY NUMBER
	RET			;WHOOPS, NONE!  USER TYPED "DELETE BLECCH"
	MOVE B,DELPGS		;CAUSE "PAGES FREED" TO BE 0 FOR NON-DIR DEVICE
	CAIE Q2,0		;DON'T TO "GTDAL" UNLESS MULTIPLE DIRECTORY DEVICE
	GTDAL			;CHECK ALLOCATION
	MOVE A,DELPGS		;GET ORIGINAL ALLOC
	SUB	A,B		;TAKE DIFFERENCE NOW
	TLNN Z,F2		;ALWAYS PRINT AFTER EXPUNGE
	JUMPE A,R		;DON'T PRINT IF 0
	MOVE C,DELDIR		;TELL TYPFRE WHICH DIRECTORY TO PRINT
	CALLRET TYPFRE		;PRINT RESULTS

;DELINI TAKES DIRECTORY NUMBER IN A AND INITIALIZES DATA TO WORK ON THAT
;DIRECTORY

DELINI:	MOVEM A,NEWDIR		;SET NEW DIRECTORY WE'RE WORKING ON
	CAMN A,DELDIR		;IS NEW ONE THE SAME AS THE OLD ONE?
	RET			;YES, SO DON'T RESET COUNTS OR TRY TO PRINT
	SKIPE DELDIR		;WAS THERE A PREVIOUS DIRECTORY?
	CALL PDLFRE		;YES, PRINT ITS RESULTS
	MOVE A,NEWDIR		;SET UP NEW ONE AS CURRENT
	MOVEM A,DELDIR		;REMEMBER DIRECTORY NUMBER
	CAIE Q2,0		;DON'T GET ALLOCATION FOR NON-DIRECTORY DEVICE
	GTDAL			;GET ALLOCATION
	MOVEM B,DELPGS		;SAVE PAGES IN USE
	RET

;GETDNM DECIDES WHAT DIRECTORY NUMBER WE'RE WORKING ON

GETDNM:	HRRZ A,@INIFH1		;GET JFN
	SETOM Q2		;ASSUME MULTIPLE DIRECTORY DEVICE
	CALL DIRQ		;SKIP IF DIRECTORY DEVICE
	MOVEI Q2,0		;NOT A MULTIPLE DIRECTORY DEVICE
	JUMPE Q2,R		;SKIP DIRECTORY NAME STUFF IF NOT MULTIPLE DIRECTORY DEVICE
	HRRZ B,@INIFH1		;JFN TO B
	LDF C,1B2+1B5+JS%PAF	;GET PUNCTUATED STRUCTURE AND DIRECTORY
	HRROI A,DELBUF		;WHERE TO PUT IT
	JFNS
	MOVSI A,(RC%EMO)	;LITERAL MATCH
	HRROI B,DELBUF		;STRING
	RCDIR			;GET DIR #
	HRROI B,DELBUF		;FOR ERROR MESSAGE
	TLNE A,(RC%AMB+RC%NOM)
	 ERROR <No such directory - %2m>
	MOVE A,C		;RETURN DIRECTORY NUMBER IN A
	RET

;DIRQ SKIPS IFF THE CURRENT JFN IS A MULTIPLE DIRECTORY DEVICE

DIRQ:	HRRZ A,@INIFH1		;GET RID OF FLAGS
	DVCHR			;GET DEVICE CHARACTERISTICS
	 ERCAL JERR		;UNEXPECTED FAILURE
	TXNE B,DV%MDD		;SKIP IF NON-DIRECTORY DEVICE
	RETSKP			;WE'LL SKIP, BECAUSE IT'S A DIRECTORY DEVICE
	RET

$DELET:	TABLE
	T ARCHIVE,,..ARCH
	T CONTENTS-ONLY,,.CNOLY
	T DIRECTORY,,..DIR
	T EXPUNGE,,..EXP
	T FORGET,,..FORG
	T KEEP,,..KEEP
	TEND

..ARCH:	NOISE <FILES INCLUDED>
	CONFIRM
	TLO Z,F5
	RET

.CNOLY:	CONFIRM
	SKIPE KEPNUM
	ERROR <Can't "KEEP" and "CONTENTS-ONLY" at the same time>
	TRO Z,1B18
	RET

..EXP:	NOISE <AFTER DELETING>
	CONFIRM
	SKIPE KEPNUM
	ERROR <Can't "KEEP" and "EXPUNGE" at the same time>
	TLO Z,F2		;FLAG EXPUNGE
	RET

..FORG:	NOISE <WITHOUT DEASSIGNING DISK ADDRESSES>
	CONFIRM
	SKIPE KEPNUM
	ERROR <Can't "KEEP" and "FORGET" at the same time>
	MOVX B,WHLU+OPRU
	CALL PRVCK
	 ERROR <WHEEL or OPERATOR capability required>
	TLO Z,F3
	RET

..KEEP:	DEFX <1>		;DEFAULT IS "1"
	DECX <Number of generations>
	 CMERRX			;NO DECIMAL NUMBER SUPPLIED
	CAIN B,1
	NOISE <GENERATION>
	CAIE B,1
	NOISE <GENERATIONS>
	CONFIRM
	SKIPN B
	ERROR <Number of generations may not be 0>
	TLNE Z,F3
	ERROR <Can't "KEEP" and "FORGET" at the same time>
	TLNE Z,F2
	ERROR <Can't "KEEP" and "EXPUNGE" at the same time>
	TRNE Z,1B18
	ERROR <Can't "KEEP" and "CONTENTS-ONLY" at the same time>
	MOVEM B,KEPNUM
	RET

..DIR:	NOISE <AND "FORGET" FILE SPACE>
	CONFIRM
	MOVX B,WHLU+OPRU
	CALL PRVCK		;MUST HAVE PRIVS FOR THIS FCN
	 ERROR <WHEEL or OPERATOR capability required>
	SKIPN KEPNUM
	TLZE Z,F2!F3
	TYPE <% KEEP or EXPUNGE or FORGET subcommand ignored>
	SETZM KEPNUM		;ZERO THIS
	TLO Z,F4		;SET FLAG FOR ZAP DIRECTORY
	RET
;PRUNE NUMBER OF GENERATIONS

;SOME BUFFER DEFINITIONS

VERBUF==BUF0			;PUT TABLE AT BUF0
VRTBLN==<BUFL-BUF0>/2		;USE 1/2 THE SPACE FOR STRING POINTERS,
				;THE OTHER 1/2 FOR STRINGS
VERSTR==VERBUF+VRTBLN		;START OF STRING SPACE
VEREND==BUFL+1000-5		;5 WORDS FOR OVERFLOW

KEEPDL:	CALL RLJFNS		;RELEASE ANY TEMPORARY JFNS
	CALL NXFILE		;CHECK FOR NON-EX TERMS
	 JRST KEEPDE		;END CHECK
	HRROI A,DELBUF		;GET POINTER TO STRING BUFFER
	HRRZ B,@INIFH1		;GET JFN
	LDF C,2B2+2B5+1B8+1B11+1B35 ;DEV, DIR, NAME, EXT
	JFNS			;SAVE NAME OF FILE
	 ERCAL JERRE
	MOVE A,[POINT 7,VERSTR]	;INIT POINTER TO VERSION STRING SPACE
	MOVEM A,KEPJNM		;SAVE HERE
	MOVSI Q1,-VRTBLN	;AOBJN PTR TO VER STRING PTR TABLE
	LDF	D,1B14+1B35	;GENERATION + PUNCTUATION
KEEPD1:	MOVE A,KEPJNM		;GET VERSION POINTER
	TLNE Z,F5		;ALLOWED TO DELETE ARCHIVE STUFF?
	 JRST KEEPD8		;YES, BYPASS CHECKS
	HRRZ A,@INIFH1		;GET CURRENT JFN
	MOVE B,[1,,.FBCTL]	;GET CONTROL BITS
	MOVEI C,C
	GTFDB
	 ERJMP .+1
	TXNE C,FB%ARC		;NOT DELETABLE?
	 JRST KEEPD9		;NO, PASS OVER IT
	HRRZ A,@INIFH1
	MOVE B,[1,,.FBBK0]
	MOVEI C,C
	GTFDB
	 ERJMP .+1
	TXNE C,AR%RAR		;REQUESTED ARCHIVE?
	 JRST KEEPD9		;YES, PASS OVER IT
KEEPD8:	MOVE A,KEPJNM		;GET VERSION POINTER
	HRRZ B,A
	CAIL B,VEREND		;BUFFER SPACE FULL?
	JRST KEEPOV		;YES
	MOVEM A,VERBUF(Q1)	;SAVE IN TABLE
	HRRZ B,@INIFH1
	MOVE C,D		;GET DISPOSITION
	JFNS			;INTO VERSION STRING SPACE
	 ERCAL JERRE
	SETZ C,
	IDPB C,A		;TERMINATE STRING
	MOVEM A,KEPJNM		;STORE UPDATED STRING POINTER
KEEPD9:	MOVE A,@INIFH1
	TLNE A,770000		;SKIP GNJFN IF NO STARS
	GNJFN
	 JRST KEEPD3
	TLNE A,(1B14+1B15+1B16)	;DIR, NAME, EXT CHANGED?
	JRST KEEPD2		;YES, FINISH THIS FILE
	JUMPN C,KEEPD1		;IF NONE FOUND
	LDF	D,1B14		;GENERATION WITHOUT PUNCT.
	AOBJN Q1,KEEPD1		;INCREMENT VERSION PTR AND LOOP BACK
KEEPOV:	TYPE <%Too many generations for internal storage, will not print generations
>
	CALL KEEPPN		;PRINT NAME
	CALL KEEPDO		;DO DELETE (RETURNS # DELETED IN A)
	SKIPL A
	ETYPE < [%1Q generations deleted]
>
	MOVE A,@INIFH1
	TLNE A,770000
KEEPD4:	GNJFN
	 JRST [	AOS A,INIFH1
		CAMLE A,INIFH2	;OFF END?
		SETZM INIFH1	;YES, INDICATE SUCH
		JRST KEEPDE]
	TLNN A,(1B14+1B15+1B16)
	JRST KEEPD4
	JRST KEEPDE

KEEPD3:	AOS A,INIFH1
	CAMLE A,INIFH2
	SETZM INIFH1
KEEPD2:	MOVEI A,1(Q1)		;GET NUMBER OF VERSIONS
	SUB A,KEPNUM		;GET NUMBER TO DELETE
	JUMPLE A,KEEPDE		;JUMP IF NONE
	CALL KEEPPN		;PRINT NAME
	MOVNI A,1(Q1)		;GET -NUMBER OF VERSIONS
	ADD A,KEPNUM		;GET NUMBER TO DELETE
	HRLZ Q1,A		;MAKE AOBJN PTR
KEEPD5:	MOVE A,VERBUF(Q1)
	ETYPE <%1M>
	AOBJN	Q1,[PRINT ","	;PRINT THEM ALL
		    JRST KEEPD5]
	CALL KEEPDO		;DO DELNF
	JUMPL A,KEEPDE		;ERROR?
	CALL TYPOK		;TYPE [OK]
KEEPDE:	SKIPE INIFH1
	JRST KEEPDL
	JRST DTDEL2

KEEPPN:	PRINT " "
	HRROI A,DELBUF		;GET NAME POINTER
	ETYPE <%1M>		;TYPE IT
	RET

KEEPDO:	MOVSI A,(GJ%OLD+GJ%PHY+GJ%SHT)
	HRROI B,DELBUF		;GET FILE VERSION 0 (HIGHEST)
	CALL GTJFS		;GET AND STACK JFN
	 JRST KEEPE1		;GTJFN FAILED
	MOVE B,KEPNUM		;NUMBER TO KEEP
	TLNE Z,F5		;ARCHIVE ALLOWED?
	 TXO A,DF%ARC		;YES, SAY SO.
	DELNF
	 JRST KEEPE2
	MOVE A,B		;RETURN NUMBER IN A
	RET

KEEPE2:	TYPE <   >
	CAIA
KEEPE1:	TYPE <   GTJFN failure for highest generation
?>
	CALL $ERSTR
	TYPE <
>
	SETO A,
	RET
;DISCARD (TAPE INFORMATION FOR FILES) <FILES>

.DISCA::NOISE <TAPE INFORMATION FOR FILES>
	MOVE A,[XWD -1,0]	;NO DEFAULT NAMES
	HRRZI B,(GJ%OLD+GJ%IFG+GJ%PHY+GJ%XTN+GJ%FNS+CF%NS) ;NO SUBCOMMANDS
	CALL SPECFN
	 JRST CERR		;DON'T ALLOW "STUFF,"
	SETOM TYPGRP		;ALWAYS TYPE THE NAME
	MOVE A,COJFN
	MOVEM A,OUTDSG		;WHERE OUTPUT GOES
	MOVE A,JBUFP
	MOVEM A,.JBUFP
DISCA1:	CALL RLJFNS		;RELEASE STRAY JFN'S
	CALL NXFILE		;STEP TO NEXT FILE IN GROUP
	 JRST DISCA2		;NO MORE IN THIS GROUP
	CALL TYPIF		;DO NAME
	CALL MFINP		;GET A SECOND JFN
	 JRST DISCA2		;FAILED?
	MOVX B,.ARDIS		;FUNCTION CODE FOR THE DISCARD
	MOVX C,AR%CR1+AR%CR2	;DO BOTH TAPES
	ARCF
	 ERJMP DISCA9		;FAILED...
	CALL TYPOK		;TELL THE USER IT'S DONE
DISCA2:	SKIPE INIFH1		;DONE THEM ALL?
	JRST DISCA1		;NO, CONTINUE THE PROCESS
	RET

DISCA9:	ETYPE < %?
>
	JRST DISCA2
;EXPUNGE (ALL DELETED FILES)

.EXPUN::TRVAR <EXPNST,EXPNFL,EXPDIR,OLDALC>
	GJINF
	MOVEM B,EXPDIR		;DEFAULT IS CONNECTED DIR
	NOISE <DIRECTORY>
	CALL CURNMS		;READ DIRECTORY NAME ALLOWING STARS
	 ERROR <No such directory>
	MOVEM A,EXPNFL		;SAVE THE FLAGS RETURNED
	MOVEM B,EXPNST		;SAVE THE POINTER TO THE DIR NAME STRING
	MOVEM C,EXPDIR		;SAVE DIRECTORY NUMBER

	CALL %EXPUN		;CHECK SUBCOMMANDS
EXPUN1:	CALL EXPDO		;GO EXPUNGE THIS DIRECTORY
	MOVE A,EXPDIR		;NOW STEP THE DIRECTORY NAME
	MOVE B,EXPNST		;GET POINTER TO THE USER NAME STRING
	MOVE C,EXPNFL		;GET THE FLAGS
	TXNE C,RC%WLD		;WILD CARDS TYPED?
	CALL STPDIR		;YES, GO STEP THE DIR NUMBER
	 RET			;NO MORE TO BE DONE
	MOVEM A,EXPDIR		;SAVE THE NEW DIRECTORY NUMBER
	JRST EXPUN1		;LOOP BACK FOR REST OF DIRS

;ROUTINE TO DO THE EXPUNGING
;ACCEPTS IN EXPDIR/	DIR NUMBER
;WARNING:  THIS IS NOT A GENERAL ROUTINE.  TO MAKE IT ONE, HAVE IT
;ACCEPT THE DIR IN A INSTEAD OF EXPDIR, SINCE EXPDIR IS LOCAL TO THE
;EXPUNGE COMMAND

EXPDO:	MOVE A,EXPDIR
	GTDAL
	MOVEM B,OLDALC
	MOVE B,EXPDIR
	HLLZ A,Q1		;GET BITS FROM ARGS
	DELDF
	  ERJMP	[TYPE <% >	;HANDLE ERROR
		 CALL %GETER	;GET ERROR CODE
		 MOVE A,ERCOD
		 CALL $ERSTR	;PRINT IT
		 MOVE A,EXPDIR	;GET DIR NUMBER
		 ETYPE< - %1R%%_> ;TERMINATE ERROR MESSAGE
		 RET]		;AND RETURN
	MOVE A,EXPDIR
	GTDAL
	MOVE A,OLDALC
	SUB A,B
	MOVE C,EXPDIR		;GET THE DIR NUMBER TO BE OUTPUT

;... FALL INTO TYPFRE

;TYPFRE TAKES NUMBER OF PAGES FREED IN A, DIR NUMBER IN C, AND PRINTS
;MESSAGE SAYING HOW MANY PAGES FREED

TYPFRE::MOVEI	B,[ASCIZ " %3R [%1Q"]
	SKIPN	A		;ANYTHING?
	MOVEI	B,[ASCIZ " %3R [No"]
	UETYPE	(B)		;PRINT FIRST PART
	TYPE	< page>		;BUILD CORRECT GRAMMAR
	CAIE	A,1		;ONLY ONE?
	PRINT	"s"		;NO - THEN PLURAL
	TYPE	< freed]
>
	RET

;ROUTINE TO GET EXPUNGE SUBCOMMANDS

%EXPUN:	SETZ Q1,		;CLEAR BITS
	CALL SPRTR
	 SUBCOM $EXPUN		;SUBCOMMANDS, READ 'EM
	RET

$EXPUN:	TABLE
	T DELETE,,.TEXP
	T PURGE,,.NXEXP
	T REBUILD,,.REBLD
	TEND

.TEXP:	NOISE <TEMPORARY FILES>
	CONFIRM
	TXO Q1,DD%DTF
	RET

.NXEXP:	NOISE <NOT COMPLETELY CREATED FILES>
	CONFIRM
	TXO Q1,DD%DNF
	RET

.REBLD:	NOISE <SYMBOL TABLE>
	CONFIRM
	TXO Q1,DD%RST
	RET

;COMMENT (END WITH ^Z)

.REMAR::NOISE (MODE)
	CONFIRM			;GET COMMAND CONFIRMATION
	TYPE <Type remark.  End with CTRL/Z.
>
	STKVAR <<CMTXTB,10>>
	SETZM .RDBFP+CMTXTB	;SAY NO BACKUP POINTER
	SETZM .RDRTY+CMTXTB	;SAY NO ^R POINTER
COM1:	MOVEI A,.RDBRK		;THIS MANY WORDS IN TEXTI BLOCK
	MOVEM A,.RDCWB+CMTXTB
	MOVX A,RD%JFN		;SAY WE'RE GIVING JFNS
	MOVEM A,.RDFLG+CMTXTB
	HRL A,CIJFN		;INPUT STREAM
	HRR A,COJFN		;EDITING STREAM
	MOVEM A,.RDIOJ+CMTXTB
	HRROI A,BUF0		;USE BUFFER SPACE FOR INPUT
	MOVEM A,.RDDBP+CMTXTB
	MOVX A,<BUFEND-BUF0+1>*5;THIS MANY CHARACTERS AVAILABLE IN BUFFER
	MOVEM A,.RDDBC+CMTXTB
	MOVEI A,[EXP 1B<3*8+2>,0,0,0]	;ONLY BREAK ON ^Z
	MOVEM A,.RDBRK+CMTXTB	;SET UP BREAK MASK
	MOVEI A,CMTXTB		;POINT TO BLOCK
	TEXTI			;INPUT SOME OF THE COMMENT
	 ERCAL CJERRE		;FAILED, GO SEE WHY
	MOVE A,.RDFLG+CMTXTB	;GET RESULTS
	TXNE A,RD%BTM		;^Z TYPED YET?
	 JRST UNMAP		;YES, CLEAN UP AND RETURN
	JRST COM1		;NOT YET, READ MORE

.CLOSE::NOISE <JFN>
	CRRX <Octal JFN number or blank for all>
	 CAIA			;NOT JUST "CLOSE<CR>"
	JRST SHUT
	OCTX <Octal JFN number>	;SEE IF OCTAL NUMBER
	 CMERRX			;NOT OCTAL NUMBER EITHER!
	CONFIRM
	PUSH P,B		;SAVE THE JFN
	CALL CLOPAT		;GO UNMAP THE FILES IF PA1050 THERE
	POP P,A			;PUT JFN IN A
	CAIG A,MAXJFN		;ERROR IF THE JFN IS NOT WITHIN BOUNDS
	SKIPG A
	ERROR <Illegal JFN number>
	CALL JFNREL
	 ERROR <JFN not in use>
	RET

;ENTER HERE WITH JFN TO RELEASE IN A

JFNREL:	TDZA	D,D		;NO SPECIAL BITS
JFNRLA::LDF	D,CZ%ABT	;CLOSE WITH ABORT
	HRRZ	A,A		;CLEAR LHS
	GTSTS
	TXNN B,GS%NAM		;ANYTHING IN THIS JFN?
	RET			;NO, RETURN
	ETYPE < %1P   %1S  >	;TYPE JFN AND NAME
	CAIN A,.PRIIN		;PRIMARY INPUT?
	JRST NRLPRI		;YES
	CAIN A,.PRIOU		;PRIMARY OUTPUT?
	JRST NRLPRO
	CALL NOTIO		;MAKE SURE JFN ISN'T BEING USED FOR EXEC COMMAND INPUT OR OUTPUT
	 JRST NRLEX		;NAUGHTY, NAUGHTY, TRYING TO CLOSE COMMAND JFN!
	TXNN B,GS%OPN		;OPEN?
	JRST [	RLJFN
		 JRST JFNER1
		JRST JFNOK1]
	HLL A,D			;USE BITS IN D
	CLOSF
	JRST JFNER2
JFNOK1:	GTSTS
	TXNE B,GS%NAM		;NAME STILL THERE?
	JRST JFNOK2
	TYPE < [OK]
>
	RETSKP

NRLPRI:	TYPE < Primary input not closed
>
	RETSKP

NRLPRO:	TYPE < Primary output not closed
>
	RETSKP

;USER TRIED TO CLOSE COMMAND JFN.  SEE WHETHER INPUT OR OUTPUT TO
;GIVE FANCY MESSAGE.

NRLEX:	TXNE B,GS%WRF		;OPEN FOR WRITE?
	JRST NRLEXO		;YES, ASSUME OUTPUT JFN
	JRST NRLEXI		;NO, ASSUME INPUT

NRLEXI:	TYPE < EXEC command input not closed
>
	RETSKP

NRLEXO:	TYPE < EXEC command output not closed
>
	RETSKP

JFNOK2:	TXNE B,GS%OPN
	TYPE < Can't close file
>
	TXNN B,GS%OPN
	TYPE < Can't release JFN
>
	RETSKP

JFNER1:	TYPE < Can't release JFN - >
	CAIA
JFNER2:	TYPE < Can't close file - >
	CALL $ERSTR		;PRINT ERROR IN A
	ETYPE<%_>
	RETSKP

SHUT:	CALL CLOPAT		;GO UNMAP THE PA1050 OPEN FILES
	MOVEI A,MAXJFN		;START WITH LARGEST TO BE LIKE FILSTAT
SHUT1:	PUSH P,A
	CALL JFNREL		;RELEASE JFN
	 JFCL			;IGNORE NOTHING THERE
	POP P,A
	SOJG A,SHUT1
	RET
;ADVISE (TERMINAL/USER)

.ADVIS::TLO Z,F2		;FLAG ADVISE
	NOISE <USER>
	JRST LINK0

.JILEN==.JILNO+1		;ROOM FOR ALL JOB INFO WE MAY NEED

;TALK (TERMINAL/USER)

.TALK::	TLZ Z,F2
	NOISE <TO>
LINK0:	TRVAR <DOLNKF,<JIBUF,.JILEN>,<LDBUF,3>,TFRAME,ADVJFN,ADVJNM,DIRNO>
	MOVEM P,TFRAME		;SAVE BEGINNING OF POSSIBITITES
	USERX <User name or terminal number>
	 JRST LTTY		;NOT USER NAME, SEE IF TERMINAL NUMBER TYPED
	CONFIRM
	MOVEM B,DIRNO		;SAVE USER NUMBER
	TLZ Z,F1		;NO DETACHED JOBS SEEN YET
	MOVEM P,TFRAME		;SAVE BEG OF ARGS
	HLLZ D,JOBRT		;MAKE AOBJN PTR
LINK3:	MOVEI B,(D)		;GET JOB NUMBER BY ITSELF
	CAME B,JOBNO		;LOOKING AT MY OWN JOB?
	SKIPN B			;OR JOB 0?
	JRST LINK6		;YES, SKIP IT
	CALL USERNO		;GET USER NUMBER
	CAME A,DIRNO
	JRST LINK6		;WRONG GUY
	GTB .JOBTT
	TLO Z,F1		;FLAG DETACHED JOB SEEN
	JUMPL A,LINK6		;AND SKIP IT IF DETACHED
	HLRZS A
	PUSH P,A		;SAVE TTY# (1ST WORD OF A POSSIBILITY)
	GTB .JOBPN		;GET PROGRAM NAME
	PUSH P,A		;SAVE SUBSYSTEM NAME (2ND WRD OF POSS.)
LINK6:	AOBJN D,LINK3		;MAY HAVE MORE JOBS
	CAMN P,TFRAME		;FOUND ANY?
	 JRST [	TLNE Z,F1
		ERROR <User has detached jobs only
 Use "MAIL" to send mail to user>
		MOVE A,CUSRNO	;GET MY USER NUMBER
		CAMN A,DIRNO	;LOOKED FOR MY OWN JOBS?
		JRST LINKNS	;YES, SAY CAN'T DO MYSELF
		ERROR <User is not logged in
 Use "MAIL" to send mail to user>]
	POP P,A			;SUBSYSTEM NAME
	POP P,B			;TTY#
	CAMN P,TFRAME		;ONLY ONE POSSIBILITY?
	JRST [	MOVE A,B	;YES, USE IT
		TLO Z,F3	;NO CONFIRM NEEDED
		JRST LINK11]

LINK7:	MOVE C,B		;SAVE FOR POSSIBLE DEFAULT
	ETYPE < TTY%2O%, >
	JUMPE A,[PRINT "?"	;NO SUBSYS NAME
		JRST LINK8]
	CALL SIXPRT		;PRINT SUBSYSTEM

LINK8:	ETYPE <%_>
	CAMN P,TFRAME		;DONE ALL?
	 JRST LINK9		;YES
	POP P,A
	POP P,B
	JRST LINK7

LINK9:	PROMPT <TTY: >
	HRROI A,LDBUF		;GET POINTER FOR DEFAULT STRING
	MOVEM A,CMDEF		;SAVE POINTER TO DEFAULT
	MOVE B,C		;GET DEFAULT TTY # (FIRST ONE ON LIST)
	MOVEI C,8		;IN OCTAL
	NOUT			;CREATE DEFAULT STRING
	 CALL JERR		;SHOULDN'T FAIL
	OCTX <Terminal number>
	 CMERRX			;NON-OCTAL NUMBER TYPED
	JRST LINK10

LTTY:	OCTX			;USER NAME NOT TYPED, SEE IF TERMINAL NUMBER
	 CMERRX <User name or terminal number required>
LINK10:	CONFIRM

LINK11:	PUSH P,B		;SAVE TTY#
	GJINF			;GET JOB INFORMATION
	TLNN Z,F2		;SKIP CHECK IF ADVISING
	CAME D,0(P)		;IS TTY# IDENTICAL TO MY TTY NUMBER ?
	SKIPA
LINKNS:	 ERROR <Cannot talk to self>
	HLRE B,TTYJOB		;GET NEG SIZE OF TABLE
	MOVMS B
	POP P,A			;TTY#
	CAIGE A,0(B)
	CAIGE A,0
	 ERROR <Nonexistent terminal number>
	TLNN Z,F3
	MOVE P,TFRAME
	PUSH P,A
	SETZ D,
	GTB .PTYPA
	MOVE D,A
	POP P,A
	CAIGE A,(D)		;PTY?
	JRST NOPTYL		;NO
	PUSH P,D		;MAYBE.  CHECK FOR ABOVE LAST PTY
	HLRZ D,D		;NUMBER OF PTYS
	ADD D,0(P)		;LAST PLUS ONE
	POP P,0(P)		;CLEAR STACK
	CAIL A,(D)		;ABOVE PTY'S?
	JRST NOPTYL		;YES.  NVT OR SOMETHING ELSE
	PROMPT < [Pseudo-terminal, confirm]>
	CALL FCONFA
NOPTYL:	TLNE Z,F2
	JRST ADVISE		;GO GIVE ADVISE
	MOVEI B,.TTDES(A)	;FORM TTY DESIGNATOR
	MOVE A,[1B2+1B3+.CTTRM]	;TO AND FROM CONTROLLING TTY
	TLINK
	 ERROR <Refused, use "MAIL" to send mail to user>
	RET
;CODE TO GIVE ADVISE - CHECK TERMINAL PRINT JOB INFO

ADVISE:	MOVEM A,ADVTNM
	MOVX B,WHLU!OPRU
	CALL PRVCK
	CAIA
	JRST ADVIS1		;SKIP CHECK IF PRIVILEGED
	TRO A,.TTDES
	RFMOD
	 ERJMP [CALL TX1SKP	;FAILED, SEE IF FOR LINE NOT ACTIVE
		 CALL JERRE	;STRANGE ERROR, REPORT IT
		JRST ADVIS1]	;NOTHING ON LINE, THAT'S O.K.
	TRNN B,TT%AAD
	ERROR <Destination not receiving advice>
ADVIS1:	SETO D,
	GTB .TTYJO
	MOVNS A,A
	CAMGE A,ADVTNM
	ERROR <Illegal terminal number>
	MOVNI A,1
	MOVE B,[-1,,C]
	MOVEI C,.JITNO
	GETJI
	 CALL JERR
	CAMN C,ADVTNM
	ERROR <Cannot advise self>
	TYPE < Escape character is <CTRL>E, type <CTRL>^? for help
>
	MOVE D,ADVTNM
	GTB .TTYJO
	HLRZ B,A
	CAIN B,-1
	JRST [	TYPE < No job on terminal.
>
		JRST CONNECT]
	CAIN B,-2
	JRST [	TYPE < Terminal being assigned.
>
		JRST CONNECT]
	TRZE B,400000
	TYPE < Not controlling terminal.
>
	MOVEM B,ADVJNM
	PRINT " "
	MOVE A,ADVJNM
	MOVEI B,JIBUF		;GET ADDRESS OF BUFFER
	HRLI B,-.JILEN		;SPECIFY LENGTH
	MOVEI C,0
	GETJI
	 CALL JERR
	SKIPN B,.JIUNO+JIBUF
	JRST [	TYPE <Not logged in>
		JRST NOLOGD]
	ETYPE <%2R>
NOLOGD:	MOVE B,.JIDNO+JIBUF
	CAMN B,.JILNO+JIBUF
	JRST NOCOND
	UETYPE [ASCIZ /, %2R/]
NOCOND:	MOVE B,ADVJNM
	ETYPE < Job %2Q>
	PRINT " "
	SKIPN A,.JIPNM+JIBUF
	MOVE A,.JISNM+JIBUF
	CALL SIXPRT
	ETYPE<%_>
;CODE TO GIVE ADVISE - MAKE CONNECTION, LOOP SENDING CHARACTERS

CONNEC:	SETOM DOLNKF		;SAY TLINK NEEDED
	MOVE B,ADVTNM		;GET TERMINAL NUMBER
	TRO B,.TTDES		;SET UP TERMINAL NUMBER FOR STI
	MOVEM B,ADVTNM
	CALL CHKLNK		;TRY TO ESTABLISH LINK FIRST
	MOVEI A,.FHSLF
	RPCAP
	MOVEI A,.FHJOB
	MOVX B,1B<ADVESC>	;ONLY THE ADVICE ESCAPE CHARACTER DOESN'T GET SENT TO THE REMOTE JOB
	TXNE C,SC%CTC		;CAN'T SET JOB TIW IF NO ^C PRIV
	STIW
	MOVE A,[ADVESC,,^D24]	;CONTROL-E IS USED TO GET OUT
	ATI
	SETOM ADVFLG		;FLAG IN ADVISE CODE
	TLZ Z,F3		;NOT IN COMMENT NOW
	LDF A,GJ%SHT		;SHORT FORM GTJFN
	HRROI B,[ASCIZ /TTY:/]	;WE NEED BINARY CHANNEL.  THIS IS SO
				;IF THINGS LIKE "TER RA" OR "TER NO RA"
				;ARE "SENT" TO REMOTE JOB, THEY HAVE
				;EFFECT
	CALL GTJFS		;GET HANDLE ON TTY FOR BINARY COMMUNICATION
	 CALL CJERRE		;FAILURE, PRINT ERROR AND RETURN
	MOVE B,[100000,,OF%RD]	;OPEN THE JFN FOR READ
	OPENF
	 ERCAL CJERRE		;FAILED
	MOVEM A,ADVJFN		;REMEMBER THE ADVISE JFN
	MOVEI A,.CTTRM		;CONTROLLING TERMINAL
	RFMOD			;GET CURRENT SETTING OF PAGE MODE
	MOVE C,B		;GET A COPY OF IT
	ANDX C,TT%PGM		;KEEP ONLY PAGE MODE
	MOVEM C,SAVPGM		;REMEMBER CORRECT SETTING
	TXZ B,TT%PGM		;TURN OFF PAGING SO WE CAN SEND CTRL/Q TO REMOTE TERMINAL
	STPAR
ADVLOP:	MOVE A,ADVJFN
	TLNE Z,F3		;COMMENT?
	MOVE A,CIJFN		;YES, USE REGULAR ECHOING TTY CHANNEL
	BIN
	MOVE C,B		;PUT CHARACTER IN C
	ANDI C,177		;STRIP TO 7 BITS FOR IDENTIFICATION
	CAIN C,"^"-100		;^^ ?
	JRST SNCTRL		;YES, SEND CONTROL CODE
ADVLP1:	TLNE Z,F3		;COMMENT?
	JRST ADVLOP		;YES, DON'T SEND CHAR
	MOVE A,ADVTNM
	STI
	 ERJMP [SKIPL DOLNKF	;HAVE WE SUCCESSFULLY LINKED YET?
		JRST ILISTI	;YES, SO ANALYZE ERROR
		PRINT .CHBEL	;NO, SO ECHO A BELL TO TYPIST
		JRST .+1]	;GO WAIT FOR TLINK TO SUCCEED (WAIT FOR USER TO TYPE ^C)
ADVLP2:	CALL CHKLNK		;SEE IF TLINK NEEDED (MAYBE OTHER JOB WENT AWAY, WHICH BREAKS LINK)
	JRST ADVLOP		;GO GET NEXT CHARACTER

;TX1SKP sees if the last error was due to line being not active.
;
;Returns+1:	other error
;	+2:	TTYX01 was last error

TX1SKP:	CALL DGETER		;GET REASON
	CAIE A,TTYX01		;IS LINE NOT ACTIVE?
	RET			;OTHER ERROR
	RETSKP			;LINE IS NOT ACTIVE

;CHKLNK ATTEMPTS TO ESTABLISH LINKS IF THEY'RE NOT ALREADY ESTABLISHED.

CHKLNK:	MOVE B,ADVTNM
	MOVE A,[1B2+1B3+.CTTRM]	;TO AND FROM CONTROLLING TTY
	TLINK
	 ERJMP [CALL TX1SKP	;TLINK FAILED, SEE IF BECAUSE LINE NOT ACTIVE
		 JRST CJERRE	;OTHER FAILURE, TELL USER WHAT IT IS
		JRST CONN1]	;LINE NOT ACTIVE, DON'T CLEAR FLAG YET
	AOSN DOLNKF		;GIVE ANNOUNCEMENT FIRST TIME
	TYPE < [Advising]
>
CONN1:	RET

ILISTI:	SETOM DOLNKF		;REMEMBER TO RETRY LINK IF WE RECOVER
	CALL %GETER
	MOVE A,ERCOD
	CAIN A,IOX33		;INPUT BUFFER IS FULL?
	JRST ADVLP2		;RIGHT, ASSUME USER HEARD BELL
	CAIN A,TTYX01		;LINE BECAME INACTIVE AND USER ISN'T A WHEEL?
	JRST IS1		;WHAT A CROCK, STI SHOULD BE FIXED IN MONITOR
				;TO MERELY WORK ON INACTIVE LINE.  ^C SHOULD
				;START JOB, AND OTHER CHARACTERS SHOULD BEEP
				;JUST AS THOUGH REAL TYPIST WERE THERE.
	CAIE A,DEVX2
	CAIN A,DESX2
	CAIA
	JRST CJERR
IS1:	TYPE <
 [Destination refused advice]
>
	JRST ADVDON

SNCTRL:	BIN
	MOVE C,B		;GET 7-BIT VERSION OF CHARACTER
	ANDI C,177
	CAIN C,"("
	JRST STCOMM
	CAIN C,")"
	JRST ENCOMM
	CAIN C,"+"
	JRST RELINK
	CAIN C,"?"
	JRST TYPADV
	CAIL C,141
	CAILE C,172
	CAIA			;NOT LOWER CASE LETTER
	TRZ B,40		;LOWER CASE, MAKE UPPER CASE
	TRZ B,300		;MAKE INTO A CONTROL (A BECOMES CTRL/A ETC.)

	JRST ADVLP1

;START COMMENT

STCOMM:	TYPE <^^(>		;ECHO CHARACTER HE TYPED
	TLO Z,F3		;FLAG NOT TO SEND CHARS
	JRST ADVLOP

;END COMMENT

ENCOMM:	TLZ Z,F3		;FLAG TO SEND CHARS AGAIN
	JRST ADVLOP

TYPADV:	UTYPE [ASCIZ /
CMND		EFFECT
----		------
<CTRL>E		Quit
<CTRL>^+	Relink to remote terminal
<CTRL>^(	Start comment
<CTRL>^)	End comment
<CTRL>^?	Type this list
<CTRL>^<CHAR>	Send <CTRL><CHAR>
/]
	JRST ADVLOP

RELINK:	MOVE A,[1B2+1B3+.CTTRM]	;TO AND FROM CONTROLLING TTY
	MOVE B,ADVTNM
	TLINK			;PUT HIS OUTPUT ON OUR TERMINAL
	 JRST [	TYPE <
 TLINK failure
>
		JRST ADVLOP]
	TYPE < [Advising]
>
	JRST ADVLOP

ESCPSI::SKIPN ADVFLG
	DEBRK			;JUST IN CASE
ADVDON:	CALL ICLEAR		;DISMISS INTERRUPT TO .+1
	CALL DOATI		;FIX ^C AND ^E (DO HERE SO ^C WORKS IF REMOTE IS XOFFED)
	CALL FIXON		;FIX PAGE MODE
ADVMES::TYPE <
 [Advice terminated]
>
	MOVEI Q1,ETTYMD
	CALL LTTYMD		;RESTORE TTY MODES
	MOVE B,ADVTNM		;GET TERMINAL WE WERE ADVISING
	CALL BREAK1		;BREAK LINKS
	SETZM ADVFLG
	MOVE A,ADVJFN		;GET SPECIAL JFN AGAIN
	CLOSF			;RELEASE IT
	 ERCAL CJERRE		;SHOULDN'T FAIL
	JRST ERRET		;ERROR RETURN TO TTY MODES RESET
;"LIST" IS WITH "TYPE" BELOW.

;LOGIN COMMAND
;LOGIN (USER) NAME (ACCOUNT) ACCOUNT (SESSION-REMARK) REMARK
;PASSWORD: PASSWORD

.LOGIN::TRVAR <LERRF,LPASP,LOGNO,RCBITS,<LDBLK,GTDLN>,LACCT>
	SKIPE CUSRNO
	ERROR <You are already logged in>

;DECODE ARGUMENTS

;FIRST ARGUMENT: USER NAME

	NOISE <USER>		;SEE COMMENTS ON "SPECEOL" ABOUT "NOISE"
	SETZM LERRF		;NO ERROR YET
	CALL USERN		;INPUT USER NAME, TRANSLATE TO USER # IN A
	 JRST [	MOVEM A,LERRF	;FAILED, REMEMBER
		MOVEI B,[FLDDB. .CMUSR,CM%PO]	;TRY TO READ PARSE-ONLY NAME
		CALL FLDSKP
		 CMERRX		;IF THAT FAILS, GIVE UP
		JRST .+1]
	MOVEM A,RCBITS		;SAVE INFO RETURNED BY "RCDIR"
	MOVEM C,LOGNO		;SAVE DIRECTORY NUMBER
	CALL NOECHO		;NOISE STUFF WAITS FOR A CHARACTER!
	NOISE (PASSWORD)
	CALL PASFLD		;READ THE PASSWORD
	MOVEM A,LPASP		;REMEMBER POINTER TO PASSWORD
	NOISE <ACCOUNT>
	MOVEI A,0		;NO SPECIAL BITS FOR RCDIR
	MOVE B,LOGNO		;USER NUMBER
	SKIPE LERRF		;USER NAME CORRECT?
	JRST LOGIN1		;NO, SO DON'T TRY TO SET UP ACCOUNT DEFAULT
	RCDIR			;GET LOGGED-IN DIRECTORY NUMBER
	MOVE A,C		;PUT DIR NUMBER INTO A
	MOVE B,LPASP		;GET POINTER TO PASSWORD
	MOVEI C,LDBLK		;GET ADDRESS TO USE FOR CRDIR BLOCK
	CALL GETDRP		;GET ACCOUNT FOR DEFAULT
	 JRST LOGIN1		;FAILED, ASSUME NO DEFAULT
	MOVEM A,CMDEF		;USE DEFAULT ACCOUNT AS DEFAULT FOR FIELD
	ILDB A,A		;GET FIRST CHARACTER
	CAIN A,0
LOGIN1:	SETZM CMDEF		;NO DEFAULT
	CALL ACCT		;INPUT AND DECODE ACCT # (USES A)
	MOVEM A,LACCT		;SAVE FOR LOGIN JSYS
	NOISE (SESSION-REMARK)
	CALL GSR		;GET SESSION-REMARK
	MOVE Q1,A		;SAVE POINTER TO SESSION-REMARK
	CONFIRM			;CONFIRM THE WHOLE COMMAND
;LOGIN...
;ALL ARGS DECODED, NOW LOG THE GUY IN

NEWF,<
	GTAD			;SET UP MAIL WATCH INTERVAL HERE
	ADDI A,^D910		; FOR +5 MINS
	MOVEM A,MWATCT		; IN CASE "MESMES" NEVER CALLED
>
	SETOM MESMSF		;SAY TYPE "YOU HAVE A MESSAGE" IF APPROPRIATE,
				;EVEN AFTER ^C'S
	SKIPE A,LERRF		;ERROR ALREADY?
	ERROR <%1?>		;YES, PRINT MESSAGE INSTEAD OF TRYING TO LOG IN
	CALL PIOFF		;^C BETWEEN LOGIN AND CUSRNO SETUP WOULD BE EMBARRASING
	MOVE C,LACCT		;ACCT # OR PTR THERETO
	MOVE B,LPASP		;PASSWORD PTR
	MOVE A,LOGNO		;USER #
	MOVE D,C		;GET ACCT STRING
	ILDB D,D		;LOOK AT FINAL ACCOUNT
	SKIPN D			;HAVE ONE?
	SETZM C			;NO. USE NOTHING
	MOVEI D,0		;RESERVE D FOR FUTURE FLAGS
	LOGIN
	 JRST [	CAIN A,LGINX1
		ERROR <Illegal account>
		CAIN A,LGINX4
		ERROR <Incorrect password>
		CALL CJERRE]	;GNRL JSYS ERR RET ROUTINE (XSUBRS.MAC).
	SETOM SYSMF		;SET FLAG SO SYSTEM MESSAGES WILL GET PRINTED
	MOVE B,LOGNO		;WHAT "RCUSR" RETURNED
	MOVEM B,CUSRNO		;STORE USER NUMBER
	MOVEM A,LOGDAT		;SAVE DATE OF LOGIN
	GJINF			;GET LOGGED-IN DIRECTORY NUMBER
	MOVEM B,LIDNO		;SAVE IT.
	CALL PION		;ALLOW ^C NOW THAT CUSRNO IS SET UP
	MOVE A,Q1		;POINTER TO SESSION REMARK
	CALL SSR		;SET SESSION-REMARK
;LOGIN...
;THE AUTOLOGOUT FOR USE TO GET KILLED HERE, NOW WE MUST KILL OFF THE
;PENDING TIMER CLOCK

	MOVE A,[.FHSLF,,.TIMBF]	;DELETE ALL ENTRIES BEFORE GIVEN TIME
	MOVE B,[377777,,-1]	;TIME WAY OUT IN THE BOONIES (WON'T
				;CLOBBER ANY RUNTIME LIMIT SETTING
	SETZ C,
	TIMER
	 JFCL			;DON'T CARE IF NONE PENDING

;TYPE "JOB <N> ON LINE N <DATE> <TIME>"

	ETYPE < Job %J on %L %D %E
>				;EOL NEEDED BEFORE LOGIN MESSAGE


	MOVE B,RCBITS		;WHAT RCUSR RETURNED
	TXNE B,RC%RLM		;B2 SAYS ALWAYS PRINT LOGIN MESSAGE
	SETZM LOGDAT		;SET DATE TO 0 TO FORCE PRINTING

NONEWF,<
;TYPE "YOU HAVE A MESSAGE" IF A FILE "MAIL.TXT.1" OF NON-0 LENGTH
; EXISTS IN THIS DIRECTORY.

	CALL MESMES
>
;GET DEFAULT EXEC INPUT FILE

	SETOM LOGINI		;SET FLAG TO DO "TAKE INITIAL-LOGIN-TYPIN.TXT"
				;AT NEXT OPPORTUNITY.
	RET

;SIMULATE "TAKE" COMMAND OF FILSPEC (STRING POINTER IN B)
;SKIPS IFF SUCCEEDS IN SETTING UP STREAM

TAKEIN::STKVAR <<TAKBUF,FILWDS>,SPB>
	MOVEM B,SPB		;SAVE STRING POINTER
	MOVE B,LIDNO		;GET LOGGED-IN DIRECTORY NUMBER
	HRROI A,TAKBUF		;GET STRING SPACE POINTER
	CAMN B,[-1]		;DEFAULT?
	JRST TAKEI1		;YES, SKIP DIR
	DIRST			;STORE DIR STRING
	 CALL JERR		;WE JUST SCANNED IT?!
TAKEI1:	MOVE B,A
	MOVE A,SPB
	SETZ C,			;READ TO NULL
	SIN			;APPEND TO STRING
	HRROI B,TAKBUF		;GET POINTER TO BEGINNING
	CALL TRYGTL		;TRY TO FIND IT.
	 JRST TAKIN2		;NO SUCH FILE, GO AWAY QUIETLY
	MOVE B,[70000,,OF%RD]
	OPENF
	 JRST [	HRROI B,TAKBUF	;GET POINTER FOR ERROR MESSAGE
		LERROR <Can't read %2m%%_%%1?>
		HRRZ A,JBUFP
		HRRZ A,(A)	;GET SAVED JFN
		RLJFN		;RELEASE IT
		 CALL JERR
		HRRZ A,JBUFP
		SETOM (A)
		RET]
	HRL A,A			;PUT INPUT JFN IN LEFT HALF
	HRR A,COJFN		;USE SAME OUTPUT AS WERE USING
	MOVE B,TAKDEF		;USE DEFAULT SETTINGS
	CALL PUSHIO		;SAVE OLD IO STREAM, START NEW ONE
	RETSKP			;DOUBLE RETURN WHEN SUCCESSFUL
TAKIN2:	RET			;FAILED, TAKE SINGLE RETURN
;SPECEOL
;SUBROUTINE TO HANDLE EOL AS FIELD TERMINATOR IN THE MIDDLE OF A COMMAND
; IN THE SPECIAL MANNER REQUIRED FOR "LOGIN".
;CR NORMALLY TERMINATES COMMAND, DEFAULTING ANY FOLLOWING FIELDS.
;BUT IF P2=EOL AND THIS SUBROUTINE IS CALLED AND A "NOISE"
;  MACRO FOLLOWS THE CALL, THE FOLLOWING NOISE WORD IS TYPED
;  (AS AFTER ALT MODE), PARENTHESIZED TEXT IS IGNORED (AS AFTER SPACE),
;  AND FIELD IS INPUT NORMALLY, NOT DEFAULTED.

	;THIS UNWRITTEN ROUTINE SHOULD SOMEHOW ALLOW CARRIAGE RETURN
	;IN THE MIDDLE OF COMMANDS, SUCH THAT THE GUIDE WORDS FOR THE NEXT
	;FIELD COME OUT ON THE NEW LINE, AS THOUGH THE CR WAS $.  BEWARE
	;OF THE FOLLOWING PITFALLS OF THIS:
	;1)	ON REPARSE, GUIDEWORDS ARE ALREADY IN BUFFER, SO SOMEHOW
	;	REPARSED CR SHOULD DO NOTHING.  NOTE THAT REPARSED $ IS
	;	NONEXISTANT, AS $ CAUSES ACTION BUT DOESN'T STAY IN
	;	BUFFER.  YOU CAN'T AFFORD NOT TO LEAVE CR IN BUFFER,
	;	BECAUSE ^R AND RUBOUT WON'T WORK CORRECTLY, ESPECIALLY
	;	ON SCREEN TERMINALS.
	;2)	IF THE CR PROVOKED GUIDEWORDS ARE IMPLEMENTED AS PROMPTS,
	;	RUBBING OUT WON'T WORK.  USER WILL JUST GET A DING.
	;3)	MOST DESIRABLY, CR IN THE MIDDLE OF COMMANDS SHOULD WORK
	;	FOR ALL COMMANDS, NOT JUST SPECIAL ONES LIKE LOGIN,ATTACH.
	;	THIS CREATES A PROBLEM WITH CASES WHERE A FIELD HAS A
	;	DEFAULT VALUE.  CONSIDER THE AMBIGUITY UPON SEEING
	;	CR:  DOES THE CR MEAN DEFAULT THE FIELD VALUE, OR
	;	TYPE THE GUIDEWORDS.  FOR INSTANCE, SHOULD "DIRECTORY<CR>"
	;	TYPE "(OF FILES)", OR DEFAULT THE FILE SPEC TO *.* AND
	;	TAKE OFF?
	RET

;USERN
;INPUT USER NAME SUBR
;USED BY "LOGIN" AND "ATTACH".
;RETURNS RCUSR'S RETURNED INFO IN A,B,C.
;SKIPS, BUT NOT IF BAD NAME TYPED, IN WHICH CASE A CONTAINS ERROR CODE

USERN:	USERX <User name>
	 JRST [	CALL %GETER	;FAILED, FIND OUT WHY
		MOVE A,ERCOD	;RETURN ERROR IN A
		RET]
	CALL BUFFF		;BUFFER IT RIGHT FOR JSYS, PUT PTR IN A
	MOVE B,A
	MOVSI A,(RC%EMO)	;SAYS NO RECOGNITION
	RCUSR			;STRING TO DIRECTORY # TRANSLATION
	RETSKP
;ACCT
;RUTINE TO INPUT ACCOUNT STRING, RETURNS SUITABLE ARG
;FOR LOGIN OR CACCT JSYS.
;USED IN ACCOUNT, CHANGE, LOGIN COMMANDS.

ACCT::	ACCTX <Account name>
	 CMERRX
	JRST BUFFF		;STRING CASE. SAVE IN BUFFER.
;PASWD
;SUBROUTINE TO INPUT PASSWORD FOR "LOGIN", "ATTACH", AND "CONNECT".
;HANDLES HALF AND FULL DUPLEX CASES.
;BUFFERS IT FOR USE AS A JSYS ARGUMENT AND RETURNS BYTE PTR IN A.

PASLIN::MOVEI A,[ASCIZ /Password: /]

PASSX::	MOVEI C,1
	CALL NOECHO		;PROMPT TYPER LOOKS AT ONE INPUT CHARACTER SO TURN OFF ECHOING FIRST
	UPROMPT @A		;TYPE PROMPT
	CALL PASWD		;SPR 13716
	CONFIRM			;SPR 13716
	RET			;SPR 13716

PASFLD::TDZ C,C			;FOR A PASSWORD FIELD, NO CRLF WANTED (IE LOGIN)

PASWD::	CALL NOECHO		;MAKE SURE ECHOING OFF
	CALL CHKPTY		;SKIP IF NOT A PTY
	JRST PASWDF		;PTY - HANDLE FULL DUPLEX CASE ONLY
	MOVE A,CIJFN
	RFMOD			;READ TTY MODE
	TRNE B,1B32		;SKIP IF FULL DUPLEX
	JRST PASWD1

;FULL DUPLEX CASE
;DON'T ECHO PASSWORD FIELD, DO ECHO TERMINATOR

PASWDF:	CALL INPPAS		;INPUT THE PASSWORD
	CALL DOECHO		;NOW WE WANT ECHOING ON
	CALL GETTER		;GET THE TERMINATING CHARACTER
	CAIE A,.CHCRT		;END OF LINE?
	CAIN A,.CHLFD
	CAIA			;YES
	JRST PSWDF1		;NO
	MOVE A,CIJFN		;YES, SEE IF IT GOT ECHOED
	RFPOS
	TRNE B,-1		;ARE WE AT COLUMN 1?
	ETYPE <%_>		;NO, TYPE A CRLF
PSWDF1:	CALLRET BUFFF		;BUFFER PASSWORD AND CHECK IT IF POSSIBLE
;PASWD...
;HALF DUPLEX CASE
;USE SEPARATE LINE, TYPE MASK FIRST

PASWD1:	TYPE <
>
	UPROMPT [BYTE (7)130,130,130,130,130,130,130,130,130,15
		BYTE (7)127,127,127,127,127,127,127,127,127,15
		BYTE (7)115,115,115,115,115,115,115,115,115,15
		BYTE (7)15,15,0]
				;PASWORD MASK, OVERLAYED X, W, M, AND GARBAGE
	CALL INPPAS		;INPUT THE PASSWORD
	PRINT CR		;SET TO OVERPRINT SAME LINE
	TYPE <Thank you ... >
	ETYPE<%_>
	ETYPE<%_>
	CALLRET BUFFF		;BUFFER AND MAYBE CHECK PASSWORD

;ROUTINE TO INPUT THE PASSWORD

INPPAS:	JUMPE C,INPP1		;DO THIS ONLY IF CRLF IS NEEDED
	STKVAR <SAVFLG,SAVPTR>
	MOVE A,CMFLG
	MOVEM A,SAVFLG		;SAVE FLAGS IN CASE REPARSE IS NEEDED
	MOVE A,CMPTR
	MOVEM A,SAVPTR
	CRRX <Password>		;HAVE TO TRY CR SO COMND DOESN'T RETYPE "PASSWORD:" IF HE TYPES NULL PASSWORD
	 JRST INPP1		;NOT NULL PASSWORD
	MOVE A,SAVFLG		;UNPARSE THE CARRIAGE RETURN
	MOVEM A,CMFLG		;CALLERS WILL PARSE CONFIRM AFTER PASSWORD
	MOVE A,CMPTR		;SEE WHERE WE ARE ON LINE NOW
	MOVE B,SAVPTR		;SEE WHERE WE WERE AT BEGINNING OF LINE
	MOVEM B,CMPTR		;RESET FIELD POINTER TO BEGINNING OF LINE
	CALL SUBBP		;GET NUMBER OF CHARACTERS WE WANT TO BACK UP
	ADDM A,CMINC		;INCREASE NUMBER OF UNPARSED CHARACTERS
	ADDM A,CMCNT		;SHOW INCREASE IN SPACE LEFT
	SETZM ATMBUF		;DENOTE NULL PASSWORD
	RET

INPP1:	WORDX <Password>	;READ NON-NULL PASSWORD
	 CMERRX
	RET
;MESMES
;SUBROUTINE TO TYPE "YOU HAVE A MESSAGE" IF FLAG "MESMSF" IS ON AND
;THERE IS A MESSAGE FILE IN CONNECTED DIRECTORY.
;USED IN LOGIN, MAIN LOOP. CLOBBERS A,B,C.

MESMES::SKIPN CUSRNO
	JRST MESMS9		;IGNORE IF NOT LOGGED IN
	SKIPE BATCHF		;DON'T CHECK FOR MESSAGES IN BATCH (TO SAVE TIME)
	 JRST MESMS9		;YES, SKIP MESSAGES
	CALL CHKDAL		;NOTE OVER ALLOCATION IN PRESENT FIRST
NONEWF,<
	MOVE B,CUSRNO		;THE USER NUMBER TO CHECK FOR MAIL
	CALL MALCHK		;CHECK FOR NEW MAIL
	 JRST MESMS9		;NO NEW MAIL, NO PRINTOUT
	TYPE < You have a message
>				;USER TYPES FILE TO RECEIVE MESSAGE
>
NEWF,<
	HRLOI B,377777		;SET INF COUNT FOR US
	MOVEM B,MWATN0
	MOVE B,CUSRNO		;SET UP FOR MAIL CHECK FOR THIS USER
	MOVEM B,MWATDR
	CALL MALCHK		;DO MAIL CHECK
	 JRST MESMS9		;NO MAIL
	TYPE < You have >
	TLNN B,77		;CHECK NETWORK MAIL FLAG
	TYPE <net >
	ETYPE <mail %1\%%_%>
>
	MOVE A,COJFN
	DOBE			;WAIT FOR IT TO REALLY PRINT
NEWF,<
	GTAD			;SET UP NEXT LOOK TIME
	ADDI A,^D910		; FOR +5 MINS
	MOVEM A,MWATCT
>
MESMS9:	SETZM MESMSF		;CLEAR FLAG SO IT WONT BE REPEATED
	RET

;CHKPTY - SKIPS IF NOT RUNNING ON PSEUDO-TELETYPE

CHKPTY::PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	SETZ D,
	GTB .PTYPA		;GET PSEUDO TTY PARMS
	HRRZ D,A		;SAVE FIRST PTY NUMBER
	PUSH P,D		;FIRST PTY ON STACK
	HLRZ A,A		;NUMBER OF PTY'S
	ADDI D,(A)		;LAST PTY NUMBER PLUS ONE
	MOVNI A,1
	MOVE B,[XWD -1,C]	;1 WORD INTO C
	MOVEI C,.JITNO		;READ TERMINAL NUMBER
	GETJI
	 CALL JERR
	POP P,A			;RESTORE FIRST PTY NUMBER
	CAML C,A		;ARE WE A PTY? (DET IS -1)
	CAML C,D
	AOS -4(P)		;NO, SKIP
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	RET
;TRYGTJ
;TAKES: B: POINTER TO STRING FOR GTJFN
;RETS:	+1: NO SUCH FILE
;	+2: JFN IN A
;USED IN "MESS", AND IN "LOGIN" WITH REGARD TO PRIVATE MESSAGES.

TRYGTO::PUSH P,B
	PUSH P,A
	MOVSI A,(GJ%FOU!GJ%SHT)
	JRST TRYGT1

TRGTV1::PUSH P,B
	PUSH P,A
	MOVE A,[GJ%OLD!GJ%SHT+1]	;OLD FILE, SHORT CALL, VERSION 1
	JRST TRYGT1

TRYGTL:	PUSH P,B
	PUSH P,A
	MOVSI A,(GJ%OLD!GJ%SHT!GJ%ACC)	;OLD FILE, SHORT, NO ACCESS
	JRST TRYGT1

TRYGTJ::PUSH P,B
	PUSH P,A
	MOVSI A,(GJ%OLD!GJ%SHT)	;OLD FILE ONLY AND SHORT FORM
TRYGT1:	CALL GTJFS		;ASSIGN JFN USING STRING POINTER IN B
	 JRST [	POP P,A		;LOSE, ERROR RETURN
		JRST TRYG9]
	SUB P,[XWD 1,1]		;FORGET SAVED A
	AOS -1(P)		;SKIP
TRYG9:	POP P,B
	RET
;LOGOUT

.LOGOU::
	SKIPN CUSRNO		;LOGGED IN?
	JRST LOGOU1		;NO, ONLY ONE CASE
	DECX <Carriage return or job number>
	 JRST LOGOU1		;NO NUMBER TYPED, LOG OUT THIS JOB
	MOVE A,B		;PUT JOB NUMBER IN A
	JRST ..LOGO		;GO LOG OUT REMOTE JOB

LOGOU1:	CONFIRM
XTND,<
	CALL BLANK1		;CLEAR SCREEN
	CALL DWNPNT		;INFORM DOWNTIME
>
	SKIPN CUSRNO
	JRST LOGOU2
	GJINF			;GET CONNECTED DIRECTORY NUMBER
	CAMN B,LIDNO		;DIFFERENT FROM LOGGED-IN ONE?
	JRST LOGOU3		;NO SO DON'T BOTHER EXPUNGING CONNECTED DIR
	LDF A,DD%DTF		;FLUSH TEMPORARY FILES
	DELDF			;EXPUNG CONNECTED DIR
	  ERJMP	[TYPE <%Warning -- EXPUNGE failed, continuing...>
		 ETYPE<%_>
		 JRST .+1]
	CALL CHKDAL		;NOW CHECK IT
LOGOU3:	MOVE B,LIDNO		;GET LOGGED-IN DIRECTORY NUMBER
	LDF A,DD%DTF		;FLUSH TEMPORARY FILES ALSO
	DELDF
	  ERJMP	[TYPE <%Warning -- EXPUNGE failed, continuing...>
		 ETYPE<%_>
		 JRST .+1]
	MOVE A,LIDNO
	GTDAL			;GET USAGE/ALLOCATION
	JUMPE B,LOGOU2		;CAN'T BE OVER IF USAGE=0
	SUB B,C			;SUBTRACT PERMANENT ALLOCATION FROM USAGE
	SKIPLE B		;EXCEEDED?
	ETYPE < <%N> Over permanent storage allocation by %2Q page(s).
>
LOGOU2:	TLO Z,LOGOFF		;SAY LOGGING OUT (TELLS ERROR AND ^C
				;ROUTINES TO SAY "NOT LOGGED OUT AFTER ALL").
	MOVE A,COJFN
	DOBE			;WAIT TO GIVE HIM MAXIMUM CHANCE TO ^C.
				;SET MAP TO "USER"
	SETO A,			;SAY ITS SUICIDE
	LGOUT
	 CALL CJERR
				;DOESN'T RETURN ON SUCCESS

;"MERGE" IS WITH "GET" ABOVE.

; 'PUSH' = 'PUSH EXEC' (FORMERLY 'EXEC')
; - STARTS AN EXEC IN INFERIOR FORK SEPARATE FROM 'FORK'

.PUSH::	NOISE (COMMAND LEVEL)
	CONFIRM
   REPEAT 0,<
	CALL PNTMES		;MAKE SURE SYSTEM MESSAGES HAVE BEEN SEEN BEFORE DOING "PUSH"
   >
	MOVSI 1,(1B2+1B17)
	HRROI 2,[GETSAVE(<SYSTEM:EXEC.>)]
	CALL TRYGTJ		;GTJFN AND SAVE IT
	 ERROR <EXEC not found>
	PUSH P,1
	MOVSI 1,(1B1)		;XMIT CAPS
	CFORK
	 CALL CJERR
	MOVEM 1,EFORK
	POP P,1
	HRL 1,EFORK
	CALL DOGET		;DO THE GET
	 CALL CJERRE		;FAILED
	MOVE 1,EFORK
	SETZ 2,
	SFRKV
	 ERJMP CJERRE
	WFORK
	RFSTS
	MOVE C,A
	MOVE A,EFORK
	SETZM EFORK
	KFORK
	CAME C,[1B0+2B17]
	CAMN C,[2B17]		;VOLUNTARY TERMINATION IS NORMAL
	RET
	ERROR <PUSH terminated abnormally - Fork status = %3O, PC = %2P>

;'POP' = 'POP EXEC' - POP TO HIGHER LEVEL EXEC

.POP::	NOISE (COMMAND LEVEL)
	CONFIRM
	CALL INFER		;TEST FOR EXISTENCE OF SUPERIOR FORK
	 ERROR <No higher command level>
	JRST QUIT2		;GO DO HALTF, ETC.
;QUIT: EXIT TO SUPERIOR EXEC OR OTHER PROGRAM.
;IF TOP-LEVEL FORK, LEGAL ONLY FOR ENABLED WHEELS OR OPERS.

.QUIT::	CALL INFER		;SKIP IF INFERIOR
	 JRST [	MOVX B,WHLU+OPRU
		SKIPE PRVENF
		CALL PRVCK
		ERROR <Not legal in top-level EXEC>
		JRST .+1]
QUIT2:	MOVE A,SAVT20		;GET STATE BEFORE WE RAN
	CALL SETMOD		;RESTORE IT
	MOVE A,SAVNAM		;GET SAVED PROGRAM NAME
	SETNM			;RESTORE IT
	HALTF
	JRST REE		;IN CASE OF RETURN FROM MINI-EXEC

;INFERIORNESS TEST SUBROUTINE: SKIP IF THIS FORK HAS A SUPERIOR
;USED IN LOGOUT, QUIT, ^E EDDT.

INFER::	ATSAVE
	MOVEI 1,.FHTOP		;SAY TOP FORK
	SETZ 2,			;SAY NO HANDLES OR STATUS
	MOVEI 3,1(P)		;SAY BUILD STRUCTURE ON STACK
	HRLI 3,-4		;BUT 4 WORDS MAX
	ADD P,[4,,4]		;MAKE ROOM ON STACK
	GFRKS			;GET 'STRUCTURE' OF TOP FORK
	 CALL [	CAIE 1,GFKSX1	;RAN OUT OF SPACE?
		JRST JERR	;NO, STRANGE
		RET]		;YES, WE EXPECT THAT
	HRRZ 1,1(3)		;GET HANDLE OF TOP FORK
	SUB P,[4,,4]		;CLEAR STACK
	CAIN 1,.FHSLF		;IS IT SELF?
	RET			;YES, WE ARE TOP AND HAVE NO SUPERIOR
	RETSKP			;NO, WE ARE AN INFERIOR
;RECEIVE (LINKS)

.RECEI::TLZ Z,F4		;SAY RECEIVE CMD
	CALL RECREF		;CALL RECEIVE/REFUSE SUBR
	MOVE A,[1B5+1B7+.CTTRM]
	JUMPE Q1,REC2		;IF Q1 STILL 0, ASSUME SYSTEM-MESSAGES
	TDO A,Q1		;GET ENABLE BITS
	TLINK
	CALL JERR
	JRST CMDIN4

RECREF:	SETZ Q1,		;ACCUMULATE LINKS/ADVICE BITS HERE
	KEYWD $LNADV
	 T LINKS,,.RELNK
	 JRST CERR
	SETZ Q2,
	CALL (P3)
	CONFIRM			;GET CONFIRMATION
	RET

$LNADV:	TABLE
	T ADVICE,,.READV
	T LINKS,,.RELNK
	T SYSTEM-MESSAGES,,[RET]
	TEND

.READV:	TLO Q1,(1B6)
	TLNE Z,F4		;RECEIVE?
	RET			;NO - RETURN
	TLO Q1,(1B4)		;LINKS TOO
	NOISE <AND LINKS>
	RET

.RELNK:	TLNE Z,F4		;WHICH KIND?
	NOISE <AND ADVICE>
	TLO Q1,(1B4)
	RET
;REFUSE (LINKS)

.REFUS::TLO Z,F4		;SAY REFUSE CMD
	CALL RECREF		;CALL RECEIVE/REFUSE SUBR
	MOVEI A,.CTTRM
	JUMPE Q1,REF2		;IF NO BITS ON IN Q1, ASSUME SYSTEM-MESSAGES
	HLL A,Q1		;COPY ENABLES FROM SUBR
	TLINK
	CALL JERR
	JRST CMDIN4

;REFUSE SYSTEM-MESSAGES

REF2:	MOVEI C,.MOSMN		;SAY REFUSE
REF1:	MOVEI A,.CTTRM
	MOVEI B,.MOSNT		;FUNCTION CODE FOR CONTROLLING MESSAGES
	MTOPR			;DO IT
	 ERCAL CJERRE		;COULDN'T
	RET

;RECEIVE SYSTEM-MESSAGES

REC2:	MOVEI C,.MOSMY
	JRST REF1

;RENAME (EXISTING FILE) <NAME> (TO BE) <NAME>

.RENAM::SETOM TYPGRP		;TYPE ALL FILES
	NOISE <EXISTING FILE>
	CALL INFGNS		;GET INPUT FILE GROUP WITH NO SEARCH
	NOISE <TO BE>
	CALL MFOUT		;GET MULTI FILE OUTPUT TERM
	CONFIRM
	HLRZ A,JBUFP
	CAIL A,-2		;WILL NEED 2 MORE FOR PROCESSING
	ERROR <Too many JFNs in command>
	MOVE A,JBUFP
	MOVEM A,.JBUFP		;SAVE THESE JFNS
RENAM1:	CALL RLJFNS		;RELEASE ALL TEMPORARY JFNS
	CALL NXFILE		;CHECK FOR NON-EX FILE TERM
	 JRST RENAM2
	CALL TYPIF		;TYPE INPUT NAME IF GROUP
	CALL MFSET		;SET UP OUTPUT TERM
	 JRST [	CALL GNFIL	;ERROR, MESSAGE ALREADY PRINTED
		 SETZM INIFH1	;CLEAR WHEN NO MORE
		JRST RENAM2]
	CALL MFINP		;GET SECOND JFN ON INPUT JFN
	 JRST RENAM2
	HRRZ B,OUTDSG		;GET OUTPUT DESCRIPTOR
	RNAMF			;RENAME FILE
	 ERJMP [LERROR <%1?>	;TELL USER WHY IT FAILED
		JRST RENAM2]	;GO ON TO NEXT FILE
	CALL TYPOK
RENAM2:	SKIPE INIFH1		;DID LAST GNFIL HIT END?
	JRST RENAM1		;NO
	RET
;REQUEST A FILE BE RETRIEVED FROM OFFLINE STORAGE

.RETRI::STKVAR <NRETR>
	NOISE <FILES>
	MOVE A,[XWD -1,0]	;NO DEFAULT NAMES
	HRLI B,0		;DEFAULT VERSION IS 0
	HRRI B,(GJ%OLD+GJ%IFG+GJ%NS+1B15+1B16+CF%NS)
	TXO Z,IGINV		;FIND INVISIBLE FILES
	CALL SPECFN
	 JRST CERR		;NO "STUFF,"
	TXZ Z,IGINV
RETRI2:	SETOM TYPGRP		;ALWAYS TYPE NAME
	MOVE A,COJFN
	MOVEM A,OUTDSG
	MOVE A,JBUFP
	MOVEM A,.JBUFP
	SETZM NRETR		;KEEP TRACK OF HOW MANY RETRIEVED
RETRI3:	CALL RLJFNS
	CALL NXFILE
	 JRST RETRI4
	CALL MFINP		;GET 2ND JFN
	 JRST RETRI4		;FAILED
	MOVE B,[1,,.FBCTL]
	MOVEI C,C		;FIND OUT IF FILE IS OFFLINE
	GTFDB
	 ERJMP RETRI4		;SKIP FILE IF CAN'T FIND OUT
	TXNN C,FB%OFF		;IS IT OFFLINE?
	JRST RETRI4		;NO, CAN'T POSSIBLEY RETRIEVE IT
	ETYPE < %1S>		;TYPE FILE NAME - SHOULD USE TYPIF
				;BUT NXFILE MAY HAVE STEPPED US OFF
				;THE END CAUSING TYPIF TO LOSE BIG
	MOVEI B,.ARRFR		;REQUEST TO RETRIEVE IT
	SETZ C,			;NO FLAGS
	ARCF
	 ERJMP [ETYPE < %?
>
		JRST RETRI4]
	CALL TYPOK
	AOS NRETR		;REMEMBER HOW MANY
RETRI4:	SKIPE INIFH1		;DONE THEM ALL?
	 JRST RETRI3		;NO, LOOP
	SKIPN NRETR		;DON'T BE TOO QUIET IF NOTHING DONE
	ETYPE <%%No files found for retrieving%_>
	RET
;^ESEND (MESSAGE) TO ALL ON SYSTEM

.SEND::	TRVAR <SNDPT,SNDLNO>
	NOISE (TO)
	OCTX <Octal line # or * for all>
	 CAIA			;NO NUMBER TYPED
	JRST SENDA		;NUMBER TYPED.
	STARX			;SEE IF "*" TYPD
	 CMERRX <Octal line number or * required>
	SETO B,			;NOTE "*" WITH -1
SENDA:	MOVEM B,SNDLNO		;SAVE LINE NUMBER
	MOVE A,CSBUFP		;GET POINTER TO STRING BUFFER
	MOVEM A,SNDPT
	CALL SCRLF		;INSERT INITIAL CRLF
	MOVEI Q1,"["		;BEGIN MESSAGE
	IDPB Q1,SNDPT
	MOVE A,SNDPT		;GET POINTER
	HRROI B,[ASCIZ /From /]
	SETZ C,
	SOUT			;"[FROM ...."
	MOVE B,CUSRNO		;GET USER NAME
	DIRST			;PUT NAME SO PEOPLE WILL KNOW WHO'S SENDING OBSENITIES
	 CALL JERR		;SHOULDN'T FAIL
	PUSH P,A		;SAVE OUTPUT DESIGNATOR
	GJINF			;FIND OUT ABOUT MY JOB
	POP P,A			;RESTORE AC
	JUMPL D,DETSND		;SKIP ON IF WE'RE DETACHED
	HRROI B,[ASCIZ / on line /] ;GET SOME MORE TEXT
	SETZ C,
	SOUT			;STORE IT
	MOVE B,D		;GET NUMBER IN RIGHT AC
	MOVEI C,^D8		;OCTAL OUTPUT
	NOUT			;STORE TERMINAL NUMBER
	 CALL JERR
DETSND:	HRROI B,[ASCIZ /: /]
	SKIPGE SNDLNO		;IF SENDING TO ALL, SAY SO
	HRRI B,[ASCIZ / to all: /]
	SETZ C,
	SOUT			;"[From OPERATOR on line 1: ..."
	MOVEM A,SNDPT		;UPDATE POINTER TO MESSAGE
	LINEX <Message to be sent>
	 CMERRX
	CONFIRM			;GET CONFIRMATION
	MOVE A,SNDPT		;GET POINTER TO MESSAGE SO FAR
	HRROI B,ATMBUF		;COPY MESSAGE FROM ATOM BUFFER
	MOVEI C,0		;STOP ON NULL
	SOUT
	MOVEM A,SNDPT		;UPDATE POINTER
	MOVEI Q1,"]"
	IDPB Q1,SNDPT		;WITH CLOSE BRACKET
	CALL SCRLF		;AND TERMINATE WITH CRLF
	MOVEI Q1,0		;GUARANTEE NULL
	IDPB Q1,SNDPT		;  AT END
	MOVE A,CSBUFP
	CALL SNDFIX		;FORMAT TEXT SO NONE LOST AT END OF LINES
	MOVE B,A		;COPY POINTER TO MESSAGE
	MOVE A,SNDLNO		;RESTORE LINE(S) FOR MESSAGE
	SKIPL A			;SENDING TO PARTICULAR TERMINAL?
	ADDI A,.TTDES		;YES, ADD IN TERMINAL DESIGNATOR
	TTMSG			;DO IT
	  ERJMP CJERRE		;IN CASE OF LOSAGE
	CALL UNMAP		;UNMAP BUFFER PAGE
	RET			;RETURN
;SNDFIX - ROUTINE TO BREAK UP LONG ^ESEND TEXT INTO MULTIPLE LINES
;
;ACCEPTS IN A/ POINTER TO ORIGINAL TEXT
;		CALL SNDFIX
;RETURNS: +1 ALWAYS, WITH A/ POINTER TO NEW TEXT

SNDSIZ==^D71			;MAX SIZE OF ^ESEND LINES

SNDFIX:	MOVE C,[POINT 7,BUF0]	;GET POINTER TO NEW STRING

SNDFX1:	MOVSI D,-SNDSIZ		;GET MAX SIZE FOR ^ESEND LINES

SNDFX2:	ILDB B,A		;GET A CHARACTER FROM INPUT STRING
	IDPB B,C		;DEPOSIT CHARACTER IN NEW STRING
	JUMPE B,SNDFX3		;IF END OF STRING, ALL DONE
	AOBJN D,SNDFX2		;LOOP OVER A LINE-FUL OF CHARACTERS

	MOVX B,.CHCRT		;GET A CARRIAGE RETURN
	IDPB B,C		;ADD RETURN TO STRING
	MOVX B,.CHLFD		;GET A LINE FEED
	IDPB B,C		;FORM NEW LINE
	MOVX B," "		;GET A BLANK
	IDPB B,C		;INDENT SUCCESSIVE LINES
	JRST SNDFX1		;GO ADD REMAINDER OF STRING

SNDFX3:	MOVE A,[POINT 7,BUF0]	;GET POINTER TO START OF STRING
	RET			;DONE, RETURN

;SCRLF - ROUTINE TO ADD CRLF TO INITIAL STRING ASSEMBLED BY ^ESEND

SCRLF:	MOVEI Q1,CR		;INSERT CRLF SEQUENCE
	IDPB Q1,SNDPT		; INTO MESSAGE
	MOVEI Q1,LF
	IDPB Q1,SNDPT		;...
	RET
;TAKE (EXEC INPUT FROM) FILESPEC

.TAKE::	TRVAR <TAKCON,JFN1,JFN2>	;CELLS TO HOLD NEW JFNS
	NOISE <COMMANDS FROM>
	SETZM JFN1		;INDICATE NO INPUT JFN YET
	MOVE A,TAKDEF		;GET THE DEFAULTS
	MOVEM A,TAKCON		;REMEMBER SETTINGS BEFORE SUBCOMMANDS CHANGE THEM
	MOVE A,COJFN
	MOVEM A,JFN2		;DEFAULT NEW JFNS TO OLD
	DEXTX <CMD>		;DEFAULT INPUT EXTENSION IS CMD
	MOVX A,GJ%OLD+GJ%ACC	;OLD FILE ONLY AND DON'T LET INFERIORS KILL IT
	MOVEM A,CJFNBK+.GJGEN	;STORE FLAGS
	MOVEI B,[FLDDB. .CMCFM,CM%SDH,,<Carriage return to end current command level>,,[
		 FLDDB. .CMCMA,CM%SDH,,<Comma to enter subcommands>,,[
		 FLDDB. .CMFIL,CM%SDH,,<Command file name>]]]
	CALL FLDSKP		;READ EITHER CR OR FILESPEC
	 CMERRX			;NEITHER TYPED!
	LDB C,[331100,,(C)]	;FIGURE OUT WHAT GOT TYPED
	CAIN C,.CMCFM		;CARRIAGE RETURN?
	 JRST PRIRES		;YES
	CAIN C,.CMCMA		;COMMA?
	 JRST TAKEC		;YES, GET SUBCOMMANDS
	MOVEM B,JFN1		;REMEMBER FIRST JFN

	NOISE <LOGGING OUTPUT ON>
	DEXTX <LOG>		;DEFAULT OUTPUT EXTENSION IS LOG
	MOVX A,GJ%FOU+GJ%MSG+GJ%ACC ;FILE FOR OUTPUT USE PLUS PRINT MESSAGE
	MOVEM A,CJFNBK+.GJGEN	;AND DON'T LET INFERIORS TOUCH THIS JFN
	MOVEI B,[FLDDB. .CMCFM,CM%SDH,,<Carriage return if no change of output desired>,,[
		 FLDDB. .CMCMA,CM%SDH,,<Comma for no change, but to enter subcommands>,,[
		 FLDDB. .CMFIL,CM%SDH,,<Output file name>]]]
	CALL FLDSKP		;READ EITHER CR OR FILESPEC
	 CMERRX			;NEITHER TYPED
	LDB C,[331100,,(C)]	;FIGURE OUT WHAT GOT TYPED
	CAIN C,.CMCFM		;CARRIAGE RETURN?
	JRST TAKE1		;YES, DON'T CHANGE OUTPUT SIDE
	CAIN C,.CMCMA		;COMMA?
	JRST TAKEC		;YES, GO GET SUBCOMMANDS
	MOVEM B,JFN2		;SAVE OUTPUT JFN
	MOVEI Q1,0		;FIRST ASSUME NO SUBCOMMANDS
	COMMAX <Comma to enter subcommands, or confirm with carriage return>
	 CAIA			;NO SUBCOMMANDS COMING
	MOVEI Q1,1		;SUBCOMMANDS COMING
	CONFIRM			;REQUIRE CONFIRMATION AFTER FILE NAME
	JUMPE Q1,TAKE1		;SKIP SUBCOMMAND STUFF IF NO COMMA
	CAIA			;WE'VE ALREADY GOT CONFIRMATION
TAKEC:	CONFIRM
	SUBCOM $TAKE		;DO THE SUBCOMMANDS
TAKE1:	SKIPN A,JFN1		;INPUT FILE TYPED?
	 RET			;NO, THIS IS A NO-OP
	MOVE B,[XWD 70000,OF%RD]
	OPENF
	 ERCAL CJERRE		;COULDN'T OPEN TAKE FILE
	MOVE A,JFN2
	MOVE B,COJFN		;GET OLD OUTPUT
	CAIN A,(B)		;OUTPUT BEING CHANGED?
	JRST TAKE33		;NO
	MOVE B,[XWD 70000,OF%APP]
	OPENF
	 ERCAL CJERRE		;GO PRINT ERROR MESSAGE
TAKE33:	HRL A,JFN1		;GET XWD INPUT,OUTPUT
	MOVE B,TAKCON		;GET DESIRED SETTING FOR NESTED TAKE
	CALLRET PUSHIO		;START NEW STREAM, REMEMBER OLD

PRIRES:	CALL CIOREL		;POP BACK ONE LEVEL
	 CAIA			;THERE WAS A LEVEL TO CLOSE
	RET			;NOTHING TO CLOSE (WE'RE AT TOP LEVEL)
	CLOSF			;CLOSE OLD INPUT SIDE
	 ERCAL JERR		;SHOULDN'T FAIL
	RET

;SUBCOMMANDS TO "TAKE" COMMAND

$TAKE:	TABLE
	T ALLOW			;IGNORE ERRORS DURING TAKE
	T DISALLOW		;STOP ON ERRORS DURING TAKE
	T ECHO			;ECHO COMMANDS IN TAKE FILE
	T LOG-FILE,,.TKLOG	;FILE TO LOG OUTPUT ON
	T NO,,.NOTAK		;NO
	TEND

.ALLOW:	CALL ALONOI
	MOVX A,TKALEF		;BIT TO ALLOW ERRORS
	IORM A,TAKCON		;TURN IT ON
	RET

.DISAL:	CALL ALONOI
	MOVX A,TKALEF		;BIT FOR ALLOWING ERRORS
	ANDCAM A,TAKCON		;TURN IT OFF
	RET

.ECHO:	CALL ECHNOI
	MOVX A,TKECOF		;FLAG TO ALLOW ECHOING
	IORM A,TAKCON		;TURN IT ON
	RET

.TKLOG:	DEXTX <LOG>		;DEFAULT OUTPUT EXTENSION IS LOG
	MOVX A,GJ%FOU+GJ%MSG+GJ%ACC ;FILE FOR OUTPUT USE PLUS PRINT MESSAGE
	MOVEM A,CJFNBK+.GJGEN	;AND DON'T LET INFERIORS TOUCH THIS JFN
	MOVEI B,[FLDDB. .CMFIL,CM%SDH,,<Output file name>]
	CALL FLDSKP		;READ FILESPEC
	 CMERRX			;THAT'S NOT WHAT IT WAS
	MOVEM B,JFN2		;SAVE OUTPUT JFN
	RET

.NECHO:	CALL ECHNOI
	MOVX A,TKECOF		;FLAG TO ALLOW ECHOING
	ANDCAM A,TAKCON		;TURN IT OFF
	RET

.NOTAK:	KEYWD $NOTAK		;GET NEXT KEYWORD
	 T ECHO,,.NECHO
	 JRST CERR
	JRST (P3)		;CALL PROPER ROUTINE

$NOTAK:	TABLE
	T ECHO,,.NECHO
	TEND

;ROUTINE TO PUSH THE EXEC PRIMARY IO STREAM
;
;ACCEPTS:	A/	INPUT JFN,,OUTPUT JFN
;		B/	FLAG BITS (SUCH AS TKALEF, TKECOF)
;
;RETURNS +1

PUSHIO::MOVE C,TAKLEN		;GET CURRENT LENGTH
	CAIL C,TAKLNX		;MAKE SURE WE'RE NOT AT MAXIMUM
	JRST NOPE		;WE ARE
	AOJ C,			;INCREASE LENGTH OF LIST
	CALL PIOFF		;NO ^C WHILE WE STRAIGHTEN THINGS OUT
	MOVEM A,TAKJFN-1(C)	;STORE JFNS
	MOVEM B,TAKBTS-1(C)	;STORE CONTROL BITS
	MOVEM C,TAKLEN		;REMEMBER NEW LENGTH
	CALL FIXIO		;SET UP DYNAMIC VARIABLES
	HRRZ A,CIJFN		;FIND OUT WHERE WE'RE READING FROM
	DVCHR
	LDB B,[221100,,B]	;GET DEVICE TYPE OF INPUT DEVICE
	MOVE A,TAKCUR		;GET CURRENT SETTINGS
	TXO A,TKTERF		;FIRST ASSUME INPUTTING FROM TERMINAL
	CAIE B,.DVTTY		;GOOD GUESS?
	TXZ A,TKTERF		;NO, LOUSY GUESS.
	MOVEM A,TAKCUR		;UPDATE SETTINGS
	MOVE B,TAKLEN		;GET POINTER TO END OF LIST AGAIN
	MOVEM A,TAKBTS-1(B)	;REMEMBER WHETHER INPUTTING FROM TERMINAL
	CALLRET PION		;ALLOW ^C AGAIN

NOPE:	MOVE C,A		;SAVE JFNS IN C
	HRRZ A,C
	MOVE B,TAKJFN-1(B)	;GET LAST JFNS ON LIST
	CAIE A,(B)		;DON'T CLOSE IF LAST JFN IS SAME
	CLOSF			;CLOSE THIS LAST SET OF JFNS, SINCE THEY'RE NOT ON THE STACK YET
	 ERJMP .+1		;FAILED, PROBABLY BECAUSE 100 OR 101
	HLRZ A,C		;GET OTHER JFN
	CLOSF
	 ERJMP .+1
	HLRZ A,C		;PCL Look at input
	CAIN A,.NULIO		;PCL Command procedure?
	ERROR <Command procedures nested too deeply> ;PCL
	ERROR <TAKE commands nested too deeply>
;"TYPE" AND "LIST" ARE IN A SEPARATE FILE BELOW.

;UNATTACH - DETACH REMOTE JOB WITHOUT REATTACHING HERE

.UNATT::TLO Z,F1		;SAY UNATTACH INSTEAD OF ATTACH
	JRST ATTAU1		;GO JOIN ATTACH

;UNDELETE <DELETED FILE NAMES>

.UNDEL::NOISE <FILES>
	MOVE A,[XWD -1,0]	;NO DEFAULT NAMES
	MOVX B,(GJ%OLD!GJ%NS!GJ%DEL!GJ%IFG!1B15!1B16!1B17) ;"MUST BE NEW" AND "IGNORE DELETED BIT"
				;  ALSO, NO SEARCHING TO BE DONE
	HRLI B,-3		;DEFAULT VERSION IS *
	TRO Z,IGINV		;SEE INVISIBLE FILES
	CALL SPECFN		;INPUT FILE NAME USING GTJFN FLAGS IN B
	 JFCL			;IGNORE SUBCOMMAND ENDING
	SETOM TYPGRP		;ALWAYS PRINT FILENAME AT TYPIF
UNDEL1:	HRRZ A,@INIFH1		;JFN
	DVCHR
	TXNN B,DV%MDD		;MULT DIR DEVICE?
	 JRST [	ETYPE <?%1H: Can't undelete files on this device
>
		MOVSI A,(77B5)
		ANDCAM A,@INIFH1 ;CLEAR * INDICATIONS TO FORCE STEPPING TO NEXT JFN
		JRST UNDEL8]
	HRRZ A,@INIFH1
	MOVE B,[XWD 1,.FBCTL]	;CONTROL BITS WORD OF FILE DESC BLOCK
	MOVEI C,C		;READ INTO C
	CALL $GTFDB		;DO GTFDB JSYS, NO SKIP IF NO ACCESS
	SETO C,			;NO ACCESS, ASSUME DELETED
	TXNN	C,FB%DEL	;"FILE IS DELETED" BIT
	JRST [	MOVE A,@INIFH1	;GET JFN WITH FLAGS
		TLNE A,<77B5>B53 ;ANY *'S?
		JRST UNDEL8	;YES, NO MESSAGE
		CALL TYPIF	;PRINT NAME
		TYPE <  Wasn't deleted
>
		JRST UNDEL8]
	CALL TYPIF		;TYPE NAME IF GROUP
	HRLI A,.FBCTL		;1: XWD DISPLACEMENT, JFN
	LDF	B,FB%DEL	;MASK OF BITS TO CHANGE
	SETZ C,			;VALUE TO CHANGE TO: OFF.
	CALL $CHFDB		;DO CHFDB AND FIELD ITRAP IF ANY
	 JRST [	TYPE <  Access not allowed
>
		JRST UNDEL8]
	CALL TYPOK		;INDICATE DONE OK
UNDEL8:	CALL GNFIL		;GET JFN OF NEXT FILE OF GROUP
	RET			;NO MORE, GO GET NEXT COMMAND.
	JRST UNDEL1		;HAVE ANOTHER
;PRIVILEGED COMMANDS

;^E EDDT
;TRANSFER CONTROL TO TOPS20 DDT, GETTING IT IF IT ISN'T ALREADY THERE.

.EDDT::	SKIPE DDTORG
	JRST EDDT4		;DDT ALREADY THERE

	SKIPN Q1,.JOBSY		;DO WE HAVE SOME SYMBOLS?
	SKIPE Q1,JOBSYM		;???
	SKIPA B,[-1,,[GETSAVE <SYS:UDDT.>]]
	HRROI B,[GETSAVE <SYS:SDDT.>] ;USE SDDT IF NO SYMBOLS
	MOVSI A,(GJ%OLD!GJ%SHT)	;OLD FILE ONLY, AND SHORT FORM
	CALL GTJFS		;GET AND STACK THE JFN
	 CALL CJERRE		;IF CAN'T, JUST GIVE ERROR TO USER
	HRLI A,.FHSLF		;SAY THIS FORK (JFN IS IN RH A)
	CALL DOGET		;DO THE GET
	 CALL CJERRE		;FAILED, SAY WHY
	CALL RLJFNS

;"GET" CHANGES ENTRY VECTOR TO POINT AT DDT.
;CHANGE IT BACK.

	MOVEI A,.FHSLF
	DMOVE B,[EXP EVLEN,EXEC] ;ENTRY VECTOR
	CALL SETENT

;IF WE CAN FIND A SYMBOL TABLE POINTER, PUT IT IN THE DDT.

	SKIPN Q1		;HAVE ONE?
	JRST	[TYPE <% No symbols
>
		 JRST EDDT4]	;NO - PROCEED
	MOVEM Q1,@DDTORG+1	;YES - STORE INTO DDT
EDDT4:	MOVX A,OURNAM		;GET OUR NAME
	SETNM			;SET IT IN CASE USER EXITS DDT AND TYPES "SAVE"
	JRST DDTORG		;ENTER DDT
;DISABLE
;DISABLES PRIVILEGED COMMANDS,
;DISABLES USER (RH) SPEC CAPS IN EXEC AND INFERIOR FORK
; (CAPS POSSIBLE ARE STILL TRANSMITTED, SO INFERIOR CAN USE THEM
; IF IT ENABLES THEM ITSELF)

.DISAB::SETZ A,			;FLAG DISABLE
DISAB1:	STKVAR <REMA>
	MOVEM A,REMA		;REMEMBER DESIRED SETTING
	NOISE <CAPABILITIES>
	CONFIRM
	MOVE A,REMA
	MOVEM A,PRVENF		;GET DESIRED SETTING
	MOVEI A,.FHSLF		;"ENABLE" JOINS HERE
	RPCAP
	TRZ C,-1
	SKIPE PRVENF
	HRR C,B
	MOVE D,C		;REMEMBER EXEC'S CAPS
	EPCAP			;EXEC'S CAPABILITIES
	SKIPG A,FORK
	RET			;NO INFERIOR, DONE
	RPCAP
	MOVE C,D		;SET FORK TO WHATEVER WE ARE
	EPCAP			;INFERIOR'S CAPS
	RET

;ENABLE
;ENABLES OTHER PRIVILEGED COMMANDS IN EXEC, AND ENABLES
;RH (USER) SPECIAL CAPS IN EXEC AND IN INFERIOR FORK, IF THERE IS ONE.

.ENABL::SETO A,			;FLAG TO DO ENABLE
	JRST DISAB1

;^ELOGOUT (JOB #)

..LOGO::PUSH P,A
	GJINF
	CAMN 3,0(P)		;THIS JOB?
	ERROR <If you want to logout this job, use LOGOUT>
	MOVE D,0(P)		;RECOVER JOB NUMBER
	HLRE A,JOBRT		;GET NUMBER OF JOBS ON SYSTEM
	MOVM A,A		;MAKE IT POSITIVE
	CAML D,A		;VALID ARG?
	JRST ELOGO1		;NO
	JUMPL D,ELOGO1		;NEGATIVE ALSO INVALID
	GTB .JOBRT		;CHECK RUNTIME TABLE
	JUMPGE 1,.+2		;REQUESTED JOB EXISTS?
ELOGO1:	ERROR <That job does not exist>
	CONFIRM
	POP P,A
	LGOUT
	 CALL CJERR
	JRST CMDIN4
NEWF,<
.BLANK::NOISE (SCREEN)
	CONFIRM
BLANK1::STKVAR <TMOD>
	MOVE 1,COJFN		;CURRENT OUTPUT JFN
	RFMOD			;GET MODE WORD
	MOVEM B,TMOD		;SAVE IT
	TXZ B,TT%DAM		;NO XLATION
	SFMOD
	GTTYP			;GET TERMINAL TYPE
	CAIG B,BLNKMX		;ALL WE KNOW ABOUT NOW
	SKIPN A,BLNKTB(B)	;GET STRING TO DUMP
	 JRST BLANK2		;NONE - DO NOTHING
	TLNN A,-1		;STRING OR PNTR?
	 TLOA A,-1		;PNTR TO TEXT
	  HRROI A,BLNKTB(B)	;STRING - POINT TO IT INSTEAD
	PSOUT			;DUMP IT
BLANK2:	MOVE A,COJFN
	MOVE B,TMOD		;RESTORE MODES WORD
	SFMOD
	RET

BLNKTB:	0			;(0) TTY 33
	0			;(1) TTY 35
	0			;(2) TTY 37
	0			;(3) TI / EXECUPORT
REPEAT 4,<0>			;(4-7) RESERVED FOR CUSTOMER
	0			;(8) SYSTEM DEFAULT
	0			;(9) IDEAL (NO FILL)
	[BYTE (7)35,177,177,177,177,177,177,37,0] ;(10) VT05
	BYTE (7)33,"H",33,"J",0	;(11) VT50
	0			;(12) LA30
	BYTE (7)35,37		;(13) GT40 - NO FILL REQUIRED
	0			;(14) LA36
	BYTE (7)33,"H",33,"J",0	;(15) VT52
	[BYTE (7)33,"[","H",33,"[","J",0] ;(16) VT100
	0			;(17) LA38
	0			;(18) LA120
BLNKMX=.-BLNKTB
>
	END