Google
 

Trailing-Edge - PDP-10 Archives - bb-m081w-sm_t20_v7_0_02_exec_src_mod - exec/exec1.mac
There are 47 other files named exec1.mac in the archive. Click here to see a list.
; Edit= 4426 to EXEC1.MAC on 18-Apr-89 by GSCOTT
;Fix typeo in previous edit.
; Edit= 4425 to EXEC1.MAC on 14-Mar-89 by GSCOTT
;Rewrite ATTACH command to allow user to pick a job to attach to if more than
;one candidate job. Also allow ETYPE's %L to take an AC argument. 
; Edit= 4420 to EXEC1.MAC on 16-Feb-89 by GSCOTT
;Make ETYPE's %W say "never" for a zero date, then clean up login message code
;in EXEC0 and EXEC1.
; Edit= 4419 to EXEC1.MAC on 9-Feb-89 by GSCOTT
;INFORMATION JOB command should show network origin. %L now will output this. 
; Edit= 4415 to EXEC1.MAC on 22-Dec-88 by RASPUZZI
;Be more forgiving to those poor souls who do not know the minimum password
;length during the login process.
; Edit= 4414 to EXEC1.MAC on 20-Dec-88 by RASPUZZI
;Keep clever users from not changing their expired passwords and make the code
;in REPWD more fool proof for those morons who can't change passwords when
;they are told to.
; Edit= 4412 to EXEC1.MAC on 13-Dec-88 by RASPUZZI
;Add new commands, features and support for security enhancements.
; Edit= 4411 to EXEC1.MAC on 25-Aug-88 by RASPUZZI, for SPR #22255
;Prevent routine MESMES from trashing the first entry in MWATDR.
; UPD ID= 4137, RIP:<7.EXEC>EXEC1.MAC.16,   7-Apr-88 15:20:18 by RASPUZZI
;TCO 7.1269 - Don't mislead users into believing that '*' is a valid answer
;	      when parsing a node name for a (^E)SEND USER when USER is
;	      logged into multiple nodes.
; UPD ID= 4107, RIP:<7.EXEC>EXEC1.MAC.15,   7-Mar-88 18:20:12 by GSCOTT
;TCO 7.1255 - Update copyright notice.
; UPD ID= 4089, RIP:<7.EXEC>EXEC1.MAC.14,  19-Jan-88 14:29:47 by RASPUZZI
;TCO 7.1187 - Fix header English for TTMSG% (^ESEND only) when doing
;	      send to local node and terminal number is given (add "to"
;	      in front of destination line.
; UPD ID= 4086, RIP:<7.EXEC>EXEC1.MAC.13,  15-Jan-88 14:39:49 by EVANS
;TCO 7.1182 - Answer Grump 141 by not allowing user to ask to KEEP
;		a negative number of versions.
;TCO 7.1178 - Implement DELETE subcommands.
; UPD ID= 4084, RIP:<7.EXEC>EXEC1.MAC.12,  18-Dec-87 10:24:03 by RASPUZZI
;TCO 7.1166 - Add help text in VALNOD for parsing *.
; UPD ID= 81, RIP:<7.EXEC>EXEC1.MAC.11,  10-Dec-87 14:57:15 by RASPUZZI
;TCO 7.1160 - Again, say "?Invalid user" if arbitrary string is parsed
;             and the parse was garbage (empty ATMBUF checked in this case).
;             This will produce a more meaningful error message for the
;             user.
; UPD ID= 80, RIP:<7.EXEC>EXEC1.MAC.10,   1-Dec-87 15:05:45 by RASPUZZI
;TCO 7.1153 - Say "?Invalid user" if arbitrary string parsed for SEND on
;             local node because arbitrary string cannot be a local user.
; UPD ID= 67, RIP:<7.EXEC>EXEC1.MAC.9,  13-Nov-87 12:50:22 by RASPUZZI
;More of TCO 7.1135 - I forgot that user names can only be 39 characters
;	              long.
; UPD ID= 66, RIP:<7.EXEC>EXEC1.MAC.8,  13-Nov-87 11:43:31 by RASPUZZI
;TCO 7.1135 - Have SEND parse arbitrary string so that cluster SENDs
;             will work when a username is given that is not valid on
;             the local system.
; UPD ID= 60, RIP:<7.EXEC>EXEC1.MAC.7,  30-Oct-87 11:29:24 by RASPUZZI
;TCO 7.1106 - Make sure to choose a terminal for the user if the specified
;             send victim is only logged into one terminal on a remote node.
; UPD ID= 58, RIP:<7.EXEC>EXEC1.MAC.6,  29-Oct-87 15:57:37 by RASPUZZI
;TCO 7.1101 - Ignore JSYS error in REMLIN.
; UPD ID= 39, RIP:<7.EXEC>EXEC1.MAC.5,  22-Oct-87 11:03:25 by RASPUZZI
;TCO 7.1076 - Add code to support cluster sends. Have LINCHK call REMLIN
;             when /NODE is given to get remote TTY of user. Modify the
;             SENDA routine to make a slightly different header for WHEELs
;             doing TTMSG%'s.
; UPD ID= 25, RIP:<7.EXEC>EXEC1.MAC.4,  23-Sep-87 15:50:31 by MCCOLLUM
;TCO 7.1063 - Fix up EXPUNGE, CONNECT and [END-]ACCESS to display STRX10
; UPD ID= 7, RIP:<7.EXEC>EXEC1.MAC.3,  21-Jul-87 14:51:53 by EVANS
; TCO 7.1025 - Prevent funny numbers of pages freed on EXPUNGE.
; *** Edit 3067 to EXEC1.MAC by GSCOTT on 12-May-87
; LOGIN command should set session remark before logging in. Requires monitor
; edit 7477 be installed before this EXEC. 
; *** Edit 3054 to EXEC1.MAC by RASPUZZI on 21-Nov-86
; Prevent double prompts from happening after a terminal has given ADVICE. This
; is done by using CFIBF% after restoring the TTY mode.
; *** Edit 3050 to EXEC1.MAC by EVANS on 29-Oct-86, for SPR #00092
; Reset STATSW to zero to prevent mulitply defined symbols when linking with
; distributed PCL and MIC modules; remove the STAT code so we don't do the
; statistics.
; *** Edit 3049 to EXEC1.MAC by EVANS on 28-Oct-86
; Prevent bogus error message on DELETE with EXPUNGE subcommand.
; *** Edit 3045 to EXEC1.MAC by EVANS on 12-Aug-86, for SPR #21270
; Make the EXEC check for STRX09 when coming back from DELDF% on an EXPUNGE. If
; found, do not continue looping thru all directories on the structure. RE
; monitor edit 7351.
; *** Edit 3040 to EXEC1.MAC by EVANS on 24-Jun-86, for SPR #21170
; Implement MAIL-WATCHing based on directory number, as users can now send mail
; to non-username directories on POBOX:
; *** Edit 3023 to EXEC1.MAC by WAGNER on 26-Nov-85, for SPR #20947
; Make DELETE command know about offline files by setting G1%IIN for
; consideration of invisible files. GTJFN changed to require this bit being
; set. 
; Edit 3016 to EXEC1.MAC by EVANS on 15-Oct-85 (TCO none)
; Change error message to account for unmounted structure in case user attempts
; to expunge such a structure. (RE: 6.1 monitor edit 7117) 
; Edit 3011 to EXEC1.MAC by SANTIAGO on 15-Aug-85
; more TCO 6.1.1519 - make code less gross 
; Edit 3010 to EXEC1.MAC by SANTIAGO on 13-Aug-85 (TCO 6-1-1519 )
; Make ADVISE work if Wheel is trying to advise user with TERMINAL INHIBIT
; UPD ID= 244, SNARK:<6.1.EXEC>EXEC1.MAC.25,  10-Jun-85 09:09:49 by SANTIAGO
;TCO 6.1.1430 - Make DISCARD command see invisible files
; UPD ID= 217, SNARK:<6.1.EXEC>EXEC1.MAC.24,  10-Jun-85 08:42:20 by DMCDANIEL
; UPD ID= 201, SNARK:<6.1.EXEC>EXEC1.MAC.23,  24-May-85 14:13:14 by EVANS
;TCO 6.1.1404 - Add command editor stuff.
; UPD ID= 193, SNARK:<6.1.EXEC>EXEC1.MAC.22,  10-May-85 15:45:16 by EVANS
;TCO 6.1.1362 - Save TAKLEN when begin LOGOUT process, and test against it
;	 (SAVTAK)         when TAKE encountered in LOGOUT.CMD.
; UPD ID= 161, SNARK:<6.1.EXEC>EXEC1.MAC.21,   3-May-85 08:29:16 by DMCDANIEL
;Update copyrights for 6.1.
; UPD ID= 153, SNARK:<6.1.EXEC>EXEC1.MAC.20,   2-May-85 11:15:23 by PRATT
;TCO 6.1.1353 - Handle GNJFN errors better
; UPD ID= 147, SNARK:<6.1.EXEC>EXEC1.MAC.19,  15-Mar-85 16:19:41 by EVANS
;Yet more TCO 6.1.1027 - Require confirm of LOGOUT when not logged-in.
; UPD ID= 145, SNARK:<6.1.EXEC>EXEC1.MAC.18,  15-Mar-85 13:22:55 by PRATT
;TCO 6.1.1068 - Change CAIGE to CAMGE in .BLANK
; UPD ID= 140, SNARK:<6.1.EXEC>EXEC1.MAC.17,  14-Mar-85 16:18:14 by SANTIAGO
;Still more TCO 6.1.1261 - Put previous patch in proper place.
; UPD ID= 139, SNARK:<6.1.EXEC>EXEC1.MAC.16,  14-Mar-85 15:40:41 by SANTIAGO
;More TCO 6.1.1261 - Don't bother checking for over quota if GTDAL% fails
; UPD ID= 134, SNARK:<6.1.EXEC>EXEC1.MAC.15,  13-Mar-85 17:06:21 by SANTIAGO
;TCO 6.1.1261 - Fix LOGOUT when GETAB% capabilities are off.
; UPD ID= 131, SNARK:<6.1.EXEC>EXEC1.MAC.14,   7-Mar-85 08:46:15 by PRATT
;TCO 6.1.1240 - If never logged in before, output Last Login Never
; UPD ID= 127, SNARK:<6.1.EXEC>EXEC1.MAC.13,   7-Feb-85 09:38:15 by PRATT
;TCO 6.1.1179 - Remove output filespec on TAKE, use LOG-FILE instead.
; UPD ID= 122, SNARK:<6.1.EXEC>EXEC1.MAC.12,   9-Jan-85 14:04:52 by EVANS
;TCO 6.1.1123 - Change confusing error message if SENDer gives wrong term #.
; UPD ID= 103, SNARK:<6.1.EXEC>EXEC1.MAC.11,  11-Dec-84 15:21:25 by MOSER
;TCO 6.1.1077 - ADD STAT STUFF
; UPD ID= 101, SNARK:<6.1.EXEC>EXEC1.MAC.10,  10-Dec-84 13:39:21 by EVANS
;More TCO 6.1.1027 - In case user redefines SYSTEM:, set GJ%PHY for GTJFN so
;			system logicals ONLY will be considered.
; UPD ID= 93, SNARK:<6.1.EXEC>EXEC1.MAC.9,  15-Nov-84 13:33:50 by EVANS
;Still more TCO 6.1.1027 - Account for case of "TAKE" at end of LOGOUT.CMD
; UPD ID= 52, SNARK:<6.1.EXEC>EXEC1.MAC.8,   5-Nov-84 15:18:04 by MCCOLLUM
;TCO 6.1.1025 - Fix up call to MFSET in .RENAM
; UPD ID= 49, SNARK:<6.1.EXEC>EXEC1.MAC.7,   1-Nov-84 12:58:14 by PRATT
;More TCO 6.1.1027 - LOGO n has an unecessary CONFIRM
; UPD ID= 38, SNARK:<6.1.EXEC>EXEC1.MAC.6,  26-Oct-84 13:35:43 by EVANS
;TCO 6.1.1027 - Add LOGOUT.CMD; SYSTEM: and user flavors, with /FAST option.
; UPD ID= 36, SNARK:<6.1.EXEC>EXEC1.MAC.5,  20-Oct-84 12:08:33 by PRATT
;More TCO 6.1.1014 - Verify the selected line to match requested username
; UPD ID= 26, SNARK:<6.1.EXEC>EXEC1.MAC.4,   1-Oct-84 22:40:56 by PRATT
;TCO 6.1.1019 - Allow some commands set CM%NSF (no suffix) for devices
; UPD ID= 5, SNARK:<6.1.EXEC>EXEC1.MAC.3,  28-Sep-84 18:44:58 by PRATT
;TCO 6.1.1014 - Allow usernames to be typed as an argument to SEND
; UPD ID= 4, SNARK:<6.1.EXEC>EXEC1.MAC.2,  28-Sep-84 18:34:47 by PRATT
;TCO 6.1.1013 - Add recognition to the DEFINE command
; UPD ID= 442, SNARK:<6.EXEC>EXEC1.MAC.48,  26-Sep-84 15:07:59 by MCCOLLUM
;TCO 6.2228 - Add entry point RTFLG1 to RTTFLG so caller can supply line #.
; UPD ID= 392, SNARK:<6.EXEC>EXEC1.MAC.47,  28-Feb-84 08:23:59 by PRATT
;TCO 6.1956 - Check the SMON Exec flags before allowing /FAST 
; UPD ID= 378, SNARK:<6.EXEC>EXEC1.MAC.46,  18-Jan-84 16:34:30 by PRATT
;More TCO 6.1796 - Use Q1 and Q2 in .RESYS, not just Q1
; UPD ID= 377, SNARK:<6.EXEC>EXEC1.MAC.45,  18-Jan-84 15:58:50 by PRATT
;TCO 6.1940 - Rewrite TCO 6.1857
; UPD ID= 371, SNARK:<6.EXEC>EXEC1.MAC.44,   5-Jan-84 10:16:00 by PRATT
;TCO 6.1923 - If detached and using .PRIIN, bypass the the DVCHR in PUSHIO
; UPD ID= 368, SNARK:<6.EXEC>EXEC1.MAC.43,  28-Dec-83 16:35:16 by PRATT
;More TCO 6.1796 - Add REFUSE USER-MESSAGES
; UPD ID= 364, SNARK:<6.EXEC>EXEC1.MAC.42,  27-Dec-83 10:14:00 by TSANG
;More for TCO 6.1857 - Need for CONFIRMATION.
; UPD ID= 363, SNARK:<6.EXEC>EXEC1.MAC.41,  19-Dec-83 12:14:02 by TSANG
;TCO 6.1857 - LOGOUT of another job give the victim's name and ask for confirm.
; UPD ID= 334, SNARK:<6.EXEC>EXEC1.MAC.40,  20-Nov-83 19:38:27 by PRATT
;TCO 6.1870 - Get rid of code which is under NONEWF. Remove NEWF's.
; UPD ID= 330, SNARK:<6.EXEC>EXEC1.MAC.38,  18-Nov-83 14:33:13 by TSANG
;More TCO 6.1837 
; UPD ID= 329, SNARK:<6.EXEC>EXEC1.MAC.37,  17-Nov-83 17:25:46 by PRATT
;More TCO 6.1796 - New RECV/REFUSE code to prepare for USER-MESSAGE option
; UPD ID= 327, SNARK:<6.EXEC>EXEC1.MAC.36,  17-Nov-83 13:59:48 by PRATT
;TCO 6.1796 - [Set] Terminal [no] Receive Advice/Links/System-messages
; UPD ID= 322, SNARK:<6.EXEC>EXEC1.MAC.35,  10-Nov-83 14:10:47 by TSANG
;TCO 6.1837 - Set flag bit for .DELET .DISCA and remove from .RENAM
; UPD ID= 318, SNARK:<6.EXEC>EXEC1.MAC.34,   8-Nov-83 13:48:35 by PRATT
;TCO 6.1847 - Fast LOGIN code
; UPD ID= 305, SNARK:<6.EXEC>EXEC1.MAC.33,   8-Aug-83 11:24:04 by TSANG
;TCO 6.1760 - Set flag bit for .RENAM
; UPD ID= 285, SNARK:<6.EXEC>EXEC1.MAC.32,  13-May-83 00:03:01 by PAETZOLD
;TCP 6.1656 - Zero SNDPTC in .USEND after the TRVAR
; UPD ID= 264, SNARK:<6.EXEC>EXEC1.MAC.31,   8-Apr-83 13:53:41 by TSANG
;TCO 6.1580 - Provide ERJMP CJERR after RPCAP and EPCAP JSYS call
; UPD ID= 255, SNARK:<6.EXEC>EXEC1.MAC.30,  28-Jan-83 14:19:27 by DONAHUE
;TCO 6.1437 - Add CONFIRM to routine TKLOG
; UPD ID= 234, SNARK:<6.EXEC>EXEC1.MAC.29,  15-Jan-83 19:23:40 by CHALL
;TCO 6.1464 - UPDATE COPYRIGHT NOTICE
; UPD ID= 215, SNARK:<6.EXEC>EXEC1.MAC.28,  10-Jan-83 14:10:07 by LOMARTIRE
;TCO 6.1449 - New entry routine TRYGTS for getting a jfn for SYSJOB.COMMANDS
; UPD ID= 192, SNARK:<6.EXEC>EXEC1.MAC.27,  11-Nov-82 21:49:38 by CHALL
;TCO 6.1366 .TALK- REPLACE REFERENCES TO "MAIL" WITH A SUGGESTION TO RUN MAIL
; UPD ID= 170, SNARK:<6.EXEC>EXEC1.MAC.25,  30-Sep-82 20:15:35 by CHALL
;TCO 6.1288 PASWD1- TURN ON ECHOING AFTER READING PASSWORD ON A HDX T'L
;TCO 6.1286 .USEND- ADD SEND COMMAND (LIKE ^ESEND, NOT ENABLED)
; UPD ID= 154, SNARK:<6.EXEC>EXEC1.MAC.22,  28-Aug-82 18:27:19 by PAETZOLD
;More TCO 6.1240 - Get last login time from login jsys and not gtdir
; UPD ID= 165, SNARK:<6.EXEC>EXEC1.MAC.23,  28-Sep-82 10:21:17 by TSANG
;TCO 6.1250 - SET BREAK MASK FOR PARSING A PASSWORD IN WORDX.
; UPD ID= 154, SNARK:<6.EXEC>EXEC1.MAC.22,  28-Aug-82 18:27:19 by PAETZOLD
;More TCO 6.1240 - Get last login time from login jsys and not gtdir
; UPD ID= 152, SNARK:<6.EXEC>EXEC1.MAC.20,  28-Aug-82 11:53:36 by PAETZOLD
;TCO 6.1240 - Output date and time of last login when logging in
; UPD ID= 133, SNARK:<6.EXEC>EXEC1.MAC.19,   4-Aug-82 17:11:37 by LEACHE
;TCO 6.1209 - Fix invocations of ETYPE
; UPD ID= 130, SNARK:<6.EXEC>EXEC1.MAC.17,  22-Jul-82 00:01:39 by WALLACE
;TCO 6.1190 - Modify PDLFRE, the routine which gives pages freed for
;  the DELETE command, to output pages freed only if EXPUNGE is
;  explicitly requested and to say nothing if directory allocation grows
;  during execution of the command.  As before, always output zero pages
;  freed for non multiple directory devices.
; UPD ID= 128, SNARK:<6.EXEC>EXEC1.MAC.16,  25-Jun-82 20:36:14 by CHALL
;TCO 6.1178 .PUSH- LOOK FOR "DEFAULT-EXEC:", THEN "SYSTEM:EXEC.EXE"
; UPD ID= 127, SNARK:<6.EXEC>EXEC1.MAC.15,  12-Jun-82 12:09:21 by CHALL
;TCO 6.1165 CANARC- SET CF%NS (NO SUBCOMMANDS) FOR CALL TO SPECFN
; UPD ID= 123, SNARK:<6.EXEC>EXEC1.MAC.14,  24-Apr-82 12:25:04 by CHALL
;TCO 6.1101 CONSOLIDATE STUFF ABOUT TERMINALS (BLNKTB) IN EXECCA
;TCO 6.1100 .SEND- RE-CAST THE ^ESEND CODE
; UPD ID= 104, SNARK:<6.EXEC>EXEC1.MAC.13,  22-Jan-82 16:42:48 by CHALL
;TCO 5.1698 .TKLOG- ADD NEW SUBCOMMAND TO TAKE: LOG-FILE
; UPD ID= 103, SNARK:<6.EXEC>EXEC1.MAC.12,  15-Jan-82 16:32:12 by CHALL
;TCO 5.1668 .CLOSE- ADD HELP MESSAGE TO OCTX LUUO
; UPD ID= 85, SNARK:<6.EXEC>EXEC1.MAC.11,   8-Jan-82 15:45:33 by CHALL
;TCO 6.1052 - UPDATE COPYRIGHT NOTICE AND DELETE PRE-V4.1 EDIT HISTORY
; UPD ID= 66, SNARK:<6.EXEC>EXEC1.MAC.9,  10-Oct-81 20:06:43 by CHALL
;TCO 5.1563 .CONNE- ADD "STRUCTURE NOT MOUNTED" TO CONNECT ERROR MESSAGE
; UPD ID= 25, SNARK:<6.EXEC>EXEC1.MAC.7,  17-Aug-81 10:33:14 by CHALL
;TCO 5.1454 CHANGE NAME FROM XDEF TO EXECDE
; UPD ID= 14, SNARK:<6.EXEC>EXEC1.MAC.6,  21-Jul-81 12:30:56 by MURPHY
;TCO 5.1427 - GET RID OF SYSTEM MAIL BEFORE PUSH
; UPD ID= 12, SNARK:<6.EXEC>EXEC1.MAC.5,  20-Jul-81 11:18:33 by CHALL
;TCO 5.1420 - DETSND: HAVE SEND * SAY IT'S GOING TO ALL
; 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

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

	SEARCH EXECDE
	TTITLE EXEC1
	EXTERN MAXCI,INFLEN	;[7.1076]

;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::TRVAR <SAVBPT>
	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:	HRROI B,[ASCIZ/Logical name to define or delete/]
	CALL STRN		;GET THE NAME
	 CMERRX
	CALL BUFFF		;GET POINTER TO NAME
	PUSH P,A		;SAVE POINTER
.ASSO2:	SKIPN (P)		;ALL?
	JRST .ASS3B		;YES, SEPARATE ROUTINE
	NOISE <AS>
	MOVE B,SBLOCK+.CMPTR	;GET POINTER TO COMMAND BUFFER
	MOVEM B,SAVBPT		;SAVE IT
	CALL PARSTX		;CHECK THE STRING, IS IT COMPLETE ?
	 JRST .ASS2B		;NO, USE RECOGNITION
	; ..			;FALL THRU INTO NORMAL .CMTXT

;HERE TO READ THE WHOLE STRING AT ONCE, NO RECOGNITION NEEDED

	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
	JRST .ASSO3		;GO JOIN COMMON CODE
;HERE TO READ THE STRING USING RECOGNITION

.ASS2B:	DEXTX <>		;CLEAR GTJFN BLOCK
	MOVX B,GJ%NEW!GJ%OLD!GJ%IFG 
	MOVEM B,CJFNBK+.GJGEN
	MOVEI B,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /,/]>,,,[
		 FLDDB. .CMFIL,CM%SDH,,<Definition list or null to delete>,,[
		 FLDDB. .CMCFM,CM%SDH]]]
	CALL FLDSKP		;GET SOME INPUT
	 JFCL			;IGNORE THE ERROR RIGHT NOW, CHECK IT LATER
	LDB C,[331100,,(C)]	;SEE WHICH WAS TYPED
	CAIN C,.CMCFM		;GOT A CONFIRM ?
	IFSKP.
	 TXNN A,CM%NOP		;NO - NO PARSE ?
	 IFSKP.
	  DEXTX <>		;CLEAR GTJFN BLOCK
	  MOVX A,GJ%OFG		;WE WANT SPEC, DON'T CARE IF EXISTS ANYMORE
	  IORM A,CJFNBK+.GJGEN
	  FILEX <>		;TRY TO READ THE FILESPEC
	   CMERRX		;COULDN'T, THIS LINE HAS REAL PROBLEMS
	 ENDIF.
	 JRST .ASS2B		;HAVEN'T GOTTEN EOL YET
	ENDIF.			;GOT END OF LINE
	MOVE A,SAVBPT		;GET POINTER TO CURRENT STRING
	CALL BUFFS		;GET POINTER TO DEFINITION STRING
	; ..         		;JOIN COMMON CODE

