Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

; UPD ID= 451, SNARK:<6.EXEC>EXEC1.MAC.49,   2-Oct-84 13:59:03 by MCCOLLUM
;TCO 6.2233 - If GTJFN% fails in PUSH command, display actual error text
; 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

;TOPS20 'EXECUTIVE' COMMAND LANGUAGE

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

	SEARCH EXECDE
	TTITLE EXEC1

;THIS FILE CONTAINS
;LOTS OF COMMANDS...

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

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

ARCHI1:	SUBCOM $ARCHI

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

;TABLES ETC. TO ARCHIVE

$ARCHI:	TABLE
	T RETAIN,,.ARFL
	TEND

.ARFL:	NOISE <DISK CONTENTS>
	CONFIRM
	TLO Z,F2
	RET

;LET (LOGICAL NAME) -- (AS) --

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

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

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

;HERE WHEN LOGICAL NAME MANIPULATION FAILED

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

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

.ASS3B:	CRRX <Confirm to delete all logical names>
	 CMERRX
	MOVEI A,.CLNJA		;DELETE ALL
	TLNE Z,F2		;SYSTEM?
	MOVEI A,.CLNSA
	TLNE Z,F2		;SYSTEM?
	PROMPT <[Confirm to delete all SYSTEM logical names]>
	TLNN Z,F2
	PROMPT <[Confirm to delete ALL logical names]>
	CALL FCONFA
	CRLNM
	 CALL CJERR
	POP P,B
	RET