;HERE FOR COMMON CODE FOR CREATING THE LOGICAL NAME

.ASSO3:	MOVE C,A		;NEW POINTER 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 TO CHECK FOR COMPLETE COMMAND

PARSTX:	MOVE C,SBLOCK+.CMPTR	;GET THE POINTER
PARST1:	ILDB A,C             	;GET THE NEXT CHARACTER 
	JUMPE A,R		;NULL MEANS COMMAND HASN'T COMPLETED
	CAIE A,14    		;FORMFEED COUNTS AS END OF LINE
	CAIN A,12    		;LINEFEED?
	RETSKP			;YES - AT END
	CAIE A,15    		;CARRIAGE RETURN?
	JRST PARST1		;NEITHER, HAVEN'T REACHED END YET
	RETSKP			;YES - AT END


;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 command

;ATTACH (USER) user (JOB #) job
;Password:

;[4425]	AC usage in this command:
;	Z/ F1 is clear if ATTACH command, set if UNATTACH command.
;	Q1/ target user number
;	Q2/ target job number
;	Q3/ line number of target job

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

;DECODE ARGUMENTS

	TRVAR <<APBUF,20>,<AT1,2>> ;[4425] Storage for later use
	NOISE <USER>
	CALL USERN		;INPUT USER (DIRECTORY) NAME
	 CMERRX			;FAILED, PRINT REASON
	TXNE A,RC%DIR		;Files only?
	ERROR <That's a FILES-ONLY directory name>
	MOVEM C,Q1		;[4425] Save user number attaching to
	NOISE <JOB #>
	DECX <Job number if more than one job under that name> ;[4425] 
	 CAIA			;NON-DECIMAL NUMBER TYPED
	JRST ATTNUM		;NUMBER TYPED, GO PROCESS IT
	CONFIRM			;REQUIRE CONFIRMATION OF COMMAND
;	JRST ATTAC5		;[4425] Go default a value
;ATTACH...

;[4425] No job number given, try to find a job to attach to.  Call a routine to
;get all of the jobs logged into this username on this system.

ATTAC5:	MOVE B,Q1		;[4425] Load usernumber to find
	CALL FNDUSR		;[4425] (B/) Fill BUF0 with job,,tty

;[4425] Table is filled with job,,terminal entries.  Loop through the table
;returned to us to find any or all jobs that could be selected today.

	SOSG A,BUF0		;[4425] Sub header word from count and load it
	ERROR <No jobs logged in under %5R> ;[4425] No users logged in
	SETZB B,C		;[4425] Zero candidates
	DO.			;[4425] Loop to discover how many possible jobs
	  HLRZ D,BUF0(A)	;[4425] Load job number of the job
	  SKIPE D		;[4425] Job 0 is never (un)attached
	  CAMN D,JOBNO		;[4425] Always skip our job
	  IFSKP.		;[4425] If not our job and not job 0
	    HRRE D,BUF0(A)	;[4425] Get the terminal number of that job
	    IFL. D		;[4425] If the job is detached
	      TLNE Z,F1		;[4425] Unattach command?
	      IFSKP.		;[4425] Nope, attach command
	        SKIPN B		;[4425] Any previous candidate?
	        SKIPA B,BUF0(A)	;[4425] Nope, this is the one
	        SETO B,		;[4425] Yes, indicate multiple candidate jobs
	      ENDIF.		;[4425] End of detached job check
	    ELSE.		;[4425] Otherwise that job is not detached
	      SKIPN C		;[4425] Any previous attached job candidate?
	      SKIPA C,BUF0(A)	;[4425] No previous attached job, remember job
	      SETO C,		;[4425] Indicate multiple jobs seen
	    ENDIF.		;[4425] End of attached job checks
	  ENDIF.		;[4425] End of "it's not my job" code
	  SOJG A,TOP.		;[4425] Loop for all jobs in the table
	OD.			;[4425] End of loop through all jobs
				;[4425] Fall through to check results
;ATTACH...

;[4425] If an UNATTACH command and only one candidate attached job, use it.  If
;multiple candidate jobs, ask which one.  If no candidate jobs to unattach,
;give an error message.

	TLNN Z,F1		;[4425] Unattach command?
	IFSKP.			;[4425] Yes, unattach command
	  IFG. C		;[4425] Any single attached job candidate?
	    HLRZ Q2,C		;[4425] Load job number
	    HRRE Q3,C		;[4425]  and terminal number
	    JRST ATTAC7		;[4425] Yes, use that one for unattaching
	  ENDIF.		;[4425] So no single attached job
	  JUMPL C,ATTAC6	;[4425] If multiple attached jobs jump
	  CAMN Q1,CUSRNO	;[4425] One of ours?
	  ERROR <No other attached jobs logged in under %5R> ;[4425] Yes
	  ERROR <No attached jobs logged in under %5R> ;[4425] No
	ENDIF.			;[4425] End of unattach command code

;[4425] Now for the case of the ATTACH command.  If there is one detached
;candidate job, use it.  If there is one candidate attached job, use it.  If
;there is more than one target job, list them amd prompt for the job number to
;attach to.  If there are no candidate give an error message.

	IFG. B			;[4425] Any detached job to use?
	  HLRZ Q2,B		;[4425] Load job number
	  HRRE Q3,B		;[4425]  and terminal number (-1 for detached)
	  JRST ATTAC7		;[4425] Yes, use that one
	ENDIF.			;[4425] No detached job to use
	IFG. C			;[4425] Any single attached job candidate?
	  HLRZ Q2,C		;[4425] Load job number
	  HRRE Q3,C		;[4425]  and terminal number
	  JUMPE B,ATTAC7	;[4425] Yes, use that one only if no det jobs
	ENDIF.			;[4425] So no single attached job

	JUMPL C,ATTAC6		;[4425] If multiple attached jobs jump
	JUMPL B,ATTAC6		;[4425] Attach, if multiple detached jobs jump

	CAMN Q1,CUSRNO		;[4425] Trying to attach to another of my jobs?
	ERROR <No other jobs logged in under %5R> ;[4425] Yes
	ERROR <No jobs logged in under %5R> ;[4425] No
;ATTACH...

;[4425] Here when we have multiple target job possibilities, list them.  Do not
;list a job in the table if (1) it is job zero (2) it is our job or (3) if it
;is an unattach command and job is detached.

ATTAC6:	MOVN Q3,BUF0		;[4425] Load -count
	HRLZ Q3,Q3		;[4425]  and make it -count,,0
	SETZ B,			;[4425] Clear job number of first one displayed
	DO.			;[4425] Loop to output jobs that are candidates
	  HLRZ D,BUF0+1(Q3)	;[4425] Load the job number
	  SKIPE D		;[4425] If job 0
	  CAMN D,JOBNO		;[4425]  and not our job
	  IFSKP.		;[4425] It's not my job (or job 0)
	    HRRE C,BUF0+1(Q3)	;[4425] Load the terminal number
	    SKIPGE C		;[4425] Is job detached?
	    TLNN Z,F1		;[4425] Yes, is this an unattach command?
	    IFNSK.		;[4425] We need to output this job
	      GTB .JOBPN	;[4425] (D/A) Get program name of that job
	      SKIPN A		;[4425] Anything there?
	      MOVX A,<SIXBIT/?/> ;[4425] Say what?
	      TXO C,.TTDES	;[4425] Make terminal designator from that
	      ETYPE < Job %4Q, %3L, %1'%%_> ;[4425] Output info to terminal
	      SKIPN B		;[4425] Any job number to default yet?
	      MOVE B,D		;[4425] Nope, use first one
	    ENDIF.		;[4425] End of need to display job code
	  ENDIF.		;[4425] End of "it's not my job or job 0" code
	  AOBJN Q3,TOP.		;[4425] Loop for all of them
	OD.			;[4425] End of loop for all of them

;[4425] Select a job if none selected and more than one target job found.

	PROMPT <Job: >		;[4425] Prompt for job number
	HRROI A,APBUF		;[4425] Get pointer for default string
	MOVEM A,CMDEF		;[4425] Save pointer to default
	MOVEI C,^D10		;[4425] In octal
	NOUT			;[4425] Create default string
	 ERJMP .+1		;[4425] Won't fail
	DECX <Job number>	;[4425] Get the job number for attach
	 CMERRX			;[4425] Bomb if not a number
;	JRST ATTNUM		;[4425] Now B/ job number to use
;ATTACH...

;[4425] Here after the job number has been input to confirm the command.

ATTNUM:	CONFIRM			;[4425] Confirm after job number input
	MOVEM B,Q2		;[4425] Save target job number 

;Check that user given job number is in legal range of jobs for this system.

	SETO D,			;[4425] We want the size of the table
	GTB .JOBRT		;[4425] (D/A) Get max job as length of table
	MOVN A,A		;[4425] Length comes back negative
	SUBI A,1		;[4425] So value comes out right in error 
	CAML A,Q2		;[4425] Length must be greater than given job
	SKIPG D,Q2		;[4425] Move given job to D, no job 0 attach
	ERROR <Job number must be between 1 and %1Q> ;[4425] Owie job number

;Make sure given job is logged in with matching username.

	GTB .JOBRT		;[4425] (D/A) Runtime negative if no such job
	JUMPL A,[UERR[ASCIZ /No job %4Q/]] ;[4425] Job not active apparently
	GTB .JOBTT		;[4425] (D/A) Line or 777777 if detached in lh
	HLREM A,Q3		;[4425] Store attached line number for later
	CALL USERNO		;[4425] (D/A) Get user owning target job
	JUMPE A,[UERR [ASCIZ /Job %4Q not logged in/]] ;[4425] Not logged in!
	CAME A,Q1		;[4425] Do the user numbers match?
	ERROR <Job %4Q not logged in under %5R>	;[4425] Nope, give gripe 
;	JRST ATTAC7		;[4425] We know the target job, get to work
;ATTACH...

;Here with 
;	Q1/ target user number
;	Q2/ target job number
;	Q3/ target's currently attached terminal number

;Check for self

ATTAC7:	CAME Q2,JOBNO		;[4425] Doing it to ourselves?
	IFSKP.			;[4425] Yes
	  TLNN Z,F1		;[4425] Attach or unattach?
	  ERROR <Cannot ATTACH to self>	;[4425] Maybe it was attach
	  ERROR <Cannot UNATTACH self> ;[4425] Uh, I guess unattach
	ENDIF.			;[4425] End of self check

;Check for already attached

	IFGE. Q3		;[4425] If the job is not detached
	  HRROI B,APBUF		;Redirect output to our buffer
	  MOVEM B,COJFN		; by pointing herre
	  MOVEI A,.TTDES(Q3)	;[4425] Load designator for that line
	  ETYPE < [Job %6Q attached to %1L, confirm]> ;[4425] Make prompt
	  CALL FIXIO		;(/) Resume normal output
	  UPROMP APBUF		;Prompt user for confirmation
	  CALL FCONFA		;(/) Call routine to get confirm
	ENDIF.			;[4425] End of "job not detached" code
;ATTACH...

;We have a legal target job, execute the ATACH JSYS now

	MOVE A,Q2		;[4425] Load job to attach to
	MOVEI C,0		;No password pointer for first try
	MOVE B,Q1		;[4425] Load user to attach to 
	TLNN Z,F1		;If not losing this job (UNATTACH command)
	SKIPN CUSRNO		; or not logged in,
	CAIA			;  then say nothing
	ETYPE < Detaching job %J
>				;Otherwise tell me you are saying good bye
	TLNE Z,F1		;Unattach?
	TXO A,AT%NAT		;[4425] Yes, tell ATACH this is an UNATTACH
	DMOVEM A,AT1		;[4425] Save args in case redo necessary
	ATACH			;Try to do it without password
	 ERJMP .+2		;Failed, maybe we need a password
	JRST ATGOOD		;Succeeded
	CAIE A,ATACX4		;Was the error due to a password problem?
	JRST ATNG		;No, some other error
	CALL PASLIN		;(/A) Password not given but required, get it
	MOVE C,A		;Store new password pointer for ATACH
	DMOVE A,AT1		;Get args saved before the first ATACH
	ATACH			;Try the attach again
	 ERJMP ATNG		;[4425] It really didn't work

ATGOOD:	JRST CMDIN4		;ATACH RETURNS +2 IF LOGGED IN--THIS JOB
				; STILL ATTACHED IF 'UNATTACH' JUST DONE.

;[4425] Here if attach failure

ATNG:	TLNN Z,F1		;[4425] UNATTACH command?
	ETYPE <?ATTACH failure, still attached to job %J
>				;[4425] Only output message if ATTACH command
	CALL CJERRE		;[4425] Give JSYS error and return 
;ATTACH...

;[4425] Local routine called to get list of jobs logged in to this username.
;Jobs are returned in BUF0 in standard INFO JSYS format.  The first word is a
;word count including that word.  Following that word are a number of words
;containing <job,,tty> for each job on the system.  Sets up BUF0 as INFO would
;have if INFO JSYS failed.
;Call with B/ user number to get information on
;Return +1 always with BUF0 set up.

	FNDUSN==BUF0+760	;[4425] Place to make username stirng
	FNDUSI==BUF0+772	;[4425] Place to make INFO JSYS block

FNDUSR:	SETZM FNDUSN		;[4425] Make sure nothing there if failure
	HRROI A,FNDUSN		;[4425] Point to storage for username
	DIRST%			;[4425] Get that changed into a string
	 ERJMP .+1		;[4425] Ignore errors for now
	 
	MOVX A,<.INJOB,,.INAC2+1> ;[4425] Load function,,size of block
	MOVEM A,.INFUN+FNDUSI	;[4425] Save function and size
	SETOM .INCID+FNDUSI	;[4425] Local system
	HRROI A,FNDUSN		;[4425] Point to username to get jobs for
	MOVEM A,.INAC1+FNDUSI	;[4425] Save as byte pointer to username
	MOVEI A,BUF0		;[4425] Point to place to store block
	MOVEM A,.INAC2+FNDUSI	;[4425]  and save that for INFO
	MOVEI A,FNDUSI		;[4425] Point to block
	INFO%			;[4425] Get the information from the monitor
	IFNJE.			;[4425] If that worked
	  RET			;[4425]  return now
	ENDIF.			;[4425] So, the INFO JSYS failed, eh?

	SETZM BUF0		;[4425] First make the header word zero
	SETO D,			;[4425] We want the size of the table
	GTB .JOBRT		;[4425] JOBRT table is a good one to pick
	HRLZ D,A		;[4425] Set up XWD -jobs,,0
	DO.			;[4425] Loop through all known jobs
	  CALL USERNO		;[4425] (D/A) Get the user number for a job
	  CAME A,Q1		;[4425] Match?
	  IFSKP.		;[4425] Yes
	    AOS C,BUF0		;[4425] Count this job as found
	    HRLM D,BUF0(C)	;[4425] Store the job number that matched
	    GTB .JOBTT		;[4425] (D/A) Get the terminal number for job
	    HLRM A,BUF0(C)	;[4425]  and save that too
	  ENDIF.		;[4425] That's all we need to do
	  AOBJN D,TOP.		;[4425] Continue for all jobs on system
	OD.			;[4425] End of loop for all jobs on system
	AOS BUF0		;[4425] Count the header word
	RET			;[4425] End of this routine
;BREAK (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
;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+CF%NS)
	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
	 JRST CJERRE		;[7.1063]Failed. Print error and quit
	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,BEFDAT,LRGSIZ,SMLSIZ,SNCDAT>
	TRO Z,F4
	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
	PUSH P,Z		;[3023]SAVE FLAGS
	TXO Z,IGINV		;[3023]FIND INVISIBLE FILES
	CALL SPECFN		;[3023]DO PARSE ONLY
	JRST [	POP P,A		;[3023]ERROR, GET FLAGS BACK
		TXZ Z,IGINV	;[3023]AND SET IGINV AS BEFORE
		TXNE A,IGINV	;[3023]
		 TXO Z,IGINV	;[3023]
		JRST DELET1]	;[3023]
	POP P,A			;[3023]SUCCESS, RESTORE FLAGS
	TXZ Z,IGINV		;[3023]
	TXNE A,IGINV		;[3023]
	 TXO Z,IGINV		;[3023]
	TDZ Z,[F5!F2!F3!F4!F7!F8!F9!F10!1B18] ;[7.1178]CAN'T BE EXPUNGE IF NO SUBCOMMAND
	JRST DELET2
DELET1:	TDZ Z,[F5!F2!F3!F4!F7!F8!F9!F10!1B18] ;[7.1178]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]
;[7.1178]
;Find out if we have any date/time/size constraints.

 	TXNN Z,F7		;[7.1178] looking for file date "before" some time?
	JRST DELET4		;[7.1178] no.
        CALL GETDAT		;[7.1178] ( /C)Yes. Get last write date for this JFN
	CAML C,BEFDAT		;[7.1178] Written before target date?
	JRST NXTJFN		;[7.1178] No. Out of the running.
DELET4: TXNN Z,F8  		;[7.1178] See if "since" wanted
	JRST DELET5		;[7.1178] No. Move along.
	CALL GETDAT		;[7.1178] ( /C)Yes. Get last write date for this JFN
	CAMG C,SNCDAT		;[7.1178] Written since target date?
	JRST NXTJFN		;[7.1178] No. Out of the running
DELET5: TXNN Z,F9		;[7.1178] See if "larger" wanted
 	JRST DELET6		;[7.1178] no
	CALL GETSIZ		;[7.1178] ( /C)Yes. get file size
	CAMG C,LRGSIZ		;[7.1178] File larger than target?
	JRST NXTJFN  		;[7.1178] No. Out.
DELET6:	TXNN Z,F10		;[7.1178] Yes. Do we want "smaller"?
        JRST DODEL		;[7.1178] No.
	CALL GETSIZ		;[7.1178]	( /C) Get size
	CAMGE C,SMLSIZ		;[7.1178] Smaller than target?
	JRST DODEL		;[7.1178] Yes.
NXTJFN:	MOVE A,INIFH1	        ;[7.1178] Before stepping to next file
        MOVEM A,INIFHO          ;[7.1178] Remember which JFN we're on
	CALL MFINP0		;[7.1178] Get second JFN on current file in AC1
	  JRST DTDEL2		;[7.1178] error
	JRST DODEL3		;[7.1178] finish stepping along