;ATTACH (USER) <NAME> (PASSWORD) -- (TSS JOB #) <#>

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

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

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

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

;DECODE ARGUMENTS

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

;ATTACH...
;CHECK THAT USER-GIVEN JOB # IS IN LEGAL RANGE

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

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

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

;ATTACH...
;NO JOB # GIVEN, SEE IF THERE IS A UNIQUE ONE FOR GIVEN NAME.

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

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

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

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

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

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

;ATTACH...

;CHECK FOR SELF

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

;CHECK FOR ALREADY ATTACHED

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

;EXECUTE THE COMMAND

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

;BREAK (LINKS)

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
	 ERROR <No such directory or structure not mounted>
	MOVEM C,ACDNUM		;REMEMBER DIRECTORY NUMBER
	CONFIRM
	TLNE Z,F2		;CONNECT?
	JRST NOCONN		;NO, SO NO OVER QUOTA REPORTING
	GJINF			;GET CONNECTED DIRECTORY
	MOVEM B,OLDCON		;REMEMBER OLD ONE
	CALL CHKDAL		;CHECK CURRENT DIRECTORY BEFORE LEAVING
NOCONN:	SETZM ACPASS		;FIRST TRY WITHOUT PASSWORD
	CALL DOACC		;DO THE JSYS
	TLNE Z,F2		;CONNECT?
	JRST CMDIN4		;NO, ACCESS, SO NO OVER QUOTA REPORT
	GJINF			;GET CONNECTED DIRECTORY NOW
	CAME B,OLDCON		;DON'T GIVE SAME REPORT TWICE!
	CALL CHKDAL		;CHECK NEW DIRECTORY
	JRST CMDIN4

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

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

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

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

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

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

;"COPY" IS IN X2CMD.MAC.

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

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

;DELETE <FILE GROUP>

.DELET::TRVAR <EXMFLG,NEWDIR,INIFHO,<DELBUF,FILWDS>,KEPNUM,KEPJNM,DELDIR,DELPGS,DELJFN>
	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
	CALL SPECFN		;INPUT FILE GROUP DESCRIPTOR
	JRST DELET1
	TDZ Z,[F5!F2!F3!F4!1B18] ;CAN'T BE EXPUNGE IF NO SUBCOMMAND
	JRST DELET2

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

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

PDLFRE:	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

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

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

;GETDNM DECIDES WHAT DIRECTORY NUMBER WE'RE WORKING ON

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

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

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

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

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

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

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

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

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

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

;PRUNE NUMBER OF GENERATIONS

;SOME BUFFER DEFINITIONS

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

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

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

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

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

KEEPE2:	TYPE <   >
	CAIA
KEEPE1:	TYPE <   GTJFN failure for highest generation
?>
	CALL $ERSTR
	TYPE <
>
	SETO A,
	RET

;DISCARD (TAPE INFORMATION FOR FILES) <FILES>

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

DISCA9:	ETYPE < %?
>
	JRST DISCA2

;EXPUNGE (ALL DELETED FILES)

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

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

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

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

;... FALL INTO TYPFRE

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

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

;ROUTINE TO GET EXPUNGE SUBCOMMANDS

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

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

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

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

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

;COMMENT (END WITH ^Z)

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

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

;ENTER HERE WITH JFN TO RELEASE IN A

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

NRLPRI:	TYPE < Primary input not closed
>
	RETSKP

NRLPRO:	TYPE < Primary output not closed
>
	RETSKP

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

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

NRLEXI:	TYPE < EXEC command input not closed
>
	RETSKP

NRLEXO:	TYPE < EXEC command output not closed
>
	RETSKP

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

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

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

;ADVISE (TERMINAL/USER)

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

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

;TALK (TERMINAL/USER)

.TALK::	TLZ Z,F2
	NOISE <TO>
LINK0:	TRVAR <DOLNKF,<JIBUF,.JILEN>,<LDBUF,3>,TFRAME,ADVJFN,ADVJNM,DIRNO>
	MOVEM P,TFRAME		;SAVE BEGINNING OF POSSIBITITES
	USERX <User name or terminal number>
	 JRST LTTY		;NOT USER NAME, SEE IF TERMINAL NUMBER TYPED
	CONFIRM
	MOVEM B,DIRNO		;SAVE USER NUMBER
	TLZ Z,F1		;NO DETACHED JOBS SEEN YET
	MOVEM P,TFRAME		;SAVE BEG OF ARGS
	HLLZ D,JOBRT		;MAKE AOBJN PTR
LINK3:	MOVEI B,(D)		;GET JOB NUMBER BY ITSELF
	CAME B,JOBNO		;LOOKING AT MY OWN JOB?
	SKIPN B			;OR JOB 0?
	JRST LINK6		;YES, SKIP IT
	CALL USERNO		;GET USER NUMBER
	CAME A,DIRNO
	JRST LINK6		;WRONG GUY
	GTB .JOBTT
	TLO Z,F1		;FLAG DETACHED JOB SEEN
	JUMPL A,LINK6		;AND SKIP IT IF DETACHED
	HLRZS A
	PUSH P,A		;SAVE TTY# (1ST WORD OF A POSSIBILITY)
	GTB .JOBPN		;GET PROGRAM NAME
	PUSH P,A		;SAVE SUBSYSTEM NAME (2ND WRD OF POSS.)
LINK6:	AOBJN D,LINK3		;MAY HAVE MORE JOBS
	CAMN P,TFRAME		;FOUND ANY?
	 JRST [	TLNE Z,F1
		ERROR <User has detached jobs only
 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
	ETYPE < TTY%2O%, >
	JUMPE A,[PRINT "?"	;NO SUBSYS NAME
		JRST LINK8]
	CALL SIXPRT		;PRINT SUBSYSTEM

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

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

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

LINK11:	PUSH P,B		;SAVE TTY#
	GJINF			;GET JOB INFORMATION
	TLNN Z,F2		;SKIP CHECK IF ADVISING
	CAME D,0(P)		;IS TTY# IDENTICAL TO MY TTY NUMBER ?
	SKIPA
LINKNS:	 ERROR <Cannot talk to self>
	HLRE B,TTYJOB		;GET NEG SIZE OF TABLE
	MOVMS B
	POP P,A			;TTY#
	CAIGE A,0(B)
	CAIGE A,0
	 ERROR <Nonexistent terminal number>
	TLNN Z,F3
	MOVE P,TFRAME
	PUSH P,A
	SETZ D,
	GTB .PTYPA
	MOVE D,A
	POP P,A
	CAIGE A,(D)		;PTY?
	JRST NOPTYL		;NO
	PUSH P,D		;MAYBE.  CHECK FOR ABOVE LAST PTY
	HLRZ D,D		;NUMBER OF PTYS
	ADD D,0(P)		;LAST PLUS ONE
	POP P,0(P)		;CLEAR STACK
	CAIL A,(D)		;ABOVE PTY'S?
	JRST NOPTYL		;YES.  NVT OR SOMETHING ELSE
	PROMPT < [Pseudo-terminal, confirm]>
	CALL FCONFA
NOPTYL:	TLNE Z,F2
	JRST ADVISE		;GO GIVE ADVISE
	MOVEI B,.TTDES(A)	;FORM TTY DESIGNATOR
	MOVE A,[1B2+1B3+.CTTRM]	;TO AND FROM CONTROLLING TTY
	TLINK
	 ERROR <Refused, 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 CHKLNK		;SEE IF TLINK NEEDED (MAYBE OTHER JOB WENT AWAY, WHICH BREAKS LINK)
	JRST ADVLOP		;GO GET NEXT CHARACTER

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

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

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

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

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

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

	JRST ADVLP1

;START COMMENT

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

;END COMMENT

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

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

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

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

;"LIST" IS WITH "TYPE" BELOW.

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

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

;DECODE ARGUMENTS

;FIRST ARGUMENT: USER NAME

	NOISE <USER>		;SEE COMMENTS ON "SPECEOL" ABOUT "NOISE"
	SETZM LERRF		;NO ERROR YET
	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]
	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 C,LACCT		;ACCT # OR PTR THERETO
	MOVE B,LPASP		;PASSWORD PTR
	MOVE A,LOGNO		;USER #
	MOVE D,C		;GET ACCT STRING
	ILDB D,D		;LOOK AT FINAL ACCOUNT
	SKIPN D			;HAVE ONE?
	SETZM C			;NO. USE NOTHING
	MOVEI D,0		;RESERVE D FOR FUTURE FLAGS
	LOGIN
	 JRST [	CAIN A,LGINX1
		ERROR <Illegal account>
		CAIN A,LGINX4
		ERROR <Incorrect password>
		CALL CJERRE]	;GNRL JSYS ERR RET ROUTINE (XSUBRS.MAC).
	MOVEI B,LDBLK		;GET THE LOGIN DATA BLOCK
	MOVEM A,.CDLLD(B)	;SAVE LOGIN DATE AND TIME IN CASE NON WHEEL
	SETOM SYSMF		;SET FLAG SO SYSTEM MESSAGES WILL GET PRINTED
	MOVE B,LOGNO		;WHAT "RCUSR" RETURNED
	MOVEM B,CUSRNO		;STORE USER NUMBER
	MOVEM A,LOGDAT		;SAVE DATE OF LOGIN
	GJINF			;GET LOGGED-IN DIRECTORY NUMBER
	MOVEM B,LIDNO		;SAVE IT.
	CALL PION		;ALLOW ^C NOW THAT CUSRNO IS SET UP
	MOVE A,Q1		;POINTER TO SESSION REMARK
	CALL SSR		;SET SESSION-REMARK

;LOGIN...
;THE AUTOLOGOUT FOR USE TO GET KILLED HERE, NOW WE MUST KILL OFF THE
;PENDING TIMER CLOCK

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

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

	MOVEI A,LDBLK		;GET ADDRESS OF THE DIRECTORY BLOCK
	MOVE A,.CDLLD(A)	;GET THE TIME AND DATE OF LAST LOGIN
	ETYPE < Job %J on %L %D %E, Last Login %1W
>				;EOL NEEDED BEFORE LOGIN MESSAGE
	MOVE B,RCBITS		;WHAT RCUSR RETURNED
	TXNE B,RC%RLM		;B2 SAYS ALWAYS PRINT LOGIN MESSAGE
	SETZM LOGDAT		;SET DATE TO 0 TO FORCE PRINTING

;GET DEFAULT EXEC INPUT FILE

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

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

TAKEIN::STKVAR <<TAKBUF,FILWDS>,SPB>
	MOVEM B,SPB		;SAVE STRING POINTER
	MOVE B,LIDNO		;GET LOGGED-IN DIRECTORY NUMBER
	HRROI A,TAKBUF		;GET STRING SPACE POINTER
	CAMN B,[-1]		;DEFAULT?
	JRST TAKEI1		;YES, SKIP DIR
	DIRST			;STORE DIR STRING
	 CALL JERR		;WE JUST SCANNED IT?!
TAKEI1:	MOVE B,A
	MOVE A,SPB
	SETZ C,			;READ TO NULL
	SIN			;APPEND TO STRING
	HRROI B,TAKBUF		;GET POINTER TO BEGINNING
	CALL TRYGTL		;TRY TO FIND IT.
	 JRST TAKIN2		;NO SUCH FILE, GO AWAY QUIETLY
	MOVE B,[70000,,OF%RD]
	OPENF
	 JRST [	HRROI B,TAKBUF	;GET POINTER FOR ERROR MESSAGE
		LERROR <Can't read %2M%%_%%1?>
		HRRZ A,JBUFP
		HRRZ A,(A)	;GET SAVED JFN
		RLJFN		;RELEASE IT
		 CALL JERR
		HRRZ A,JBUFP
		SETOM (A)
		RET]
	HRL A,A			;PUT INPUT JFN IN LEFT HALF
	HRR A,COJFN		;USE SAME OUTPUT AS WERE USING
	MOVE B,TAKDEF		;USE DEFAULT SETTINGS
	CALL PUSHIO		;SAVE OLD IO STREAM, START NEW ONE
	RETSKP			;DOUBLE RETURN WHEN SUCCESSFUL
TAKIN2:	RET			;FAILED, TAKE SINGLE RETURN

;SPECEOL
;SUBROUTINE TO HANDLE EOL AS FIELD TERMINATOR IN THE MIDDLE OF A COMMAND
; IN THE SPECIAL MANNER REQUIRED FOR "LOGIN".
;CR NORMALLY TERMINATES COMMAND, DEFAULTING ANY FOLLOWING FIELDS.
;BUT IF P2=EOL AND THIS SUBROUTINE IS CALLED AND A "NOISE"
;  MACRO FOLLOWS THE CALL, THE FOLLOWING NOISE WORD IS TYPED
;  (AS AFTER ALT MODE), PARENTHESIZED TEXT IS IGNORED (AS AFTER SPACE),
;  AND FIELD IS INPUT NORMALLY, NOT DEFAULTED.

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

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

USERN:	USERX <User name>
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
	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,CUSRNO		;SET UP FOR MAIL CHECK FOR THIS USER
	MOVEM B,MWATDR
	CALL MALCHK		;DO MAIL CHECK
	 JRST MESMS9		;NO MAIL
	TYPE < You have >
	TLNN B,77		;CHECK NETWORK MAIL FLAG
	TYPE <net >
	ETYPE <mail %1\%%_%>
	MOVE A,COJFN
	DOBE			;WAIT FOR IT TO REALLY PRINT
	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
	JRST TRYGT1

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

;LOGOUT

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

LOGOU1:	CONFIRM
XTND,<
	CALL BLANK1		;CLEAR SCREEN
	CALL DWNPNT		;TELL USER WHEN SYSTEM WILL GO DOWN
>
	SKIPN CUSRNO
	JRST LOGOU2
	GJINF			;GET CONNECTED DIRECTORY NUMBER
	CAMN B,LIDNO		;DIFFERENT FROM LOGGED-IN ONE?
	JRST LOGOU3		;NO SO DON'T BOTHER EXPUNGING CONNECTED DIR
	LDF A,DD%DTF		;FLUSH TEMPORARY FILES
	DELDF			;EXPUNG CONNECTED DIR
	  ERJMP	[TYPE <%Warning -- EXPUNGE failed, continuing...>
		 ETYPE <%_>
		 JRST .+1]
	CALL CHKDAL		;NOW CHECK IT
LOGOU3:	MOVE B,LIDNO		;GET LOGGED-IN DIRECTORY NUMBER
	LDF A,DD%DTF		;FLUSH TEMPORARY FILES ALSO
	DELDF
	  ERJMP	[TYPE <%Warning -- EXPUNGE failed, continuing...>
		 ETYPE <%_>
		 JRST .+1]
	MOVE A,LIDNO
	GTDAL			;GET USAGE/ALLOCATION
	JUMPE B,LOGOU2		;CAN'T BE OVER IF USAGE=0
	SUB B,C			;SUBTRACT PERMANENT ALLOCATION FROM USAGE
	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

;"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 <Can't get EXEC because: %?> ;PRINT LAST ERROR
		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
	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)
	OCTX <Octal line #>
	 CMERRX <Octal line number required>
	TRVAR <SNDPT,SNDPTC,SNDLNO>
	SETZM SNDLNO		;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)
	OCTX <Octal line # or * for all>
	 CAIA			;NO NUMBER TYPED
	JRST SENDA		;NUMBER TYPED.
	STARX			;SEE IF "*" TYPED
	 CMERRX <Octal line number or * required>
	SETO B,			;NOTE "*" WITH -1