DODEL:	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
DODEL3:	MOVE B,INIFHO		;[7.1178]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:	SKIPE A,DELDIR		;GET CURRENT DIRECTORY NUMBER - ANY?
	TLNN Z,F2		;OR EXPUNGE REQUESTED?
	RET			;NO - NO NEED TO SAY ANYTHING ABOUT FREE PAGES
	JUMPN Q2,PDLFR2		;JUMP IF MULTIPLE DIRECTORY DEVICE
	SETZ A,			;ELSE SAY NO PAGES FREED
PDLFR1:	MOVE C,DELDIR		;TELL TYPFRE WHICH DIRECTORY TO PRINT
	CALLRET TYPFRE		;PRINT RESULTS

PDLFR2:	GTDAL%			;CHECK ALLOCATION:
	MOVE A,DELPGS		;GET ORIGINAL ALLOCATION
	SUB A,B			;TAKE DIFFERENCE
	JUMPGE A,PDLFR1		;CONTINUE IF THERE'S A DIFFERENCE
	RET			;ELSE JUST RETURN

;GETDAT - Uses current JFN to find last write date of file. Returns it in AC3.


GETDAT:	HRRZ A,@INIFH1		;[7.1178] Get JFN
 	MOVE B,[1,,.FBWRT]	;[7.1178] Last write date
 	MOVEI C,C 		;[7.1178] Put it here
 	GTFDB			
 	 ERJMP .+1
	RET

;GETSIZ - Uses current JFN to find size of file. Returns it in AC3.

GETSIZ:	HRRZ A,@INIFH1		;[7.1178] Get JFN
 	MOVE B,[1,,.FBBYV]	;[7.1178] Last write date
 	MOVEI C,D 		;[7.1178] Put it here
 	GTFDB			
 	 ERJMP .+1
	HRRZ C,D		;[7.1178] Get right half - page count
	RET

;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 BEFORE,,..BE4			;[7.1178]
	T CONTENTS-ONLY,,.CNOLY
	T DIRECTORY,,..DIR
	T EXPUNGE,,..EXP
	T FORGET,,..FORG
	T KEEP,,..KEEP
	T LARGER,,.LARGR		;[7.1178]
	T SINCE,,.SINCE			;[7.1178]
	T SMALLER,,.SMALR		;[7.1178]
	TEND

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

;[[7.1178]]
..BE4:  NOISE <DATE AND TIME>
	DTPX <
Only files written earlier than specified date and time will be deleted>
	 CMERRX <Invalid BEFORE subcommand>
	CONFIRM
	SKIPE KEPNUM
	ERROR <Can't "KEEP" and "BEFORE" at the same time>
	MOVEM B,BEFDAT
	TXO Z,F7		;[7.1178] set flag that says "BEFORE"
	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
	SKIPG B			;[7.1182]
	ERROR <Number of generations may not be 0 or negative number> ;[7.1182]
	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
;[[7.1178]]
.LARGR:	NOISE <THAN>
	DECX <Only files larger than specified decimal number of pages will be deleted>
	 CMERRX <Invalid LARGER subcommand>
	CONFIRM
	SKIPE KEPNUM
	ERROR <Can't "KEEP" and "LARGER" at the same time>
	MOVEM B,LRGSIZ		;[7.1178] save target size
	TXO Z,F9		;[7.1178] Say "LARGER" seen
	RET

;[7.1178]
.SINCE:	NOISE <DATE AND TIME>
	DTPX <
Only files written more recently than specified date and time will be deleted>
	 CMERRX <Invalid SINCE subcommand>
	CONFIRM
	SKIPE KEPNUM
	ERROR <Can't "KEEP" and "BEFORE" at the same time>
	MOVEM B,SNCDAT
	TXO Z,F8		;[7.1178] set flag that says "SINCE"
	RET


;[7.1178]
.SMALR:	NOISE <THAN>
	DECX <Only files smaller than specified decimal number of pages will be deleted>
	 CMERRX <Invalid SMALLER subcommand>
	CONFIRM
	SKIPE KEPNUM
	ERROR <Can't "KEEP" and "SMALLER" at the same time>
	MOVEM B,SMLSIZ		;[7.1178]Save target size
	TXO Z,F10    		;[7.1178]Say "SMALLER" subcommand given
	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
	CALL GNJFS		;STEP TO NEXT FILE
	 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:	CALL GNJFS		;STEP TO NEXT
	 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>
	TRO Z,F2		;SET THE FLAG
	TXO Z,IGINV		;LET IT SEE INVISIBLE 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
	 JRST CJERRE		;[7.1063]Failed. Print error and quit
	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
	IFNSK.			;[7.1063]If error...
	  CAIE B,STRX09		;[7.1063]Is structure not mounted?
	  CAIN B,STRX10		;[7.1063]Or is structure offline?
	  RET			;[7.1063]Yes, then don't continue
	  JRST EXPUN2		;[7.1063]Some other error, keep going
	ENDIF.			;[7.1063]
        CALL TYPFRE		;[3049] [7.1025] A,C/ NOW TELL PAGES FREED
EXPUN2:	MOVE A,EXPDIR		;[7.1025] 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
		 MOVE B,A	;[3045] SAVE ERROR CODE
		 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
	RETSKP			;[3049] RETURN AND CALL TYPFRE - NO LONGER FALL THRU
;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			;[3045] [3049] ALWAYS RETURN +1 FROM TYPFRE
;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
 Send mail to the user instead>
		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
 Send mail to the user instead>]
	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
	SKIPN A			;[4425] Any subsys name?
	MOVX A,<SIXBIT/?/>	;[4425] Nope, say something at least
	TXO B,.TTDES		;[4425] Make terminal designator
	ETYPE < %2L, %1'%%_>	;[4425] Print line and what's running
	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, Send mail to the user instead>
	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 CHKLK1		;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:	TLZ Z,F4		;Assume everything's gonna go OK. 
CHKLK1:	MOVE B,ADVTNM
	MOVE A,[1B2+1B3+.CTTRM]	;TO AND FROM CONTROLLING TTY
	TLINK
	 ERJMPR [CAIN A,TTYX01	;Failed because Line not active?
		  JRST CONN1	; yes, ignore for now
		 CAIN A,TTMSX2	;Was it because user has TERMINAL INHIBIT?
		 TLNE Z,F4	;Yes, is this the second try?
		  JRST CJERRE	; yes, or not INHIBIT. Tell user what happened
		 JRST LKFAIL ]	;Let's try to link once more if we're WHEEL
	AOSN DOLNKF		;GIVE ANNOUNCEMENT FIRST TIME
	TYPE < [Advising]
>
CONN1:	RET
LKFAIL:	MOVX A,.FHSLF		;User has INHIBIT set, try to turn it off
	RPCAP%
	 ERJMP INHERR		; shouldn't fail
	TXNN C,<SC%WHL!SC%OPR>	;Do we have privs?
	 JRST CJERRE		; no, tell user we couldn't link and why
	MOVE A,ADVTNM		;Get destination  terminal number
	MOVEI B,.MORTF
	MTOPR%			;Read user's terminal inhibit word
	 ERJMP INHERR		;Couldn't, let user know we tried anyway.
	MOVEI B,.MOSTF
	TXZ C,MO%NTM		;Reset his TERMINAL INHIBIT bit
	MTOPR%
	 ERJMP INHERR  		;Couldn't
	TLO Z,F4		;Remember this is the second attempt
	JRST CHKLK1		;Try, try again!

INHERR:	ERROR <Could not advise TTY, couldn't turn off TERMINAL INHIBIT status>

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]
>
	TLNE Z,F4		;Did we set user's terminal to NO INHIBIT?
	 JRST [	MOVE A,ADVTNM	; Yes, set it back to INHIBIT
		MOVX B,.MORTF
		MTOPR%		;Read terminal inhibit word
		 ERJMP CJERRE	; Shouldn't fail
		MOVX B,.MOSTF
		TXO C,MO%NTM	;Set TERMINAL INHIBIT bit, leave else the same.
		MTOPR%		;Do it
		 ERJMP CJERRE
		JRST .+1 ]
	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
	MOVEI A,.PRIIN		;[3054] Clear input buffer after TTY mode change
	CFIBF%			;[3054]
	 ERJMP .+1		;[3054] Don't care about errors
	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,LASNLD> ;[4419][4412]
	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
	SETZM FSTLGN		;CLEAR FAST LOGIN FLAG
	CALL FSTUSR		;READ USER NAME OR /FAST
	 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]
	SETOM CEBPTR		;DON'T SAVE THE LOGIN COMMAND FOR COMMAND EDITOR
	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

	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 A,Q1		;[3067] Pointer to session remark string
	CALL SSR		;[3067] Set the session-remark before LOGIN
	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
	SETZM .CDNLD+LDBLK	;[4412] Clear this
	SETZM .CDPED+LDBLK	;[4412] And this
	SETZM .CDFPA+LDBLK	;[4412] And this
	LOGIN
	 JRST [	CAIN A,LGINX1
		ERROR <Illegal account>
		CAIN A,LGINX4
		ERROR <Incorrect password>
		CALL CJERRE]	;GNRL JSYS ERR RET ROUTINE (XSUBRS.MAC).
	MOVEM B,LASNLD		;[4412] Hold onto this for a second
	MOVEI B,LDBLK		;GET THE LOGIN DATA BLOCK
	MOVEM A,.CDLLD(B)	;SAVE LOGIN DATE AND TIME IN CASE NON WHEEL
	MOVEM A,LOGDAT		;[4412] Save date of login
	MOVE A,LASNLD		;[4412] Now get last non-interactive login
	MOVEM A,.CDNLD(B)	;[4412] And save it
	MOVEM C,.CDPED(B)	;[4412] Save password expiration date and time
	MOVEM D,.CDFPA(B)	;[4412] Save password fail counts
	SETOM SYSMF		;SET FLAG SO SYSTEM MESSAGES WILL GET PRINTED
	MOVE B,LOGNO		;WHAT "RCUSR" RETURNED
	MOVEM B,CUSRNO		;STORE USER NUMBER
	GJINF			;GET LOGGED-IN DIRECTORY NUMBER
	MOVEM B,LIDNO		;SAVE IT.
	CALL PION		;ALLOW ^C NOW THAT CUSRNO IS SET UP
;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 TTYn origin(type) date-time", and last login dates.

	MOVE A,.CDLLD+LDBLK	;[4420] Get last interactive login date-time
	ETYPE < Job %J on %L %D %E
  Last interactive login %1W
>				;[4420] Output usual stuff on TTY
	SETO A,			;[4412] This job
	HRROI B,A		;[4412] Put last non-interactive time in 1
	MOVEI C,.JINLD		;[4412] This is the function
	GETJI%			;[4412] Retrieve it
	 ERJMP NOPEXP		;[4420] If not there, monitor doesn't give it
	MOVE A,.CDNLD+LDBLK	;[4420] Get last non-interactive login date
	ETYPE <  Last non-interactive login %1W
>				;[4420] Output last d-t of non-interactive

;[4420] Output login failures if any, as returned by LOGIN JSYS.

	HLRZ B,.CDFPA+LDBLK	;[4420] Any password failures?
	IFN. B			;[4412] Are there any?
	  ETYPE <%% %2Q interactive login failure>
	  CAIE B,1		;[4412] Singular?
	  ETYPE <s>		;[4412] No, say so
	  ETYPE < since last succesful login
>				;[4412] Be wordy
	ENDIF.			;[4412]
	HRRZ B,.CDFPA+LDBLK	;[4420] Get non-interactive failures
	IFN. B			;[4412] Are there any?
	  ETYPE <%% %2Q non-interactive login failure>
	  CAIE B,1		;[4412] Are we singular?
	  ETYPE <s>		;[4412] Nope
	  ETYPE < since last succesful login
>				;[4412]
	ENDIF.
;LOGIN...

;[4420] Check password expiration and get new password if current one expired.

	MOVEI A,.SFPEX		;[4412] Password expiration turned on?
	TMON%			;[4412] Check to see
	 ERJMP NOPEXP		;[4412] If not in here, then bypass this code
	JUMPE B,NOPEXP		;[4420] If not enabled don't bother user

	MOVE B,.CDPED+LDBLK	;[4420] Get password expiration date and time
	JUMPE B,NOPEXP		;[4412] If no password expiration, continue
	JUMPG B,PWECHK		;[4420] Check password expiration if a date

;[4420] Password has expired.  Ask for a new one.

	ETYPE <
?Your password has expired. Please change your password now.

>				;[4420]
	HRROI A,BUF0		;[4412] Put username here
	MOVE B,LIDNO		;[4412] Get logged in directory
	DIRST%			;[4412] Put directory string in here
	 ERJMP .+1		;[4412]

REPWD:	SETZM LDBLK		;[4412] Zero out first word
	HRLZI A,LDBLK		;[4412] And now for the source
	HRRI A,1+LDBLK		;[4412] Get destination
	BLT A,.CDFPA+LDBLK	;[4412] And zero out everything
	MOVEI A,[ASCIZ /Old password: /] ;[4412] Prompt for old password
	CALL PASSX		;[4412] (A/A) Input the current password
	PUSH P,A		;[4412] Save pointer to it here
	MOVEI A,[ASCIZ /New password: /] ;[4412] Get new one
	CALL PASSX		;[4412] (A/A) Read password
	MOVEM A,.CDPSW+LDBLK	;[4412] Save pointer to new password string
	MOVEI A,[ASCIZ /Retype new password: /]	;[4412]
	CALL PASSX		;[4412] (A/A) Read new password again
	MOVE B,.CDPSW+LDBLK	;[4412] Get first attempt at typing it
	STCMP%			;[4412] Make sure they're the same
	 ERJMP .+1		;[4412]
	IFN. A			;[4412] Are they?
	  POP P,A		;[4412] Restore this
	  ETYPE <?The two copies of the new password weren't the same> ;[4420]
	  JRST REPWD		;[4412] Have the user try again
	ENDIF.			;[4420] Typed in passwords not the same
;LOGIN...

	MOVE A,(P)		;[4414] Get pointer to old password back
	MOVE B,.CDPSW+LDBLK	;[4414] And get the one to the new password
	STCMP%			;[4414] Are they the same?
	ERJMP .+1		;[4414] Let's be safe
	IFE. A			;[4414] Are they the same?
	  POP P,A		;[4414] Make the stack normal again
	  ETYPE <?The new password is the same as the old password. Try again.%_> ;[4414]
	  JRST REPWD		;[4414] And have the user give it another shot
	ENDIF.			;[4414]
	HRROI A,BUF0		;[4412] Get directory string again
	MOVEI B,LDBLK		;[4412] And get argument block
	TXO B,CD%PSW		;[4412] Say we just want to set this
	MOVEI C,.CDFPA		;[4412] Length of argument block
	MOVEM C,.CDLEN+LDBLK	;[4412] Put it in argument block
	POP P,C			;[4412] Get old password string back
	CRDIR%			;[4412] Try to change it
	IFJER.			;[4414] If error,
	  ETYPE <?Could not change password - %?. Try again.%_> ;[4414]
	  MOVEI A,.SFMPL	;[4415] Get minimum password length
	  TMON%			;[4415] Well
	   ERJMP REPWD		;[4415] If this fails, don't say anything
	  JUMPE B,REPWD		;[4415] System manager has not set a minimum password length
	  ETYPE <Your new password must be at least %2Q character> ;[4415]
	  CAIE B,1		;[4415] Only 1 character minimum?
	  ETYPE <s>		;[4415] No, smart system manager
	  ETYPE < long.%_>	;[4415]
          JRST REPWD		;[4414] And go try again
	ENDIF.			;[4414]
	JRST NOPEXP		;[4412] Password changed, continue below
;LOGIN...

;Here to check to see if password is within a week of expiring

PWECHK:	GTAD%			;[4420][4412] Get current date and time
	SUB B,A			;[4412] Find the difference
	HLRZS B			;[4412] Just get days
	CAILE B,7		;[4412] Within a week?
	IFSKP.			;[4412] If so,
	  MOVE B,.CDPED+LDBLK	;[4412] Get password expiration date and time
	  ETYPE <  Warning: Your password expires on %2W
>				;[4412] Let user know what is happening
	ENDIF.			;[4412]

;Here when all password-expiration work is done.

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

;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
;COME TO TAKSYS FOR SETTING UP DIRECTORY/FILENAME STRING FOR SYSTEM: COMMAND FILES
;TAKEIN SETS UP FOR USER'S COMMAND FILES

TAKSYS::STKVAR <<TAKBUF,FILWDS>,SPB>
	MOVEM B, SPB		;SAVE THE FILENAME STRING
	HRROI A, TAKBUF		;PUT STRING HERE
	SETZ C,
	SOUT
	 ERJMP CJERR		;SHOULDN'T FAIL
	MOVEI C,(GJ%PHY)	;ALLOW SYSTEM-WIDE LOGICALS ONLY
	JRST TAKEI2
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
TAKEI2:	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>
USERNR:	 JRST [	CALL %GETER	;FAILED, FIND OUT WHY
		MOVE A,ERCOD	;RETURN ERROR IN A
		RET]
REGUSR:	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

;READ USER NAME OR /FAST FOR LOGIN COMMAND
FSTUSR:	MOVX A,.SFXEC		;GET EXEC FLAGS WORD
	TMON			;GET THE WORD
	 ERJMP USERN 		;.SFXEC PROBABLY NOT IN MONITOR 
	TXNE B,XC%FST		;ARE FAST LOGINS ALLOWED ?
	 JRST USERN 		;NO. ONLY EXCEPT USER NAME
	MOVEI B,[FLDDB. .CMUSR,CM%SDH,,<User name>,,[
		 FLDDB. .CMSWI,CM%SDH!CM%DPP,FASTAB,</FAST to get to command level quickly after LOGIN>,<FAST>]]
	CALL FLDSKP		;PARSE THIS MESS
	 JRST [CAIN B,NPXNOM	;GOT A SWITCH OR KEYWORD ERROR ?
	        CMERRX		;YES. BLOW UP FROM BAD SWITCH
	       JRST USERNR]	;NO. USER NAME ERROR
	LDB C,[POINT 9,0(C),8]	;FIGURE OUT WHAT WAS TYPED
	CAIN C,.CMUSR		;USER NAME ?
	 JRST REGUSR		;YES - CONVERT TO USER #
	SETOM FSTLGN		;FLAG THE FAST LOGIN
	NOISE (USER)
	CALL USERN		;NOW GET USER NAME
	 RET			;FAILED
	RETSKP

FASTAB:	TABLE
	[ASCIZ/FAST/],,0
	TEND


;ACCT
;ROUTINE 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
	SETOM CEBPTR		;DON'T SAVE PASSWORD FOR COMMAND EDITOR
	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]
				;PASSWORD MASK, OVERLAYED X, W, M, AND GARBAGE
	CALL INPPAS		;INPUT THE PASSWORD
	CALL DOECHO		;MAKE SURE ECHOING IS TURNED ON NOW
	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:	MOVE Q3,[ASCIZ /PSWD/]	;SET FLAG IN Q3
 	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
	HRLOI B,377777		;SET INF COUNT FOR US
	MOVEM B,MWATN0
	MOVE B,POBXNO		;[3040] SET UP FOR MAIL CHECK FOR THIS USER
	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
	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.

TRYGTS::PUSH P,B			;THIS IS CALLED FROM CTRL/E-SPEAK
	PUSH P,A
	MOVSI A,(GJ%FOU!GJ%SHT!GJ%PHY)
	JRST TRYGT1

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
	CAIN C,(GJ%PHY)			;WANT SYSTEM LOGICALS ONLY?
	MOVSI A,(GJ%OLD!GJ%SHT!GJ%ACC!GJ%PHY) ; YES, TELL GTJFN
	SETZ C,				;RESET FOR USER CASE
	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::SKIPE LGORET		;ARE WE ALREADY TAKING LOGOUT.CMD?
	JRST ERRFIN		;YES. CAN'T SAY "LOGOUT" IN LOGOUT.CMD (MUCH LOOPING)
	MOVE A, TAKLEN		;WE NEED TO GET OUR CURRENT I/O (TAKE FILE) LEVEL
	MOVEM A, SAVTAK		;AND SAVE IT FOR LATER
	SETZM FSTOUT		;INIT FAST LOGOUT FLAG
	SKIPN CUSRNO		;LOGGED IN?
	IFNSK.
	 CONFIRM		;REQUIRE CONFIRM
         JRST LOGOU1		                  
	ENDIF.
	MOVEI B,[FLDDB. .CMNUM,CM%SDH,12, <Job number, to log out another job >,,[
		 FLDDB. .CMCFM,CM%SDH,,<Carriage return, to log out this job >,,[
		 FLDDB. .CMSWI,CM%SDH!CM%DPP,FLOTAB,</FAST to log out this job quickly >, <FAST>]]]
	CALL FLDSKP
            CMERRX
	LDB C,[POINT 9,0(C),8]
	CAIN C,.CMSWI		;GOT A SWITCH?
	JRST LGOFS1             ;YES,SET UP FOR FAST LOGOUT
	CAIN C, .CMCFM		;CARRIAGE RETURN?
        JRST LOGOU1		;YES, LOG OUT THIS JOB
	MOVE A,B		;PUT JOB NUMBER IN A
	JRST ..LOGO		;GO LOG OUT REMOTE JOB
LOGOU1: XTND,<
	CALL BLANK1		;CLEAR SCREEN
	CALL DWNPNT		;TELL USER WHEN SYSTEM WILL GO DOWN
>
	SKIPN CUSRNO
	JRST LOGOU2
	SKIPE FSTOUT		;USER WANT FAST LOGOUT?
	JRST LGOFST		;YES, BYPASS .CMD FILES

;SEE IF THERE'S A SYSTEM:LOGOUT.CMD, THEN TRY FOR USER'S LOGOUT.CMD

	SETOM LGORET		;SET THE "TAKING LOGOUT.CMD" FLAG 
	HRROI B, [ASCIZ/SYSTEM:LOGOUT.CMD/]
	CALL TAKSYS		;SEE IF IT'S THERE
	CAIA			;PROBABLY NO SUCH FILE
	CALL CMDOUT		;IT'S THERE, GO DO IT
	HRROI B, [ASCIZ "LOGOUT.CMD"]
	CALL TAKEIN		;SEE IF USER'S LOGOUT.CMD IS THERE
	CAIA			;GUESS THEY DON'T HAVE ONE
	CALL CMDOUT		;IT'S THERE - GO DO IT
	SETZM LGORET		;DONE WITH LOGOUT.CMD FILES - RESET THE FLAG
LGOFST:	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
	 ERJMP [TYPE <%Warning -- Disk allocation info not available...>
		ETYPE <%_>
		JRST LOGOU2]
	JUMPE B,LOGOU2		;CAN'T BE OVER IF USAGE=0
	SUB B,C			;SUBTRACT PERMANENT ALLOCATION FROM USAGE
	JUMPLE B,LOGOU2		;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 IT'S SUICIDE
	LGOUT
	 CALL CJERR
				;DOESN'T RETURN ON SUCCESS

;HERE TO SET UP IF /FAST SWITCH SEEN - USER DOESN'T WANT LOGOUT.CMD FILES TAKEN

LGOFS1:	CONFIRM
	SETOM FSTOUT		;SET THE "FAST LOGOUT" FLAG
	JRST LOGOU1		;AND CONTINUE LOGOUT PROCESS

FLOTAB:	TABLE
	[ASCIZ/FAST/],,0
        TEND


;"MERGE" IS WITH "GET" ABOVE.

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

.PUSH::	NOISE (COMMAND LEVEL)
	CONFIRM
	HRROI B,[ASCIZ /DEFAULT-EXEC:/]
	CALL TRYGTJ		;LOOK FOR THE DEFAULT EXEC; STACK THE JFN
	 JRST [	HRROI B,[GETSAVE(<SYSTEM:EXEC.>)]
		CALL TRYGTJ	;FAILED - JUST GET SYSTEM EXEC
		 ERROR <EXEC not found>
		JRST .+1]
	PUSH P,A
	MOVSI A,(1B1)		;XMIT CAPS
	CFORK
	 CALL CJERR
	MOVEM A,EFORK
	POP P,A
	HRL A,EFORK
	CALL DOGET		;DO THE GET
	 CALL CJERRE		;FAILED
	MOVE A,EFORK
	SETZ B,
	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 and REFUSE (LINKS/ADVICE/SYSTEM-MESSAGES)
; Can also get here from [SET] TERMINAL [NO] RECEIVE ...
; If so, F1 is on (see .TERNO routine) if the user typed NO. 
; If F1 is on, do a REFUSE since the user typed NO RECEIVE.

.RECEI::TLNE Z,F1		;DID USER SAY "NO RECEIVE" ?
	 SKIPA      		;YES, IMPLIED REFUSE
	TLZA Z,F4		;SAY RECEIVE CMD AND SKIP .REFUS
.REFUS::TLO Z,F4		;IF REFUSE, SAY SO.
	SETZB Q1,Q2		;ACCUMULATE LINKS/ADVICE BITS HERE
	KEYWD $LNADV
	 T LINKS,,.RELNK
	 JRST CERR
	CALL (P3)
	CONFIRM			;GET CONFIRMATION
RECREF:	TLZE Z,F2		;USE MTOPR OR TLINK ?
	 JRST .REMTO		;MTOPR
	MOVE A,Q1		;GET THE BITS
	HRRI A,.CTTRM
	TLINK
	 CALL JERR
	JRST CMDIN4


;Common code for REFUSE
.REMTO:	MOVE B,Q1		;GET THE FUNCTION
	MOVE C,Q2		;GET THE VALUE
	MOVEI A,.CTTRM
	MTOPR			;DO IT
	 ERCAL CJERRE		;COULDN'T
	RET

;Here to get terminal flags. RTFLG1 can be called with a terminal number in A.
RTTFLG::MOVEI A,.CTTRM
RTFLG1::MOVEI B,.MORTF		;READ TERMINAL FLAGS
	MTOPR			;DO IT
	 ERJMP R
	RETSKP

$LNADV:	TABLE
	T ADVICE,,.READV
	T LINKS,,.RELNK
  	T SYSTEM-MESSAGES,,.RESYS
	T USER-MESSAGES,,.REUSR
 	TEND
;User-messages
.REUSR:	CALL RTTFLG		;RETURN EXISTING TERMINAL FLAGS
	 JRST [CONFIRM
	       ERROR <The USER-MESSAGES function is not implemented>]
	MOVE Q2,C
	TXZ Q2,MO%NUM		;SET RECEIVE USER MESSAGES
	TLNE Z,F4		;BUT SHOULD IT REALLY BE REFUSE ?
	 TXO Q2,MO%NUM		;YES. TURN BIT ON.
	TLO Z,F2		;FLAG THE NEED TO USE MTOPR, NOT TLINK
	MOVEI Q1,.MOSTF		;FUNCTION CODE FOR SETTING TERMINAL FLAGS
	RET

;System-messages
.RESYS:	MOVEI Q1,.MOSNT		;FUNCTION CODE FOR CONTROLLING MESSAGES
	MOVEI Q2,.MOSMY		;SET RECEIVE BY DEFAULT
	TLNE Z,F4		;BUT SHOULD IT REALLY BE REFUSE ?
	 MOVEI Q2,.MOSMN	;YES
	TLO Z,F2		;FLAG THE NEED TO USE MTOPR, NOT TLINK
	RET

;Advice
.READV:	TLO Q1,(TL%STA)		;ADVISE "ENABLE" BIT 
	TLNE Z,F4		;RECEIVE?  
	 RET			;NO - ENABLE BIT AND "ADVICE" OFF
	TLO Q1,(TL%SAB!TL%AAD!TL%ABS) ;ENABLE BITS AND "ADVICE AND LINKS" ON
	NOISE <AND LINKS>
	RET

;Links
.RELNK:	TLO Q1,(TL%SAB)		;LINK "ENABLE" BIT
	TLNE Z,F4		;RECEIVE ?
	 JRST [NOISE <AND ADVICE> ;NO. REFUSE, SO ADVICE IS IMPLICIT
	       RET]
	TLO Q1,(TL%ABS)		;YES. ENABLE BIT AND "LINK" BIT ON
	RET
;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
	SETZM A			;NOT COPYING FILES
	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
;SEND (MESSAGE) TO SPECIFIC USER ON THE SYSTEM (UNPRIVILEGED)