SENDA:	TRVAR <SNDPT,SNDPTC,SNDLNO>
	MOVEM B,SNDLNO		;SAVE LINE NUMBER
	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
	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 / on 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:	HRROI B,[ASCIZ /:/]
	SKIPGE SNDLNO		;IF SENDING TO ALL, SAY SO
	HRRI B,[ASCIZ / to all:/]
	CALL SAPPND		;FINISH OFF THE HEADER
	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:	MOVE B,[POINT 7,BUF0]	;GET POINTER TO THE MESSAGE STRING
	SKIPL A,SNDLNO		;RESTORE LINE(S) FOR MESSAGE - JUST ONE?
	ADDI A,.TTDES		;YES - ADD IN TERMINAL DESIGNATOR
	TTMSG			;SEND THE MESSAGE
	  ERJMP CJERRE		;IT FAILED SOMEHOW
	CALLRET UNMAP		;O.K. - UNMAP BUFFER PAGE AND RETURN

;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

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

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

;SUBCOMMANDS TO "TAKE" COMMAND

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

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

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

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

.TKLOG:	DEXTX <LOG>		;DEFAULT OUTPUT EXTENSION IS LOG
	MOVX A,GJ%FOU+GJ%MSG+GJ%ACC ;FILE FOR OUTPUT USE PLUS PRINT MESSAGE
	MOVEM A,CJFNBK+.GJGEN	;AND DON'T LET INFERIORS TOUCH THIS JFN
	MOVEI B,[FLDDB. .CMFIL,CM%SDH,,<Output file name>]
	CALL FLDSKP		;READ FILESPEC
	 CMERRX			;THAT'S NOT WHAT IT WAS
	MOVEM B,JFN2		;SAVE OUTPUT JFN
	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.
	SKIPGE A,.JITNO(C)	;GET TTY 
	 IFSKP.
	  ETYPE < on TTY%1O>	;TYPE IT
	 ELSE.
	  ETYPE <, Detached>	;UNLESS -1
	 ENDIF.
	SKIPN B,.JIPNM(C)	;AND PROGRAM NAME UNLESS IT'S 0
	 MOVE B,.JISNM(C)	;IF PROG NAME WAS ZERO, USE SYSTEM NAME
	ETYPE <, running %2'>
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
	CAIGE 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

	END