.USEND::SKIPE PRVENF		;ENABLED?
	JRST .SEND		;YES - BEHAVE THE SAME AS ^ESEND
	NOISE (TO)
	MOVEI B,[FLDDB. .CMSWI,CM%SDH,NODTAB,</NODE to send to a remote system>,,[
		 FLDDB. .CMUSR,CM%SDH,,<User name or Terminal number>,,[
		 FLDDB. .CMNUM,CM%SDH,8,,,[
		 FLDBK. .CMFLD,CM%SDH,,,,[BRMSK. USRB0.,USRB1.,USRB2.,USRB3.]]]]] ;[7.1160]
	CALL FLDSKP		;GET THE TO FIELD
	 CMERRX			;CAN'T
	TRVAR <SNDPT,SNDPTC,SNDLNO,USRNO,SAVP,SNDNOD,SNDMSK,<USNAM,10>> ;[7.1135]
	SETZM USNAM		;[7.1135] Say we don't have arbitrary string
	SETZM SNDNOD		;[7.1076] Indicate local send in progress for now
	SETZM SNDMSK		;[7.1076] Init node mask for send all
	LDB C,[POINT 9,0(C),8]	;FIGURE OUT WHAT WAS TYPED
	CAIE C,.CMSWI		;[7.1076] Was it a switch?
	IFSKP.			;[7.1076] Yes,
	  CALL VALNOD		;[7.1076] (A/A,B,C) Get valid CI node name
	  TXO B,TT%REM		;[7.1076] Indicate send will be remote
	  MOVEM B,SNDNOD	;[7.1076] Save the node to send to
	  MOVEM C,SNDMSK	;[7.1076] Save node mask
	  MOVEI B,[FLDDB. .CMUSR,CM%SDH,,<User name or Terminal number>,,[
		   FLDDB. .CMNUM,CM%SDH,8,,,[
		   FLDBK. .CMFLD,CM%SDH,,,,[BRMSK. USRB0.,USRB1.,USRB2.,USRB3.]]]] ;[7.1160]
	  CALL FLDSKP		;[7.1076] (A,B/A,B) Now continue to parse
	   CMERRX		;[7.1076] Slap the user's wrist
	  LDB C,[POINT 9,0(C),8] ;[7.1076] Get function parsed
	ENDIF.			;[7.1076]
	CAIE C,.CMUSR		;GOT A USER NAME ?
	IFSKP.
	 MOVEM B,USRNO		;SAVE THE USER NUMBER
	 MOVEI B,-1		;NOTE USER NAME WITH -1 IN RIGHT HALF ONLY
	ENDIF.
	CAIE C,.CMFLD		;[7.1135] Non-local user name?
	IFSKP.			;[7.1135] If so,
	  HRROI A,USNAM		;[7.1135] Save user name string here
	  HRROI B,ATMBUF	;[7.1135] User name string is here now
	  MOVEI C,^D39		;[7.1135] Don't transfer more than this
	  SETZ D,		;[7.1135] End on null
	  SOUT%			;[7.1135] Move string
	   ERJMP .+1		;[7.1135] Just another FATCDP
	  LDB A,[POINT 7,USNAM,6] ;[7.1160] Get me a character
	  SKIPN A		;[7.1160] Did this field parse reasonably?
	  ERROR <Invalid username> ;[7.1160] No, it didn't
	  MOVEI B,-1		;[7.1135] Say we have user name
	  SETZM USRNO		;[7.1135] But say it is not local
	  JRST USEND1		;[7.1160] And go on
	ENDIF.			;[7.1135]
	CAIE C,.CMNUM		;LINE # ?
	IFSKP.
	 SKIPL B		;CHECK FOR BIT 0
	 CAIL B,-1		;LESS THAN 777777
	 ERROR <Invalid terminal number> ;NO OR BIT 0 ON
	ENDIF.
USEND1:	SETZM SNDPT		;[7.1160] Say no pointer to end of header
	SETZM SNDPTC		;SAY NO POINTER TO HEADER STRING
	MOVEM B,SNDLNO		;SAVE LINE NUMBER
	MOVE A,[POINT 7,BUF0]	;GET POINTER TO STRING BUFFER
	HRROI B,[ASCIZ /
[/]
	CALL SAPPND		;BEGIN THE MESSAGE
	JRST SENDD0		;JUMP INTO ^ESEND CODE


;^ESEND (MESSAGE) TO ALL ON SYSTEM

.SEND::	NOISE (TO)
	MOVEI B,[FLDDB. .CMSWI,CM%SDH,NODTAB,</NODE to send to a remote system>,,
		[FLDDB. .CMUSR,CM%SDH,,<User name or Terminal number>,,
		[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /*/]>,,,
		[FLDDB. .CMNUM,CM%SDH,8,,,
		[FLDBK. .CMFLD,CM%SDH,,,,[BRMSK. USRB0.,USRB1.,USRB2.,USRB3.]]]]]] ;[7.1160]
	CALL FLDSKP		;GET THE TO FIELD
	 CMERRX			;CAN'T
	TRVAR <SNDPT,SNDPTC,SNDLNO,USRNO,SAVP,SNDNOD,SNDMSK,<USNAM,10>> ;[7.1135]
	SETZM USNAM		;[7.1135] Say we haven't done arbitrary string
	SETZM SNDNOD		;[7.1076] Start out as a local send
	SETZM SNDMSK		;[7.1076] Init send node mask
	LDB C,[POINT 9,0(C),8]	;FIGURE OUT WHAT WAS TYPED
	CAIE C,.CMSWI		;[7.1076] Did user type /NODE?
	IFSKP.			;[7.1076] If so,
	  CALL VALNOD		;[7.1076] (A/A,B,C) Parse CI node name
	  TXO B,TT%REM		;[7.1076] Indicate remote send in progress
	  MOVEM B,SNDNOD	;[7.1076] Save parsed CI node number, and continue parsing
	  MOVEM C,SNDMSK	;[7.1076] Save node mask too
	  MOVEI B,[FLDDB. .CMUSR,CM%SDH,,<User name or Terminal number>,,
		  [FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /*/]>,,,
		  [FLDDB. .CMNUM,CM%SDH,8,,,
		  [FLDBK. .CMFLD,CM%SDH,,,,[BRMSK. USRB0.,USRB1.,USRB2.,USRB3.]]]]] ;[7.1160]
	  CALL FLDSKP		;[7.1076] Get destination
	   CMERRX		;[7.1076] Can't
	  LDB C,[POINT 9,0(C),8] ;[7.1076] Now get typed function
	ENDIF.			;[7.1076]
	CAIE C,.CMUSR		;GOT A USER NAME ?
	IFSKP.
	 MOVEM B,USRNO		;SAVE THE USER NUMBER
	 MOVEI B,-1		;NOTE USER NAME WITH -1 IN RIGHT HALF ONLY
	ENDIF.
	CAIE C,.CMFLD		;[7.1135] J-Random string?
	IFSKP.			;[7.1135] If so,
	  HRROI A,USNAM		;[7.1135] Transfer string to here
	  HRROI B,ATMBUF	;[7.1135] Get it from here
	  MOVEI C,^D39		;[7.1135] Don't transfer more than biggest name
	  SETZ D,		;[7.1135] Stop on null
	  SOUT%			;[7.1135] Do it
	   ERJMP .+1		;[7.1135] Have a magic mushroom
	  LDB A,[POINT 7,USNAM,6] ;[7.1160] Get character from user name
	  SKIPN A		;[7.1160] Did this field parse reasonably?
	  ERROR <Invalid username> ;[7.1160] No, it didn't
	  MOVEI B,-1		;[7.1135] Now pretend like username typed
	  SETZM USRNO		;[7.1135] But don't really have a user number
	  JRST SENDA		;[7.1160] And go on
	ENDIF.			;[7.1135]
	CAIN C,.CMTOK		;GOT A STAR ?
	SETO B,			;NOTE "*" WITH -1
	CAIE C,.CMNUM		;LINE # ?
	IFSKP.
	 SKIPL B		;CHECK FOR BIT 0
	 CAIL B,-1		;LESS THAN 777777
	 ERROR <Invalid terminal number> ;NO OR BIT 0 ON
	ENDIF.
SENDA:	MOVEM B,SNDLNO		;SAVE LINE NUMBER
	TLZ Z,F1		;[7.1076] This is for punctuating a local send properly
	MOVE A,[POINT 7,BUF0]	;GET POINTER TO STRING BUFFER
	HRROI B,[ASCIZ /
[From /]
	CALL SAPPND		;BEGIN THE MESSAGE
	MOVE B,CUSRNO		;GET USER NAME
	DIRST			;PUT NAME SO PEOPLE WILL KNOW WHO'S SWEARING
	 CALL JERR		;SHOULDN'T FAIL
	HRROI B,[ASCIZ / on node /] ;[7.1076] Say our node please
	CALL SAPPND		;[7.1076] (A,B/A) Put the prep in send all buffer
	PUSH P,A		;[7.1076] Temporarily save send all header byte pointer
	HRROI A,OURNOD		;[7.1076] Put our node name here
	MOVEI B,NODBLK		;[7.1076] Argument block for NODE% is here
	MOVEM A,.NDNOD(B)	;[7.1076] Save byte pointer for monitor
	MOVEI A,.NDGLN		;[7.1076] Get our node name
	NODE%			;[7.1076] Please...
	 ERCAL JERR		;[7.1076] Something messed up
	POP P,A			;[7.1076] Restore header place mat
	HRROI B,OURNOD		;[7.1076] Put our node name in send all header
	CALL SAPPND		;[7.1076] (A,B/A) Do it
	PUSH P,A		;SAVE OUTPUT DESIGNATOR
	GJINF			;FIND OUT ABOUT MY JOB
	POP P,A			;RESTORE AC
	JUMPL D,SENDD		;SKIP ON IF WE'RE DETACHED
	HRROI B,[ASCIZ / line /] ;GET SOME MORE TEXT
	CALL SAPPND
	MOVE B,D		;GET NUMBER IN RIGHT AC
	MOVEI C,^D8		;OCTAL OUTPUT
	NOUT			;STORE TERMINAL NUMBER
	 CALL JERR
SENDD:	SKIPN B,SNDNOD		;[7.1076] Get destination node
	IFSKP.			;[7.1076] If there is one,
	  TXZ B,TT%REM		;[7.1076] Turn this off please
	  MOVEI C,CFGNOD	;[7.1076] Find our CI node number
	  HLRZ C,1(C)		;[7.1076] Here's our CI node
	  CAME B,C		;[7.1076] Is it the same?
	  IFSKP.		;[7.1076] If same,
	    SETZM SNDNOD	;[7.1076] Say local send
	    TLO Z,F1		;[7.1076] Say send was local
	    JRST SEND05		;[7.1076] And go on
	  ENDIF.		;[7.1076]
	  MOVE B,SNDLNO		;[7.1076] Get line number
	  CAIN B,-1		;[7.1076] Did user give us terminal?
	  JRST SEND06		;[7.1076] No, then can't put it in header
	  HRROI B,[ASCIZ / to /] ;[7.1076] Say this is going somewhere
	  CALL SAPPND		;[7.1076] (A,B/A) Let header know
	  SKIPL SNDNOD		;[7.1076] Sending to all nodes?
	  IFSKP.		;[7.1076] If so,
	    HRROI B,[ASCIZ /all nodes/] ;[7.1076] Say so
	  ELSE.			;[7.1076] Else, find the node string
	    HRROI B,[ASCIZ /node /] ;[7.1076] Say node something
	    CALL SAPPND		;[7.1076] (A,B/A) Put it in
	    HRRZ B,SNDNOD	;[7.1076] Get node number back
	    SETZ Q1,		;[7.1076] Here's our counter
	    DO.			;[7.1076] Loop over all CI node names until we find the one we want
	      AOS Q1		;[7.1076] Here's the entry
	      HLRZ C,CFGNOD(Q1)	;[7.1076] Get its CI node number
	      CAME B,C		;[7.1076] Is it the one we want?
	      JRST TOP.		;[7.1076] No, do next entry
	      MOVE B,CFGBLK(Q1)	;[7.1076] Get byte pointer to CI node
	    ENDDO.		;[7.1076]
	  ENDIF.		;[7.1076]
	  CALL SAPPND		;[7.1076] (A,B/A) Put node name in header (or all nodes)
	ELSE.			;[7.1076] Flag local send (for all lines potentially)
	  TLO Z,F1		;[7.1076] Say local send
	ENDIF.			;[7.1076]
SEND05:	SKIPL SNDLNO		;[7.1076] Sending to all lines?
	IFSKP.			;[7.1076] If so,
	  HRROI B,[ASCIZ / to/]	;[7.1187] This was left out
	  TLNE Z,F1		;[7.1187] Must we use proper English?
	  CALL SAPPND		;[7.1187] (A,B/A) Put it in
	  HRROI B,[ASCIZ / all lines/] ;[7.1076] Say so
	  CALL SAPPND		;[7.1076] (A,B/A) Finish off the header
	ELSE.			;[7.1076] Else, say individual line
	  MOVE B,SNDLNO		;[7.1076] Get line number
	  CAIN B,-1		;[7.1076] Did user give us terminal?
	  JRST SEND06		;[7.1076] No, then can't put it in header
	  HRROI B,[ASCIZ / to/]	;[7.1187] Insert to
	  TLNE Z,F1		;[7.1187] Has "to" been set yet?
	  CALL SAPPND		;[7.1187] (A,B/A) Put it in sendall header
	  HRROI B,[ASCIZ / line /] ;[7.1076] Give cute prefix
	  CALL SAPPND		;[7.1076] (A,B/A) Stick it in
	  MOVE B,SNDLNO		;[7.1076] Now put in destination terminal
	  MOVEI C,^D8		;[7.1076] Make it octal
	  NOUT%			;[7.1076] Do it
	   CALL JERR		;[7.1076] Oops
	ENDIF.			;[7.1076]
SEND06:	HRROI B,[ASCIZ /:/]	;[7.1076] Terminate header with a :
	CALL SAPPND		;[7.1076] (A,B/A) Do the terminator
	MOVEM A,SNDPTC		;SAVE POINTER TO START OF CRLF
	HRRI B,[ASCIZ /
 /]
	CALL SAPPND		;SEPARATE HEADER FROM CONTENTS WITH A CRLF
SENDD0:	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		;POINT TO  MESSAGE IN ATOM BUFFER
	CALL SNDFIX		;COPY, ADDING CRLF WHEN LINE WILL OVERFLOW
	HRROI B,[BYTE (7) "]",15,12,0]
	CALL SAPPND		;TERMINATE WITH "]", CRLF
	SETZ Q1,		;END THE MESSAGE WITH A NULL
	IDPB Q1,A
	HRRZ B,A		;GET ADDRESS OF END OF MESSAGE
	CAIG B,BUF0+17		;IS THE MESSAGE SHORTER THAN 80 CHARACTERS?
	SKIPN A,SNDPTC		;YES - IS THERE A HEADER?
	JRST SENDD1		;NO TO EITHER - PROCEED
	MOVEI B," "		;YES TO BOTH - REPLACE THE CRLF BETWEEN
	IDPB B,A		; THE HEADER AND THE MESSAGE SO THE WHOLE
	IDPB B,A		; THING WILL FIT ENTIRELY ON ONE LINE
SENDD1:	CALL LINCHK		;CHECK THE LINE NUMBER
	MOVE B,[POINT 7,BUF0]	;GET POINTER TO THE MESSAGE STRING
	SETZ A,			;[7.1076] Clear this out
	SKIPN A,SNDNOD		;[7.1076] Doing remote send of some type?
	IFSKP.			;[7.1076] If so,
	  CAME A,[-1]		;[7.1076] Are we doing all nodes?
	  IFSKP.		;[7.1076] If so,
	    MOVX A,<.CSALL>	;[7.1076] Say doing all nodes
	  ELSE.			;[7.1076] Else just put in CI node number
	    HRRZ C,SNDNOD	;[7.1076] Get just CI node number
	    HRLZM C,A		;[7.1076] Save CI node here
	  ENDIF.		;[7.1076]
	  TXO A,TT%REM		;[7.1076] Say this is a remote send
	  HRR A,SNDLNO		;[7.1076] Get line number to send to
	ELSE.			;[7.1076] If not doing remote send
	  MOVE A,SNDLNO		;[7.1076] Get full line value
	ENDIF.			;[7.1076]
	TXO A,.TTDES		;[7.1076] Now make it a terminal designator
	TTMSG%			;[7.1076] Send the message
	 ERJMP CJERRE		;IT FAILED SOMEHOW
	CALLRET UNMAP		;O.K. - UNMAP BUFFER PAGE AND RETURN

;HERE TO CHECK THE LINE NUMBER TO SEE IF IT'S REALLY THE USER FLAG

LINCHK:	MOVE A,SNDLNO		;GET THE LINE NUMBER
	CAIE A,-1		;GOT USER ARGUMENT ?
	RET			;NO
	SKIPE SNDNOD		;[7.1076] Remote send with username?
	JRST REMLIN		;[7.1076] Yes, handle seperately
	SKIPN USRNO		;[7.1153] Was arbitrary string typed?
	ERROR <Invalid username> ;[7.1153] If so, tell user that we can't do that
	MOVEM P,SAVP		;SAVE THE CURRENT STACK POINTER
	TLZ Z,F1!F2		;INIT FLAGS
	HLLZ D,JOBRT		;-# OF JOBS AS AOBJN CNTR
LICK2:	CALL USERNO		;GET USER # OF JOB IN D
	CAME A,USRNO		;IS IT THE ONE WE WANT?
	JRST LICK3		;NO
	GTB .JOBTT
	TLO Z,F1		;FLAG DETACHED JOB SEEN
	JUMPL A,LICK3		;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.)
LICK3:	AOBJN D,LICK2		;LOOP THRU ALL JOBS
	CAME P,SAVP  		;FOUND ANY?
	IFSKP.
	 TLNE Z,F1
	 ERROR <User has detached jobs only,  Send mail instead>
	 ERROR <User is not logged in, Send mail instead>
	ENDIF.
	POP P,A			;SUBSYSTEM NAME
	POP P,B			;TTY#
	CAMN P,SAVP  		;ONLY ONE POSSIBILITY?
	JRST LICK9		;YES - USE IT
LICK7:	SKIPN A			;[4425] Any program name?
	MOVX A,<SIXBIT/?/>	;[4425] Nope, load unknown
	TXO B,.TTDES		;[4425] Make terminal designator please
	ETYPE < %2L, %1'%%_>	;[4425] Tell about user's job
	CAMN P,SAVP  		;DONE ALL?
	IFSKP.
	 POP P,A		;NO - NOT YET - GET PROGRAM NAME
	 POP P,B		;GET TTY 
	JRST LICK7
	ENDIF.
	PROMPT <TTY: >
	OCTX <Terminal number>
	 CMERRX			;NON-OCTAL NUMBER TYPED
LICK9:	MOVEM B,SNDLNO		;SAVE THE LINE NUMBER
	TRO B,.TTDES		;MAKE LINE DESIGNATOR
	MOVE A,B		;PUT WHERE GETJI LIKES LINE #
	MOVE B,[-1,,A]		;PUT 1 WORD IN AC A
	MOVEI C,.JIUNO		;THAT WORD IS USER NUMBER
	GETJI			;GET IT
	 CMERRX
	CAME A,USRNO		;SAME USER NAME THAT WAS ORIGNALLY WANTED ?
	ERROR <Terminal number does not belong to specified user>
	RET			;RETURN
;[7.1076]
;REMLIN - Routine used to handle remote sends with a specific user
;name in mind.
;
; Called with:
;	SEND TRVAR setup (SNDNOD and SNDMSK)
;	CALLRET REMLIN from LINCHK
;
; Returns:
;	+1 - Always, with a definite send destination

REMLIN:	SAVEAC <Q1,Q2,P1,P2>	;Save some quasi's
	STKVAR <<JOBS,100>,PNAME> ;[7.1135] Temp storage
	SKIPE USNAM		;[7.1135] Have something already?
	JRST RLICK0		;[7.1135] Yes, no need to do DIRST%
	HRROI A,USNAM		;Put username string here
	MOVE B,USRNO		;Get user number for translation
	DIRST%			;Now get the username string
	 CMERRX			;If error, then report it
RLICK0:	TLZ Z,F1!F2		;[7.1135] Say no node obtained yet and no terminal yet
	MOVEI A,INFBLK		;Here's the INFO% argument block
	MOVEI B,INFLEN		;Get INFO% argument block size
	HRLI B,.INJOB		;Do this INFO% function
	MOVEM B,.INFUN(A)	;Store this
	MOVEI B,JOBS		;Have INFO% put job list here
	DO.
	  MOVEM B,.INAC2(A)	;Put it in the arg block
	  SETZM .JOLEN(B)	;Zero out count of words returned
	  MOVE B,SNDMSK		;Get node mask
	  JFFO B,RLICK1		;Find node to check
	  EXIT.			;No more nodes to do
RLICK1:	  MOVEM C,.INCID(A)	;Save destination CI node
	  HRROI B,USNAM		;Here's the username
	  MOVEM B,.INAC1(A)	;Pass it in the JSYS
	  INFO%			;Get those job numbers from the remote system
	   ERJMP .+1		;Errors don't phase us
	  TXNE A,IN%RER		;[7.1106] Remote error?
	  MOVEI A,INFBLK	;[7.1106] Yes, user not logged in, setup again
	  MOVE B,.INAC2(A)	;Find the count word
	  HRLM C,.JOLEN(B)	;Now save node number there too
	  HRRZ D,.JOLEN(B)	;Retrieve count
	  ADD B,D		;This is where new stuff is to be stored
	  MOVEI A,INFBLK	;INFO% block back
	  MOVE C,.INCID(A)	;Retrieve CI node number
	  MOVE D,BITS(C)	;Now clear this bit in node mask
	  ANDCAM D,SNDMSK	;Clear this node, we have checked it already
	  JRST TOP.		;Do more
	ENDDO.
	MOVEI B,JOBS		;Now check to see if user is logged in
	SKIPN .JOLEN(B)		;Is user logged in anywhere?
DETLIK:	ERROR <User is not logged in, Send mail instead>
	HRRZ C,.JOLEN(B)	;Get how many words until next set of jobs
	ADDI C,.JOLEN(B)	;This is address of next set of jobs
	SKIPE .JOLEN(C)		;If there are no more sets of jobs,
	IFSKP.			;Then user logged into one node only
	  HLRZ C,.JOLEN(B)	;Get the node the user is logged into
	  TLO Z,F1		;Say we have a node
	  MOVEM C,SNDNOD	;And save it for the JSYS to come
	ENDIF.
	SETZ C,			;Indicate no real job seen yet
	HRRZ Q1,.JOLEN(B)	;Here's our loop ender
	SOS Q1			;But don't count the count word
	SETZ Q2,		;And here's the loop counter
	DO.			;Loop through entry in the jobs and see if user has all detached jobs
	  AOS Q2		;Step to an entry
	  MOVE A,B		;B holds the address of the current set of jobs
	  ADD A,Q2		;Figure in the offset
	  HRRZ D,(A)		;Get the terminal
	  CAIE D,-1		;Is it detached?
	  IFSKP.		;If so,
	    TLO Z,F2		;Say we have seen a detached job
	  ELSE.			;Else,
	    JUMPN C,LICTTY	;Have we seen other jobs?
	    MOVE C,D		;Save terminal number
	    HLL C,.JOLEN(B)	;And the node number
	  ENDIF.
	  CAME Q1,Q2		;Have we done all for this node?
	  JRST TOP.		;No, continue on
	  AOS B			;Increment past the count word
	  ADD B,Q1		;Add on block length
	  SKIPN .JOLEN(B)	;Are we done?
	  EXIT.			;Yes, no more jobs in this block
	  HRRZ Q1,.JOLEN(B)	;No, get how many jobs in this block
	  SOS Q1		;Adjust for count word
	  SETZ Q2,		;Start the counter
	  JRST TOP.		;And do this set of jobs
	ENDDO.
	IFE. C			;If we never found a job
	  TLNE Z,F2		;Did we see a detached job?
	  JRST DETLIK		;Yep, that's all we saw
	  ERROR <User is not logged in, Send mail instead>
	ENDIF.
	HLRZM C,SNDNOD		;Here's the node the user is logged into
	HRRZM C,SNDLNO		;And the terminal
	RET			;Done

;At this point, we know the user is multiply logged in but we are not
;sure where the message should be sent. So now we will prompt the user
;to find out.
LICTTY:	MOVEI P1,JOBS		;Start checking from here
	SETZ Q1,		;Init our loop counter
	HRRZ Q2,.JOLEN(P1)	;Init our loop fence
	SOS Q2			;But don't count the first word
	DO.			;Loop over each terminal
	  HLRZ P2,.JOLEN(P1)	;Get node number
	  SETZ C,		;Init our loop counter
	  DO.			;Find byte pointer to node name
	    AOS C		;Do next entry
	    HLRZ A,CFGNOD(C)	;Get CI node for this entry
	    CAME P2,A		;Have we found what we are looking for?
	    JRST TOP.		;Nope, go on
	    MOVE P2,CFGBLK(C)	;Get byte pointer to node
	  ENDDO.
	  AOS Q1		;Move to next entry
	  MOVE A,P1		;P1 is our lower fence
	  ADD A,Q1		;Get to right index
	  HLRZ D,(A)		;Get job number for GETJI%
	  HRRZ B,(A)		;Get the terminal number
	  CAIE B,-1		;Is this a detached one?
	  IFSKP.		;If so,
	    CAME Q1,Q2		;Have we done them all?
	    JRST TOP.		;No, go on to next job
	    ADD P1,Q2		;Yes, now move to next set of jobs
	    AOS P1		;Make sure we include the count word
	    SKIPN .JOLEN(P1)	;Are there more jobs to check?
	    EXIT.		;No, time for maroon to give us data
	    SETZ Q1,		;Reinit our counter
	    HRRZ Q2,.JOLEN(P1)	;And move our fence post up
	    SOS Q2		;But don't go too far
	    JRST TOP.		;Now check the next set of jobs
	  ENDIF.
	  ETYPE < Node %11M, TTY%2O%, running > ;[4426]
	  MOVEI A,INFBLK	;Store information here
	  MOVE B,[.INGJI,,.INAC3] ;Get function code and argument block length
	  MOVEM B,.INFUN(A)	;Save this
	  HLRZ B,.JOLEN(P1)	;Get node number
	  MOVEM B,.INCID(A)	;Save it here
	  HRRZM D,.INAC1(A)	;Save job number
	  HRLI B,-1		;Only want one word for GETJI%
	  HRRI B,PNAME		;And it goes here
	  MOVEM B,.INAC2(A)	;Stash this in the INFO% block
	  MOVEI B,.JIPNM	;Only want program name
	  MOVEM B,.INAC3(A)	;Save it
	  SETZM PNAME		;Init program name
	  INFO%			;Get job program name
	   ERJMP .+1		;[7.1101] If remote not supplying...
	  SKIPN A,PNAME		;Get program name
	  IFSKP.		;If there was one,
	    CALL SIXPRT		;(A/) Print it
	  ELSE.			;Otherwise,
	    PRINT "?"		;At this point, we don't know
	  ENDIF.
	  ETYPE <%_>		;Make things real pretty
	  CAME Q1,Q2		;Have we done them all?
	  JRST TOP.		;No, continue
	  ADD P1,Q2		;Yes, now move to next set of jobs
	  AOS P1		;Don't forget the count word
	  SKIPN .JOLEN(P1)	;Are there more jobs to check?
	  EXIT.			;No, time for maroon to give us data
	  SETZ Q1,		;Reinit our counter
	  HRRZ Q2,.JOLEN(P1)	;And move our fence post up
	  SOS Q2		;But not too far
	  JRST TOP.		;Now check the next set of jobs
	ENDDO.
	TLNE Z,F1		;Have a node name?
	IFSKP.			;If not,
	  PROMPT <Node: >	;Get it from the user
	  CALL VALNDE		;[7.1269] (A,B/A,B,C) Get us a node (no * allowed)
	  CONFIRM		;Get confirmation
	  MOVEI A,JOBS		;Start here
	  DO.			;Loop over all entries
	    HLRZ Q1,.JOLEN(A)	;Get node number here
	    CAMN B,Q1		;Did we parse goodness?
	    EXIT.		;That we did
	    HRRZ Q1,.JOLEN(A)	;No, move onto next set of jobs
	    ADD A,Q1		;Point to next set of jobs
	    SKIPE .JOLEN(A)	;No more?
	    JRST TOP.		;There is more
	    ERROR <User not logged in on given node>
	  ENDDO.
	  MOVEM B,SNDNOD	;Now we have a real node
	  HRRZ Q1,.JOLEN(A)	;[7.1106] See how many jobs logged into this system
	  CAIE Q1,<1+1>		;[7.1106] Target logged in only once? (Header
				;[7.1106] plus job word)
	  JRST LICTT1		;[7.1106] No, find out which terminal to zap
	  HRRZ B,1(A)		;[7.1106] User logged in once, here's the TTY
	  MOVEM B,SNDLNO	;[7.1106] Put TTY here for TTMSG%
	  RET			;[7.1106] And return
	ENDIF.
LICTT1:	PROMPT <TTY: >		;Ask user for a choice
	OCTX <Terminal number>	;Get user input
	 CMERRX			;User gafawed
	CAIN B,-1		;Did user do something stupid?
	JRST BADLIK		;Sure did, tell them
	MOVEM B,SNDLNO		;Save what we got from user
	MOVEI A,JOBS		;Now we have to check the terminal given
	DO.			;Find the node with the correct chunk of jobs
	  HLRZ B,.JOLEN(A)	;Get the node number
	  CAMN B,SNDNOD		;Correct one?
	  EXIT.			;Yes, now verify terminal
	  HRRZ B,.JOLEN(A)	;Get offset to next set of jobs
	  ADD A,B		;Here they are
	  JRST TOP.		;Try again
	ENDDO.
	MOVEI Q1,1		;Here's our loop counter starting over
	HRRZ Q2,.JOLEN(A)	;Here's the loop fencepost
	MOVE B,A		;Get starting point
	DO.			;Now check to make sure this is correct TTY
	  ADD B,Q1		;Move to  correct index
	  HRRZ B,(B)		;Now get the terminal for this job
	  CAMN B,SNDLNO		;Did user give us a good one?
	  RET			;Yes, now return
	  AOS Q1		;Move onto next entry to check
	  MOVE B,A		;Get starting point
	  CAME Q1,Q2		;Have we exhausted out possibilities?
	  JRST TOP.		;No, keep checking
	ENDDO.			;Yes, tell maroon he goofed
BADLIK:	ERROR <Terminal number does not belong to specified user>
;SNDFIX - ROUTINE TO BREAK UP LONG ^ESEND TEXT INTO MULTIPLE LINES

;ACCEPTS IN A/ POINTER TO WHERE TO STORE TEXT
;	    B/ ADDRESS OF USER'S TEXT
;RETURNS: +1 ALWAYS, WITH A/ POINTER TO END OF TEXT

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

SNDFIX:	HRLI B,(POINT 7,)	;MAKE ADDRESS OF USER'S DATA BE A POINTER
SNDFX0:	MOVEI D,SNDSIZ		;GET MAX SIZE FOR ^ESEND LINES
SNDFX1:	ILDB C,B		;GET A CHARACTER FROM THE USER'S STRING
	JUMPE C,R		;ALL DONE IF END OF STRING
	CAIN C," "		;BETWEEN WORDS?
	JRST SNDFXW		;YES - SEE IF NEAR END OF LINE
SNDFX2:	IDPB C,A		;ELSE DEPOSIT CHARACTER IN NEW STRING
	SOJG D,SNDFX1		;LOOP OVER A LINE-FULL OF CHARACTERS
SNDFX3:	MOVEI C,.CHCRT		;THEN PUT IN A CRLF AND A SPACE
	IDPB C,A
	MOVEI C,.CHLFD
	IDPB C,A
	MOVEI C," "
	IDPB C,A
	JRST SNDFX0		;AND CONTINUE COPYING

SNDFXW:	CAILE D,7		;NEAR THE END OF THE LINE?
	JRST SNDFX2		;NO - PROCEED
	JRST SNDFX3		;YES - START THE NEW LINE NOW

;SUBROUTINE TO APPEND A STRING TO THE END OF (A)
;ENTER WITH ASCIZ STRING POINTER IN AC B

SAPPND:	HRLI B,(POINT 7,)	;MAKE ADDRESS INTO A POINTER
SAPND1:	ILDB Q1,B		;GET A CHARACTER
	JUMPE Q1,R		;DONE IF NULL
	IDPB Q1,A		;ELSE SAVE IT AT END OF MESSAGE
	JRST SAPND1		;AND GET MORE
;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
	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
;HERE IF "TAKE" SEEN WITH NO FILESPEC - WILL SUPPRESS "END OF filespec" MESSAGE

PRIRES: SKIPE LGORET		;ARE WE LOGGING OUT? (i.e.,"TAKE" AT END OF LOGOUT.CMD)
	JRST PRIR01		;YES, DO THIS A LITTLE DIFFERENTLY
	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
PRIR01:	CALL CIOREL		;POP BACK ONE LEVEL
	 CAIA			;THERE WAS A LEVEL TO CLOSE
	JRST @LGORET		;NO LEVEL TO CLOSE - KEEP ON LOGGIN' OUT
	CLOSF			;CLOSE OLD INPUT SIDE
	 ERCAL JERR		;SHOULDN'T FAIL HERE, EITHER
	MOVE A, TAKLEN		;SEE WHAT LEVEL WE'RE ON NOW
	CAME A, SAVTAK		;SAME AS WHEN WE ENTERED "LOGOUT" PROCESSING?
	RET			;NO, MUST BE MORE TO DO (TAKING A FILE INSIDE LOGOUT.CMD)
	JRST @LGORET		;YES - ALL DONE NOW, KEEP LOGGING OUT
;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
	CONFIRM			;DON'T FORGET
	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
	GJINF			;GET JOB INFO
	HRRZ A,CIJFN		;FIND OUT WHERE WE'RE READING FROM
	SKIPGE D		; IF DETACHED
	 CAIE A,.PRIIN		; AND READING FROM PRIMARY INPUT
	  SKIPA
	   JRST [MOVE A,TAKCUR	;GET CURRENT SETTINGS
		 JRST PSH1]	;FALL IN TO TURN OFF TKTERF
	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?
PSH1:	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
	 ERJMP CJERR
	TRZ C,-1
	SKIPE PRVENF
	HRR C,B
	MOVE D,C		;REMEMBER EXEC'S CAPS
	EPCAP			;EXEC'S CAPABILITIES
	 ERJMP CJERR
	SKIPG A,FORK
	RET			;NO INFERIOR, DONE
	RPCAP
	 ERJMP CJERR
	MOVE C,D		;SET FORK TO WHATEVER WE ARE
	EPCAP			;INFERIOR'S CAPS
	 ERJMP CJERR
	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::TRVAR <<JUSBLK,.JIPNM+1>,JUSJOB>	
	MOVEM A,JUSJOB
	GJINF
	CAMN 3,JUSJOB		;THIS JOB?
	ERROR <If you want to logout this job, use LOGOUT>
	MOVE D,JUSJOB		;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
	MOVE A,D		;JOB NUMBER
	MOVSI B,-<.JIPNM+1>	;GET UP TO THE PROGRAM NAME 
	HRRI B,JUSBLK		;PUT DATA IN TEMP AREA
	MOVEI C,.JIJNO		;START WITH JOB NUMBER
	GETJI			;GET IT
	 ERJMP CJERR		
	MOVEI C,JUSBLK		;POINT AT TEMP AREA
	SKIPN A,.JIUNO(C)	;GET USER # 
	 IFSKP.
	  ETYPE <User %1N>	;TYPE USER NAME OUT
	 ELSE.
	  ETYPE <Not logged in>	;OR NOT LOGGED IN IF USER # IS 0
	 ENDIF.
	MOVE A,.JITNO(C)	;[4425] Load terminal number
	TXO A,.TTDES		;[4425] Make that a designator
	SKIPN B,.JIPNM(C)	;Load program name, skip if nonzero
	MOVE B,.JISNM(C)	;If prog name was zero, use system name
	ETYPE < %1L, running %2'> ;[4425] Give location and program running
ELOGO2:	CALL FCONF		;CONFIRM   
	MOVE A,JUSJOB		;NOW, RECHECK THE USER NUMBERS
	MOVE B,[1,,C]		;ONE WORD INTO AC C
	MOVEI C,.JIUNO		;THE WORD IS THE USER NUMBER
	GETJI			;GET IT
	 ERJMP CJERR		
	MOVEI B,JUSBLK
	MOVE A,.JIUNO(B)	;GET JOB NUMBER 
	CAME C,A     		;STILL THE SAME USER?
	 JRST CMDIN4		;DIFFERENT USER, DO NOTHING
	MOVE A,JUSJOB		;GET THE JOB NUMBER
	LGOUT			;LOGOUT THE JOB
	 CALL CJERR
	JRST CMDIN4
.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
	CAMGE B,NTTYPS		;IS IT WITHIN THE TABLE?
	SKIPN A,BLNKTB(B)	;YES - GET STRING TO DUMP
	 JRST BLANK2		;NO - DO NOTHING
	TLNN A,-1		;STRING OR POINTER?
	 TLOA A,-1		;POINTER 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
;[7.1076] NODTAB is used when /NODE is parsed or NODE keyword is parsed.
;VALNOD is then dispatched to and it attempts to parse a CI node name.
NODTAB:	TABLE
	[ASCIZ /NODE:/],,0
	TEND

;[7.1076]
;VALNOD - Used to parse a CI node name ala COMND% style. The table
;that houses the CI nodes can dynamic change. Each time this routine
;is called, the table is wiped clean and a new table is built. This
;routine has 2 entry points. When VALNOD is called, privs are checked
;before parsing a '*' (non-prived users can't parse '*' in this case).
;If VALNDN is called, both '*' and CI nodes can be parsed no matter
;if privs are there or not. VALNDE was added as an after thought.
;When we are parsing a node name and must absolutely positively have
;a node name (* not allowed) then we call VALNDE.
;
; Call with:
;	A/ COMND% state block
;	CALL VALNOD
;	     or
;	CALL VALNDN
;	     or
;	CALL VALNDE
;
; Returns:
;	+1 - Always, with
;	     A/ COMND% state block
;	     B/ Bit mask of node parsed (or -1 when * is seen)
;	     C/ CI node number (or -1 when * is seen)
;
;Note - on COMND% parse error, we return to EXEC command level.
VALNDE::MOVEI C,1		;[7.1269] Flag entry point
	JRST VALND0		;[7.1269] And join common code

VALNDN::TDZA C,C		;Parse token regardless
VALNOD::SETO C,			;Check privs before parse
VALND0:	SAVEAC <Q1,Q2>		;Preserve the smashed ones
	STKVAR <SAVBLK,ENTPNT>	;Need place for COMND% state block
	MOVEM A,SAVBLK		;Save this for later
	MOVEM C,ENTPNT		;Save where we came in for later
	SETZM CINODT		;Clear out lookup table
	MOVE A,[CINODT,,CINODT+1] ;Force each entry in table to become 0
	BLT A,CINODT+17		;Do it
	MOVEI A,MAXCI		;Only this many nodes allowed
	MOVEM A,CINODT		;Save this value in table
VALND1:	MOVEI A,CFGSIZ		;This is how big the argument block is
	MOVEM A,CFGBLK		;Save it
	MOVEM A,CFGNOD		;Save for CI node numbers too
	MOVEI A,.CFCND		;Get all CI node names
	MOVEI B,CFGBLK		;Get CI node names and put them here
	CNFIG%			;Get node names
	 ERJMP JERR		;Must not have a KLIPA
	MOVEI A,.CFCSE		;Now get all CI node numbers
	MOVEI B,CFGNOD		;Store the node numbers here
	CNFIG%			;Have the monitor get them
	 ERJMP JERR		;Must not have a KLIPA
	HLRZ Q1,CFGBLK		;Get number of host names we received
	HLRZ Q2,CFGNOD		;Also get number of CI nodes we received
	SOS Q2			;CNFIG% is messed up, it counts the count word for node numbers
	CAME Q1,Q2		;They at least better be the same
	JRST VALND1		;They weren't do it again because of cluster transition
	SETZ Q1,		;This is our index counter
;Note - at this point there must be at least one living node in the cluster
;or things get sicker from here. Of course, since this machine is up, then
;there will be at least one node (us!).
VALND2:	AOS Q1			;Move onto next node entry
	HRLZ B,CFGBLK(Q1)	;Get address of node name string
	HLR B,CFGNOD(Q1)	;Get node number with string address
	MOVEI A,CINODT		;Put entry into this table
	TBADD%			;Do it
	 ERCAL JERR		;If error, report it
	CAME Q1,Q2		;Done all nodes returned?
	JRST VALND2		;No, do next node name
	MOVE A,SAVBLK		;Recapture COMND% state block
	MOVE B,ENTPNT		;[7.1269] Get entry point
	CAIN B,1		;[7.1269] Is it special?
	JRST VALND3		;[7.1269] Yes, don't parse token!
	SKIPE ENTPNT		;Must we check privs first?
	SKIPE PRVENF		;Is our user prived?
	IFNSK.			;If so, use this FDB
	  MOVEI B,[FLDDB. .CMKEY,,CINODT,<CI node name,>,,
		  [FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /*/]>,<* for all nodes>]] ;[7.1166]
	ELSE.			;User is just a peon
VALND3:	  MOVEI B,[FLDDB. .CMKEY,,CINODT,<CI node name,>] ;[7.1269] Token not included
	ENDIF.
	CALL FLDSKP		;(A,B/A,B,C)
	 CMERRX			;User is a bafoon
	LDB C,[POINT 9,0(C),8]	;Get function that user did
	CAIE C,.CMTOK		;Got token?
	IFSKP.			;If so,
	  SETZ Q1,		;Start this counter over again
	  SETZ C,		;Init mask
	  DO.			;Loop over each CI node to return bit mask
	    AOS Q1		;Go to entry to be worked on
	    HLRZ B,CFGNOD(Q1)	;Get its CI node number
	    IOR C,BITS(B)	;Light the bit for this node
	    CAME Q1,Q2		;Done with all nodes?
	    JRST TOP.		;No, do next node for mask
	  ENDDO.
	  SETO B,		;Now say all nodes were requested
	  RET			;And return to caller
	ENDIF.
	HRRZ B,(B)		;Return CI node to caller
	MOVE C,BITS(B)		;Get bit for this CI node also
	RET			;Done

	ENDSV.
	END