;[I4-TENEX]<MFEXEC>X1CMD.MAC;20270, 28-DEC-79 10:24:17, Ed: RLWSSD
; BUG FIX IN ACCESS COMMAND
;[I4-TENEX]<MFEXEC>X1CMD.MAC;20269,  4-DEC-79 17:12:18, Ed: RLWSSD
; FIXED UP NEW MAIL MSGS AT LOGOUT.
;[I4-TENEX]<MFEXEC>X1CMD.MAC;20268,  4-DEC-79 10:55:36, Ed: RLWSSD
; CHANGED "PAGE-TABLE" ARG TO ACCESS COMMAND TO BE "LIST".
;<MFEXEC>X1CMD.MAC;20267     7-AUG-79 14:16:38    EDIT BY RLWSSD
; ADDED FCONTINUE COMMAND; SAME AS FOREGROUND FOLLOWED BY CONTINUE
;<MFEXEC>X1CMD.MAC;20266     3-AUG-79 14:58:05    EDIT BY RLWSSD
; MOVED UNTRAPPING & TIW STUFF BACK TO $WAIT 'CAUSE IT COULDN'T BE MADE
; TO WORK IN .FOREGROUND.  FOO.
;<MFEXEC>X1CMD.MAC;20265     2-AUG-79 10:54:07    EDIT BY RLWSSD
; MOVED UNTRAPPING & RESTORATION OF TIW OF BACKGROUND FORKS FROM
; $WAIT TO .FOREGROUND
;<MFEXEC>X1CMD.MAC;20264    19-JUL-79 23:45:52    EDIT BY WEISSMAN
; MORE JSYS TRAPPING STUFF FOR BACKGROUND FORKS: TERM INTERRUPT HANDLING
;<MFEXEC>X1CMD.MAC;20263    18-JUL-79 14:44:45    EDIT BY WEISSMAN
; CHANGED MAIL WATCH TO BE FOR ANY USER
;<MFEXEC>X1CMD.MAC;20262    17-JUL-79 19:54:22    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20261    17-JUL-79 19:29:02    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20260    16-JUL-79 20:15:30    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20259    13-JUL-79 14:15:23    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20258    13-JUL-79 13:55:40    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20257    13-JUL-79 10:46:31    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20256    12-JUL-79 19:09:15    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20255    12-JUL-79 18:12:40    EDIT BY WEISSMAN
; ADDED PRINTER WATCH ROUTINE (PRIWAT)
;<MFEXEC>X1CMD.MAC;20254    12-JUL-79 17:45:24    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20253    12-JUL-79 17:21:42    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20252    12-JUL-79 16:59:54    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20251    12-JUL-79 16:38:32    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20250    12-JUL-79 16:03:02    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20249    12-JUL-79 15:30:41    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20248    12-JUL-79 14:54:31    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20247    11-JUL-79 20:49:36    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20246    11-JUL-79 20:30:16    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20245    11-JUL-79 20:07:16    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20243    11-JUL-79 19:40:44    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20242    11-JUL-79 19:17:15    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20241    11-JUL-79 18:59:54    EDIT BY WEISSMAN
; ADDED MAP COMMAND (.MAP ROUTN)
;<MFEXEC>X1CMD.MAC;20240     5-JUL-79 12:07:42    EDIT BY WEISSMAN
; ADDED CHECK FOR ANONYMOUS USER IN .LOGIN
;<MFEXEC>X1CMD.MAC;20239     3-JUL-79 17:45:41    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20238     3-JUL-79 17:37:55    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20237     3-JUL-79 17:23:24    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20236     3-JUL-79 17:13:46    EDIT BY WEISSMAN
; ADDED SET TABSTOPS (EVERY) N (SPACES) COMMAND
;<MFEXEC>X1CMD.MAC;20235     3-JUL-79 14:43:09    EDIT BY WEISSMAN
; FIXED BUG IN STOPS COMMAND (.STOPS ROUTINE)
;<MFEXEC>X1CMD.MAC;20234    29-JUN-79 16:10:35    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20233    29-JUN-79 16:03:33    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20232    29-JUN-79 15:54:39    EDIT BY WEISSMAN
;<MFEXEC>X1CMD.MAC;20231    28-JUN-79 15:31:53    EDIT BY WEISSMAN
; ADDED SPELLING CORRECTION (FEATUR %CORECT) AND JSYS TRAPPING
;  (FEATUR %BAKTRP) LOGIC
; CHANGES FOR IAC OPERATION
;<MFEXEC>X1CMD.MAC;20202  24-OCT-78 09:09:33  EDIT BY B-SMITH
;Changed archive-lookup to always be from <system>
;<MFEXEC>X1CMD.MAC;20201  18-OCT-78 09:51:30  EDIT BY B-SMITH
;Fixup MOVE for MFEXEC table macros
;Make RLPJFN a little cleaner
;Fix typo in LINK1 feature
;<MFEXEC>X1CMD.MAC;20200  27-SEP-78 09:43:17  EDIT BY B-SMITH
;Added BBN move command
;Removed restriction that fork names must not start with an octal digit.
; The name will always take precidence.
;Add new search path code
;Cleaned CONNECT, add From where feature.
;Bug fix in ASSIGN error reporting
;<MFEXEC>X1CMD.MAC;20104   2-FEB-78 17:02:53  EDIT BY DALE
; Bug fix PERPETUAL/PERMANENT
;<MFEXEC>X1CMD.MAC;20103   6-JAN-78 09:32:57  EDIT BY B-SMITH
;Bug fix to ephemeral dispatch
;Bug fix to BACKGROUND and GETFH
;Made CONTINUE more tolerant
;<MFEXEC>X1CMD.MAC;20102   2-JAN-78 16:50:20  EDIT BY DALE
;<MFEXEC>X1CMD.MAC;20101  29-DEC-77 08:42:04  EDIT BY B-SMITH
;2.01
;<MFEXEC>X1CMD.MAC;20000  11-JAN-77 19:23:34  EDIT BY B-SMITH
;2.00

; PDP-10 TENEX EXECUTIVE COMMANDS ROUTINES

PRINTX Entering X1CMD

;ROUTINES TO DECODE AND EXECUTE SPECIFIC COMMANDS.
;DISPATCHED TO BY EXEC COMMAND INTERPRETER MAIN FILE (XMAIN.MAC).
;IN ALPHABETICAL ORDER BY COMMAND NAME.

;ACCESS (TO FILES) <LIST> (BY) SELF,GROUP,OTHERS (IS) READ,WRITE,
;    EXECUTE,APPEND,PAGE-TABLE,UNUSED,ALL,NONE

.ACCES:	NOISE <to files>
	CALL .INFG		;INPUT FILES LIST
	ALLOW TSPC!TALT!TLPR
	NOISE <by>
	PUSH P,[0]		;TEMP
ACCES1:	TLO Z,NEOLF		;SAY DON'T ECHO EOLS
	KEYWD $ACCS1
	 T OTHERS,,COMOK!NSPALT,000077	;DEFAULT
	 JRST CERR
	ANDI KWV,-1		;FLUSH FLAGS
	IORM KWV,0(P)		;VALUE IS MASK
	ALLOW TCOM!TALT!TSPC
	TRNE CBT,TCOM		;SEPARATOR WAS COMMA?
	 JRST ACCES1		;COMMA, GET NEXT WORD

ACCES2: ALTYPE ( )
	NOISE <is>
	PUSH P,[0]		;TEMP
ACCE21:	TLO Z,NEOLF
	KEYWD $ACCS2
	 T NORMAL,,COMOK!EOLOK,52
	 JRST CERR
	ANDI KWV,-1		;FLUSH FLAGS
	CAIE KWV,0		;"NONE"
	CAIN KWV,52		;"NORMAL"
	 SETZM 0(P)		;CLEAR WHAT WAS SAID BEFORE
	IORM KWV,0(P)		;ACCUMULATE
	CALL	SPRTR		;ANALYSE FIELD, TERMINATOR
	JRST ACCE21		;ANOTHER FIELD, PROCESS IT
	JRST ACCE21		;COMMA, PROCESS NEXT FIELD
	CONFIRM			;EOL,  GO

ACCES3:	POP P,E
	IMULI E,010101
	POP P,F			;MASK
	CALL FRSTF		;TYPE FIRST FILE NAME
ACCES4:	HRRZ 1,@INIFH1		;GET JFN
	DVCHR
	TLNN 2,(1B4)		;DISK?
	 JRST [	ETYPE < %1H: Does not have protected files
>
		JRST NEXTF]	;GET NEXT FILE, GO TO ACCES4
	MOVSI 1,FDBPRT		;PROTECTION WORD
	HRR 1,@INIFH1		;FORM INDEX,,JFN
	HRRZ 2,F		;ACCESS PATHS
	HRRZ 3,E		;PROTECTION
	TRNE 2,20000		;TRYING TO CHANGE THIS BIT TO 0?
	TROE 3,20000
	CAIA
	 TYPE < 20000-bit forced on
>
	HRLI 3,(5B2)		;MAKE IT NUMERIC
	CHFDB
	 ERJMP [ERROR (Access violation)]
	JRST NEXTF		;GET NEXT FILE, RETURN TO ACCES4



$ACCS1:	TABLE
	T ALL,,COMOK,777777
	T GROUP,,COMOK,007700
	T OTHERS,,COMOK,000077
	T SELF,,COMOK,770000
	TEND


$ACCS2:	TABLE
	T ALL,,COMOK!EOLOK,77
	T APPEND,,COMOK!EOLOK,04
	T EXECUTE,,COMOK!EOLOK,10
IAC <	T LIST,,COMOK!EOLOK,02 >
	T NONE,,COMOK!EOLOK,00
	T NORMAL,,COMOK!EOLOK,52
NOIAC <	T PAGE-TABLE,,COMOK!EOLOK,02 >
IAC <	T PAGE-TABLE,,COMOK!EOLOK!INVIS,02 >
	T READ,,COMOK!EOLOK,40
	T UNUSED,,COMOK!EOLOK!INVIS,01
	T WRITE,,COMOK!EOLOK,20
	TEND

;ACCOUNT (OF FILE) <NAME> (IS) <ACCOUNT # OR STRING>

.ACCOU:	NOISE <of files>
	CALL .INFG		;INPUT FILE GROUP

REPEAT 0,<	;SEE IF TARGET DIRECTORY SPECIFIES STRING OR NUMBER
ACCOU0:	MOVE A,CSBUFP
	MOVE B,CJFN1
	HRLZI C,B5		;DIRECTORY NAME ONLY, UNPUNCTUATED.
	JFNS			;GET STRING FOR DIRECTORY NAME
>

REPEAT 1,<	;SEE IF USER SPECIFIES STRING OR NUMERIC ACCT
ACCOU1:	MOVE B,CUSRNO		;USER'S LOGIN DIRECTORY
	MOVE A,CSBUFP
	DIRST
	 CALL SCREWUP>


ACCOU2:	MOVEI A,1
	MOVE B,CSBUFP
	STDIR			;CONVERT BACK TO GET LEFT HALF BITS
	 JRST CERR
	 JRST CERR
	ALLOW TSPC!TALT!TLPR!TEOL
	NOISE <is>
	CALL ACCT		;GET ACCOUNT NUMBER OR STRING, USING A.
	MOVE E,A		;SAVE THRU DVCHR'S
	CONFIRM
	CALL FRSTF		;PRINT NAME OF FIRST FILE IN GROUP

ACCOU3:	HRRZ 1,@INIFH1		;GET THE JFN
	DVCHR
	HLRZS 1
	CAIE 1,600000		;DEVICE IS DSK: ?
	 JRST [	UTYPE [ASCIZ / Not a disk file/]
		JRST NEXTF]	;DO NEXT, RETURN TO ACCOU3
	HRRZ 1,@INIFH1		;JFN
	MOVE 2,E		;ACCOUNT
	SACTF			;SET ACCOUNT OF FILE
	 CALL [	CAIN 1,SACTX4
		 UERR [ASCIZ /No access to change account of that file/]
		JRST JERR]
	JRST NEXTF		;GNJFN, TYPE NAME, GO TO ACCOU3

;ADVISE (USER) <USERNAME OR TERMINAL NUMBER>

.ADVIS:	NOISE (user)
	CALL TTYNUM
	MOVEI 1,400000(1)	;FORM TTY DESIGNATOR
	TLO 1,(1B1)		;SET "ADVISE TO" FLAG
	ADVIZ
	 CALL [	CAIN 1,ADVX4
		 ERROR <Only one advise link is permitted>
		CAIN 1,ADVX2
		 ERROR <Ignored>
		CAIN 1,ADVX1
		 ERROR <Refused>
		JRST JERR]
	RET

;ALERT (AT TIME) <DAYTIME OR TIME>

FEATUR %ALERT,<
.ALERT:
	SKIPLE A,ALRTIM
	ERROR <Alert already exists for %1D %E>
	NOISE (at time)
	CALL SHTIME
	JUMPLE A,CERR		;BAD DAYTIME (OR TOO FAR IN FUTURE)
	MOVEI B,^D30(A)
	IDIVI B,^D60		;Truncate seconds off to minutes
	MULI B,^D60		; and restore back
	HRR A,B
	PUSH P,A
	GTAD
	CAML A,0(P)
	ERROR <Use time after %D %E>
ALERT1: CONFIRM			;LET WAKEUP MERGE IN, TIME PUSHED
;THERE SHOULD BE A STRING INPUT (MESSAGE) TO ASSOCIATE WITH
; THE ALERT
	POP P,ALRTIM
	RET

;WAKEUP (IN) <MINUTES TO ALERT>

.WAKEUP:
	SKIPLE A,ALRTIM
	ERROR <Alert already exists for %1D %E>
	NOISE (in)
	INHELP <Minutes until alert>
	ALLOW TALT+TEOL+TSPC
	TLO Z,BAKFF
	CALL DECIN
	JRST CERR
	JUMPL A,CERR
	MOVE B,A
	GTAD
	CALL TIMPMN
	PUSH P,A
	JRST ALERT1
>

;"APPEND" IS WITH "COPY" IN X2CMD.MAC.

;ASSIGN <DEVICE>

.ASSIG:	NOISE (device)
	CALL DEVN		;READ DEVICE NAME, CHECK IT.
				;ACCEPTS USUAL TERMINATORS, PLUS COLON
	PUSH P,A		;...RETURNS DEV DESGNATOR IN A,
	PUSH P,B		;...CHARACTERISTICS IN B,
				;...JOB # ASS TO IN C.
	TLNN B,B3
	ERROR <%1H: Cannot be assigned>
	TLNN B,B5		;"AVAILABLE" BIT
	JRST [	TLNN B,B6	;NOT AVAIL, ASSIGNED?
		UERR [ASCIZ /%1H: Not available/] ;%H: DEV NAME
		UERR [ASCIZ /%1H: Already assigned to job %3Q/]]
	TLNE B,B6
	$TYPE < [Already assigned to you] >;  ADVISORY MSG, NOT ERROR
	LDB C,[POINT 9,A,17]
	CAIE C,12		;DEVICE TYPE TTY?
	JRST ASSIG3		;NO
	MOVEI E,(A)		;MASK TTY #
	GJINF			;JOB'S CONT TTY # TO D, JOB # TO C
	CAMN D,E
	ERROR <You can't assign your controlling terminal>
	MOVE A,['TTYJOB']
	CALL $SYSGT		;GET # OF TABLE OF TTYS
	HRR A,B			;TABLE #
	HRL A,E			;TTY # IS TABLE INDEX
	GETAB			;GET TABLE WORD
	 CALL JERR
	HLRZ B,A
	CAME B,C		;Assigned to me already
	CAIN B,-1		; or free is ok
	JRST ASSIG3
	MOVE A,-1(P)		;DEV DESIG FOR ERROR MESSAGES
	SKIPG C,B
	ERROR <%1H: Busy>;	;-2: BEING ASSIGNED
				;B0+JOB # ASSIGNED TO ALSO GETS THIS
				;IF FOR SOME REASON ABOVE CHECKS FAIL.
	MOVE A,['JOBTTY']
	CALL $SYSGT
	HRR A,B			;Table number
	HRL A,C			;Job that owns specified tty.
	GETAB
	 CALL JERR
	HLRZ D,A		;Get job's controlling tty
	MOVE A,-1(P)		;Device designator
	CAME D,E		;Specified and controlling same?
	ERROR <%1H: Is assigned to job %3Q>
	ERROR <%1H: Is the controlling terminal for job %3Q>

ASSIG3:	CONFIRM
	POP P,A		;DEVICE CHARACTERISTICS
	TLNN A,B7		;"MOUNTABLE" BIT
	JRST ASSIG5		;NOT MOUNTABLE
	MOVE A,(P)		;DEVICE DESIGNATOR
		;TLO A,B3	;SAY DON'T READ DIRECTORY
	MOUNT			;MIGHT BE NEEDED TO INVALIDATE DIR IN CORE
	 CALL JERR
ASSIG5:	POP P,A			;DEVICE DESIGNATOR
	ASND
	 CALL JERR
	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.

.ATTAC:	CALL SPECEOL		;SPECIAL HANDLING OF EOL TERMINATOR FOR 
				;OPTIONAL FANCY FORMAT.
	NOISE <user>
	GJINF			;DEFAULT IS HIMSELF
	CALL USER		;INPUT USER (DIRECTORY) NAME
	TLNE A,B0
	ERROR <That's a files-only directory name>
	ALTYPE	( )
	MOVEI A,(A)		;MASK DIR #
	PUSH P,A		;SAVE DIR #
	CALL SPECEOL		;CHECK TERMINATOR & HANDLE EOL SPECIALLY
	HRRZ A,0(P)		;DIRNUM
	CALL PASWD		;INPUT AND CHECK PASSWORD (USES A)
	PUSH P,A		;SAVE PASSWORD STRING POINTER
	NOISE <Tenex job #>
	INHELP <
 Number if you have more than one job>
	ALLOW TALT+TSPC+TEOL
	CAIN CNT,2
	JRST [	MOVE B,.BFP
		ILDB B,B
		CAIN B,"-"
		JRST ATTAC5	;NULL INDICATED WITH "-"
		JRST .+1]
	TLO Z,BAKFF
	CALL DECIN
	JRST [	UALTYP [ASCIZ /-/] ;NULL. TYPE "-" ON ALT MODE.
		JRST ATTAC5]
	PUSH P,A		;SAVE JOB # INPUT BY USER

;ATTACH...
;CHECK THAT USER-GIVEN JOB # IS IN LEGAL RANGE
	SETO D,
	GTB 3			;MAX JOB # IS LENGTH OF SYS TABLE 3
	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 <Tenex job # must be between 0 and %1Q>

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

	GTB 1			;ENTRY NEG IF NO SUCH JOB
	JUMPL A,[UERR	[ASCIZ/No job %4Q/]]
	GTB 0			;LINE # OR NEGATIVE FOR DETACHED IN LH
	JUMPL A,ATAC4B
	HLRZ A,A		;TTY #
	ETYPE < [Attached to TTY%1O]>
	TLO KWV1,CONMAN		;REQUIRE CONFIRMATION IN THIS CASE
ATAC4B:	GTB 3			;LOGIN DIR NO IN RH
	MOVEI A,(A)		;MASK DIR NO UNDER WH THIS JOB IS LOGGED IN
	JUMPE A,[UERR [ASCIZ /Job %4Q not logged in/]]
	MOVE E,-2(P)		;DESIRED DIRECTORY #, FOR USE IN ERR MSG
	CAME A,E
	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 SYSTEM TABLE 3 FOR A MATCH
	MOVE E,-1(P)		;DIR # TO SEARCH FOR (USED IN ERR MSGS!)
	SETO D,
	GTB 3			;SYS TAB 3: BY JOB #, LOGIN DIR # IN RH.
	HRLZ D,A		;SET UP LENGTH,,INDEX FOR AOBJN & GTB.
ATA5A:	GTB 3
	MOVEI A,(A)		;MASK THIS JOB'S LOGIN DIR #
	CAME A,E
ATA5B:	JRST [	AOBJN D,ATA5A	;LOOP ENDTEST
		UERR [ASCIZ /No detached job logged in under %5R/]]
	GTB 0
	JUMPGE A,ATA5B		;IGNORE NON-DETACHED JOBS
				;FOUND ONE, SEE IF ITS THE ONLY ONE.
	MOVEI B,(D)
	PUSH P,B		;SAVE JOB # OF JOB FOUND
ATA5C:	AOBJP D,ATTAC7		;IF END OF TABLE, GO CONFIRM AND EXECUTE
	GTB 3
	MOVEI A,(A)
	CAME A,E
	JRST ATA5C
	GTB 0
	JUMPGE A,ATA5C		;IGNORE NON-DETACHED JOBS
	ERROR <Tenex job # required - %5R has more than one detached job>

;ATTACH...

ATTAC7:	CONFIRM
;EXECUTE THE COMMAND
;IF LOGGED IN, TYPE JOB # OF THIS JOB
	GJINF
	JUMPLE A,.+2
	ETYPE < Detaching job # %3Q
>
;ATTACH
	POP P,A			;TSS JOB # TO ATTACH TO
	POP P,C			;PASSWORD STRING POINTER
	POP P,B			;RH: DIR # TO ATTACH TO
				;B0 OFF SAYS DON'T STOP IT
	ATACH
	 CALL [	CAIN A,ATACX4
		UERR [ASCIZ /Incorrect password/]
		;NOTE THAT BAD PASSWORD IS DETECTED ABOVE
		;IF NOT LOGGED IN
		JRST JERR]
;THIS JOB CONTINUES RUNNING IF LOGGED IN.
	GJINF		;GET TSS JOB # IN A
	JUMPG A,CMDIN4		;LOGGED IN, GO GET NEXT COMMAND
;NOT LOGGED IN, ATACH FAILED TO KILL JOB, DO SO IN EXEC.
	SETO A,			;SAY SELF
	LGOUT			;KILL JOB
	 CALL JERR		;LGOUT FAILED

;AVAILABLE [LINES/DEVICES]

.AVAIL:	KEYWD $AVAIL
	 T LINES,,NOLOG+EOLOK,..TERM
	 JRST CERR
		;CAN'T CONFIRM HERE BECAUSE OF FUDGE-ENTRIES IN TABLE
	JRST (KWV)

$AVAIL:	TABLE
	T DEVICES,,NOLOG+EOLOK
	T LINES,,NOLOG+EOLOK,..TERM
	T T,,NSPALT+EOLOK+INVIS,<[UALTYP [ASCIZ /ERMINALS /]
				JRST ..TERM]>	;"T" = "TERMINALS"
	T TE,,NSPALT+EOLOK+INVIS,<[UALTYP [ASCIZ /RMINALS /]
				JRST ..TERM]>
	T TELETYPES,,EOLOK+INVIS,..TERM
	T TERMINALS,,EOLOK+INVIS,..TERM
	T TTYS,,EOLOK+INVIS,..TERM
	TEND

;AVAILABLE TERMINALS

..TERM:	CONFIRM
	SETO D,			;TABLE LENGTH
	GTB 4			;SYS TAB 4 IS LINE STATUS
	HRLZ D,A		;D IS AOBJN COUNT,,LINE #
		;TLZ Z,F1	;CLEAR TO SAY NOTHING PRINTED YET
TERMI1:	GTB 4			;GET A LINE'S STATUS.
	HLRZ A,A		;LEFT HALF OF TABLE WORD
	CAIE A,-1		;IS -1 FOR FREE LINES
	JRST TERMI9
	CALL BEFORE		;TYPE COMMA OR MAYBE EOL
		;TYPE <Line >;	;DESIREABLE?
	HRRZ B,D
	CALL TOCT		;TYPE LINE NUMBER
TERMI9:	AOBJN D,TERMI1
	TLNN Z,F1
	TYPE < All lines in use>
EOLRET:	PRINT EOL		;COME HERE TO TYPE CRLF AND POPJ.
	RET

;AVAILABLE DEVICES
;DOES NOT LIST TTYS OR ANY NON-ASSIGNABLE DEVICES
;THIS LEAVES DTAS, MTAS, PTP, PTR, AND ANY OTHER DEVICES ADDED LATER.
;ALSO LISTS SEPARATELY DEVICES ALREADY ASSIGNED TO THIS JOB.

.DEVIC:	CONFIRM
		;TLZ Z,F1	;SAY NOTHING TYPED YET
		;"DEVLUP" EXECUTES THE NEXT LOC FOR EACH DEVICE, WITH
	CALL DEVLUP		;...NAME IN A, DVCHR WORD IN B.
	 CALL [	JUMPGE C,[RET]	;DONE IF ASSIGNED WITH ASND.
		TLNN B,B3	;DONE IF NOT ASSIGNABLE
		RET
		LDB B,[POINT 9,B,17] ;EXTRACT DEVICE TYPE
		CAIN B,12	;EXCLUDE TTYS ALSO
		RET
		CALL BEFORE	;SEPARATING CHARACTER(S)
		JRST SIXPRT]	;PRINT SIXBIT NAME
	TLNE Z,F1
	PRINT EOL
	JRST ASTTJ		;LIST DEVS ASSIGNED TO THIS JOB. WITH FILSTAT.

;SUBROUTINE FOR FORMATTING A LIST OF ITEMS SEVERAL TO A LINE.
;USED FOR AVAILABLE TERMINALS, AVAILABLE DEVICES, FILSTAT, AND TRMSTAT
;BEFORE EACH ITEM: COMMA EXCEPT CRLF IF TOO FAR TO RIGHT.

BEFORE:	PUSH P,A
	PUSH P,B
	MOVE A,COJFN
	RFPOS
	MOVEI B,(B)		;MASK COLUMN POSITION
	CAIL B,^D65
	JRST [	PRINT EOL
		JRST .+3]
	TLOE Z,F1		;SUPPRESS COMMA BEFORE FIRST ONE
	PRINT ","
	PRINT " "		;SPACE AFTER COMMA OR EOL
	JRST [	POP P,B
		POP P,A
		RET]

;SUBROUTINE TO LOOP OVER ALL DEVICES FOR "AVAIL DEVICES" AND "FILSTAT".
;FOR EACH DEVICE, EXECUTES LOCATION AFTER CALL WITH SIXBIT NAME IN A
;    DEVICE CHARACTERISTICS WORD (A LA "DVCHR" EXCEPT B5) IN B,
;    -1 OR JOB # ASSIGNED TO IN C.
;RETURNS +2.
;DESTROYS A, B, C, D.

DEVLUP:	SETO D,
	GTB 6			;GET # DEVICES FROM TABLE 6
	HRLZ D,A		;AOBJN COUNT,,ABLE INDEX
DEVL1:	GTB 7			;DEVICE CHARACTERISTICS WORD (TABLE 7)
	MOVE B,A
	GTB 10			;GET JOB # ASS TO, OR -1, FROM LH TABLE 8
	HLRE C,A
	GTB 6			;GET DEVICE NAME IN SIXBIT FROM TABLE 6
	PUSH P,D
	XCT @-1(P)
	POP P,D
	AOBJN D,DEVL1
	JRST [	AOS (P)
		RET]

;TYPE SIXBIT SYMBOL FROM A.
;USED IN "AVAILABLE DEVICES", "SYSTAT", "STATISTICS", AND "FILSTAT".

SIXPRT::PUSH P,B
	PUSH P,C
	MOVE C,A
SIXPR1:	SETZ B,
	LSHC B,6
	ADDI B,40
	CALL CCHRO
	JUMPN C,SIXPR1
	JRST [	POP P,C
		POP P,B
		RET]

;BACKGROUND (fork) forkname (infile) oldfilespec (outfile) filespec (and) -

.BACKGROUND:
	NOISE <fork>
	MOVE A,FORK		;Get fork handle
	CALL GETFH		; default current fork (if any)

	ALLOW TALT+TSPC+TEOL+TLPR
	NOISE <infile>
	MOVEI A,[ASCIZ /INP/]
	CALL CINFN
	 JRST [	SETOM CJFN1
		MOVE A,BHC+1
		ADDM A,JBUFP
		JRST .+1]
	ALLOW TALT+TSPC+TEOL+TLPR
	NOISE <outfile>
	MOVEI A,[ASCIZ /OUT/]
	CALL COUTFN
	 JRST [	SETOM CJFN2
		JRST BACK1]
	TRNE CBT,TSPC
	PRINT " "

BACK1:	ALLOW TALT+TSPC+TEOL+TLPR
	NOISE <and>
	KEYWD $REDIR
	T -,,EOLOK,<[CMDIN4,,[RET]]>
	 JRST CERR
BACK2:	HRRZ A,0(KWV)	; BCONTINUE JOINS HERE
	CALL 0(A)

	CONFIRM

	MOVE A,CJFN1		;Open input file if necessary
	JUMPL A,.+3
	MOVEI B,1B19		;For read
	CALL $OPEN7
	MOVE A,CJFN2		;Open output file if necessary
	JUMPL A,.+3
	MOVEI B,1B20		;For write
	CALL $OPEN7

	NOINT			;While non-interruptable,
	MOVE A,FORK		;Change primary JFNs for background fork
	GPJFN			; to those specified..
	SKIPG CJFN1
FEATUR -%BAKTRP,<
	JRST .+4
>
FEATUR %BAKTRP,<
	JRST	[HRLI	A,(1B0)
		 PUSH	P,2
		 MOVEI	2,IJTBTS
		 TFORK
		  CALL	JERR
		 HLLI	A,
		 POP	P,2
		 JRST	.+4]>
	HLRZ C,B
	EXCH C,CJFN1
	HRLI B,(C)
	SKIPG CJFN2
FEATUR -%BAKTRP,<
	JRST .+4
>
FEATUR %BAKTRP,<
	JRST	[HRLI	A,(1B0)
		 PUSH	P,2
		 MOVEI	2,OJTBTS
		 TFORK
		  CALL	JERR
		 HLLI	A,
		 POP	P,2
		 JRST	.+4]>
	HRRZ C,B
	EXCH C,CJFN2
	HRRI B,(C)
	SPJFN
FEATUR %BAKTRP,<
	TLO	A,B0		; GET DEFERRED INTERRUPT MASK ALONG WITH
	RTIW			; TERMINAL INTERRUPT WORD
	MOVEM	B,FKTIW-.FH(A)	; SAVE IT
	MOVEM	C,FKDIM-.FH(A)	; AND THIS ONE TOO
	SETZB	B,C		; ZERO THEM OUT
	TLZ	A,B0
	STIW			; SHUT OFF TTY INTERRUPTS!
	HRLI	A,(1B0)
	MOVEI	B,PSIBTS
	TFORK			; TRAP APPROPRIATE PSI JSYSES
	 CALL	JERR
	HLLI	A,
>
	OKINT

	CALL RLJFNS		;Release stacked JFN's

	MOVSI B,FK%BAK+FK%KPT	;Mark fork background and kept
	IORM B,FKFLG-.FH(A)
	HLRZ A,0(KWV)
	JRST 0(A)

FEATUR %BAKTRP,<
OJTBTS:	1B9!1B16!1B24!1B33		; ERSTR,GTJFN,JFNS,DIRST
	1B5!1B7!1B24!1B26		; BOUT,SOUT,PBOUT,PSOUT
	1B9				; DEVST
	BLOCK 1
	1B0!1B4!1B8!1B11!1B13		; ODTIM,NOUT,ODTNC,FLOUT,DFOUT
	1B10!1B23			; CVHST,ESOUT
	1B4				; GPSGN
	BLOCK ^D8

IJTBTS:	1B16				; GTJFN
	1B4!1B6!1B23			; BIN,SIN,PBIN
	BLOCK 2
	1B1!1B5!1B9!1B10!1B12		; IDTIM,NIN,IDTNC,FLIN,DFIN
	BLOCK ^D10

PSIBTS:	BLOCK 2
	1B17!1B23		; AIC,ATI
	1B15!1B16		; RTIW,STIW
	BLOCK ^D11
>

; BCONTINUE (FORK) --
; SAME AS BACKGROUND (FORK) FORK (INFILE) - (OUTFILE) - (AND) CONTINUE

.BCONTINUE:
	MOVE	A,FORK
	CALL	GETFH
	ALLOW	TALT+TSPC+TEOL
	SETOM	CJFN1
	SETOM	CJFN2
	MOVE	A,BHC+1
	ADDM	A,JBUFP
	MOVE	A,$REDIR+1
	HLRZS	A
	MOVE	KWV,(A)
	JRST	BACK2

;BLANK (SCREEN)
;THIS ONLY WORKS ON SITES THAT HAVE REASONABLE TERM TYPE NUMBERS
;I THINK IT IS NOW INCONSISTANT SO IT WORKS AT SRI FOR TERMINAL
;TYPE 14 FOR THE DATA-MEDIAS AND AT ISI FOR THE HP'S.
;IT SHOULD BE STRAIGHTENED OUT LATER. BES

NOBBN <
.BLANK:	NOISE (screen)
	CONFIRM
BLANK1:	CALL GCTTY		;ONLY ON CONTROLLING TTY
	 RET
	GTTYP
	CAIL B,14
	CAILE B,26
	RET			;UNKNOWN BLANK SEQUENCE
	MOVE D,BPTRS-14(B)	;PICK UP SEQUENCE POINTER
	RFCOC
	PUSH P,B
	PUSH P,C
	MOVE B,[BYTE (2) 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2]
	MOVE C,[BYTE (2) 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2]
	SFCOC
BLANK2:	ILDB B,D
	CAIN B,377
	JRST BLANK3
	BOUT
	JRST BLANK2
BLANK3:	POP P,C
	POP P,B
	SFCOC
	RET

BPTRS:	POINT 8,[BYTE (8) 36,35,377]	;14 DM2500
	POINT 8,[BYTE (8) 377]	;15
	POINT 8,[BYTE (8) 33,"E",377] ;16 HP
	POINT 8,[BYTE (8) 14,377] ;17 C100
	POINT 8,[BYTE (8) 33,"H",33,"J",377] ;20 TL1061
	POINT 8,[BYTE (8) 377]	;21
	POINT 8,[BYTE (8) 33,"[","H",33,"[","J",377] ;22 VT100
	POINT 8,[BYTE (8) 33,"H",33,"J",377] ;23 H19
	POINT 8,[BYTE (8) 33,"H",33,"J",377] ;24 VT52
	POINT 8,[BYTE (8) 33,"[","H",33,"[","J",377] ;25 AMBASSADOR
	POINT 8,[BYTE (8) 177,220-176,377] ;26 IIMLAC
>

;BREAK (LINKS)

.BREAK:	NOISE <links>
BREAK1:	CONFIRM
	CALL GCTTY		;Check if there is a controlling tty
	 RET			;Noop if not
	NOINT
	HRLOI 1,(1B0+1B1)	;BREAK TO AND FROM CONTROLLING
	JRST BREAK3


BREAK2:	CALL GCTTY		;Get controlling tty
	 RET			;Noop if none
	NOINT			;BE SURE TO DO BOTH TLINK AND ADVIZ
	HRLOI 1,(1B0+1B1+1B4)	;BREAK TO AND FROM CONTROLLING
BREAK3:	MOVEI 2,-1		;ALL REMOTES, AND "REFUSE"
	TLINK
	 CALL JERR
	MOVSI 1,(1B0)		;BREAK ADVISE LINKS
	ADVIZ
	 CALL JERR
	OKINT
	RET

;CANCEL ALERT/MAILWATCH/PRINTERWATCH
;LATER: CANCEL ALERT (FORK TIME)

.CANCEL:
	KEYWD $CANCEL
FEATUR %ALERT,< TE ALERT,,,ALRTIM>
FEATUR -%ALERT,< 0>
	JRST CERR
	CONFIRM
	SETOM (KWV)
	RET

$CANCEL:TABLE
FEATUR %ALERT,< TE ALERT,,,ALRTIM>
FEATUR %DAEMON,< TE DAEMON,,,DAENAM>
	TE MAILWATCH,,,MSGTIM
	TE PRINTERWATCH,,,PRNTIM
	TEND


;CAPABILITIES AND CAPSTAT

.CAPSTAT:
.CAPABILITIES:
NOIAC <	RET >
IAC <	JRST	NIYE## >

;"CHANGE" COMMAND

.CHANGE:
	TRNE CBT,TEOL
	JRST C.ACT1		;DEFAULT TO ACCOUNT
	KEYWD $CHANG
	 TE ACCOUNT,,,C.ACCT
	JRST C.ACCT
	JRST 0(KWV)

$CHANG:	TABLE
	T ACCOUNT,,,C.ACCT
	T PASSWORD,,,C.PSWD
	TEND


;"CHANGE ACCOUNT (TO) ..."

C.ACCT:
	CAIN CNT,1
C.ACT1:	TLO Z,F1		;INDICATE LONG PROMPTING
;DETERMINE WHETHER LOGGED IN USER TAKES STRING OR NUMERIC ACCT
..ACNT:	GJINF			;LOGIN DIR # TO A
	MOVE B,A
	MOVE A,CSBUFP		;STRING BUFFER PTR
	DIRST			;CONVERT DIR # TO STRING
	 CALL SCREWUP
	MOVEI A,1
	MOVE B,CSBUFP
	STDIR			;CONVERT BACK TO # PLUS BITS
	 CALL SCREWUP
	 CALL SCREWUP
;NOW B1 OF A ON FOR STRING ACCT. FINISH INPUTTING COMMAND.
	TLNE Z,F1		;LONG PROMPTING MESSAGE?
	JRST [	TLNN A,B1
		$TYPE <(account # to) >
		TLNE A,B1
		$TYPE <(account to) >
		JRST C.ACT2]
	TLNN A,B1		;NOISE DEPENDS ON WHETHER USER TAKES...
	NOISE <# to>		;NUMERIC ACCOUNT,
	TLNE A,B1
	NOISE <to>		;OR STRING.
C.ACT2:	CALL ACCT		;INPUT, CHK, CNVT ACCT INTO A (USES A )
	CONFIRM
	CALL PIE.P		;SKIP IF PIESLICE SYSTEM
	 JRST C.ACT3
	PUSH P,A		;SAVE NEW ACCOUNT
	ADD P,BHC+10		;NO CHECK FOR POV _____
	MOVEI A,-7+0(P)		;WHERE TO PUT STRING ACCT
	SETO B,			;SAY THIS JOB
	GACTJ			;GET CURRENT ACCOUNT
	 CALL JERR
	ETYPE < Time used on account %1M: %B in %C>
	SUB P,BHC+10
	POP P,A			;NEW ACCOUNT
	JRST C.ACT4

C.ACT3:	ETYPE < Time used on previous acct: %B in %C>

C.ACT4:	SETZ B,			;NO SPECIAL FUNCTION BITS
	CACCT			;JSYS TO CHANGE ACCOUNT #
	 CALL JERR
	RET




;"CHANGE PASSWORD (OF DIRECTORY) ... (FROM) ... (TO) ... (TO) ... "

C.PSWD:	CALL BREAK2		;DO "BREAK" AND "REFUSE"
	CALL SPECEOL		;MAKE EOL FORCE NOISE
	NOISE <of directory>
	CALL DIRNAM		;INPUT AND CHECK DIRECTORY NAME
	PUSH P,A		;BITS,,# FROM STDIR
	PUSH P,B		;POINTER TO BUFFERED NAME STRING
	ALLOW TSPC+TALT+TEOL
	ALTYPE ( )
	CALL SPECEOL
	ANDI A,-1		;KEEP ONLY DIR NUM
	MOVNS A			;SPECIAL NOISE & CHECK IT
	CALL PASWD		;INPUT AND CHECK PASSWORD
	PUSH P,A		;SAVE POINTER TO IT
	ALLOW TSPC+TALT
	SETZ A,			;SAY DON'T CHECK PASSWORD
	CALL PASWD		;INPUT NEW PASSWORD
	PUSH P,[0]		;CRDIR BLOCK BEGINS HERE
	PUSH P,A		;SAVE POINTER TO IT
	ALLOW TALT+TSPC+TEOL
	ILDB B,A		;GET FIRST CHR OF NEW PASSWORD
	JUMPE B,CERR		;WILL BE HARD TO LOGIN IF PSWD IS NULL
	SETZ A,		;SAY DON'T CHECK PASSWORD
	CALL PASWD		;AND INPUT NEW PASSWORD (AGAIN)
	ALLOW TSPC+TALT+TEOL
	MOVE B,(P)		;POINTER TO FIRST COPY
	ILDB C,A		;GET A CHAR FROM 2ND STRING
	ILDB D,B		;AND ONE FROM 1ST STRING
	CAME C,D		;SAME?
	ERROR <Password copies do not agree>
	JUMPN C,.-4		;UNTIL NULL BYTE
	CONFIRM

C.PSW1:	MOVE 1,-3(P)		;POINTER TO OLD NAME
	MOVSI 2,(1B1)		;"SET PASSWORD" BIT
	HRRI 2,-1(P)		;PARAMETER BLOCK LOCATION (PARTIAL)
	MOVE 4,-2(P)		;NEW PASSWORD
	CRDIR
	 XJMP C.PSWT		;JUMP ON ITRAP
	SUB P,BHC+5		;FLUSH JUNK
	RET


;CRDIR TRAPS TO HERE

C.PSWT:	CAIN 1,CRDIX1
	 ERROR <Ownership rights required>
;THE FOLLOWING SHOULD REALLY SIMULATE A CALL TO JERR IF IT DID NOT
;TRAP (PC SHOULD POINT JUST AFTER CRDIR) BUT IF IT DID TRAP THEN
;THE FOLLOWING IS CORRECT (PC PICKED UP FROM LEV1PC)
	JRST ILITRP##

;CLEAR (DIRECTORY OF DEVICE) <DEVICE NAME>
;FORCED CONFIRMATION

.CLEAR:	NOISE <directory of device>
	CALL DEVN		;GET DEVICE DESIGNATOR (IN A)
	LDB D,[POINT 9,A,17]	;DEVICE TYPE
	CAIE D,3
	ERROR <Dectapes only>
	TLNN B,B5		;AVAILABLE?
	JRST [	TLNN B,B6	;ASSIGNED?
		UERR [ASCIZ /%1H: Not available/]
		UERR [ASCIZ /%1H: Assigned to job %3O/]]
	TLNN B,B8
	ERROR <%1H: Not mounted>
	CONFIRM
	INIDR			;INITIALIZE DIRECTORY (DESIGNATOR IN A)
	 CALL JERR
	RET

;CONNECT (TO DIRECTORY) <NAME> (PASSWORD) --
;(IF A WAY IS PROVIDED TO FIND OUT WHETHER A GIVEN DIRECTORY
; REQUIES A PASSWORD, MAKE IT REQUEST PASWD ON NEXT LINE (LIKE LOGIN)
; INSTEAD OF ASSUMING NULL IF NAME IS TERMINATED WITH CR BUT THIS
; DIRECTORY REQUIRES A PASSWORD).

.CONNE:
	GJINF			;GET DIRECTORY NUMBERS
	HRRZ D,B		;SAVE CONNECT DIRECTORY FROM USER
	TRNE CBT,TEOL		;EOL MEANS SKIP DIRNAM
	JRST CONNE1
	NOISE <to directory>
	CALL USER		;INPUT & CHECK DIRECTORY NAME
CONNE1:	CAIN D,(A)		;IF SAME AS CURRENT CONNECT DIRECTORY
	TLO Z,F1		; FLAG SO AS NOT TO PRINT DISK MISMATCH
	PUSH P,A		;DIR # ETC AS RETURNED BY "STDIR"
	ALTYPE ( )
	ALLOW TSPC+TALT+TEOL
;PASSWORD IS SECOND, OPTIONAL ARGUMENT
	HRROI A,[ASCIZ //]	;USE NULL IF OMITTED
	TRNE CBT,TEOL
	JRST CONNE4
	HRRZ A,0(P)		;DIRNUM FOR PASWD
	CALL PASWD		;INPUT & CHECK PASSWORD
CONNE4:	ALLOW TALT+TSPC+TEOL
	CONFIRM
	PUSH P,A		;SAVE TEXT PTR TO PASSWD
	CALL CHKDAL		;CHECK CURRENT DIRECTORY BEFORE LEAVING
	POP P,B
	HRRZ A,(P)		;DIRECTORY #
	CNDIR
	 CALL [	CAIN A,CNDIX1
		UERR [ASCIZ /Incorrect password/]
		JRST JERR]
	SUB P,BHC+1
	TLNE Z,F1		;Any change?
	RET			;No, done
	ETYPE < [From %4R]
>
	CALL CHKDAL		;CHECK NEW DIRECTORY
	RET

;CONTINUE
;RESUMES FROZEN INFERIOR FORKS
;DECODE AND CHECK SUBROUTINE ALSO USED BY REDIRECT/DETACH
;DECIDE WHICH FORK TO CHECK ON

; WHEN THIS ROUTINE IS CALLED, "FORK" SHOULD CONTAIN THE CURRENT FORK
; HANDLE OR A VALID FORK HANDLE.  IT SHOULD CONTAIN -1 ONLY IF THERE
; IS NO CURRENT FORK AND NO VALID FORK WAS SPECIFIED (ON TYPEIN)

$CONTI:	SKIPGE A,FORK		;HANDLE OF AN INFERIOR FORK
	ERROR <No current fork>	;NO INFERIOR TO CONTINUE
	CALL FNDFSB		;GET A POINTER IN STRUCTURE
	PUSH P,B		;SAVE IT
	CALL FTPFKB		;GET THE IMMEDIATE INFERIOR FOR IT
	HRRZ A,1(B)		;HANDLE
	MOVE C,0(P)		;Original pointer into structure
	JUMPE A,$CONT2		;NO HANDLE (DON'T THINK THIS CAN HAPPEN)
	MOVE B,FKFLG-.FH(A)	;FORK FLAGS
	TLNN B,FK%STD		;HAS IT BEEN STARTED?
	ERROR <Program hasn't been run>
FEATUR %BAKTRP,<
	SETCA	B,
	TLNE	B,FK%BAK!FK%TRP	; A TRAPPED BACKGROUND FORK?
	JRST	$CONT2
	ERROR	<Can't continue a trapped, background fork>
>
$CONT2:	HRRZ A,1(C)		;HANDLE
	RFSTS
	TLZ B,B0		;IGNORE FROZEN BIT
	HLRZ B,A		;STATUS
	CAIE B,4		;FORK WAIT?
	MOVEM C,0(P)		;HIGHEST FORK NOT IN FORK WAIT
	HLRZ C,1(C)		;SUPERIOR POINTER
	CAIE C,FKSTC		;THIS FORK BLOCK
	JRST $CONT2
	POP P,B			;BLOCK POINTER
	HRRZ A,1(B)		;FORK HANDLE
	MOVEM A,FORK
	RET

;FIND FORK STRUCTURE BLOCK
;A/ HANDLE OR NUMBER DESIRED
;RETURNS +1
; A/ HANDLE
; B/ POINTER TO BLOCK (GFRKS ENTRY)
; C/ SAME AS B

FNDFSB::CALL $GFRKS		;GET A STRUCTURE (START AT FKSTC)
	TRO A,.FH		;BE SURE OF HANDLE
	SETZ B,			;RETURN 0 IF NOT FOUND
	MOVEI C,FKSTC		;START OF SCAN
	CALL FNDFSP
	SKIPN C,B
	 CALL SCREWUP
	RET

;FIND FORK STRUCTURE FROM POINTER
;A/ HANDLE
;C/ POINTER TO STRUCTURE

FNDFSP:	PUSH P,C		;BLOCK WE ARE AT
	HRRZ D,1(C)
	CAIN D,(A)
	JRST [	POP P,B
		RET]		;FOUND IT RETURN POINTER
	HRRZ C,0(C)		;DO INFERIORS
	JUMPE C,FNDFS1		; IF ANY
	CALL FNDFSP
	JUMPN B,[ POP P,C
		RET]
FNDFS1:	POP P,C			;GET BACK POINTER
	HLRZ C,(C)		;DO PARALLELS
	JUMPN C,FNDFSP		;AT SAME LEVEL
	RET

;FIND TOP FORK (IMMEDIATE INFERIOR)
;POINTER IN A (ENTRY IS FTPFKA)
;POINTER IN B (ENTRY IS FTPFKB)
;POINTER RETURNED IN B

FTPFKA:	MOVE B,A
FTPFKB::HLRZ A,1(B)		;SUPERIOR POINTER
	CAIE A,FKSTC		;TOP FORK
	JRST FTPFKA
	RET

$GFRKS:	SKIPE FKSTCF
	RET			;ALREADY HAVE STRUCTURE
	PUSH P,A
	PUSH P,B
	MOVEI A,.FHSLF
	MOVEI B,FKSTC		;WHERE TO STORE IT
	GFRKS
	 ERJMP ILITRP##
	SETOM FKSTCF
	POP P,B
	POP P,A
	RET

;"CONTINUE" COMMAND DISPATCHES HERE

.CONTI:	CALL GFRKNM		;WHICH FORK
SCRC <
	SKIPG A,FORK		;IS THERE ONE TO CONTINUE NOW?
	 JRST .+3
	TRZ A,.FH		;MAKE FORK NUMBER FOR CIFORK
	MOVEM A,CIFORK
>;SCRC
	CALL $CONTI
	CONFIRM
;"REDIRECT/DETACH ... (AND) CONTINUE" JOINS HERE

..CONT:	SETOM A
	CALL MAPPF		;UNMAP ANY PAGE OF USER
	MOVE A,FORK		;FORK TO MANIPULATE
	RFSTS			;FIND OUT WHY IT STOPPED
	HLRZ C,A
	TRZ C,B0		;FLUSH FROZEN BIT
	MOVE A,FORK
	CAIE C,2		;FORK WAS HALTED OR FORCE TERM?
	CAIN C,3
	SFORK			;YES. START IT
	CALL IFORK		;TRACE UP STRUCTURE
	CALL SFKTTM##		;SET TTY STUFF
	TLO Z,RUNF		;SAY SO.
	JRST $WAIT		;GO RESUME FORK AND WAIT FOR IT

;"COPY" IS IN X2CMD.MAC.
; "CORRECT" IS IN SPLCOR.MAC

FEATUR %DAEMON,<;CONDITIONAL COMMANDS
;  ROUTINES FOR THE "DAEMON" FEATURE
;  .DAEMO IS THE COMMAND PROCESSOR FOR THE "DAEMON" COMMAND:
;        @DAEMON (FILE) DEMON.SAV (EVERY) N
;  WHERE N IS A NUMBER OF MINUTES.
;  CANCELING THE DAEMON IS IN THE CANCEL COMMAND
;	@CANCEL DAEMON
;  CKDAEM IS CALLED IN THE MAIN COMMAND RECOGNITION LOOP, AND STARTS
;    THE DAEMON IF IT'S TIME.
;  STDAEM IS CALLED TO START UP THE DAEMON.

STDAEM:	TIME			;FIRST SET UP NEXT TIME
	ADD 1,DAEINC
	MOVEM 1,DAENXT
	HRROI B,DAENAM		;THEN TRY TO OPEN IT
	CALL TRYGTJ
	 RET			;NOT THERE, TRY AGAIN LATER
	JRST ERUN2		;RUN EPHEMERAL RETURNS TO TOP OF COMMAND LOOP

CKDAEM:	SKIPG DAENAM
	RET			;NO DAEMON INITIATED
	TIME
	CAML 1,DAENXT
	JRST STDAEM		;IT'S TIME!
	RET

.DAEMO:	SKIPLE DAENAM
	ERROR <Daemon already initiated>
	CALL $GET1
	MOVE A,[^D300000]	;DEFAULT 5 MINUTES
	TRNE CBT,TEOL
	JRST DAEM1
	NOISE (every)
	CALL DECIN
	JRST [	UALTYP [ASCIZ /5/]
		MOVE A,[^D300000] ;5-MINUTES IN MILLS
		JRST DAEM1]
	JUMPLE A,CERR		;MUST BE POSITIVE
	IMULI A,^D60000		;CONVERT MINUTES TO MILLS
DAEM1:	CONFIRM
	MOVEM A,DAEINC
	MOVE B,CJFN1		;WE'VE GOT AN INCREMENT,
	HRROI A,DAENAM		;SO NOW WE CAN PUT NAME AWAY
	MOVE C,[2B2!1B5!1B8!1B11!1B35]
	JFNS
	CALL RLJFNS
	JRST STDAEM		;START IT UP RIGHT NOW
>;END CONDITIONAL COMMANDS

;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
	PRINT EOL
	RET

;DELETE <FILE GROUP>

.DELET:	MOVE A,BHC+2		;SAY DEFAULT NAME & EXT TO PREVIOUS
	HRLI B,-2		;DEFAULT VERSION TO LOWEST
	HRRI B,B2+B11+B15+B16	;OLD FILE, *'S AND COMMA OK
	CALL SPECFN		;INPUT FILE GROUP DESCRIPTOR
	 JRST CERR
	ALLOW TSPC+TALT+TEOL
	CONFIRM
	CALL FRSTF		;TYPE NAME IF A GROUP

DELET0:	HRRZ A,@INIFH1		;JFN
	DVCHR
	TLNN B,(1B4)		;DISK?
	 JRST DELET1		;NO
	HRRZ A,@INIFH1

DELET2:	MOVE B,[1,,FDBCTL]	;GET CONTROL BITS
	MOVEI C,C		;TO C
	CALL $GTFDB		;GET FDB OR DON'T SKIP
	 ERROR <DELET2: GTFDB error>
	TLNE C,(FDBUND)		;CHECK THE PERPETUAL BIT
	 JRST [	TYPE < Perpetual file -- cannot delete
>
		JRST NEXTF]	;DO NEXT FILE

DELET3:	MOVE B,[1,,FDBBCK]	;GET BACKUP WORD
	MOVEI C,C		;TO C
	CALL $GTFDB
	 ERROR <$GTFDB error>
	TLNE C,FDBARC		;ARCHIVE BIT
	 JRST [	TYPE < Archive-pending -- cannot delete
>
		JRST NEXTF]	;RETURNS TO FRSTF CALL +1

DELET1:	MOVE A,@INIFH1		;JFN(FLAGS TELL DELF WHETHER TO RELEASE)
	DELF
	 CALL [	CAIN A,DELFX1
		ERROR <Protection violation>
		JRST JERR]
	JRST NEXTF		;GET NEXT FILE IF GROUP, TYPE NAME,
				;RETURN TO WHERE FRSTF WAS CALLED.
				;GO TO RLJFNS IF NO MORE FILES.

;"DDT" COMMAND. LOAD DDT IN INFERIOR FORK IF NECESSARY,
;TRANSMIT SYMBOL TABLE POINTER, START DDT.

.DDT:

;DETERMINE WHETHER THERE IS INFERIOR FORK WITH SYMBOL TABLE POINTER
;IF NOT, USE DDT THAT ALREADY CONTAINS STENEX SYMBOLS.

	SETZ C,			;SAYS NO SYM TAB PTR
	SKIPGE A,FORK
	JRST DDT2		;NO FORK
	TRZ A,.FH		;MAKE FORK NUMBER
	JUMPE A,.EDDT		;IF FORK 0, GO TO EDDT
	MOVE B,FKFLG(A)
	TLNE B,FK%ACT		;Disallow if fork still active
	ERROR <%1F not suspended>
	TLNE B,FK%DDM		;DDT ALREADY LOADED?
	JRST DDT4

;THERE IS A FORK, SEE IF IT ALREADY CONTAINS SOMETHING THAT LOOKS
;LIKE A DDT.  IF SO, LEAVE IT, AS IT MAY CONTAIN BREAKPOINTS,
;MODIFIED SYM TAB PTR, ETC.

	MOVEI A,DDTORG		;DDT BEGINNING ADDRESS
	CALL MAPPF
	TLNN A,B5		;PAGE EXISTS?
	JRST DDT1		;NO, FORK DOESN'T HAVE DDT
	CALL LOADF		;YES, LOAD FIRST WORD
	CAME A,[JRST DDTORG+2]
	JRST DDT1
	MOVEI A,DDTORG+1
	CALL LOADF		;SECOND WORD IS 0,,PTR PTR
	CAIG A,-1
	CAIG A,DDTORG
	JRST DDT1
	JRST DDT3		;ALREADY HAVE ACCEPTABLE DDT
;FORK DOESN'T HAVE DDT, SEE IF IT HAS SYM TAB PTR

DDT1:	MOVEI A,.JBSYM		;WHERE LOADER LEAVES SYM TAB PTR
	CALL MAPPF		;MAP PAGE OF FORK
		;SETZ C,	;SAYS NO SYM TAB PTR
	TLNE A,B5		;NO PAGE?
	TLNN A,B2		;READ PROTECT?
	JRST DDT2		;NO USEABLE PTR
		;ANDI	A,777
	MOVE C,PAGEN(A)		;FETCH SYM TAB PTR WORD
		;IF NEGATIVE, IT WILL BE ASSUMED TO BE PTR
	MOVE D,PAGEN+1(A)	;.JBUSY IS .JBSYM+1
		;NO CHECKING NEEDED,  DDT WILL FIX IT UP.

;DDT...

DDT2:	PUSH P,C		;SAVE SYM TAB PTR OR 0
	PUSH P,D		;SAVE UNDEF SYM PTR
	MOVE B,[POINT 7,[ASCIZ /<SUBSYS>SDDT.SAV/]] ;DDT WITH SYMBOLS
	JUMPGE C,.+2		;SYM TAB PTR CANT BE .GE. 0
	MOVE B,[POINT 7,[ASCIZ /<SUBSYS>UDDT.SAV/]]
;LOAD SELECTED DDT
	CALL $GTJFN		;ASSIGN JFN FOR STRING PTR IN B
	CALL $MERGE		;MERGE IT INTO FORK, CREATE FORK IF NONE,
				;AND RELEASE JFN

;STORE SYMBOL TABLE POINTER

	POP P,D
	POP P,C
	JUMPGE C,DDT3		;NOT A SYMBOL TABLE POINTER
	MOVEI A,DDTSYM
	CALL MAPPF
	ANDI A,777
	HRRZ E,PAGEN+1(A)	;WHERE TO STORE UNDEF PTR
	HRRZ A,PAGEN(A)		;POINTER TO WHERE TO PUT POINTER
	CALL MAPPF
	ANDI A,777
	MOVEM C,PAGEN(A)	;STORE POINTER
	HRRZ A,E		;WHERE TO PUT UNDEF PTR IN DDT
	CALL MAPPF
	ANDI A,777
	MOVEM D,PAGEN(A)	;STORE IT
DDT3:	MOVE A,FORK		;FORK HANDLE
	TRZ A,.FH		;BECOMES FORK NUMBER
	MOVSI B,FK%DDM		;DDT LOADED FLAG
	IORM B,FKFLG(A)		;SAY DDT LOADED!!
;TRANSFER CONTROL TO DDT

DDT4:	MOVNI B,3		;CODE FOR PA1050 IF ANY
	CALL CHKPAT		;PA1050 RUNNING IN FORK?
	JUMPG B,GOTO2		;RETURNS RESTART ADDRESS IF YES
	MOVEI B,DDTORG		;DDT STARTS AT ITS FIRST LOCATION
	JRST GOTO2		;JOIN "GOTO" COMMAND: UNMAP PAGE, START FORK.

;DEASSIGN <DEVICE NAME>
;ACCEPTS LOGICAL OR REAL DEVICE NAME

.DEASS:	NOISE (device)
	CALL DEVN		;INPUT DEVICE NAME

;NOW HAVE DEVICE DESGNATOR IN A, CHARACTERISTICS WORD IN B.

	TLNN B,B6
	ERROR <%1H: Not assigned>
	TLNN B,B5
	ERROR <%1H: Not assigned to you>
	CONFIRM
	TLNE B,B8		;MOUNTED?
	TLNN B,B7		;MOUNTABLE?
	JRST .+3		;NOT MOUNTED OR NOT MOUNTABLE
	DSMNT			;REDUCES CHANCES OF CLOBBEREING NEXT
	 CALL JERR		;...USER'S DECTAPE.
	RELD
	 CALL JERR
	RET

;"DETACH" CODE IS WITH "REDIRECT" IN X2CMD.


;"DOWNTIME" COMMAND
; JUST OUTPUTS EVERYTHING FROM <SYSTEM>SCHEDULED.DOWNTIME TO COJFN
SRI <

.DOWNT:	HRROI	B,[ASCIZ /<SYSTEM>SCHEDULED.DOWNTIME/]
	CALL	TRYGTJ
	JRST	DWNTM4
	MOVEI	B,1B19
	CALL	$OPEN7
	CALL	TYPIT
	JRST	RLJFNS	;TYPED, GO RELEASE IT AND RETURN.

;  TYPE ALL OF FILE WHOSE JFN IS IN A, AND RETURN.

TYPIT:	PUSH	P,A	;STACK JFN OF OPEN FILE
	HRRZI	B,DWNTM2
	MOVEM	B,EOFDSP	;ARM EOF INT TO HERE
DWNTM1:	BIN
	MOVE	A,COJFN
	BOUT
	MOVE	A,(P)	;GET INFIL JFN
	JRST	DWNTM1
DWNTM2:	SUB	P,BHC+1	;FLUSH MY COPY OF JFN
	RET		;RETURN FROM TYPIT

DWNTM4:
	CALL	CRIF
	TYPE	<No downtime scheduled>
	JRST	RLJFNS
>

;EDIT (FILE) <FILE> [<EDITOR>]

;Fires up TECO, SOS, XED, and TV, at CCL entry with JFN of file
;specified in AC1, starts up POET in its funny manner (get DSR to fix it).
;The EDITOR to be used once set is remembered until it is reset.
;A pointer is kept in EDITOR which is saved until logout.
; THE DEFAULT FILE IS A RECENT VERSION OF THE LAST ONE MENTIONED
; IN AN "EDIT" COMMAND.  THE ACTUAL NAME OF THIS IS SAVED AWAY IN
; "EDFILE" SO THAT IT IS PRESERVED THROUGH RESETS.

.EDIT:	CALL CEDFN		;GET EDIT FILE NAME,DEFAULT=PREVIOUS
	 JRST EDIT7		;NO FILE SPECIFIED
	TRNE CBT,TSPC
	PRINT " "
	CAIN TRM,EOL
	JRST [	MOVEI TRM,SPACE
		MOVE CBT,CHRTBL(TRM)
		DPB TRM,BFP	;OVER THE EOL
		JRST .+1]
	PUSH P,A		;SAVE THE JFN FOR STARTING THE EDITOR
	DVCHR
	TLNE B,777
	ERROR <Disk files only!>
	CALL EDITR

	MOVE A,[EDFILE,,EDFILE+1]
	SETZM -1(A)		;CLEAR DEFAULT POINTERS WORD
	BLT A,EDFILE+EDFILL-1	;AND SAVED STRINGS

EDIT1:	HRROI A,EDFILE+1	;BEG OF STRING STORAGE
	MOVE B,0(P)		;EDIT JFN
	HRLZM A,EDFILE		;SET NAME HALF OF POINTER WORD
	MOVSI C,(1B8)		;OUTPUT NAME OF JFN
	JFNS
	IBP A			;INSERT A NULL
	HRROI A,1(A)		;BUMP TO NEXT WORD
	HRRM A,EDFILE		;SET EXT HALF OF POINTER WORD
	MOVSI C,(1B11)		;OUTPUT EXT OF JFN
	JFNS

EDIT2:	MOVE A,0(P)		;GET EDIT JFN AGAIN
	MOVE B,[1,,FDBCTL]
	MOVEI C,C		;INTO C
	CALL $GTFDB		;GTFDB OR DON'T SKIP
	 JRST CERR
	MOVEI B,1B20		;WRITE
	TLNE C,(FDBNXF)		;FIRST WRITE DONE
	TLOA Z,F1		;NO. SAY SO - SEE IF IT IS OK
	MOVEI B,1B19		;YES, THEN READ
	CALL $OPEN7		;7 BIT FANCY OPENER
	TLO A,(1B0)		;DONT RELEASE THE JFN
	CLOSF			;THE EDITOR WILL OPEN IT
	 CALL SCREWUP


EDIT3:
	MOVE A,EDITOR
	IMULI A,3
	MOVE B,EDITBL-3(A)	;POINTER TO EDITOR FILE
	CALL TRYGTJ
	ERROR <%2W not available>
	PUSH P,A

EDIT4:
	CALL $RESET		;FLUSH CURRENT FORK
	CALL ECFORK		;CREATE A FORK FOR EDITOR
	MOVE A,EDITOR
	IMULI A,3
	MOVE A,EDITBL-2(A)	;NAME OF EDITOR
	CALL FRKNAM
	 JFCL			;FORGET IT IF NAME IN USE
	MOVE A,CIFORK		;EDITOR FORK
	IMULI A,SFKBLK
	MOVE C,EDITOR
	IMULI C,3
	MOVE C,EDITBL-1(C)	;SIXBIT NAME OF EDITOR
	MOVEM C,FK.SNM(A)	;SIXBIT NAME
	POP P,A			;JFN!
	HRL A,FORK
	GET
	 ERJMP GETILI

EDIT5:
	MOVE A,EDITOR
	CAIN A,E.POET		;POET?
	SKIPN EDFILE		;AND A FILE?
	JRST .+2
	JRST EDPOET		;MUST HANDLE SPECIALLY
	MOVEI A,1		;AC1
	CALL MAPPF
	POP P,PAGEN+A		;JFN
	MOVE A,FORK
	MOVEI B,PAGEN
	SFACS
	JRST EDIT6

;UNTIL D. S. RUSSELL FIXES POET
	IFCRJP==767000		;SPECIAL LOCATION (READ)
	IFCWJP==767001		;WRITE JFN
	IFCTXT==767040		;BUFFER SPACE

EDPOET:
	MOVEI A,IFCRJP
	CALL MAPPF		;GET THE RIGHT PAGE
	HRROI A,PAGEN		;WINDOW
	ADDI A,<IFCTXT&777>	;DISPLACEMENT
	POP P,B			;JFN
	SETZ C,			;DEFAULT FORMAT
	JFNS			;PASS STRING
	TLZE Z,F1		;NEW FILE
	JRST [	SETZ A,
		HRROI B,IFCTXT
		JRST EDIT5A]	;YES. FORGET READ
	HRROI A,IFCTXT
	HRLOI B,500000		;NORMAL OVERWRITE
EDIT5A:
	MOVEI C,PAGEN
	MOVEM A,<IFCRJP&777>(C)
	MOVEM B,<IFCWJP&777>(C)
	CALL RLJFNS
	MOVE A,FORK

EDIT6:
	MOVE B,EDITOR
	SKIPE B,EDFILE		;EDFILE=0 IF NO FILE SPECIFIED
	MOVEI B,2		;CCL ENTRY
	JRST START1		;START IT UP


EDIT7:	SKIPN A,EDFILE		;IS THERE A SAVED FILE NAME.EXT?
	JRST EDIT9		;NO
	MOVE B,[CJFNBK,,CJFNBK+1]
	SETZM -1(B)
	BLT B,CJFNBK+10		;CLEAR DEFAULT BLOCK

	HLROM A,CJFNBK+4	;DEFAULT NAME
	HRROM A,CJFNBK+5	;DEFAULT EXTENTION
	MOVE B,[377777,,377777]
	MOVEM B,CJFNBK+1	;NO IO
	MOVSI C,100000
	MOVEM C,CJFNBK+0	;OLD FILE ONLY, NO CONFIRM

EDIT8:	MOVEI A,CJFNBK		;DEFAULT BLOCK PTR
	MOVEI B,0		;FORCE DEFAULTING
	GTJFN
	JRST CERR		;ANOTHER DIRECTORY OR DELETED
				;MAYBE SHOULD CLEAR EDFILE
	MOVE B,JBUFP
	PUSH B,A		;SAVE FOR RELEASING ON ERROR,ETC
	MOVEM B,JBUFP
EDIT9:
	PUSH P,A		;WHERE REST OF EDIT WANTS THE JFN
	CALL EDITR
	JRST EDIT3		;FILE KNOWN TO EXIST

EDITR:
	KEYWD $EDITR
	TE (,,NSPALT,-1)	;DEFAULT IS LAST EDITOR
	JRST CERR
	HRREI A,(KWV)
	JUMPGE A,EDITR1
	SKIPG A,EDITOR
	MOVEI A,DFEDIT		;DEFAULT EDITOR
	MOVEI B,-1(A)
	IMULI B,3
	UALTYP @EDITBL+1(B)
	ALTYPE ( )
EDITR1:
	PUSH P,A		;EDITOR NUMBER
	CONFIRM
	POP P,EDITOR
	RET

DEFINE EDITAB (EDITOR)<
$EDITR:	TABLE
IRP EDITOR,<
IFIDN <EDITOR><TECO>,<DFEDIT==.-$EDITR>
IFIDN <EDITOR><POET>,<E.POET==.-$EDITR>
	TE EDITOR,,,.-$EDITR>
	TEND

EDITBL:
IRP EDITOR,<
	POINT 7,[ASCIZ "<SUBSYS>'EDITOR'.SAV"]
	POINT 7,[ASCIZ "EDITOR"]
	SIXBIT /EDITOR/>
>

;EDITOR LIST -- MUST BE ALPHABETICAL
EDITAB <HTECO,POET,SOS,TECO,TVEDIT,XED>


;ENTRY (VECTOR LOCATION) <OCTAL> (LENGTH) <OCTAL>

.ENTRY:	SKIPGE FORK
	ERROR <No current fork>
	NOISE <vector location>
	CALL OCTAL
	 JRST CERR
	ALLOW TALT+TEOL+TSPC
	PUSH P,A
	MOVEI A,1		;DEFAULT LENGTH
	TRNE CBT,TEOL
	JRST ENTRY5
	NOISE <length>
	CALL OCTAL		;OCTAL TO ALLOW 254000 FOR COMPATIBILITY
	 JRST [	UALTYP [ASCIZ /1 /]		;NULL INPUT
		MOVEI A,1		;DEFAULT LENGTH AGAIN
		JRST .+1]
	ALLOW TALT+TEOL+TSPC
	CAIN A,1050		;ANOTHER NAME FOR 254000
	MOVEI A,(JRST)		;
	CAILE A,777		;TOO LONG?
	CAIN A,(JRST)		;10-50 ENTRY VECTOR ?
	JRST ENTRY5		;ENTRY VECTOR OK
	JRST CERR		; (?)
ENTRY5:	CONFIRM
	POP P,B		;LOCATION
	HRL B,A		;LENGTH
	MOVE A,FORK
	SEVEC
	RET

SCRC <
;"NOT AUTOKEEP"
.NOTAU:	TDZA 1,1
;"AUTOKEEP" TURNS ON THE FDBKEP BIT
.AUTOK:	 SETO 1,
	PUSH P,1
	PUSH P,[FDBKEP]
	JRST EPHEM1
>

;"NOT EPHEMERAL"  TURNS OFF FDBEPH BIT IN FDB

.NOTEP:	TDZA 1,1		;0 FOR USE IN CHFDB


;"EPHEMERAL" TURNS ON THE FDBEPH BIT

.EPHEM:	SETOM 1			;1 FOR USE IN CHFDB
	PUSH P,1
	PUSH P,[FDBEPH]
EPHEM1:	CALL $GET1		;GET A PROGRAM JFN, LIKE "GET" OR "RUN"
	ALLOW TSPC+TALT+TEOL
	CONFIRM
	MOVE 1,CJFN1		;JFN OF THE NAMED FILE
	DVCHR
	TLNN 2,(1B4)
	 ERROR <%1H doesn't have ephemerons>
	HRR 1,CJFN1
	HRLI A,FDBCTL		;FDB CONTROL BITS WORD
	POP P,2
	POP P,3
	CHFDB
	JRST RLJFNS		;RELEASE JFN AND RETURN

; ERSTR (ERROR NUMBER) N - TYPES ERROR MESSAGE FOR N.
;

.ERSTR:	NOISE (error number)
	CALL OCTAL
	 JRST ERSTR1
	SKIPA B,A
ERSTR1:	MOVEI B,-1		;USE LAST ERROR
	CONFIRM
	MOVE A,COJFN
	HRLI B,.FHSLF		;USE EXEC LAST ERROR
	SKIPL FORK		;UNLESS THERE IS A FORK
	HRL B,FORK		;THEN USE IT
	MOVEI C,0
	PRINT " "
	ERSTR
	 ERROR <Undefined error number.>
	 CALL SCREWUP
	RET


;  NAME (OF USER NUMBER) N     - TYPES DIRECTORY NAME.
;

.XNAME:	NOISE (of user number)
	CALL OCTAL
	 JRST CERR
	CONFIRM
	PRINT " "
	MOVE B,A
	MOVE A,COJFN
	CALL $DIRST
	 ERROR <non-existent.>
	RET

   SRI	<
.CT:	NOISE (^T for job # )
	CALL DECIN
	 JRST CERR
	JRST JCPUTL		; LET IT DO THE RETURN TO MAIN.
>

FEATUR %SCHED,<
.SCHED:
	NOISE (priority word is)
	KEYWD $SCHED
	 0
	 JRST CERR
	ALLOW TALT+TEOL
	CONFIRM
	SETO A,		; POINT TO THIS JOB ONLY
	HRRE B,KWV	; PICK UP VALUE TO TELL SCHEDULER
	SKIPL B
	MOVSI B,(1.0)	; NORMAL VALUE IS FLOATING 1.0
	JSYS 606	; PERFORM SKUSR JSYS.
	RET

$SCHED: TABLE
	TE BATCH,,,-1
	TE NORMAL,,,0
	TEND
>

;'EXEC' - STARTS AN EXEC IN INFERIOR FORK SEPARATE FROM 'FORK'

.EXEC:	ALLOW TSPC+TEOL+TALT
NOSCRC <HRROI B,MFSAV		;ASCIZ "<DIR>MFEXEC.SAV">
SCRC <	HRROI B,[ASCIZ /<SYSTEM>EXEC.SAV/]>
	CALL TRYGTJ		;GTJFN AND SAVE IT
	 ERROR <MFEXEC not available>
	CONFIRM
	JRST ERUN2		;HANDLE AS AN EPHEMERON


;OEXEC -- RUN OLD EXEC IN THIS FORK SPACE
; REPLACES SELF WITH SPECIAL FILE

.OEXEC:	HRROI B,[ASCIZ /<SYSTEM>EXEC.SAV/] ;
OEXEC0:	CALL TRYGTJ		;
	 ERROR <Not available>
	MOVE B,[44B5+5B21+1B25]	;36-Bit, Read, XCT, and Thawed
	CALL $OPENF		;Try to open it before DIR

OEXEC1:	MOVE 0,CJFN1		;
FEATUR %IIT,<
	MOVEI A,.FHSLF		;
	MOVSI B,(1B14)		;TIME CHANNEL
	SETZ C,			;CLEAR
	IIT			;CLEAR IT OUT
>
	MOVEI A,.FHSLF		;
	DIR			;
	MOVE B,PRIMRY
	SPJFN			;RESTORE PRIMARY JFN'S TO ENTRY VALUES
	MOVE 1,[OEXBLT,,OEXACS]	;
	BLT 1,OEXACE		;SETUP AC CODE
	SETO 1,			;
	MOVSI 2,.FHSLF		;
	SETZ 3,			;
	MOVSI 4,-1000		;
	JRST OEXACS		;

OEXBLT:	PHASE 5
OEXACS:!HRRI 2,(4)		;UPDATE PAGE NUMBER
	PMAP
	AOBJN 4,OEXACS		;
	MOVSI 1,.FHSLF		;
	HRR 1,0			;FORM FORK,,JFN
	GET			;
	RESET			;
	MOVEI 1,.FHSLF		;
	GEVEC			;
OEXACE:!JRST 0(2)		;
	DEPHASE

;EXPUNGE (DELETED FILES)

.EXPUN:	KEYWD $EXPUN
	T DELETED,,EOLOK+LPROK,..EXDL
	 JRST CERR
	 JRST (KWV)

$EXPUN:	TABLE
	T ALL,,EOLOK+LPROK,..EXAL
	T DELETED,,EOLOK+LPROK,..EXDL
IAC <	T NON-EXISTENT,,EOLOK+LPROK,..EXNE >
NOIAC <	T PERMANENT,WHEEL+OPER+ENAREQ,CONMAN+EOLOK+LPROK,..EXPE >
	T SCRATCH,,EOLOK+LPROK,..EXSC
	T TEMPORARY,,EOLOK+LPROK,..EXTM
	TEND


..EXAL:	NOISE <deleted, scratch, and temporary files>
	HRLZI A,(1B12!1B13!1B15!1B16)
	JRST ..EXPU

..EXDL:	NOISE <files> 
	HRLZI A,(1B12!1B13)
	JRST ..EXPU

..EXPE:	NOISE <files>
	HRLZI A,(1B14)
	JRST ..EXPU

..EXSC:	NOISE <files>
	HRLZI A,(1B15)
	JRST ..EXPU

..EXTM:	NOISE <files>
	HRLZI A,(1B16)
IAC <	JRST	..EXPU

..EXNE:	NOISE	<files only>
	HRLZI	A,(1B12)
>

..EXPU:	PUSH P,A
	ALLOW TSPC+TALT+TEOL
	CONFIRM
	MOVEI A,0		;Get pages used for connected dir
	GTDAL
	EXCH B,0(P)
	PUSH P,B
	GJINF
	POP P,A			;GET LEFT HALF BITS
	HRR A,B
	DELDF

	MOVEI A,0
	GTDAL
	POP P,A
	SUB A,B

	SKIPN A
	TYPE < [No>
	SKIPLE A
	ETYPE < [%1Q>
	TYPE < page>
	CAIE A,1
	PRINT "s"
	TYPE < freed]
>
	RET

; FCONTINUE <fork> = FOREGROUND <fork> / CONTINUE <fork>

.FCONTINUE:
	CALL	.FOREGROUND
	CALL	$CONTI
	JRST	..CONT


;FOREGROUND <fork>

.FOREGROUND:
	NOISE <fork>
	SETO A,			;Get fork handle..
	CALL GETFH		; no default
	MOVE B,FKFLG-.FH(A)	;Test state of fork..
	TLNN B,FK%BAK
	ERROR <Fork not background>
	TLNE B,FK%ACT
	ERROR <Fork not suspended>
	CONFIRM
	MOVSI B,FK%BAK		;Mark fork no longer background
	ANDCAM B,FKFLG-.FH(A)
	NOINT			;While non-interruptable,
	CALL RLPJFN		;Return primary JFNs for fork
	MOVEI A,.FHSLF		; to those of MFEXEC..
	GPJFN
	MOVE A,FORK
	SPJFN
	OKINT
	RET

;FORK <FORK NAME/OCTAL FORK HANDLE>
;SETS FORK ACCESSED BY START, REENTER, GOTO, /, \, TEN50 DDT, SAVE.

.FORK:	MOVEI A,.FHSLF
	RPCAP
	MOVSI A,(FH%MF)
	TRNE C,WHEEL+OPER
	IORM A,PSPRIV
	SETO A,			;Get fork handle..
	CALL GETFH		; no default
	ALLOW TALT+TSPC+TEOL
	CONFIRM
	TRZ A,.FH		;MAKE FORK NUMBER FOR CIFORK
	MOVEM A,CIFORK
	RET

;GETFH - GET A HANDLE ON A FORK THAT EXISTS
; A/ fork handle default specification;
;     >0 fork handle, =0 unspecified default, <0 no default
; PSPRIV/ bit FH%ALL to allow handle "*", bit FH%MF to allow handle "MF"
;	CALL GETFK
; RET +1; always,
;  A/ fork handle (also stored in FORK), OR
;     .FHINF if * entered (FORK unchanged), OR
;     0 if unspecified default (FORK unchanged)

GETFH:	TLNN Z,BAKFF		;If BAKFF, input string
	TRNN CBT,TEOL		;If command line ended, use default..
	JRST GETFH0
	JUMPL A,CERR		; Command error if no default
	RET

GETFH0:	PUSH P,A
	PUSH P,B
	PUSH P,C
	MOVEI A,FKNMT
	MOVSI B,(FH%ALL)	;CHECK FOR EXTRA HELP MESSAGE
	TDNN B,PSPRIV
	TDZA B,B
	HRROI B,[ASCIZ / * (for all forks)
/]
	INHELP <
%1Z%%2W% Fork number>
	MOVE A,.BFP
	ILDB B,A
	CAIN B,"*"
	JRST [	MOVE A,PSPRIV
		TLNE A,(FH%ALL)	;OK TO SAY "ALL"
		CAILE CNT,2	;YES. DID I?
		 JRST CERR	;NO
		MOVEI A,.FHINF
		JRST GETFH3]
	TLO Z,BAKFF
	KEYWD FKNMT
	TE (,,NSPALT,777777)
	 JRST GETFH1
	HRREI A,(KWV)
	JUMPGE A,GETFH2
	SKIPGE A,-2(P)		;Default allowed?
	JRST CERR		; no
	JUMPE A,GETFH3		;Unspecified default gets quick return
	CAIG CNT,1		;Solitary altmode displays fork handle
	CALL ALTFRK
	JRST GETFH2

GETFH1:	CALL OCTAL
	 CALL CERR
	TRZ A,.FH
	MOVEI B,NFKS-1
	CAIL A,0
	CAILE A,(B)
	 ERROR <Fork number must be between 1 and %2O%>
GETFH2:	MOVSI B,(FH%MF)
	TDNN B,PSPRIV
	JUMPE A,CERR
	TRO A,.FH
	PUSH P,A
	RFSTS
	TLNE A,077700		;IS HANDLE VALID?
	ERROR <No such fork>
	POP P,A
	MOVEM A,FORK
GETFH3:	POP P,C
	POP P,B
	SUB P,BHC+1
	RET


ALTFRK:	CAIE TRM,ALTM
	RET
	PUSH P,A
	PUSH P,B
	TRZ A,.FH		;Make fork index
	MOVE B,FKFLG(A)
	TLNN B,FK%NAM
	JRST [	$TYPE <- >
		JRST ALTFK1]
	IMULI A,SYMLTH
	U$TYPE FKNAM(A)
	$TYPE < >
ALTFK1:	POP P,B
	POP P,A
	RET

;GFRKNM - SUBROUTINE TO ACCEPT FORK NAME OR NUMBER WITH AN INTELLIGENT
; DEFAULT
;  USED BY CONTINUE, REENTER AND START

GFRKNM:	SKIPGE A,FORK		;Get fork handle..
	SKIPL A,LFORK		; default current fork,
	CAIA			; if none, default last run fork,
	SETZ A,			; if none, unspecified default
	CALL GETFH
	SKIPE A			;Unspecified default?
	RET
	CALL $GFRKS		;Yes, interrogate fork structure..
	HRRZ B,FKSTC		;INFERIOR POINTER
	SKIPN B
	ERROR <No program>
	HLRZ C,0(B)		;PARALLELS
	SKIPE C			;ANY?
	RET			;YES. LEAVE FORK -1
	HRRZ A,1(B)		;ONLY ONE INFERIOR, USE IT.
	MOVEM A,FORK
	RET

;MERGE <FILE> COMMAND.
;GETS A FILE INTO CURRENT FORK WITHOUT RESETTING.
;PUTS BACK ENTRY VECTOR WORD THAT WAS THERE BEFORE COMMAND

.MERGE:	CALL $GET1		;INPUT PROGRAM NAME
	ALLOW TSPC+TEOL+TALT
	CONFIRM

;SUBROUTINE ENTRY FOR "DDT" COMMAND. JFN IN CJFN1.
$MERGE:	SKIPGE A,FORK		;SKIP IF EXEC HAS INFERIOR FORK
	JRST $GET2		;CREATE FORK, GET PROG, USE ITS ENTRY.
	GEVEC			;ALREADY HAVE A FORK
	PUSH P,B		;SAVE SAME
	CALL $GET2		;GET PROGRAM
	POP P,B			;PREVIOUS ENTRY VECTOR
	MOVE A,FORK		;FORK HANDLE AGAIN
	JUMPE B,.+2		;JUMP IF THERE WAS NO ENTRY VECTOR WD
	SEVEC			;SET ENTRY VECTOR TO OLD VALUE
	RET

;NEW and OLD only have command table entries at ISI and ECL

.NEW:	NOISE <file>
	MOVEI A,[ASCIZ "NEWSYS"]
	CALL $GET12
	JRST SRUN		;HANDLE AS SUBSYS

.OLD:	NOISE <file>
	MOVEI A,[ASCIZ "OLDSYS"]
	CALL $GET12
	JRST SRUN		;HANDLE AS SUBSYS


SRUN:	CAIE TRM,ALTM		;NO CONFIRM IF OTHER THAN ALTMODE
	TLO KWV1,PROGX
	MOVE A,CJFN1		;FILE TO "RUN"
	DVCHR
	TLNE A,177777		;ON DISK?
	 JRST RUN1		;NO JUST RUN IT
	MOVE A,CJFN1		;GET FILE AGAIN
	MOVE B,[1,,FDBCTL]	;CONTROL WORD
	MOVEI C,C		;TO C
	CALL $GTFDB		;GTFDB OR DON'T SKIP
	 JRST CERR##		;DOESN'T EXIST FOR THIS USER
SCRC <
	TLNE C,(FDBKEP)		;AUTO KEEP?
	 TLO Z,F2		;YES, REMEMBER THAT
>;SCRC
	TLNN C,(FDBEPH)		;IS THE FILE AN EPHEMERON?
	 JRST RUN1
	ALTYPE <(;E) >
	JRST ERUN1		;RUN AS EPHEMERON



.ERUN:	NOISE (file)
	MOVEI A,[ASCIZ "SUBSYS"]
	TLO Z,F3
	CALL $GET12		;GET FILENAME AND HANDLE ERRORS
	CALL DIRNOI

ERUN1:	ALLOW TSPC+TEOL+TALT+TCOM
	CONFIRM
ERUN2:	CALL ERUN3
	JRST ..STRT
ERUN3:	SETOM FORK		;TELL GET TO GET A NEW FORK
	CALL $GET2
	MOVE A,FORK
	MOVSI B,FK%EPH
	IORM B,FKFLG-.FH(A)	;SAY ITS AN EPHEMERAL
	RET

ERUNB:	PUSH P,B
	CALL ERUN3
	POP P,B
	JRST START1


;SUBROUTINE TO INPUT A PROGRAM NAME.
;FIRST PART OF GET, RUN, MERGE.
$GET1:	NOISE (file)
$GET11:	SETZ A,			;SAY DEFAULT TO CONNECTED DIRECTORY
$GET12:	PUSH P,A		;SAVE DIRECTORY DEFAULT
	CALL CPFN		;INPUT PROGRAM NAME AND ASSIGN JFN
	 JRST [	TRNE CBT,TEOL	;FAIL.
		JRST CERR	;AFTER CR TYPE "?" AND ABORT COMMAND.
		UTYPE [ASCIZ /? /] ;OTHER TERMINATORS, " ? " AND RETRY.
		MOVE BFP,.BFP	;BACK UP COMMAND BUFFER POINTER
		BTCHER		;STOP IF NON-INTERACTIVE
		POP P,A
		JRST $GET12]	;GO RETRY.
	POP P,A
	RET

;RUN <FILE> COMMAND = GET + START

.RUN:	CALL .GET
	JRST ..STRT

;<SUBSYS NAME> JOINS HERE
RUN1:	CALL GET1
SCRC <
	TLZN Z,F2		;KEEP THIS ONE?
	 JRST ..STRT		;NO - START IT NOW
	MOVE A,FORK		;YES - MARK IT
	TRZ A,.FH
	MOVSI B,FK%KPT
	IORB B,FKFLG(A)
	TYPE <[Keeping>
	TLNN B,FK%NAM
	 ETYPE < as %1O>
	TYPE <]
>
>;SCRC
	JRST ..STRT


;GET <FILE> COMMAND.
;RESETS THEN CREATES ONE FORK AND GETS PROGRAM INTO IT.
;CODED IN SUBROUTINES SO CODE CAN BE SHARED WITH "MERGE".

.GET:	CALL $GET1		;INPUT PROGRAM NAME

GET1:	ALLOW TSPC+TEOL+TALT
	CONFIRM
	CALL $RESET		;CLOSE FILES, KILL CURRENT INF. FORK
				;NOW FALL INTO $GET2, WHICH WILL RETURN
				;TO COMMAND INPUT FOR "GET" BECAUSE
				;DISPATCH WAS WITH "PUSHJ".

;GET...
;SUBROUTINE TO GET A PROGRAM INTO CURRENT FORK, FOR GET, RUN, AND MERGE.
;AT ENTRY CJFN1 MUST CONTAIN JFN OF FILE TO GET.

$GET2:	SKIPL FORK		;IS THERE A FORK?
	JRST GET2B		;YES (HAPPENS FOR "MERGE")
	CALL ECFORK		;CREATE A FORK

;Put program name in fork block and table for SETNM and commands.
	MOVE B,CJFN1
	CALL SUBNAM
GET2B:
	MOVE A,FORK
	TRZ A,.FH
	MOVSI B,FK%PRO
	ANDCAM B,FKFLG(A)	;"PROPRIETARY" BIT MAY BE SET IF
				;APPROPRIATE
	HRRZ A,CJFN1		;TRY TO OPEN THE FILE BEFORE THE GET
	MOVE B,[44B5+5B21+1B25]	; IN ORDER TO DETECT PROTECTION ERRORS
	CALL $OPENF
	HRL A,FORK
	GET
	 ERJMP GETILI
	CALL RLJFNS		;RELEASE JFNS
	RET



;ILLEG INST TRAP DURING GET JSYS
;TYPE EXEC ERROR MESSAGES FOR CERTAIN ERRORS

GETILI:	CALL LSTERR
	CAIN A,GETX1
	ERROR <Bad core save file format>
	CAIN A,GETX2
	ERROR <System special pages table full>
	JRST ILITRP##		;OTHER ERRORS TREATED IN GENERAL MANNER

LSTERR::PUSH P,B
	MOVEI A,.FHSLF
	CALL $GETER##
	MOVE A,B
	POP P,B
	RET

;THE FOLLOWING CODE WAS PROVIDED BY SUMEX.  B.E.S.  MARCH 77

DIRNOI:	TLNE Z,F3		;WAS SEARCH PATH INVOKED?
	CAIE TRM,33		;AND ALTMODE TERMINATED?
	RET			;NO, NO NAME

	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	MOVE A,CSBUFP		;PLACE TO STORE STRING
	MOVE B,CJFN1		;PROGRAM JFN
	MOVE C,[1B5+1B35]	;DIRECTORY NAME WITH PUNCUATION
	JFNS
	MOVE C,CSBUFP		;
	MOVE D,[POINT 7,[ASCIZ /<SUBSYS>/]] ;
DIRNO1:	ILDB A,C		;COMPARE THE TWO STRINGS
	ILDB B,D		;
	CAMN A,B		;
	JUMPN B,DIRNO1		;KEEP GOING TO END OF STRING
	JUMPE B,DIRNO2		;SUBSYS, DON'T SHOW DIR
	PRINT "("		;SHOW LIKE NOISE
	MOVE A,CSBUFP		;
	CALL CTYPE		;TYPE STRING
	TYPE <) >		;
DIRNO2:	POP P,D
	POP P,C
	POP P,B
	POP P,A
	RET

;ECFORK -- Create fork TTY block.  Put fork handle in FORK
; (also CIFORK if no current fork)
;Returns +1 always
;1/ Fork number

ECFORK:
	MOVEI A,0		;NO OPTIONS
	CFORK
	 CALL [	CAIN A,CFRKX3
		ERROR <No forks available>
		CAIN A,FRKHX6
		ERROR <No fork handles available>
		JRST JERR]
	FFORK
	MOVEM A,FORK
	TRZ A,.FH		;MAKE FORK NUMBER
	SKIPGE CIFORK		;CURRENT EXIST?
	MOVEM A,CIFORK		;NO -- THIS WILL BE CURRENT
	SETZM FKSTCF		;INVALIDATE STRUCTURE
	IMULI A,SFKBLK		;COMPUTE OFFSET
	MOVSI B,FKBLK+IFKBLK	;INITIAL PROGRAM BLOCK
	HRRI B,FKBLK(A)
	BLT B,FKBLK+SFKBLK-1(A)
	MOVE A,FORK
	HRLOI B,777000		;PRIV. TO XMIT, INC. USER
	SKIPE C,PRVENF		;IF ENABLED
	MOVE C,B		;ENABLE FORK.
	EPCAP
	TRZ A,.FH		;RETURN FORK NUMBER IN A
	MOVSI B,FK%BLK		;FORK BLOCK SETUP
	MOVEM B,FKFLG(A)	;INITIAL STATE
	RET

;SUBNAM
;SUBR THAT CONVERTS JFN IN B TO APPROPRIATE SUBSYSTEM NAME WORD
;  FOR "SETNM" JSYS.
;TRANSPARENT, ONE USE IN "GET" CODE.

SUBNAM:
	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSH P,CSBUFP
	MOVE A,CSBUFP		;GET STRING FOR JFN IN B
	MOVSI C,(1B8)		;NAME ONLY
	JFNS

;Use this name to identify this fork in the local tables.

	MOVE A,CSBUFP
	CALL FRKNAM
	 JFCL			;Don't worry about failure

;Convert name to sixbit for SETNM

SUBN4:	SETZ A,
	MOVE B,[POINT 6,A,-1]
	MOVEI D,6
SUBN4A:	ILDB C,CSBUFP
	JUMPE C,SUBN5		;END OF NAME, DONE
	TRC C,40		;CONVERT TO SIXBIT
	IDPB C,B
	SOJG D,SUBN4A		;ALSO STOP AT 6 CHARS
SUBN5:	MOVE B,FORK
	TRZ B,.FH
	MOVE C,FKFLG(B)
	IMULI B,SFKBLK
	TLNE C,FK%BLK
	MOVEM A,FK.SNM(B)	;STORE SIXBIT NAME IN BLOCK
	POP P,CSBUFP
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	RET

;GOTO <OCTAL #>

.GOTO:
	CALL OCTAL
	 JRST CERR
	ALLOW TSPC+TALT+TEOL
	SKIPGE FORK		;CHECK FORK HANDLE
	ERROR <No current fork>
	MOVE B,A
	CALL MAPPF		;MAP PAGE CONTAINING ADDRESS. GETS ACCESS.
	TLNN A,B5
	ERROR <No such page>
	TLNN A,B4
	ERROR <Can't execute that page>
	CONFIRM
	CALL CHKPAT		;SETUP STUFF FOR PA1050 IF LOADED

;START FORK AT ADDRESS IN B
;"DDT" JOINS HERE

GOTO2:	SETO A,
	CALL MAPPF		;UNSHARE MAPPED PAGE, IF ANY
	MOVE A,FORK
	TLNN B,1		;DON'T START IF LH NON-0
	SFORK			;START FORK (USES A AND B)
	CALL IFORK		;PREPARE FORK(S) AND SETUP LFORK
	CALL SFKTTM##
	TLO Z,RUNF		;SAY PROGRAM'S TELETYPE MODES ARE IN EFFECT
	JRST $WAIT		;WAIT FOR IT TO TERMINATE

;HERALD (CHARACTER IS) <CHARACTER> [CONFIRM]

.HERALD:
	ALTYPE <(character is) >;;CAN'T ALLOW NOISE HERE
	MOVE .BFP,BFP
	SETZ CNT,
	CALL ALLBK		;ALL CHARACTERS BREAK
HRLD1:	CALL CCHRI		;GET A CHARACTER
	TLNN Z,CTRLVF		;IF NOT CONTROL-V'ED
	CAIE CHR,"?"		;AND IS A QUESTION MARK
	JRST HRLD2
	ETYPE < New herald%Y>;;GIVE HELP.
	JRST HRLD1
HRLD2:	TRNN CBT,HERCHR
	JRST CERR		;ILLEGAL CHARACTER
	PUSH P,CHR		;SAVE IT FROM CONFIRM
	TYPE < [Confirm]>
	CONFIRM
	POP P,A			;OK, RESTORE HERALD CHARACTER
	SKIPN PRVENF		;CHANGE THE CURRENT HERALD
	HRRM A,HERALD
	SKIPE PRVENF
	HRLM A,HERALD
	RET

; "BDDT" COMMAND AND "NO BDDT" COMMANDS

;F1 IS CLEARED BY MAIN DISPATCH (TO .BDDT) AND SET BY "NO"

.BDDT:	TLNE Z,F1		;"NO BDDT" COMMAND?
	 JRST .NOBD
	SKIPN CIFORK		;MFEXEC FORK?
	SETOM CIFORK		;ASSUME NO FORK
	SETOM A
	CALL MAPPF		;UNMAP ANY INFERIOR PAGE
	CALL CDBGFK		;CREATE DEBUGGER AND/OR USER FORKS
	 JRST BDDT5		;ALREADY EXISTS
	MOVSI B,FK%BDD		;BDDT FLAG
	IORM B,FKFLG(A)		;FORK NUMBER IN A
	MOVE A,[POINT 7,[ASCIZ "BDDT"]]
	CALL FRKNAM
	 JFCL
	HRROI 2,[ASCIZ /<SUBSYS>BDDT.SAV/]
	MOVE 3,['BDDT  ']
	CALL LDRUND		;LOAD AND RUN IT
	JRST $WAIT

BDDT5:	MOVEI A,FORK
	MOVSI B,FK%BDD
	TDNN B,FKFLG-.FH(A)
	JRST CERR
	JRST ..REEN


; "NO BDDT"   COMMAND
.NOBD:	SKIPGE A,CIFORK
	 RET
	MOVSI B,FK%BDD
	CALL UNSPLIC		;DO THE UNSPLICE/RESPLICE
	RET

; "IDDT" COMMAND AND "NO IDDT" COMMANDS

;F1 IS CLEARED BY MAIN DISPATCH (TO .IDDT) AND SET BY "NO"

.IDDT:	TLNE Z,F1		;"NO IDDT" COMMAND?
	 JRST .NOID
	SKIPN CIFORK		;MFEXEC FORK?
	SETOM CIFORK
	SETOM A
	CALL MAPPF		;UNMAP ANY INFERIOR PAGE
	CALL CDBGFK		;CREATE DEBUGGER AND/OR USER FORKS
	 JRST IDDT5		;ALREADY EXISTS
	MOVSI B,FK%IDD		;IDDT FLAG
	IORM B,FKFLG(A)		;FORK NUMBER IN A
	MOVE A,[POINT 7,[ASCIZ "IDDT"]]
	CALL FRKNAM
	 JFCL
	HRROI 2,[ASCIZ /<SUBSYS>IDDT.SAV/]
	MOVE 3,['IDDT  ']
	CALL LDRUND		;LOAD AND RUN IT
	JRST $WAIT

IDDT5:	MOVE A,FORK
	MOVSI B,FK%IDD
	TDNN B,FKFLG-.FH(A)
	JRST CERR
	JRST ..REEN


; "NO IDDT"   COMMAND
.NOID:	SKIPGE A,CIFORK
	 RET
	MOVSI B,FK%IDD
	CALL UNSPLIC		;DO THE UNSPLICE/RESPLICE
	RET

;ROUTINES USED BY COMMANDS WHICH RUN PROGRAMS SUCH AS IDDT, BDDT,
; TENEX LOADERS, ETC.  THESE ALL OPERATE ON A "USER FORK".  WHEN
; THE COMMAND IS INVOKED, THE USER IS SPLICED UNDER THE FORK
; CONTAINING THE OPERATIONAL PROGRAM




;CREATE THE DEBUGGER FORK AND/OR USER

;	CREATE A USER FORK IF NECESSARY (CIFORK)
;	AND A DEBUG FORK IF NECESSARY (FORK)
;	SKIP RETURN IF DEBUG FORK IS NEW (NUMBER IN A)
;	DEBUG FORK IS IN FORK

CDBGFK:	SKIPGE A,CIFORK		;IS THERE A CURRENT FORK?
	CALL ECFORK
	MOVE B,FKFLG(A)		;FORK FLAG BITS
	TLNE B,FK%BDD+FK%IDD
	RET			;FORK SHOULD CONTAIN THE DEBUGGER
	CALL FNDFSB		;FIND IT IN STRUCTURE
	PUSH P,B
	CALL FTPFKB		;GET AN IMMEDIATE INFER FOR IT
	POP P,C
	CAME B,C		;THE SAME?
	JRST [	HRRZ A,1(B)	;FORK HANDLE
		MOVE B,FKFLG-.FH(A) ;GET ITS FLAG BITS
		TLNN B,FK%BDD+FK%IDD ;A DEBUGGER?
		ERROR	<Can't debug this fork>
		MOVEM A,FORK
		RET]
	CALL ECFORK		;CREATE A FORK FOR DEBUGGER
	AOS 0(P)		;SAY NEW FORK
	RET

;LOAD AND RUN THE DEBUGGER INTO FORK SPECIFIED BY "FORK"
;DEBUG FORK SPECIFIED BY "CIFORK"
;	2:	POINTER TO ASCIZ FILE NAME (DEBUGGER)
;	3:	SIXBIT NAME OF DEBUGGER (STNAM)


LDRUND:
	PUSH P,C		;SIXBIT NAME
	MOVSI A,B2+B17
	GTJFN
	JRST [	MOVE A,FORK
		CALL $KFORK
		JRST CERR]
	HRL A,FORK		;FORK FOR DEBUGGER
	GET
	 ERJMP [MOVE A,FORK
		CALL $KFORK
		JRST GETILI]
	MOVE A,FORK
	GEVEC
	HLRZS B
	CAIGE B,10		;GENERAL SUSPICION
	CAIGE B,3
	JRST [	MOVE A,FORK
		CALL $KFORK
		ERROR (Bad entry vector)]
	NOINT
	MOVE A,FORK
	MOVE B,CIFORK		;THIS IS WHAT NEEDS DEBUGGING
	TRO B,.FH		;MAKE SURE IT'S A HANDLE
	SPLFK
	 CALL [	PUSH P,A
		MOVE A,FORK
		CALL $KFORK
		POP P,A
		JRST JERR]
	SETZM FKSTCF		;SAY STORED STRUCTURE BAD
	MOVEM A,PAGEN+1		;HANDLE FOR DEBUGGER TO KNOW FORK BY
	MOVE A,FORK		;HANDLE TO KNOW DEBUGGER BY
	TRZ A,.FH
	IMULI A,SFKBLK
	POP P,FK.SNM(A)		;NAME TO SETNM
	MOVE A,FORK
	MOVEI B,PAGEN
	SFACS
	OKINT
	MOVE A,FORK
	MOVEI B,2
	SFRKV
	 ERJMP SFVILI
	CALL IFORK
	CALL SFKTTM##
	TLO Z,RUNF
	RET

;UNSPLICE

;	FOLLOW THE STRUCTURE TO FIND A DEBUGGER
;	AND KILL IT
;A/ FORK HANDLE OR NUMBER
;B/ MASK OF "DEBUGGER TYPE" BITS

UNSPLICE:
	PUSH P,B
	CALL FNDFSB
UNSPL1:	HRRZ A,1(B)		;HANDLE
	JUMPE A,UNSPL2		;NO HANDLE, FORGET IT
	MOVE C,FKFLG-.FH(A)	;FLAGS
	TDNE C,0(P)		;THIS THE ONE TO KILL?
	JRST UNSPL3		;YES.
UNSPL2:	HLRZ B,1(B)		;SUPERIOR
	CAIE B,FKSTC		;TOP
	JRST UNSPL1		;NOT YET
	SUB P,[XWD 1,1]
	RET			;NO DEBUGGER TO KILL!
UNSPL3:	SUB P,[XWD 1,1]
	CALL UNSPFK		;SPLICE UP ALL INFERIORS
	JRST $KFORK

;UNSPFK -- UNSPLICE THE FORKS BELOW SPECIFIED FORKS
;A/ HANDLE OF FORK TO HAVE ITS INFERIORS REMOVED

UNSPFK:	NOINT
	CALL FNDFSB
	HLRZ B,1(C)		;SUPERIOR
	HRRZ A,1(B)		;HANDLE
	HRRZ B,0(C)		;INFERIOR
UNSPF1:	PUSH P,B
	HRRZ B,1(B)		;HANDLE
	SETZM FKSTCF		;INVALIDATE STRUCTURE
	SPLFK
	 CALL JERR
	POP P,B
	HLRZ B,0(B)		;PARALLEL
	JUMPN B,UNSPF1
	OKINT
	HRRZ A,1(C)		;ORIGINAL HANDLE
	RET

;INTERROGATE (THE ARCHIVE)


;NOTE: THE INTERROGATE PROGRAM EATS THE REST OF THE COMMAND LINE.

.INTER:	ALLOW TSPC+TALT
	HRROI B,[ASCIZ	"<SYSTEM>ARCHIVE-LOOKUP.SAV"]
	CALL TRYGTJ
	 ERROR <No lookup program>
	TLO KWV1,PROGX		;SAY CONFIRMATION TO BE DONE BY LOOKUP
	JRST ERUN2		;GO HANDLE AS AN EPHEMERON

SCRC <
;FINGER (USER) EATS ITS COMMAND LINE
.FINGE:	ALLOW TSPC+TALT+TEOL
	HRROI B,[ASCIZ /<SUBSYS>FINGER.SAV/]
	CALL TRYGTJ
	 ERROR (No FINGER program)
	TLO KWV1,PROGX		;SAY CONFIRMATION TO BE DONE BY LOOKUP
	JRST ERUN2		;GO HANDLE AS AN EPHEMERON
>

;JFNCLOSE <JFN>

.JFNCL:	CALL OCTAL
	 JRST CERR
	ALLOW TSPC+TALT+TEOL
	CAIG A,MAXJFN
	CAIGE A,0
	 JRST CERR
	GTSTS
	TLNN B,B10
	 JRST CERR		;INVALID OR UNASSIGNED JFN
	CONFIRM
	MOVE B,JBUFP
	PUSH B,A		;PUT JFN IN STACK WHERE RLJFNS LOOKS
	MOVEM B,JBUFP
	JRST RLJFNS		;CLOSE IF OPEN, AND RELEASE JFN.

;KEEP (FORK AS) NAME

.KEEP:
	SKIPG A,CIFORK
	ERROR <No fork>
	CALL FNDFSB
	HRRZ A,1(C)		;HANDLE
	MOVE B,FKFLG-.FH(A)
	TLNE B,FK%BDD+FK%IDD
	ERROR <Can't KEEP debugger>
	HLRZ B,1(C)		;SUPERIOR
	CAIN B,FKSTC		;MFEXEC (IMMEDIATE INFERIOR)
	JRST KEEP1
	HRRZ A,1(B)		;HANDLE
	CAIE A,0
	MOVE A,FKFLG-.FH(A)	;BITS
	TLNN A,FK%BDD+FK%IDD
	ERROR <Requires immediate inferior>
KEEP1:	TRNE CBT,TEOL		;KEEP<CR>
	JRST KEEP4
	NOISE <fork as>
	INHELP <Name or CR>
	ALLOW TALT+TSPC+TEOL
	CAILE CNT,^D20
	ERROR <Name too long>
	MOVE A,.BFP		;STRING POINTER
	HRREI B,-1(CNT)
	JUMPLE B,KEEP4
	CALL BUFFF
	CALL KCKOCT		;Check for octal name
	 ERROR <Name conflicts with possible fork number>
	ALTYPE ( )
	CONFIRM
	CALL FRKNAM		;MAKE A NAME FOR "FORK"
	 ERROR <Name already in use>	;Only error left

KEEP3:	MOVE A,CIFORK
	MOVEI B,(A)
	IMULI B,SYMLTH
	HRROI C,FKNAM(B)
	TLZE Z,F1
	ETYPE < Kept as %3W%
>
	MOVSI B,FK%KPT
	IORM B,FKFLG(A)
	RET

KEEP4:
	MOVE A,CIFORK
	MOVE B,FKFLG(A)
	TLNN B,FK%NAM
	JRST KEEP5
	IMULI A,SYMLTH
	UALTYP FKNAM(A)
	ALTYPE ( )
	TRNE CBT,TEOL
	TLO Z,F1		;SAY TYPE NAME
	CONFIRM
	JRST KEEP3

KEEP5:	;KEPT AS NUMBER
	ALTYPE (- )
	CONFIRM
	MOVE A,CIFORK
	MOVSI B,FK%KPT
	IORM B,FKFLG(A)
	ETYPE < Kept as Fork %1O
>
	RET

KCKOCT:	PUSH P,A		;Byte pointer
	PUSH P,B
KCKOC1:	ILDB B,A		;Get a character
	JUMPE B,KCKOC2		;Possible conflict
	MOVE B,CHRTBL(B)	;Class
	TRNE B,OCTDIG		;Test for octal digit
	JRST KCKOC1		;Check all characters of field
	JRST KCKOC3		;No conflict
KCKOC2:	PUSH P,C
	MOVE A,-2(P)
	MOVEI C,^D8
	NIN
	 MOVEI B,377777		;Assume no conflict
	POP P,C
	TRZ B,.FH
	CAIL B,0		;Check range of fork handles
	CAILE B,NFKS-1
KCKOC3:	AOS -2(P)		;No conflict, skip return
	POP P,B
	POP P,A
	RET

;FRKNAM - Set fork name
; A/ Pointer to ASCIZ string
;	CALL FRKNAM
; RET +1; Name in use or conflicts with number

FRKNAM:	CALL KCKOCT		;Does name conflict with number
	 RET			;Yes. Fail return.
	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	SETZM CWBUF
	SETZM CWBUF+1
	SETZM CWBUF+2
	SETZM CWBUF+3
	MOVEI B,SYMLTH*5-1
	MOVE D,[POINT 7,CWBUF]
FKNAM1:
	ILDB C,A
	CAIL C,141		;LOWER CASE A
	CAILE C,172		;LOWER CASE Z
	JRST .+2
	SUBI C,40
	IDPB C,D
	SKIPE C
	SOJG B,FKNAM1
	MOVEI A,FKNMT
	MOVEI B,CWBUF
	SETOM NOCKPV
	CALL FSYM
	   JFCL			;NO MATCH AT ALL -- GO AHEAD
	  JFCL			;AMBIGUOUS -- DO THE SAME
	 JRST FKNAM3		;PARTIAL -- SAME
	SETZM NOCKPV
	HRRZ C,(C)		;GET FORK NUMBER
	TRO C,.FH		;MAKE FORK HANDLE
	CAMN C,FORK		;EXACT MATCH, SEE IF IT'S THE RIGHT FORK
FKNAM2:	AOS -4(P)		;SKIP RETURN
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	RET

FKNAM3:	SETZM NOCKPV
	NOINT			;DON'T ALLOW ^C DURING THIS
	MOVE A,FORK
	TRZ A,.FH		;FORK NUMBER
	CALL KFNAME
	MOVEI A,FKNMT
	MOVEI B,CWBUF
	CALL FSYM		;POINTER MAY TO CHANGE (DELETED ENTRY)
	   JFCL
	  JFCL
	 JRST .+2
	CALL SCREWUP		;EXACT MATCH IMPOSSIBLE, ANTHING ELSE OK
	MOVE A,FORK
	TRZ A,.FH		;FORK NUMBER AGAIN
	MOVSI C,FK%NAM
	IORM C,FKFLG(A)
	MOVE C,A
	IMULI A,SYMLTH
	MOVEI A,FKNAM(A)
	HRLI A,FKNNB##(C)
	MOVEI C,(A)
	HRLI C,CWBUF
	BLT C,3(A)
	EXCH A,(B)
	CAIGE B,FKNMT+NFKS	;END OF TABLE,  STOP
	AOJA B,.-2
	AOS FKNMT		;BUMP TABLE LENGTH
	OKINT
	JRST FKNAM2

;LABEL (of device) DTAn: (is) <SIXCHARS>

.LABEL:	NOISE <of device>
	CALL DEVN
	PUSH P,A		;START OUT AS IN ASSIGN
	PUSH P,B
	LDB B,[POINT 9,A,17]
	CAIE B,3		;DTA?
	 ERROR <Only dectapes may be labeled>
	MOVE B,0(P)
	TLNN B,B5		;AVAILABLE?
	 JRST [	TLNN B,B6	;NO, SAY WHY
		 UERR [ASCIZ/%1H: not available/]
		 UERR [ASCIZ/%1H: already assigned to Job %3Q/]]
	TLO A,(1B3)		;MOUNT IN NON-DIR MODE
	MOUNT
	 CALL JERR 		;CAN'T ,SAY WHY
	MOVE B,A		;DONE NOW GENERATE A JFN
	TLZ B,(1B3)		;REAL DESIG
	HRROI A,1(P)		;STUFF NAME ONTO STACK
	DEVST
	 CALL [	EXCH A,B	;PUT REASON IN CORRECT PLACE
		 JRST JERR]
	MOVEI B,":"		;COMPLETE THE NAME
	IDPB B,A
	SETZ B,B
	IDPB B,A
	MOVSI A,(1B17)
	HRROI B,1(P)
	GTJFN
	 CALL JERR
	MOVE B,JBUFP		;STACK QUICKLY SO RLJFNS CAN RELEASE
	PUSH B,A
	MOVEM B,JBUFP
	MOVE B,[17B9+3B20]	;OPEN R/W DUMP MODE
	OPENF
	 CALL JERR
	MOVEI B,30		;FOCUS ON THE DIR BLOCK
	MOVEI C,^D100
	MTOPR
	MOVEI B,[IOWD 200,BUF1
		0]
	DUMPI			;GET THE WHOLE BLOCK
	 JRST LABL1
	MOVEI B,30		;REFOCUS ON DIR BLOCK
	MOVEI C,^D100
	MTOPR
	SETZ A,A
	TRNE CBT,TEOL		;EOL MEANS NO LABEL
	 JRST LABL2
	NOISE <is>
	CALL SIXIN		;RETURN WITH RESULT IN 'A'
LABL2:	MOVEM A,BUF1+177	;LABEL WORD IN DIR BLOCK
	CONFIRM
	MOVE A,JBUFP
	MOVE A,0(1)
	MOVEI B,[IOWD 200,BUF1
		0]
	DUMPO
	 ERROR <Unable to write label - Check if DTA is on-line>
LABL3:	CALL RLJFNS
	POP P,B
	POP P,A
	DSMNT
	 CALL JERR
	TLNN B,B8		;PREVIOUSLY MOUNTED?
	RET
	MOUNT			;YES, MOUNT NORMAL
	 CALL JERR
	RET

LABL1:	TYPE <Unable to read directory block - DTA may be off-line>
	JRST LABL3

SIXIN:	TLO Z,PUNCF
	CALL CSTR
	CAIG CNT,1
	 JRST [	TLO Z,BAKFF	;RETURN NULL
		SETZ A,A
		RET]
	CALL BUFFF		;STUFF IN BUFFER
	MOVE B,A
	CAIN TRM,ALTM
	CALL UBP
	SETZ A,A
	MOVE C,[POINT 6,A]
SIXI1:	ILDB D,B
	JUMPE D,SIXI2
	CAIGE D,40
	MOVEI D,40		;FLUSH CONTROL CHARS
	CAIGE D,140		;LOWER CASE?
	ADDI D,40		;YES, CONVERT
	IDPB D,C
	TRNN C,777776		;IS B CLOBBERED?
	JRST SIXI1		;NO, MORE TO GET
SIXI2:	RET

;LINK (TERMINAL/USER)

.LINK:	NOISE (to)
	CALL TTYNUM		;GET LINE NUMBER, MAYBE FROM USER NAME
	MOVEI B,400000(A)	;FORM TTY DESIGNATOR
	SKIPG CUSRNO		;Are we logged in?
	CALL LINK1		;No, check for system CTY
	HRLOI A,(1B2!1B3)	;TO AND FROM CONTROLLING TTY
	TLINK
	 ERROR <Refused>
	RET

LINK1:	PUSH P,A
	PUSH P,B
	MOVE A,['LOGDES']
	SYSGT
	JUMPE B,LINK1A		;No table, allow link
	MOVE A,B
	HRLI A,1
	GETAB
	 CALL JERR
	CAME A,0(P)		;Requested CTY
	CAIN A,377777		; or no CTY
	JRST LINK1A
	TRZ A,1B18
	ERROR <You may only link to the console (TTY%1P) until you log in.>
LINK1A:	POP P,B
	POP P,A
	RET


;"LIST" IS WITH "TYPE" BELOW.

;LOG COMMAND
;  ALLOWS LOG TO DEFAULT TO LOGIN IF NOT LOGGED IN BUT GIVES A
;  QUESTION MARK IF ALREADY LOGGED IN (INSTEAD OF LONG MESSAGE.)

.LOG:
	SKIPLE CUSRNO
	JRST CERR
	ALTYPE (IN )

;LOGIN COMMAND
;LOGIN (USER) <NAME> (PASSWORD) <NOT ECHOED> (ACCOUNT [#]) <#>

.LOGIN:	SKIPLE CUSRNO
	ERROR <You are already logged in>
	TLZE Z,F1
	JRST LOGIN1		;SKIP THE CRUD IF SPECIAL LOGIN TYPE
	CALL LGNCHK		;TYPE MSG IF LOGINS ARE PROHIBITTED
	JUMPE A,LOGIN0		;NOTHING WAS TYPED, PROCEDE
	TYPE <
 You may "ATTACH" to an existing job>	;PROVIDE ADDITIONAL INFO
	RET

;DECODE ARGUMENTS

;TWO GENERAL FORMS ACCEPTED: ARGS ON SAME LINE, TERMINATED WITH
;SPACE OR ALT MODE, AND ARGS ON SEPARATE LINES, TERMINATED WITH EOL.
;SECOND FORM IS INCONSISTENT WITH REST OF EXEC LANGUAGE BUT WAS ADDED
;BECAUSE IT MAKES HDX LOGIN CLEANER: ON HALF DUPLEX TTY, PASSWORD
;IS INPUT ON A SEPARATE LINE WHERE A MASK HAS BEEN TYPED.
;SPECIAL HANDLING OF EOL AS A TERMINATOR IS DONE BY THE "SPECEOL" SUBR
;WHICH IMMEDIATELY FOLLOWS "LOGIN" IN THIS LISTING.

LOGIN0:
	CALL SPECEOL		;HANDLE TERMINATOR FOR THE WORD "LOGIN"
;FIRST ARGUMENT: USER NAME
	NOISE <user>;		;SEE COMMENTS ON "SPECEOL" ABOUT "NOISE"
LOGIN1:	CALL USERN		;INPUT USER NAME, XLATE TO USER # IN A
				;USE "DIRNAM" IF RECOGNITION DESIRED
	PUSH P,A		;SAVE INFO RETURNED BY "STDIR"
	TLNE A,B0
	ERROR <You cannot log in under that directory name>
IAC <	MOVEI	1,1
	HRROI	2,[ASCIZ /ANONYMOUS/]
	STDIR
	 JFCL
	 JRST	.+5
	HRRZ	2,1
	HRRZ	1,(P)
	CAMN	1,2
	ERROR	<Anonymous logins not permitted>
	MOVE	A,(P)		; GET BACK LOGIN ARG
>
SCRC <	TRNE CBT,TEOL		;ALLOW NOT GIVING A PASSWORD
	 JRST [	HRRZ A,(P)	;GET USER NUMBER
		TLO A,400000	;JUST CHECK PASSWORD
		HRROI B,[ASCIZ //]
		CNDIR
		 JRST .+1	;LOOKS LIKE WE NEED A PASSWORD
		HRROI A,[ASCIZ //]
		JRST .+4]>
	CALL SPECEOL		;HANDLE TERMINATOR OF "USER" FIELD
;2ND ARGUMENT: PASSWORD
	HRRZ A,(P)		;USER #
	CALL PASWD		;INPUT PASSWORD, RETURN POINTER IN A.
	PUSH P,A		;SAVE PTR FOR USE IN "LOGIN" JSYS CALL

;3RD ARGUMENT: ACCOUNT NUMBER
	MOVE A,-1(P)		;WHAT STDIR RETURNED:B1 SAYS STRING ACCT
SCRC <	TRNE CBT,TEOL		;ENDED WITH NEWLINE?
	 JRST [	CALL DEFACT
		CAMN A,MINUS1
		 JRST .+1
		JRST .+6]
>
	TLNN A,B1
	NOISE <account #>;	IF USER REQUIRES NUMERIC ACCOUNT
	TLNE A,B1
	NOISE <account>;	IF USER REQUIRES STRING
	CALL ACCT		;INPUT AND DECODE ACCT # (USES A)
	PUSH P,A		;SAVE FOR LOGIN JSYS
	PUSH P,B		;SAVE PIE SLICE
	CONFIRM			;CONFIRM THE WHOLE COMMAND

;LOGIN...
;ALL ARGS DECODED, NOW LOG THE GUY IN

	POP P,D			;PIE SLICE
	POP P,C			;ACCT # OR PTR THERETO
	POP P,B			;PASSWORD PTR
	HRRZ A,(P)		;USER #
	LOGIN
	 CALL [	CAIN A,LGINX1	;CHECK FOR A FEW ERRORS NOT CHECKED B4.
		UERR [ASCIZ /Illegal account/]
		JRST JERR]	;GNRL JSYS ERR RET ROUTINE (XSUBRS.MAC).
	MOVE B,(P)		;WHAT "STDIR" RETURNED
	HRRZM B,CUSRNO		;STORE USER NUMBER
	PUSH P,A		;SAVE DATE & TIME OF LAST LOGIN

;KILL AUTOLOGOUT FORK WHICH WATCHES FOR ABANDONED JOB
	SKIPG ALOFH		;AUTOLOGOUT FORK HANDLE, OR 0 OR -1
	JRST LOGIN6		;NO AUTOLOGOUT FORK - EG STARTUP FAILED
	MOVE A,ALOFH
	CAIE A,400000		;IIT SYSTEM?
	KFORK			;KILL THE FORK
	SETOM ALOFH		;SAY THE ALO FORK HAS BEEN KILLED

LOGIN6:	SETOM LOGINI		;REQUEST LOGIN.CMD TO BE PROCESSED
	SETZM OLDDTM		;CLEAR DOWNTIME FLAG
	SETZM ITIMER		;DO PERIODIC CHECKS
	;...

;LOGIN...

;UPDATE SPECIAL CAPABILITIES
	;...
	MOVEI A,B0
	RPCAP
	HLLZ C,B
	SKIPE PRVENF
	HRR C,B
	EPCAP

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

	ETYPE < Job %J on %L %D %E>
	PRINT EOL
	SKIPE B,0(P)		;THE DATE
	ETYPE < Previous login: %2D %E>

	CALL JOBCNT		;PRINT OTHER JOBS IF ANY FOR THIS USER

LOGIN7:	PRINT EOL
	POP P,DOLGTM		;DATE & TIME OF LAST LOGIN
	POP P,DOLGBT		;WHAT STDIR RETURNED

	CALL CHKDAL		;WARN USER ABOUT OVER ALLOCATION
	RET

;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 TRM=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.

SPECEOL: ALLOW TSPC+TALT+TEOL+TLPR
	TRNN CBT,TEOL
	RET
	CALL PASCOM		;AFTER SEMICOLON PASS CHARACTERS TO EOL
;RETURN "!" IN AC "TRM". THIS CAUSES "NOISE" TO DO THE REQUIRED
;SPECIAL PROCESSING.
	MOVEI TRM,"!"
	RET

;USERN
;INPUT USER/DIRECTORY NAME SUBR
;USED BY "LOGIN" AND "ATTACH".
;RETURNS STDIR'S RETURNED INFO IN A.

USERN:	TLO Z,PUNCF		;ALLOW PUNCTUATION CHARS
	CALL CSTR		;INPUT A FIELD
	CALL BUFFF		;BUFFER IT RIGHT FOR JSYS, PUT PTR IN A
	MOVE B,A
	SETZ A,			;NO RECOGNITION
	STDIR			;STRING TO DIRECTORY # TRANSLATION
	 JRST CERR
	 CALL SCREWUP
	ALTYPE ( )
	RET


;CHECK TO SEE IF NEW LOGINS ARE BEING ALLOWED. TYPES MSG IF NOT AND
; RETURNS A NON-0 IF THAT IS THE CASE.  IF LOGINS ARE OK, A RETURNED 0.

LGNCHK:	CALL LGNCH0
	 RET
	CALL CRIF
	MOVEI 1,101
	SETZ 3,
	ERSTR
	 JFCL
	 JFCL
	TYPE <: New logins not permitted
>
	MOVE 1,2		;RETURN ERROR CODE (IE NON-0)
	RET

LGNCH0:	MOVE 1,['LGNPAR']
	CALL $SYSGT
	SKIPN 1,2		;SKIP IF IMPLEMENTED
	 RET			;0 SAYS "ALLOW LOGINS" TO CALLER
	HRRZS 1			;INDEX 0,,TABLE
	GETAB
	 CALL JERR		;LOT'S OF LUCK IF THIS HAPPENS
	SKIPE 2,1		;NO SKIP IF NON FAIL
	AOS 0(P)
	RET

;ACCT
;SUBROUTINE TO INPUT ACCOUNT STRING, CONVERT TO NUMBER IF
; REQUIRED AND RETURN IN A A SUITABLE ARGUMENT FOR LOGIN OR CACCT JSYS
;TAKES IN A: B1 ON FOR STRING ACCT, OFF FOR # (AS RETURNED BY "STDIR")
;USED IN ACCOUNT, CHANGE, LOGIN COMMANDS.

ACCT:	PUSH P,B		;SAVE FOR CALLER
ACCT0:	CALL CSTR		;COLLECT A STRING
	ALLOW TSPC+TALT+TEOL
	TLO Z,NEOLF		;DON'T ECHO EOL'S
	PUSH P,A
	CAIN CNT,1		;JUST THE TERMINATOR INPUT?
	 JRST [	CALL DEFACT	;GET THE DEFAULT ACCOUNT FOR THIS USER
		CAMN 1,MINUS1	;IS THERE A DEFAULT?
		 JRST [	CALL DING	;NO
			CALL UBP
			POP P,A		;GET BACK USER NUMBER
			JRST	ACCT0]	;TRY AGAIN
		TRNE CBT,TALT	;ASKED FOR DEFAULT EXPLICTLY?
		ETYPE <%1M>	;YES, TYPE IT OUT
		ALTYPE ( )
		SUB P,BHC+1
		JRST ACCTX]
	ALTYPE ( )
	TLNE A,B1
	JRST [	CALL BUFFF	;STRING CASE. SAVE IN BUFFER.
		JRST ACCT2]	;CHECK IT
ACCT1:	TLO Z,BAKFF		;NUMERIC CASE. USE FIELD ALREADY INPUT.
	CALL DECIN		;CONVERT
	 JRST CERR		;IT WAS NULL.
	JUMPLE A,.+2
	CAMLE A,[^D999999]
	 JRST CERR		;OUT OF RANGE
	TLO A,500000		;SAY ITS NUMBER NOT STRING

ACCT2:	POP P,B
	SKIPE PRVENF		;VERIFY IF NOT ENABLED
	JRST ACCTX		;VERIFY IF NOT ENABLED ON PIE SLICE SYS.
	EXCH A,B
	VACCT
	 ERROR (Account invalid)
	EXCH A,B
ACCTX:	POP P,B
	RET



;SKIP IF PIE SLICE CODE ON SYSTEM

PIE.P:	PUSH P,1
	PUSH P,2
	MOVE 1,['GRPDES']
	CALL $SYSGT
	JUMPE 2,PIEPX
	AOS -2(P)
PIEPX:	POP P,2
	POP P,1
	RET

;ACCT ...

;GET DEFAULT ACCOUNT OF USER
;	1: USER DESIGNATOR

;RETURNS -1 OR ACCT DESIGNATOR IN AC1

DEFACT:	MOVE B,A		;SAVE FOR GDACC
	ADD P,BHC+10		;ROOM FOR AN AC BLOCK
	JUMPGE P,[SUB P,BHC+10	;UNDO PDL OVF
		PUSH P,[DEFACT+1]	;ERROR PC
		JRST SCREWUP]
	MOVSI A,-7+0(P)
	HRRI A,-7+1(P)
	SETZM -1(A)
	BLT A,0(P)		;CLEAR THE BLOCK

	MOVEI A,-7+0(P)		;WHERE TO STORE IT
	GDACC			;GET DEFAULT ACCOUNT DESIGATOR
DEFA15:	 JRST [	SUB P,BHC+10
		SETOM A		;SAY DING NEEDED TO CALLER
		RET]

DEFAC2:	MOVE B,A		;FORM STRING PTR FOR BUFFS
	HRLI B,(POINT 7,)
	MOVEI CNT,^D39		;FOR BUFFS
	LDB C,[POINT 3,A,2]
DEFAC3:	CAIE C,5		;NUMERIC MEANS DON'T BUFFER
	CALL BUFFS		;MOVE ASCIZIFIED STRING TO BUFFER
	SUB P,BHC+10
	RET

;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.
;CALLS "SPECEOL" AFTER IT.
;IF A=0, NO VALIDITY CHECK
;IF A<0, SPECIAL NOISE AND ALWAYS CHECK PASSWORD
;IF A>0, CHECKS VALIDITY FOR DIRECTORY # IN A IF NOT LOGGED IN.

PASWD:	PUSH P,B
	PUSH P,A
	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
;PASSWORD IS ACTUALLY INPUT IN CALL TO "NOISE" IF THERE IS NO
;NOISE WORD, OTHERWISE IN "CSTR".
	CALL NOECHO		;TURN OFF ECHOING OF INPUT CHARACTERS
	SKIPL 0(P)
	NOISE <password>	;THIS CAN TURN ECHOING ON AGAIN
	SKIPGE 0(P)
	NOISE <from password>
	CALL NOECHO		;MAKE SURE ITS OFF
	TLO Z,PUNCF		;ALLOW "PUNCTUATION" CHARACTERS IN PASSWORD
	TLZ Z,EOLNEF		;TELL CSTR THAT NOISE DIDN'T ECHO EOL
	CALL CSTR		;(RE)READ PASSWORD STRING
	PRINT (TRM)		;ECHO TERMINATOR
	POP P,A			;0 OR GIVEN DIRECTORY #
	CALL PSWDCK		;BUFFER PASSWORD AND CHECK IT

;A MUST BE PRESERVED FROM HERE TO RETURN

	CALL DOECHO		;NOW WE WANT ECHOING ON
	CALL SPECEOL		;CHECK TERMINATOR, ETC
	ALTYPE ( )
	JRST PASWD3		;JOIN OTHER CASE

;PASWD...
;HALF DUPLEX CASE
;USE SEPARATE LINE, TYPE MASK FIRST
;AS WITH FDX, PASSWORD IS READ BY "NOISE" IF NO (NOISE)

PASWD1:	TRNE CBT,TLPR
	JRST CERR		;DISALLOW ( AS USER NAME TERMINATOR
	TRNN CBT,TEOL		;TYPE EOL UNLESS USER ENDED USER NAME WITH EOL
	$TYPE <
>;
	MOVEI TRM,"!"		;MAKES "NOISE" TYPE " (PASSWORD) "
	SKIPL 0(P)
	U$TYPE [ASCII / (password) 
 /			;EXACTLY 3 WORDS (15 CHARS)
		BYTE (7)130,130,130,130,130,130,130,130,15,40
		BYTE (7)127,127,127,127,127,127,127,127,15,40
		BYTE (7)115,115,115,115,115,115,115,115,15,40
		BYTE (7)041,042,043,044,045,046,043,045,15,40,15,40,0]
		;PASWORD MASK, OVERLAYED X, W, M, AND GARBAGE
	SKIPGE 0(P)
	U$TYPE [ASCII / (from password) 
 /			;EXACTLY 4 WORDS (20 CHARS)
		BYTE (7)130,130,130,130,130,130,130,130,15,40
		BYTE (7)127,127,127,127,127,127,127,127,15,40
		BYTE (7)115,115,115,115,115,115,115,115,15,40
		BYTE (7)041,042,043,044,045,046,043,045,15,40,15,40,0]
		;PASWORD MASK, OVERLAYED X, W, M, AND GARBAGE
	TLO Z,PUNCF
	CALL CSTR		;INPUT PASSWORD
	TRNE CBT,TLPR
	JRST CERR		;DISALLOW ( HERE
	PRINT CR		;SET TO OVERPRINT SAME LINE
	TYPE <Thank you ... >
	PRINT EOL
	PRINT EOL
	POP P,A
	CALL PSWDCK		;BUFFER AND MAYBE CHECK PASSWORD
	CALL SPECEOL
	MOVEI TRM,"!"		;FORCES "NOISE" TO TYPE NEXT NOISE WD
PASWD3:	POP P,B
	RET

;PSWDCK
;PASSWORD BUFFERER AND CHECKER USED AT TWO PLACES IN "PASWD".
;TAKES: A: 0 OR DIRECTORY #.
;RETS:  B: BYTE PTR TO PASSWORD TEXT.
;PASSWORD MUST BE LAST FIELD CSTR'D.

PSWDCK:	PUSH P,A
	PUSH P,B
	CALL BUFFF
	MOVE BFP,.BFP		;FLUSH THE PASSWORD FIELD (^R FIX)
	MOVEI CNT,0		;SAY CURRENT FIELD HAS NO CHR'S
	MOVE B,A
	EXCH A,-1(P)		;SAVE POINTER TO RETURN, GET DIRECTORY #
	JUMPL A,PSWDC4		;NEGATIVE, ALWAYS CHECK.
	JUMPE A,PSWDCX		;NO DIR # GIVEN, NO CHECK.
	SKIPLE CUSRNO		;IF LOGGED IN, NO CHECK.
	 JRST PSWDCX
PSWDC4:	MOVMS A
	TLO A,B0		;SAY PASSWORD CHECK ONLY, NOT CONNECT.
	CNDIR		;CHECK. ILLEGAL IF LOGGED IN.
	 JRST [	CAIN A,CNDIX1
		JRST CERR	;BAD PASSWORD. "?" AND ABORT COMMAND.
		CALL JERR]		;OTHER ERROR.
PSWDCX:	POP P,B			;AVOID PAGE FAULTS IN MULTI-LINE LITS
	POP P,A
	RET

;CHKMSG

;SKIPS IF NEW MAIL EXISTS FOR USER # SUPPLIED IN A
;USED IN MAIN LOOP, LOGOUT, AND MAIL COMMANDS

;RET+1:	NO NEW MAIL
;RET+2:	NEW MAIL
;A/ AS PASSED
;B/ AUTHOR (-1 if no mailbox)
;C/ WRITE TIME AND DATE

CHKMSG::PUSH P,A
	PUSH P,[0]		;VALUES FOR NO FILE
	PUSH P,[0]		;
	HRROI A,CSBUF		;POINTER TO STRING AREA BEGINNING
	MOVEI B,"<"		;FORM <USER>MESSAGE.TXT
	BOUT
	HRRZ B,-2(P)		;USER #
	DIRST
	 CALL JERR
	HRROI B,[ASCIZ />MESSAGE.TXT;1/]
	SETZ C,
	SOUT
	HRROI B,CSBUF
	CALL TRYGTJ		;GET JFN AND STACK IT FOR RELEASE
	 JRST [	CAIN A,GJFX35
		ERROR <Directory protected>
		CAIN A,GJFX24	;No mailbox error?
		SETOM -1(P)	;Yes, return -1 for author
		JRST CHKMS9]
	MOVE B,[1,,FDBUSE]	;GET AUTHOR
	MOVEI C,C		;
	GTFDB			;
	HLRZM C,-1(P)		;RETURN IT
	MOVE B,[2,,FDBWRT]	;WRITE AND READ DATES
	MOVEI C,B		;TO B AND C
	GTFDB
	MOVEM B,0(P)		;RETURN WRITE DATE
	CAMG B,C		;WRITTEN MORE RECENTLY THAN READ?
	 JRST [	MOVEI C,0	;NO, FORCE NO TYPEOUT
		JRST CHKMS4]
	MOVE B,[1,,FDBSIZ]
	MOVEI C,C
	GTFDB			;GET # BYTES IN FILE
CHKMS4:	RLJFN			;GET RID OF JFN
	 CALL JERR
	MOVN A,BHC+1		;REMOVE FROM STACK TOO
	ADDB A,JBUFP
	SETZM 1(A)
	JUMPLE C,CHKMS9		;NO MSG IF FILE IS NULL
	AOS -3(P)		;ARRANGE FOR SKIP RET
CHKMS9:	POP P,C
	POP P,B
	POP P,A
	RET

;TRYGTJ
;TAKES: B: POINTER TO STRING FOR GTJFN
;RETS:	+1: NO SUCH FILE (Error code in A for expected errors)
;	+2: JFN IN A
;USED IN "MESS", AND IN "LOGIN" WITH REGARD TO PRIVATE MESSAGES.

TRYGTJ:	PUSH P,B
	MOVSI 1,(1B2!1B17)	;SAY OLD FILE ONLY, SHORT GTJFN CALL
	GTJFN			;ASSIGN JFN USING STRING POINTER IN B
	 CALL [	CAIE A,GJFX24	;FAILURE. LOOK AT CODE. "NO NEW FILES"
		CAIN A,GJFX18		;"NO SUCH NAME"
		JRST [	SUB P,BHC+1
			JRST TRYG9]
		CAIE A,GJFX19		;"NO SUCH EXTENSION"
		CAIN A,GJFX20		;"NO SUCH VERSION"
		JRST [	SUB P,BHC+1
			JRST TRYG9]
		CAIE A,GJFX17		;"NO SUCH DIRECTORY"
		CAIN A,GJFX35		;"DIRECTORY PROTECTED"
		JRST [	SUB P,BHC+1
			JRST TRYG9]
		JRST JERR]
	MOVE B,JBUFP		;SAVE JFN IN JFN STACK, SO IT WILL BE
	PUSH B,A		;RELEASED ON ^C OR ERROR
	MOVEM B,JBUFP		;..
	AOS -1(P)		;SKIP
TRYG9:	POP P,B
	RET

;MESS
;SUBROUTINE TO PRINT MESSAGE FROM A GIVEN FILE, IF FILE EXISTS.
;SLOW NOP IF FILE DOES NOT EXIST.
;RETURN TO TOP OF COMMAND LOOP IF THE FORK WAS ACTIVATED
;TAKES: A: A DATE & TIME. FILE PRINTED IF NEWER THAN THIS.
;		TYPICALLY, THIS IS THE LAST LOGIN TIME.
;	B: STRING POINTER TO FILE NAME. CLOBBERS B.
;7/3/70: ONLY ONE CALL, IN "LOGIN"

MESS:	PUSH P,C
	PUSH P,A		;SAVE CONVERTED GIVEN DATE & TIME
	CALL TRYGTJ		;ASSIGN A JFN TO FILE NAMED BY STRING
	JRST MESS9		;NO SUCH FILE
	PUSH P,A		;MESSAGE FILE JFN
	MOVE B,[1,,FDBWRT]
	MOVEI C,C
	GTFDB			;GET WRITE DATE & TIME FROM FILE
	CAMGE C,-1(P)		;COMPARE TO GIVEN
	 JRST MESS8		;NO NEED TO PRINT IT

	MOVE A,-1(P)
	PUSH P,A		;A COPY OF DATE
	MOVE A,COJFN		;JFN FOR OUTPUT
	TLO A,(1B1)		;NO STATIC IF NO SYSTEM MSG
	PUSH P,A
	SETOM FORK
	CALL ECFORK
	MOVSI B,FK%EPH+FK%PRO
	IORM B,FKFLG(A)
	HRROI 2,[ASCIZ /<SUBSYS>READMAIL.SAV/]
	CALL TRYGTJ
	 JRST MESS4		;READMAIL NOT AVAILABLE
	HRL 1,FORK		;MAKE FORK.JFN
	GET			;AND RELEASE READMAIL JFN
	MOVE 1,FORK		;FORK HANDLE
	MOVEI 2,-3(P)		;WHERE GOODIES ARE
	SFACS			;FROM ON THE STACK
	GEVEC
	MOVEI 2,1(2)		;REENTER ADDR, EVEN IF OLD EV
	SFORK

	JRST START2		;JOIN START

MESS4:	MOVE A,FORK
	CALL $KFORK
	SUB P,BHC+2		;FLUSH OUTPUT JFN AND DATE
MESS8:	POP P,1			;MESSAGE FILE JFN
	RLJFN
	 CALL JERR
	MOVN A,BHC+1		;Remove from stack
	ADDB A,JBUFP
	SETZM 1(A)
MESS9:	POP P,A			;FROM CALLER
	POP P,C			; "
	RET

;LOGOUT

.LOGOU:	TRNN CBT,TEOL		;STANDARD CASE IF EOL TERMINATED
	SKIPG CUSRNO		;LOGGED IN?
	JRST LOGOU1		;NO, ONLY ONE CASE
	MOVEI A,$LOGOU
	INHELP < One of the following:
%1Z% EOL or job number>
	ALLOW TEOL+TSPC+TALT
	TLO Z,BAKFF
	KEYWD $LOGOU
	 TE (,,NSPALT,777777)
	 JRST .+2
	JRST [	MOVEI A,(KWV)
		CAIE A,-1
		JRST (KWV)
		TRNN CBT,TALT
		JRST LOGOU1
		CALL DING
		CALL UBP
		JRST .LOGOU]
	TLO Z,BAKFF
	CALL DECIN		;TRY TO READ JOB NUMBER
	 JRST LOGOU1		;NO NUMBER, LOGOUT THIS JOB

..LOGO:	PUSH P,A
	GJINF
	CAMN 3,0(P)		;THIS JOB?
	ERROR <If you want to logout this job, use LOGOUT>
	MOVE 1,['JOBRT ']
	CALL $SYSGT		;TABLE OF RUNTIMES
	MOVE 1,2
	HRL 1,0(P)
	GETAB
	 CALL JERR
	JUMPGE 1,.+2		;REQUESTED JOB EXISTS?
	ERROR <That job does not exist>
	CONFIRM
SCRC <
	MOVE D,(P)
	ETYPE < Job %4Q, >
	MOVE A,['JOBTTY']
	CALL $SYSGT
	GTB (B)
	HLRES A
	JUMPL A,[TYPE <Det, >
		JRST .+2]
	ETYPE <TTY%1O, >
	MOVE A,['JOBNM2']
	CALL $SYSGT
	GTB (B)
	JUMPE A,[PRINT "?"
		JRST .+2]
	CALL SIXPRT
	MOVE A,['JOBDIR']
	CALL $SYSGT
	GTB (B)
	ANDI A,-1
	ETYPE <, %1R [Confirm] >
	TRZ CBT,TEOL		;FAKE NOT CONFIRM LAST TIME
	CALL CONF2##
>
	POP P,1
	LGOUT
	 CALL JERR
	JRST CMDIN4

$LOGOU:	TABLE
	T ALL,,EOLOK,L.ALL
	T DETACHED,,EOLOK,L.DET
	T OTHERS,,EOLOK,L.OTH
	TEND

LOGOU1:	CALL LOGCAP		;CHECK LOG CAPABILITY AND SKIP IF
	 JRST LOGO14
	$TYPE < [Not top-level]>;;INFERIOR
	TLO KWV1,CONMAN		;REQUIRE CONFIRMATION
LOGO14:	CONFIRM
	TLO Z,LOGOFF		;SAY LOGGING OUT (TELLS ERROR AND
				;^C TO SAY "NOT LOGGED OUT")
NOBBN <	CALL BLANK1>
	SKIPG A,CUSRNO		;Now logged in
	JRST LOGOU3		;No, no expunge or CHKDAL etc.
	PUSH P,ZERO##		;Flag for special messages
IAC <	HRRZ	A,MWUSER	; WHO WE'RE CHECKING AT IAC >
	CALL CHKMSG		;Check for new mail
	 JRST LOGO1A
	SETOM 0(P)		;Require reconfirmation
NOIAC <	CAIG B,1 >
IAC <	SKIPN	B >
	ETYPE < [You have net mail at %3D %E]>
NOIAC <	CAILE B,1 >
IAC <	SKIPE	B >
	ETYPE < [You have a message from %2R]>
	PRINT EOL

LOGO1A:	CALL JOBCNT
	SKIPLE A		;Number of other jobs
	MOVEM A,0(P)

	GJINF
	CAMN A,B		;Connected to logged in directory?
	JRST LOGO1B		;Yes.
	CALL CHKDAL
	MOVE A,CUSRNO
	CNDIR			;Conn back to home base
	 CALL JERR

LOGO1B:	MOVE A,CUSRNO
	SKIPG 0(P)		;If he has no other jobs then
	DELDF			; expunge the directory
	CALL CHKDAL

	MOVE A,CUSRNO
	CALL CHKPRN
	 JRST LOGO1D
	TYPE < [Printing in progress]>
	PRINT EOL

LOGO1D:	CALL DWNTIM		;Tell of next downtime

LOGOU2:	FEATUR %IIT,<
	SKIPN 0(P)		;Any reason to reconfirm?
	JRST LOGOU3		;No
	MOVEI A,.FHSLF
	MOVSI B,(1B<HUCHN>)
	MOVEI C,^D30000		;30 Seconds
	IIT
	TYPE < Confirm logout >
	CALL TCONF
	 ERROR <>
	MOVEI A,.FHSLF
	MOVSI B,(1B<HUCHN>)
	SETZ C,
	IIT
>
LOGOU3:	MOVE A,COJFN
	DOBE			;WAIT TO GIVE HIM MAXIMUM CHANCE TO ^C.

	CALL BREAK2		;DO "BREAK" AND "REFUSE"
LOGOU4:	CALL $RESET
	SETO A,			;SAY ITS SUICIDE
	LGOUT
	 CALL JERR
	;BETTER NOT RETURN IF SUCCESSFUL

LOGCAP:	CALL INFER
	 RET			;LOG CAPAGILITY NOT NEEDED ON TOP FORK
	AOS 0(P)
	MOVEI A,B0
	RPCAP
	TLNN B,(1B3)
	ERROR <Log capability not enabled>
	RET

L.ALL:	CALL L.OTH		;LOGOUT ALL is LOGOUT OTHERS then LOGOUT
	JRST LOGO14

L.DET:	TLOA Z,F2		;LOGOUT DETACH flag
L.OTH:	TLO Z,F1		;LOGOUT OTHERS FLAG
	CONFIRM
	CALL LOGCAP
	JFCL
	CALL JOBKIL
	RET


NOBBN <
.KKJOB:	CALL BLANK1		;WIPE THE SCREEN CLEAN.
	TYPE < Bye.
>
	MOVE A,COJFN
	DOBE
	NOINT
	CIS
	DTACH
	JRST LOGOU4
>

;COUNT JOBS LOGGED IN UNDER THIS USER'S DIRECTORY
;IF MORE THAN ONE, PRINT INFORMATIVE MESSAGE
;Returns in A the number of other jobs

JOBCNT:	TLZ Z,F1+F2
JOBKIL:	GJINF
	CAIN A,1		;SYSTEM?
	 RET			;YES, FORGET IT
	MOVE E,A		;LOGIN DIRECTORY #
	MOVE A,['JOBDIR']
	CALL $SYSGT		;AVOID MISHAP IF FORK LACKS GETAB CAP.
	JUMPE B,JOBCNX		;BUT CONTINUE TO ASSUME JOBDIR IS TAB 3
	SETO D,			;GET LENGTH OF 'JOBDIR' GETAB
	GTB 3			;WHICH IS CONN#,,LOGIN# [JOB#]
	HRLZ D,A		;SET UP LENTH,,INDEX FOR AOBJN & GTB.

	MOVE F,P		;Stack frame
JOBCN1:	CALL JOBCNF
	 JRST JOBCN2
	HRR A,D
	PUSH P,A		;STACK TTY,,JOB#
	AOBJN D,JOBCN1		;LOOP FOR ALL JOBS
JOBCN2:	HRRZ A,P
	SUBI A,(F)
	JUMPE A,JOBCNX		;If no other jobs just return
	MOVN D,A
	HRLZS D
	HRRI D,1(F)		;Make AOBJN pointer into stack
	TLNE Z,F1+F2
	JRST JOBKI1

	CALL CRIF
	TYPE <[Job>
	CAILE A,1
	PRINT "s"
	SKIPA
JOBCN3:	PRINT ","
	HRRZ B,0(D)
	ETYPE < %2Q>
	SKIPGE 0(D)
	TYPE <(Det)>
	AOBJN D,JOBCN3
	MOVE P,F
JOBCN5:	ETYPE < also logged in under %5R]>
	PRINT EOL
JOBCNX:	RET

JOBKI1:	SKIPL 0(D)		;Detached or
	TLNE Z,F1		; or logging out all jobs
	 SKIPA			;Yes.
	JRST JOBKI2		;No.
	HRRZ A,0(D)		;Get job number
	MOVE C,A		;Save it for error
	LGOUT
	 ETYPE < [Can't kill job %3Q]
>
JOBKI2:	AOBJN D,JOBKI1
	MOVE P,F		;RESTORE STACK
	RET

;LOCAL ROUTINE TO FIND NEXT "OTHER JOB"
;AOBJN PTR IN D, TARGET DIRECTORY # IN E, OWN JOB # IN C
;SKIPS IF FOUND ANOTHER JOB, JOBPT(D) IN A

JOBCNF:	GTB 3			;JOBDIR(D) TO A
	CAIN E,(A)		;LOGIN DIRECTORY SAME AS TARGET?
	CAIN C,(D)		;AND NOT OUR OWN JOB?
JOBCNN:	 AOBJN D,JOBCNF		;NO, TRY NEXT
	JUMPGE D,JOBCXX		;NO SKIP RETURN IF FOUND NONE
	GTB 0			;JOBPT(D) TO A
	AOS 0(P)		;SIGNAL SUCCESS
JOBCXX:	RET

;"MAIL"

.MAIL:	KEYWD $MAIL
	 TE CHECK,,SECOK+NOLOG,M..CHK
	 JRST CERR
	JRST 0(KWV)

$MAIL:	TABLE
	TE CHECK,,SECOK+NOLOG,M..CHK
	TE WATCH,,,M..WAT
	TEND

M..CHK:	NOISE <for user>
	TLO Z,NEOLF		;SUPPRESS ECHO OF EOL
	CALL DEFDIR		;INPUT A USER NAME TO A
	ALLOW TSPC+TALT+TEOL
	TLO KWV1,NOCONF
	CONFIRM
	PUSH P,A
	CALL CHKMSG		;For user in A
	 JRST M..CH1		;No mail or no mailbox
	SKIPG B
	TYPE < New NET mail>
	SKIPLE B
	ETYPE < New mail from %2R>
NOIAC <	CAIG B,1		;Handle this directory special >
	ETYPE < at %3D %E>
	JRST M..CH2

M..CH1:	SKIPGE B
	TYPE < No local mailbox for this directory>
	SKIPL B
	TYPE < No new mail exists>

M..CH2:	PRINT EOL
	MOVE A,COJFN
	DOBE
	POP P,A
	SKIPLE CUSRNO
	CAME A,CUSRNO
	RET
	SKIPGE MSGTIM
	RET
	TIME
	MOVEI C,^D<10*60>	;10 MINUTES
	IMUL C,B
	ADD A,C
	MOVEM MSGTIM
	RET

;MAIL WATCH ON/OFF

M..WAT:	KEYWD $M.WAT
	 TE ON,,,M.WA.N
	 JRST CERR
	JRST 0(KWV)

$M.WAT:	TABLE
	TE OFF,,,M.WA.F
	TE ON,,,M.WA.N
	TEND

NOIAC <
M.WA.N:	TDZA A,A
M.WA.F:	SETO A,
	CONFIRM
	MOVEM A,MSGTIM
	RET
>
IAC <
M.WA.F:	SETO	A,
	CONFIRM
	MOVEM	A,MSGTIM
	RET

M.WA.N:	NOISE	<for user>
	TLO	Z,NEOLF
	CALL	DEFDIR
	ALLOW	TALT+TSPC+TEOL
	CONFIRM
	HRRZM	A,MWUSER
	SETZM	MSGTIM
	RET
>

; MAP (FILE) FILENAME (STARTING AT PAGE) P0 (THROUGH PAGE) PN
;  (STARTING AT FORK PAGE) F0 (ACCESS) ACCESSES

.MAP:	NOISE	<file>
	SETZ	A,
	CALL	CINFN
	 JRST	CERR
	NOISE	<from page>
	CAIE	TRM,EOL		; GUY USED CR TO TERMINATE?
	CALL	OCTAL		; NO, GET A NUMBER
	 JRST	[ALLOW	TALT+TEOL
		 SETZ	A,
		 ALTYPE	<0 >
		 JRST	.+1]
	PUSH	P,A		; SAVE STARTING FILE PAGE
	NOISE	<thru page>
	CAIE	TRM,EOL
	CALL	OCTAL
	 JRST	[ALLOW	TALT+TEOL
		 MOVE	B,(P)
		 ADDI	B,777
		 PUSH	P,B
		 ADD	P,[5,,5]
		 HRROI	A,-4(P)
		 MOVEI	C,10
		 NOUT
		  CALL	JERR
		 UALTYP	-4(P)
		 ALTYPE	< >
		 SUB	P,[5,,5]
		 JRST	MAP1]
	PUSH	P,A		; SAVE LAST FILE PAGE
MAP1:	NOISE	<starting at fork page>
	CAIE	TRM,EOL
	CALL	OCTAL
	 JRST	[ALLOW	TALT+TEOL
		 SETZ	A,
		 ALTYPE	<0 >
		 JRST	.+1]
	CAIL	A,1000
	 JRST	CERR		; DON'T LET HIM GET AWAY WITH IT HERE
	PUSH	P,A		; SAVE START FORK PAGE
	SETZ	C,		; ORIGINAL ACCESS BITS=0
	NOISE	<access>
	TRNA
MAP2:	POP	P,C
	TLO	Z,NEOLF
	KEYWD	$PAGE1		; USE ACCESS TABLE FROM "PAGE" COMMAND
	 TE	RC,,COMOK,B2!B9		; DEFAULT R,CW
	 JRST	CERR
	HRLZI	A,(KWV)		; GET ACCESS BITS
	SKIPN	A		; ZERO?
	SETZ	C,		; YEP, NO ACCESS
	IORM	A,C		; INCLUDE NEW BIT(S)
	PUSH	P,C
	CALL	SPRTR		; ANALYZE TERMINATOR
	 JRST	MAP2
	 JRST	MAP2		; SPACE & COMMA MEAN GO BACK FOR MORE
	CONFIRM
	HRRZ	A,CJFN1
	MOVE	B,[440000,,202000]	; OPEN THAWED
	MOVSI	D,(1B4)
	TDNE	D,(P)		; GUY WANT EXECUTE ACCESS?
	IORI	B,1B21		; YES
	MOVSI	D,(1B3)
	TDNE	D,(P)		; GUY WANT WRITE ACCESS?
	IORI	B,1B20
	OPENF
	 CALL	JERR
	SKIPG	A,CIFORK	; GOT A CURRENT FORK? (NOT MFEXEC)
	CALL	ECFORK		; NO, GET ONE
	TRZ	A,.FH
	MOVEM	A,CIFORK	; MAKE IT CURRENT FORK
	TRO	A,.FH
	POP	P,C		; RETRIEVE PMAP'S AC3
	POP	P,B		; RETRIEVE FORK STARTING PAGE
	HRL	B,A		; GET FORK HANDLE IN LH
	POP	P,D		; RETRIEVE LAST FILE PAGE
	HRL	D,CJFN1
	POP	P,A		; RETRIEVE FIRST FILE PAGE
	HRL	A,CJFN1		; GET JFN IN LH
MAP3:	PUSH	P,B
	RPACS
	TLNN	B,(1B5)		; PAGE EXIST?
	JRST	[POP	P,B
		 JRST	MAP4]	; NO, GET ANOTHER
	POP	P,B		; GET BACK PMAP ARG
	PMAP
MAP4:	CAML	A,D		; DONE?
	JRST	MAP6		; YES
	PUSH	P,B
	HRRZS	B
	CAIL	B,777		; ANY MORE ROOM IN FORK?
	JRST	[POP	P,B
		 JRST	MAP5]	; NO, ABORT
	POP	P,B
	ADDI	B,1
	AOJA	A,MAP3		; LOOP THRU PAGES
MAP5:	ADDI	A,1
	RPACS
	TLNN	B,(1B5)		; GUESS THERE'RE ANY MORE PAGES?
	JRST	MAP6		; I DON'T THINK SO...
	CALL	CRIF
	ETYPE	<Can't map file page %1P, quitting>
MAP6:	HRRZ	A,CJFN1
	CLOSF			; FAKE CLOSF SO RESET WILL CLOSE FILE
	 JFCL
	RET

;"MERGE" IS WITH "GET" ABOVE.

;MOUNT <DEVICE>

.MOUNT:	CALL DEVN
	TLNN B,B7
	ERROR <%1H: not a mountable device>
	TLNN B,B5
	JRST [	TLNN B,B6
		UERR [ASCIZ /%1H: Not available/]
		UERR [ASCIZ /%1H: Assigned to job %3Q/]]
	CONFIRM
	MOUNT		;NO ERROR IF ALREADY MOUNTED.
	 CALL JERR
	RET

;MOVE (TERMINAL TO HOST) host (AND) DETACH|LOGOUT

;BBN-SPECIFIC COMMAND FOR PLURIBUS TIP. CAUSE TERMINAL TO BE RECONNECTED
;TO ANOTHER BBN SITE. DOESN'T REQUIRE LOGIN.

BBN <
.MOVE::NOISE <terminal to host>
	KEYWD $MOVE		;SEE WHERE TO MOVE TO
	 0			;NO DEFAULT
	 JRST CERR		;NULL IS ILLEGAL
	PUSH P,KWV		;SAVE ANSWER
	ALLOW TALT+TSPC+TEOL
	NOISE <and>
	KEYWD $MVAND		;GET EITHER DETACH OR LOGOUT
	 TE DETACH,,,.MVDET	;DEFAULT IS DETACH, LOGOUT IF NOT LGD IN
	 JRST CERR		;NULL
	JRST (KWV)		;DISPATCH ON KEY WORD
.MVDET:	TLO Z,DTACHF		;WANTS TO DETACH PRESENT JOB
.MVLGO:	CONFIRM			;REQUIRE A CONFIRMATION
	GJINF			;GET JOB'S CONTROLLING TTY NUMBER
	JUMPLE A,MOVE2		;IF LOGGED IN, MENTION JOB NUMBER.
	TLNE Z,DTACHF		;BUT NOT UNLESS DETACH OPTION SELECTED
	ETYPE <Detaching job # %3Q
>
MOVE2:	MOVE A,COJFN
	DOBE			;WAIT FOR TTY TO SILENCE
	POP P,B			;DESIRED SITE INDEX IN RH
	HRLI B,(1B2)		;FLAG REQUESTING MOVE
	MOVE A,['OPRMLC']	;OPRFN COMMAND NAME
	MOVEI C,(D)		;THIS TTY NUMBER IN 3
	OPRFN			;DO THE MOVE
	 ERROR (Must be on a pluribus TIP LINE)	;NOT FROM PTIP LINE
	GJINF			;NOW SEE IF JOB SHOULD BE KILLED
	TLNE Z,DTACHF		;IF DETACH REQUESTED, DO IT IF LOGGED IN
	JUMPG A,MOVE1		;IF LOGGED IN, DEFENSIVE DETACH.
	SETO A,0		;NOT LOGGED IN OR REQUESTED LOGOUT.
	LGOUT
	 CALL JERR
MOVE1:	RET

$MOVE:	TABLE			;ARG IS INDEX KNOWN TO PTIP FOR SITENAME
	TE A,,,1
	TE B,,,2
	TE BBN,,,3
	TE BBNA,,,1
	TE BBNB,,,2
	TE BBNC,,,3
	TE BBND,,,4
	TE BBNE,,,5
	TE BBNF,,,6
	TE BBNG,,,7
	TE C,,,3
	TE D,,,4
	TE E,,,5
	TE F,,,6
	TE G,,,7
	TEND

$MVAND:	TABLE
	TE DETACH,,,.MVDET
	TE LOGOUT,,,.MVLGO
	TEND
>;END OF BBN CONDITIONAL

;"NO" PREFIX

;THE "NO" PREFIXED VERSIONS GO THRU THE SAME ROUTINES AS THE UNPREFIXED
;VERSIONS, BUT WITH F1 SET WHICH REVERSES THE EFFECT OF THE SUBROUTINES
;THEY CALL.  F1 IS CLEAR ON DISPATCH FROM THE MAIN LOOP.

.NO:	KEYWD $NO		;"NO". LOOK UP NEXT WORD.
	 0			;NO DEFAULT
	JRST CERR		;NULL ILLEGAL
FEATUR %CORECT,<
	MOVEI	1,(KWV)
	CAIE	1,.CORRECT##	; DONT CONFIRM CORRECT YET
>
	CONFIRM
	TLO Z,F1		;SAY NO
	JRST (KWV)		;GO TO .FORMF, .TABS, OR .LOWER.

$NO:	TABLE
NOIAC <	TE BDDT >
IAC <	TE BDDT,,INVIS >
FEATUR %CORECT,<
	TE CORRECT,,NOLOG+LPROK
>
	TE FORMFEED,,NOLOG
	TE IDDT
	TE INDICATE,,NOLOG
	TE LOWERCASE,,NOLOG
	TE RAISE,,NOLOG
	TE TABS,,NOLOG
	TEND

;"NOT" COMMAND PREFIX

.NOT:	KEYWD $NOT
	 0			;NO DEFAULT
	 JRST CERR		;NULL NOT ACCEPTABLE
	JRST (KWV)		;OFF TO ROUTINE

$NOT:	TABLE
	T EPHEMERAL,,LANOK+LPROK,.NOTEP
	T PERMANENT,WHEEL+OPER+ENAREQ,LANOK+LPROK,.NTPER
	T PERPETUAL,,LANOK+LPROK,.NOTPE
	TEND

;"NUMBER (OF DIRECTORY) <NAME>"

;RETURNS DIRECTORY NUMBER (FOR 10/50 PPN'S AND KNOWING WHICH DIR TO MAP)

.NUMBE:	NOISE <of directory>
	CALL DIRNAM		;INPUT DIRECTORY NAME WITH RECOGNITION
	ALTYPE ( )
	ALLOW TEOL+TSPC+TALT	;CHECK TERMINATOR
	CONFIRM			;MUST ALWAYS DO THIS
	ETYPE ( Directory number %1P)
	RET

;"PAGE (access from page) N (to) N, (from) N (to) N (is) RWX/TRAP/READ/WRITE/
;					EXECUTE/COPY/NONE/UNPROTECTED

;CHANGES FORK PAGES ACCESS BITS!

.PAGE:	SKIPGE FORK
	ERROR <No current fork>
	MOVE F,P		;STACK FRAME
	TRNE CBT,TEOL
	JRST [	PUSH P,[1B2+1B3+1B4] ;RWX
		PUSH P,[XWD -1000,0] ;ALL PAGES
		JRST .PAGE3]
	PUSH P,ZERO##		;INIT ACCESS TO NONE
	NOISE <access from page>
.PAGE1:	CALL OCTAL
	 JRST [	ALLOW TALT
		MOVEI A,0
		$TYPE <0 >
		JRST .+1]
	ALLOW TSPC!TALT!TLPR
	CAILE A,777
	JRST CERR
	PUSH P,A
	NOISE <to>
	CALL OCTAL
	 JRST [	ALLOW TALT
		MOVEI A,777
		$TYPE <777 >
		JRST .+1]
	SUB A,0(P)
	MOVN A,A
	SUBI A,1
	JUMPGE A,CERR
	HRLM A,0(P)
;First entry (-no.pages,,first.page) is on stack.
;if terminated by a comma allow another set of pages

	CAIN TRM,","
	JRST [	CALL SAVNOI
		JRST .PAGE1]
	ALLOW TSPC!TALT!TLPR
	NOISE <is>
.PAGE2:	TLO Z,NEOLF
	KEYWD $PAGE1
	 TE RWX,,COMOK,B2!B3!B4
	 JRST CERR
	HRLZI A,(KWV)		;GET BITS AND MOVE TO PROPER PLACE
	CAIN A,0
	SETZM 1(F)		;CLEAR PREVIOUS BITS ON "NONE"
	IORM A,1(F)		;ADD TO LIST
	CALL SPRTR		;ANALYSE TERMINATOR
	 JRST .PAGE2
	 JRST .PAGE2
.PAGE3:	CONFIRM
	HRRZI E,1(F)		;LOCATION BEFORE FIRST ENTRY
	SUBI E,0(P)		;DIFFERENCE FROM STACK IS NUMBER OF ENTRIES
	HRLZ E,E		;MAKE AOBJN POINTER TO LIST
	HRRI E,2(F)

.PAGE4:	MOVE D,0(E)
.PAGE5:	HRLZ A,FORK
	HRRI A,0(D)
	CALL PAGSET
	AOBJN D,.PAGE5
	AOBJN E,.PAGE4

	MOVE P,F		;RESTORE STACK FRAME
	RET

PAGSET:	RPACS
	TLNN B,B5		;Does it exist?
	RET			;No. Nothing to do
	SKIPGE C,1(F)		;Get access and check for "remove page"
	JRST [	MOVE B,A
		SETO A,
		PMAP
		RET]
	TLNN B,B10		;Is it a shared page?
	CAME C,[1B2+1B3+1B4]	; and requesting Read, Write Execute?
	SKIPA B,C		;No. Use bits as specified
	MOVSI B,B2+B4+B9	;Yes.  Use Read, Execute and Copy on write
	SPACS
	RET


$PAGE1:	TABLE
	TE COPY,,COMOK,B9
NOIAC <	TE DUPLICATE,,COMOK,B9 >
IAC <	TE DUPLICATE,,COMOK+INVIS,B9 >
	TE EXECUTE,,COMOK,B4
	TE KILL,,COMOK,B0
	TE NONE,,COMOK,0
IAC <	TE RC,,COMOK,B2!B9 >
	TE READ,,COMOK,B2
	TE RWX,,COMOK,B2!B3!B4
	TE TRAP,,COMOK+INVIS,B8
	TE WRITE,,COMOK,B3
	TEND

;"PERPETUAL <FILE LIST>"     AND  "NOT PERPETUAL <FILE LIST>"
;"PERMANENT <FILE LIST>"     AND  "NOT PERMANENT <FILE LIST>"


.NTPER:	TLO Z,F1		;REMEMBER NOT
.PERMA:	MOVSI D,(FDBPRM)	;PERMANENT BIT
	MOVSI B,0		;Default is highest version
	JRST PERMA1

.NOTPE:	MOVSI B,-2		;Default version to lowest
	TLOA Z,F1		;REMEMBER "NOT"
.PERPE:	MOVSI B,0		;Default version is highest
	MOVSI D,(FDBUND)	;DIDDLE FDBUND BIT
PERMA1:	NOISE <files>
	MOVE A,BHC+2		;SAY DEFAULT NAME AND EXT TO PREVIOUS
	HRRI B,B2+B11+B15+B16	;OLD FILE, *'S, COMMA OK
	CALL SPECFN		;INPUT FILE NAME DESCRIPTOR
	 JRST CERR
	ALLOW TSPC+TALT+TEOL
	CONFIRM
	CALL FRSTF		;TYPE NAME IF A GROUP
PERPE0:	HRRZ A,@INIFH1		;JFN
	DVCHR
	TLNN B,(1B4)		;DISK?
	 JRST [	UTYPE [ASCIZ / not a disk file/]
		JRST NEXTF]
	HRRZ A,@INIFH1		;JFN
	HRLI A,FDBCTL
	MOVE B,D		;Bit to change
	TLNE Z,F1		;"NOT" ?
	TDZA C,C		;YES, CLEAR THE BIT
	MOVE C,B
	CHFDB
	JRST NEXTF		;GET NEXT FILE, RET TO PERPE0

;"PRINTER"

.PRNTR:	KEYWD $PRNTR
	 0
	 JRST CERR
	JRST 0(KWV)

$PRNTR:	TABLE
	T CHECK,,SECOK+EOLOK,P..CHK
	T WATCH,,EOLOK,P..WAT
	TEND

P..CHK:	NOISE <for user>
	TLO Z,NEOLF		;SUPPRESS ECHO OF EOL
	CALL DEFDIR		;INPUT DIRECTORY NAME WITH RECOG
	PUSH P,A		;SAVE IT
	ALLOW TSPC!TALT!TEOL
IAC <	TLO	KWV1,NOCONF >
	CONFIRM
	CALL CRIF
	TYPE <Printing>
	POP P,A
	CALL CHKPRN		;CHECK PRINTER FOR USER IN A
	 TYPE < not>
	TYPE < in progress>
	RET

;"PRINTER WATCH ON/OFF"

P..WAT:	KEYWD $P.WAT
	 TE ON,,,P.WA.N
	 JRST CERR
	JRST 0(KWV)

$P.WAT:	TABLE
	TE OFF,,,P.WA.F
	TE ON,,,P.WA.N
	TEND

P.WA.F:	ALLOW TSPC!TALT!TEOL
	CONFIRM
	SETOM PRNTIM
	RET

P.WA.N:	ALLOW TSPC!TALT!TEOL
	CONFIRM
	SETZM PRNTIM
	RET

;CHECK PRINTER ROUTINE

;CALLED FROM MAIN LOOP WITH USER NUMBER IN 1
;SKIPS IF A FILE(S) <PRINTER>*.USER;* EXISTS

CHKPRN:	PUSH P,1
	PUSH P,2
	PUSH P,3
	HRROI 1,CSBUF		;STRING BUFFER AREA
NOIAC <	HRROI 2,[ASCIZ /<PRINTER>*./] >
IAC <	HRROI	2,[ASCIZ /<PRINTER-QUEUE>*./] >
	SETZ 3,
	SOUT
	HRRZ 2,-2(P)		;USER #
	DIRST
	 CALL [	SETOM PRNTIM	;CANCEL THE WATCH
		JRST JERR]
CHKPR1:	MOVSI 1,(1B2!1B11!1B17)	;OLD, ALLOW STARS, SHORT
	HRROI 2,CSBUF
	GTJFN
	 JRST CHKPRX		;NONE THERE. NO SKIP.
	RLJFN
	 CALL JERR
	AOS -3(P)		;ARRANGE FOR SKIP RETURN

CHKPRX:	POP P,3
	POP P,2
	POP P,1
	RET

PRIWAT:	MOVE	A,CUSRNO
	CALL	CHKPRN
	 JRST	PRIWA1
	SETOM	PRINPR		; SAY PRINTING IN PROGRESS
	RET
PRIWA1:	SKIPN	PRINPR		; PRINTING WAS IN PROGRESS?
	RET			; NO
	CALL	CRIF
	TYPE	<[Printing completed]>	; YES
	SETZM	PRINPR		; SAY NO LONGER IN PROGRESS
	RET

;PROTECTION (OF FILE) <EXISTING NAME> (IS) <18 BIT OCTAL>

.PROTE:	NOISE <of file>
	CALL .INFG
	ALLOW TSPC+TALT+TLPR
	NOISE <is>
	CALL OCTCOM		;OCTAL INPUT TO A. ALLOWS LH,,RH ETC.
	JRST CERR		;NULL - NO DEFAULT.
	TLNE A,-1
	ERROR <Left half must be 0> ;ONLY NUMERIC PROTECTIONS NOW
				; OCTCOM CHECKS TERMINATOR.
	CONFIRM
	TLO A,500000		;SAY THERE'S 18-BIT PROTECTION IN RH
	PUSH P,A
PROTE1:	HRRZ A,@INIFH1
	DVCHR
	TLNN B,(1B4)		;MULTIPLE DIRECTORY DEVICE?
	ERROR <%1H: Doesn't have protected files>
	HRRZ A,@INIFH1
	MOVE B,[XWD 1,FDBPRT]
	MOVEI C,C
	CALL $GTFDB
	JRST PROTE3
	CAMN C,(P)
	JRST PROTE3
	CALL TYPIF		;RETURNS JFN IN A:
	HRLI A,FDBPRT
	MOVEI B,-1
	MOVE C,(P)
	CHFDB
	 ERCAL PROILL

;THE FOLLOWING SHOULD REPLACE THE ABOVE IF CPRTF IS EVER IMPLEMENTED

REPEAT 0,<
	CPRTF		;CHANGE PROTECTION OF FILE
	 CALL [	CAIN A,CPRTX1
		ERROR <Protection of %1S is protected from you>
		JRST JERR]
>

PROTE3:	CALL GNFIL
	JRST [	POP P,C
		JRST RLJFNS]
	JRST PROTE1

PROILL:	PUSH P,A
	CALL LSTERR
	CAIE A,CFDBX2
	CAIN A,CFDBX3
	JRST .+2
	CAIN A,CFDBX4
	JRST [	POP P,A
		TYPE <     Failed
>
		RET]
	POP P,A
	JRST ILITRP##

;POP	EXIT TO SUPERIOR EXEC OR OTHER PROGRAM.

.POP::	CALL INFER		;SKIP IF INFERIOR
	 ERROR <Not legal in top-level MFEXEC>
;DEASSIGN SUPER-PANIC PSI CHARACTER ^C
	MOVEI A,.FHSLF
	RPCAP			;GETS ENABLED CAPS IN C
	MOVEI A,CTRLC
	TLNE C,B0
	DTI			;DEASSIGN TERMINAL INTERRUPT
	MOVEI A,CTCODE		;CHAR THAT PRINTS RUNTIME (^T)
	DTI
	MOVEI A,HUCODE		;DATAPHONE HANGUP CODE
	DTI

	MOVE 1,SUPSUB
	SETNM			;BUT RESTORE SUPERIOR'S SUBSYS
	HALTF
	JRST REE		;AFTER CONTINUE FROM SUPERIOR EXEC

.QUIT:	NOISE (to mini)
	CONFIRM
	CALL INFER
	 JRST QUIT1
	CALL CRIF
	TYPE <Not top level >
	CALL TCONF
	 RET
;THE MINI DEASSIGNS ALL TERMINAL INTERRUPTS FOR THIS FORK
QUIT1:	JSYS 777
	JRST REE

;INFERIORNESS TEST SUBROUTINE: SKIP IF THIS FORK HAS A SUPERIOR
;USED IN LOGOUT, QUIT, ^E EDDT.

INFER:	PUSH P,A
	PUSH P,B
	MOVEI A,.FHTOP		;TOP FORK OF JOB
	MOVEI B,1(P)		;STORE STRUCTURE ON STACK
	ADD P,[3*NFKJ,,3*NFKJ]	;3 WORDS PER FORK (IN WHOLE JOB)
	JUMPGE P,INFER3		;NEED MORE ROOM
	PUSH P,B		;POINTER TO TOP OF STRUCTURE
	GFRKS
	 ERJMP .+1		;IGNORE ERRORS
	POP P,B			;TOP FORK
	HRRZ A,1(B)		;FORK HANDLE
INFER3:	SUB P,[3*NFKJ,,3*NFKJ]	;RESTORE STACK POINTER
	CAIE A,.FHSLF
	AOS -2(P)		;WE ARE NOT TOP FORK
	POP P,B
	POP P,A
	RET

;RECEIVE

.RECEI:	KEYWD $RECTB
	 T LINKS,,EOLOK,..LINK
	 JRST CERR
	 JRST (KWV)

$RECTB:	TABLE
	T ADVICE,,EOLOK+LPROK,..ADVZ
	T LINKS,,EOLOK,..LINK
	TEND

..ADVZ:	NOISE <from>
	CALL TTYNUM
	MOVEI 1,400000(1)	;FORM TTY DESIGNATOR
	TLO 1,(1B2)		;SET "ACCEPT" ADVICE FLAG
	ADVIZ
	 CALL [	CAIN 1,ADVX2
		 ERROR <Ignored>
		CAIN 1,ADVX4
		 ERROR <Advice already in progress>
		JRST JERR]
	RET


..LINK:	CONFIRM
	NOINT			;BE SURE BOTH ADVISE AND TLINK HAPPEN
	HRLOI 1,(1B4+1B5)
	TLINK
	 CALL JERR
	MOVSI 1,(1B0)		;BREAK "ADVISE" LINK
	ADVIZ
	 CALL JERR
	OKINT
	RET

;REENTER
;DECODE AND CHECK SUBROUTINE ALSO USED BY REDIRECT/DETACH

$REENT:	SKIPGE A,FORK
	ERROR <No current fork>
	GEVEC
	HLRZ B,B
	CAIE B,<JRST>B53
	 JRST	[ CAIGE B,2		;LONG ENOUGH TO HAVE REENTER?
		UERR [ASCIZ	/No reenter address/]
		RET]
	MOVEI A,.JBREN		;COMPATIBLE CASE CHECK
	CALL MAPPF
	TLNN A,B5
	ERROR <No page 0>
	TLNN A,B2
	ERROR <Page 0 read-protected>
	MOVE A,.JBREN+PAGEN
	TRNN A,-1
	ERROR <No reenter address>
	RET

;REENTER COMMAND DISPATCHES HERE

.REENT:	CALL GFRKNM		;GET FORK
	CALL $REENT
	CONFIRM
;REDIRET/DETACH...(AND) REENTER  JOINS HERE

..REEN:	MOVNI B,2		;REENTER CODE FOR PA1050
	CALL CHKPAT		;SETUP PA1050 IF THERE
	JUMPG B,START1
	MOVEI B,1		;REENTER
	JRST START1

;REFUSE (LINKS)
; REFUSES BOTH ORDINARY LINKS AND ADVISE LINKS


.REFUS:	NOISE <links>
	CONFIRM
	CALL GCTTY		;Get controlling TTY
	 RET			;Noop if none.
	NOINT			;BE SURE BOTH HAPPEN
	HRLOI 1,(1B4)		;CHANGE ACCEPT BIT TO 0
	TLINK
	 CALL JERR
	MOVSI 1,(1B0)		;"BREAK"
	ADVIZ
	 CALL JERR
	OKINT
	RET

;RELEASE (fork handles of)

.RELEA: NOISE (fork handles of)
	SETO A,			;Get fork handle..
	CALL GETFH		; no default
	ALLOW TSPC+TALT+TEOL
	CONFIRM
	MOVE B,FKFLG-.FH(A)
	TLNE B,FK%IDD+FK%BDD
	ERROR <Can't release handle for debugger>
	CALL FNDFSB
	NOINT
	CALL RELESI		;RELEASE INFERIORS
	HLRZ C,1(B)		;POINTER TO SUPERIOR
	HRRZ D,1(C)		;SUPERIOR HANDLE
	SKIPE D			;USE ZERO FOR FLAGS IF NO HANDLE
	MOVE D,FKFLG-.FH(D)	;FLAGS
	CAIE C,FKSTC		;TOP OF STRUCTURE
	TLNE D,FK%IDD+FK%BDD	;OR DEBUGGER
	JRST RELES1		;THEN DON'T RELEASE
	HRRZ A,1(B)		;GET HANDLE
	CALL CLRFKT
	RFRKH
	 ERJMP [TLO Z,F1
		JRST RELES1]
RELES1:	OKINT
	TLZE Z,F1		;ANY ERRORS OCCURE
	ERROR <Failure of RFRKH during processing>
	RET

RELESI:	HRLM B,0(P)
	HRRZ B,0(B)		;POINT TO FIRST INFERIOR
	CALL RELALL
	HLRZ B,(P)
	RET


RELAL1:	HRLM B,0(P)
	HRRZ B,0(B)		;DO INFERIORS
	CALL RELALL
	HLRZ B,0(P)
	HRRZ A,1(B)		;HANDLE
	JUMPE A,RELAL2		;NO HANDLE FOR THIS FORK
	CALL CLRFKT
	RFRKH
	 ERJMP [TLO Z,F1
		JRST RELAL2]	;FLAG ERROR
	SETZM FKSTCF		;INVALIDATE STRUCTURE
RELAL2:	HLRZ B,0(B)		;DO PARALLELS

RELALL:	JUMPN B,RELAL1		;IF THERE IS A POINTER
	RET

;RENAME (EXISTING FILE) <NAME> (TO BE) <NAME>

.RENAM:	NOISE <existing file>
	HRROI A,		;SAY NO DEFAULT EXTENSION
	CALL CINFN		;GET INPUT FILE NAME
	 JRST CERR		;NO DEFAULT IF USER TYPES "-"
	ALLOW TSPC+TALT+TLPR
	NOISE <to be>
	MOVE A,BHC+2	;SAY DEFAULT NAME AND EXT TO THOSE OF FIRST FILE
	CALL COUTFN		;OUTPUT FILE NAME, OLD OR NEW.
	 JRST CERR
	CONFIRM
	MOVE A,CJFN1		;EXISTING FILE JFN
	MOVE B,CJFN2		;NEW FILE JFN
	RNAMF		;RENAME FILE
	 CALL [	CAIN A,RNAMX1
		 ERROR <Files not on same device>
		CAIN A,RNAMX3
		 ERROR <No access to destination (Protected or Perpetual)>
		CAIN A,RNAMX4
		 ERROR <No room>
		CAIN A,RNAMX5
		 ERROR <Destination busy>
		CAIN A,RNAMX8
		 ERROR <No access to source (Protected or Perpetual)>
		CAIN A,RNMX10
		 ERROR <Source is in use>
		CAIN A,RNMX12
		 ERROR <Rename to self is illegal>
		JRST JERR]
	JRST RLJFNS		;RELEASE THE JFNS

;RESET

.RESET:	MOVSI A,(FH%ALL)
	IORM A,PSPRIV
	SETZ A,			;Get fork handle..
	CALL GETFH		; unspecified default
	ALLOW TSPC+TALT+TEOL+PUNBIT
	CONFIRM
	PUSH P,A
	SETO A,
	CALL MAPPF
	CALL UNMAP
	POP P,A
	JUMPE A,$RESET		;Unspecified default?  (Normal thing)
	CAIN A,.FHINF		;ALL ?
	JRST RESALL
	MOVSI B,FK%BDD+FK%IDD
	TDNE B,FKFLG-.FH(A)
	JRST [	CALL UNSPFK	;DO A NO IDDT (NO BDDT)
		CALL $KFORK
		JRST RESET3]
	CALL FNDFSB
	PUSH P,B		;POINTER TO SPECFIED BLOCK
	HLRZ B,1(B)		;SUPERIOR
	HRRZ A,1(B)
	JUMPE A,.RESE1		;NO HANDLE, FORGET IT
	MOVE C,FKFLG-.FH(A)
	TLNN C,FK%BDD+FK%IDD
	JRST .RESE1
	HRRZ C,0(B)		;INFERIOR
	HLRZ C,0(C)		;PARALLEL
	JUMPN C,.RESE1		;TOO MANY INFERIORS TO KILL DEBUGGER
	HRRZM B,0(P)		;OK TO KILL DEBUGGER ON DOWN
.RESE1:	POP P,B
	HRRZ A,1(B)		;HANDLE
	CALL KFSTR
	JRST RESET3

.RESE2:	ALLOW TSPC+TALT+TEOL
	CONFIRM

;GET AND EDIT USE THE FOLLOWING AS A SUBROUTINE

$RESET:	SETOM CIFORK		;ANY RESET REMOVES
	SETOM FORK		;CURRENT FORK STATUS
	CALL $GFRKS
	SKIPA B,FKSTC		;START OF STRUCTURE
RST1:	HLRZ B,0(B)		;PARALLEL
	JUMPE B,RESET3		;DONE?
	HRRZ A,1(B)		;NO. GET HANDLE
	JUMPE A,RST1		;IGNORE FORKS WITHOUT HANDLES
	MOVE C,FKFLG-.FH(A)
	TLNE C,FK%ACT+FK%KPT
	JRST RST1		;IGNORE ACTIVE AND KEPT FORKS
	TLNN C,FK%BDD+FK%IDD	;DEBUGGER?
	JRST [	CALL KFSTR	;NO. KILL IT
		JRST RST1]
	PUSH P,B
	PUSH P,[0]
	HRRZ B,0(B)		;INFERIOR
RST2:	HRRZ A,1(B)		;HANDLE
	JUMPE A,RST3
	MOVE C,FKFLG-.FH(A)
	TLNE C,FK%KPT
	AOSA 0(P)
	CALL KFSTR
RST3:	HLRZ B,0(B)		;PARALLEL
	JUMPN B,RST2
	POP P,A
	POP P,B
	JUMPG A,RST1
	HRRZ A,1(B)
	NOINT
	CALL CLRFKT
	CALL RLPJFN
	KFORK
	OKINT
	JRST RST1

RESALL:	CALL $GFRKS
	NOINT
	SKIPA B,FKSTC
RESAL1:	HLRZ B,0(B)
	JUMPE B,RESAL2
	MOVE C,B
	CALL KFTBLS
	HRRZ A,1(B)
	CALL RLPJFN
	KFORK
	JRST RESAL1
RESAL2:	OKINT
	CALL INFER		;SKIP IF INFERIOR
	 CALL RESRES		;RESET RESOURCES (JOB WIDE)

RESET3:	SKIPG CREDIF		;ABANDONED PRIMARY INPUT FILE?
	 JRST RESET4		;NO
	HRRZ 1,CRJFNI
	CALL CLSRLF##
	SETZM CRJFNI
	SETZM CREDIF		;SAY INPUT NO LONGER REDIRECTED

RESET4:	SKIPG CREDOF
	RET
	HRRZ 1,CRJFNO
	CALL CLSRLF##
	SETZM CRJFNO
	SETZM CREDOF
	RET


;Reset job wide resources

RESRES:	SETOM A
NOIAC <	RLPTY>
IAC <	REPTY>
	 JFCL
	RLSIG
	 JFCL
NOSCRC<	RELSQ>
	RET


$KFORK:	CALL $GFRKS
KFSTR:	TRO A,.FH		;BE SURE OF HANDLE
	PUSH P,A
	NOINT
	MOVE A,0(P)
	SETZ B,
	MOVEI C,FKSTC
	CALL FNDFSP
	SKIPN C,B
	CALL SCREWUP
	CALL KFTBLS
	MOVE A,0(P)
	CALL RLPJFN
	KFORK
	SETZM FKSTCF
	OKINT
	POP P,A
	RET

;KFTBLS -- KILL FORK TABLES
;B/ POINTER TO THE STRUCTURE
;C/ POINTER TO THE TOP FORK TO KILL

KFTBLP:	HLRZ B,0(B)		;ENTRY TO DO PARALLELS

KFTBLS:	SKIPN B			;DONE IF ZERO
	RET
	HRLM B,0(P)		;SAVE POINTER
	HRRZ B,0(B)		;POINTER TO INFERIORS
	CALL KFTBLS		;DO INFERIORS
	HLRZ B,0(P)		;RESTORE POINTER
	HRRZ A,1(B)		;FORK HANDLE
	JUMPE A,KFTBL1		;DON'T HAVE A HANDLE TO IT
	CALL CLRFKT
KFTBL1:	CAIE B,(C)		;TOP?
	JRST KFTBLP		; NO. DO PARALLELS
	RET			;YES. DONE

CLRFKT:	CAMN A,LFORK
	SETOM LFORK
	CAMN A,FORK
	SETOM FORK
	TRZ A,.FH		;MAKE IT A NUMBER
	CAMN A,CIFORK
	SETOM CIFORK
	PUSH P,C
	PUSH P,D
	CALL KFNAME		;REMOVE NAME FROM TABLE
	SETZM FKFLG(A)		;SAY NO MORE FORK
	POP P,D			;RESTORE D
	POP P,C			;AND TOP POINTER
	TRO A,.FH		;RETURN HANDLE
	RET

RLPJFN:	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,A		;Save fork handle
	MOVEI A,.FHSLF
	GPJFN
	HLRZ A,B
	EXCH A,0(P)		;Save JFN get fork handle
	HRRZS B
	PUSH P,B
	HLRZ B,PRIMRY
	PUSH P,B
	HRRZ B,PRIMRY
	PUSH P,B
	GPJFN
	HRRZ A,B
RLPJF1:	MOVSI C,-4
	HRRI C,-3(P)
	CALL RLPJF2
	HLRZS A,B
	JUMPN B,RLPJF1
	SUB P,BHC+4
	POP P,C
	POP P,B
	POP P,A
	RET

RLPJF2:	CAMN A,0(C)
	RET
	AOBJN C,RLPJF2
	PUSH P,B
	SKIPE B,CREDIF
	CAMN A,CRJFNI
	JUMPN B,RLPJF3
	SKIPE B,CREDOF
	CAMN A,CRJFNO
	JUMPN B,RLPJF3
	CALL CLSRLF##
RLPJF3:	POP P,B
	RET


KFNAME:	MOVSI D,-NFKS
KFNAM1:	HLRZ C,FKNMT+1(D)	;VALUE POINTER
	CAIN C,FKNNB##(A)	;VALUE TABLE
	JRST KFNAM2
	AOBJN D,KFNAM1
	JRST KFNAM3		;NOT IN TABLE
KFNAM2:	MOVEI C,FKNMT+1(D)	;ENTRY TO REMOVE
	HRLI C,1(C)
	BLT C,FKNMT+NFKS-1	;TO END OF TABLE
	SETZM FKNMT+NFKS	;PULL IN ZEROS
	SOS FKNMT
KFNAM3:	MOVSI C,FK%NAM
	ANDCAM C,FKFLG(A)	;SAY NO NAME
	RET

;"RUN" IS WITH "GET" ABOVE.

;SAVE (CORE FROM) N (TO) N, (FROM) N (TO) N ... (ON) F

.SAVE:	SKIPGE FORK
	ERROR <No current fork>
	NOISE <core from>
	MOVEI B,1(P)		;WHERE "SAVE" ARGUMENT TABLE WILL BEGIN
SAVE1:  CALL OCTAL        	;INPUT OCTAL NUMBER AND SKIP
        JRST [	ALLOW TALT	;NO SKIP, NULL INPUT.
		MOVEI A,20	;ON ALT MODE ONLY, ASSUME 20.
		$TYPE <20 >
                JRST .+1]
	ALLOW TSPC+TALT+TLPR
	PUSH P,A		;BUILD TABLE OF "SAVE" ARGUMENTS IN PUSHDOWN
        NOISE <to>
        CALL OCTAL
	JRST [	ALLOW TALT
                MOVEI A,777777
		$TYPE <777777 >
                JRST .+1]
	SUB A,(P)
	JUMPL A,CERR		;MAX < MIN
	ADDI A,1
	TLNE A,1
	JRST [	MOVEI A,1B18	;FOR 0 TO 777777 LENGTH IS 1000000,
		HRLM A,(P)	;...WHICH IS MORE THAN 18 BITS,
		PUSH P,[B0,,B0]	;...SO USE TWO BLOCKS OF HALF SIZE.
		JRST .+2]
	HRLM A,(P)		;FORM LENGTH,,LOCATION
        CAIN TRM,","    	;COMMA AFTER SECOND ONE?
	JRST [	CALL SAVNOI	;SPECIAL HANDLING OF NOISE "FROM"
                JRST SAVE1]	;GET ANOTHER PAIR
	ALLOW TSPC+TALT+TLPR+TLAN
        NOISE <on>
	TLZ Z,EOLNEF		;EOL JUST TRIGGERED [NEW FILE]
	HRROI A,[ASCIZ /SAV/]	;DEFAULT .SAV, NO NULL CASE.
        CALL COUTFN		;COLLECT OUTPUT FILE NAME
	 JRST CERR
        CONFIRM
        ;TRANSFER DATA
	PUSH P,[0]		;TERMINATE TABLE
	HRL A,FORK
	HRR A,CJFN1
		;B ALREADY CONTAINS POINTER TO TABLE
	SAVE		;SAVE. IGNORES NON-EXISTENT OR 0 CORE.
	CALL RLJFNS		;RELEASE JFN.
	JRST CMDIN4		;CAN'T POPJ WITHOUT FLUSHING TABLE

;SAVNOI
;SUBROUTINE FOR SPECIAL HANDLING OF NOISE WORD "(FROM)" AFTER COMMA
; IN SAVE AND SSAVE COMMANDS:
;IF NEXT INPUT IS ALT MODE, TYPE OUT THE NOISE WORD.
;THIS IS BECAUSE PREVIOUS FIELD CAN'T END WITH ALT MODE - 
; ALT MODE MEANS SOMETHING DIFFERENT IN THIS CONTEXT.

SAVNOI:	PRINT " "		;SOME INDICATION THAT COMMA WAS ACCEPTED
	CALL CSTR		;PRE-READ NEXT FIELD
	TLO Z,BAKFF		;SAY RE-USE IT
	TRNN CBT,TALT		;DID IT END IN ALT MODE?
	JRST SAVNO1		;NO, MIGHT BE "(", IN WHICH CASE "NOISE" MACRO
		;WILL ALLOW USER TO TYPE IN NOISE WORD.
	CAILE CNT,1		;WAS IT NULL?
	RET		;NO, ITS NEXT ARG, NO "NOISE" MACRO NEEDED.
	TLZ Z,BAKFF		;ALT MODE ONLY, DON'T RE-USE, "NOISE" MACRO
		;WILL TYPE OUT NOISE.
SAVNO1:	NOISE (from)
	RET

;SECURE AND UNSECURE (PASSWORD)

.SECURE:
	SETOM SECURE		;Turn on secure mode
	SKIPE PRVENF		;If enabled then imply a disable
	JRST .DISABL
	RET

.UNSECURE:
	ALLOW TSPC!TALT
	HRRZ A,CUSRNO		;Logged in user number
	CALL PASWD		;Get a password
	ALLOW TSPC!TALT!TEOL
	CONFIRM
	MOVE B,A
	HRRZ A,CUSRNO		;Directory number
	TLO A,(1B0)		;Just check password
	CNDIR
	 CALL [	CAIN A,CNDIX1
		ERROR <Incorrect password>
		JRST JERR]
	SETZM SECURE		;OK. Clear secure mode
	RET

;SET 		;set exec param
 
;SET PATH and SHOW PATH commands.
;Code provided by Sumex. B.E.S. March 77


..SET:	KEYWD $SET
	 TE PATH,,,..SEAR 	;DEFAULT
	 JRST CERR		;NOPE, BYE
	JRST (KWV)
 
;SHOW				;DISPLAY PARAM
 
.SHOW:	KEYWD $SHOW
	 TE PATH,,,..PATH	;DEFAULT
	 JRST CERR
	JRST (KWV)
 
$SET:	TABLE
	TE PATH,,,..SEAR	;SET DIRECTORY SEARCH PATH
IAC <	T TABSTOPS,,LPROK,..TABS	; SET TABSTOPS (EVERY) N (SPACES) >
	TEND
 
$SHOW:	TABLE
	TE PATH,,,..PATH	;SHOW DIRECTORY SEARCH PATH
	TEND


IAC <
..TABS:	NOISE	(every)
	CALL	DECIN
	 JRST	CERR
	CAIL	A,1
	CAILE	A,^D107
	  JRST	CERR
	NOISE	(spaces)
	CONFIRM
	SETZB	B,C
	SETZB	D,F
	MOVNS	A
	MOVSI	E,B0
	MOVEI	G,B
TABST1:	LSHC	E,(A)
	JUMPE	E,[AOS G
		   CAILE G,D
		   JRST STOPS2
		   MOVE E,F
		   SETZ F,
		   JRST .+1]
	IORM	E,(G)
	JRST	TABST1
>

..PATH:	CONFIRM
	SETZ 5,
PATH:	MOVE 1,CDEFDR(5)	;GET THE DEFAULT DIR INDICATOR
	JUMPE 1,CMDIN4		;QUIT ON A ZERO
	CALL BEFORE		;COMMA WHEN NECESSARY
	JUMPL 1,[TYPE <Connected>
		 AOJA 5,PATH]
	ETYPE <%1R>
	AOJA 5,PATH


..SEAR:	TRNE CBT,TEOL		;DID EOL TERMINATE
	JRST PATHIX		;INIT PATH EVEN IF ONE EXISTS
	ALTYPE <(to be) >
	MOVEM P,.P		;Stack frame
SEAR0:	MOVEI 1,$SEAR
	INHELP <
 Directory name, or one of the following:
%1Z>
	CAIG CNT,1
	JRST [	TRNE CBT,TEOL	;CNT IS < 1, IS TERM. AN EOL?
		JRST SEAR3	;YES, GO FINISH
		TRNE CBT,TCOM	;IS IT A COMMA?
		JRST SEAR0	;YES, JUST A DELIMITER, NEW FIELD
		JRST SEAR2]	;NOPE, TRY DIRNAM
	 
	TLO Z,BAKFF		;USE THE FIELD OVER AGAIN
	KEYWD $SEAR
	 0
	 JRST SEAR2		;NOT A KEYWORD, DIRNAM?
	HRRE KWV,KWV		;ONLY RH IS INTERESTING
	JUMPL KWV,[PUSH P,MINUS1 ;Negative means connected
		JRST SEAR1]
	JUMPE KWV,[JSP 5,SEADEF	;Zero means insert default series
		JRST SEAR1]	;
	HRRZ 1,CUSRNO		;OTHERWISE IT MEANS LOGIN
	PUSH P,1
 
SEAR1:	TRNN CBT,TEOL		;QUIT ON EOLS
	JRST SEAR0
	JRST SEAR3
	
SEAR2:	TLO Z,BAKFF		;LETS TRY DIRNAM
	CALL DIRNAM		;DIRNAM HANDLES THE ERRORS
	TLZ 1,-1		;Clear flags
	PUSH P,1		;
	ALTYPE < >
	JRST SEAR1
 
SEAR3:	CONFIRM
	HRRZ 1,.P		;Make AOBJN pointer to directories
	SUBI 1,1(P)		; that were stacked
	HRLZ 5,1		;
	HRR 5,.P		;
	AOBJP 5,PATHIX		;If none specified, use default

	SETZM CDEFDR		;Clear out old path
	MOVE 1,[XWD CDEFDR,CDEFDR+1]
	BLT 1,CDEFDR+NDEFDR-1

	MOVEI 4,0		;Count of directories
SEAR4:	MOVE 2,0(5)		;Get item
	MOVN 3,4		;Make AOBJN pointer to real
	HRLZS 3			; search path table

	CAMN 2,CDEFDR(3)	;Is item already in path?
	JRST SEAR5		;Yes, forget it
	AOBJN 3,.-2		;Scan the table

	CAIL 4,NDEFDR-1		;Over limit?
	ERROR <The search path may only contain %4Q directories>
	MOVEM 2,CDEFDR(4)	;Save item
	ADDI 4,1		;

SEAR5:	AOBJN 5,SEAR4		;Do all stacked directories
	MOVE P,.P		;
	SETZM .P		;
	RET			;

$SEAR:	TABLE
	T CONNECTED,,EOLOK+COMOK,-1
	T DEFAULT,,EOLOK+COMOK,0
	T LOGIN,,EOLOK+COMOK,1
	TEND



;CALL PATHIN TO INITIALIZE PATH IF LOGGED IN AND NEEDED
;CALL PATHIX TO INITIALIZE TO DEFAULT IF LOGGED IN

PATHIN:	SKIPN CDEFDR		;NEEDS A PATH?
PATHIX:	SKIPG CUSRNO		;LOGGED IN?
	RET			;NO, DON'T INITIALIZE PATH
 
	SETZM CDEFDR+0		;SAY NOT INITIALIZED (IN CASE OF ^C)

	HRRZ 3,P		;Remember stack level
	JSP 5,SEADEF		;Stack default directories
	HRRZ 4,P		;
	SUB 4,3			;
	SETZM CDEFDR(4)		;Terminate list
	POP P,CDEFDR-1(4)	;
	SOJG 4,.-1		;
	RET


SEADEF:	HRROI 2,[ASCIZ \SUBSYS\]
	CALL PATHIA
	 PUSH P,1		;
	HRROI 2,[ASCIZ \USRSYS\] ;
	CALL PATHIA		;
	 PUSH P,1		;
	HRROI 2,[ASCIZ \UNSUPPORTED\] ;
	CALL PATHIA		;
	 PUSH P,1		;

	PUSH P,MINUS1		;Connected directory
	HRRZ 1,CUSRNO		;Login directory
	PUSH P,1		;
	JRST (5)		;Return

 
PATHIA:	MOVEI 1,0		;THIS RETURNS THE DIR NUM OF THE NAME
	STDIR			;GIVEN IN AC2 IN AC1
	 JFCL
	 AOS 0(P)		;Skip if no directory
	TLZ 1,-1		;Clear flags
	RET

;SPLICE (fork) - (below fork) -

.SPLICE:
	NOISE <fork>
	SETO A,			;Get handle on new inferior..
	CALL GETFH		; no default
	MOVE B,FKFLG-.FH(A)	;Debugger fork not allowed
	TLNE B,FK%IDD+FK%BDD
	ERROR <Can't SPLICE debugger>
	PUSH P,A
	NOISE <below fork>
	MOVSI B,(FH%MF)		;Get handle on new superior..
	IORM B,PSPRIV		; allow handle on self
	SETO A,			; no default
	CALL GETFH
	EXCH A,0(P)
	PUSH P,A
	CONFIRM
	POP P,B			;Have system do splice..
	MOVE A,0(P)
	SPLFK
	 CALL JERR
	POP P,A			;If the new inferior was spliced
	MOVSI C,FK%ACT		; immediately below MFEXEC,
	CAIE A,.FHSLF		; then clear fork active
	ANDCAM C,FKFLG-.FH(B)
	RET

;SSAVE (PAGES FROM) N (TO) N, (FROM) N (TO) N ... (ON) FILE
;SHARABLE SAVE, WITH READ-EXECUTE PAGE ACCESS.
;CODING SIMILAR TO "SAVE", SEE ITS COMMENTS.
;SHOULD WE CHECK THAT PAGES EXIST?

.SSAVE:	SKIPGE FORK
	ERROR <No current fork>
	NOISE <pages from>
	MOVEI B,1(P)		;WHERE TABLE WILL BEGIN IN PUSHDOWN
SSAV1:	CALL OCTAL
	 JRST [	ALLOW TALT
		MOVEI A,0
		$TYPE <0 >
		JRST .+1]
	ALLOW TSPC+TALT+TLPR
	CAILE A,777
	JRST CERR
	PUSH P,A
	NOISE (to)
	CALL OCTAL
	JRST [	ALLOW TALT
		MOVEI A,777
		$TYPE <777 >
		JRST .+1]
	SUB A,(P)		;FORM -# PAGES
	MOVN A,A		;..
	SUBI A,1		;..
	JUMPGE A,CERR
	HRLM A,(P)
	MOVEI A,520		;READ-EXECUTE PERMIT, DUPLICATE ON WRITE
	DPB A,[POINT 9,(P),26]		;PUT PROTECTION IN TABLE WORD
	CAIN TRM,","
	JRST [	CALL SAVNOI		;SPECIAL HANDLING OF NOISE "(FROM)"
		JRST SSAV1]
	ALLOW TSPC+TALT+TLPR+TLAN
	NOISE <on>
	TLZ Z,EOLNEF			;EOL JUST TRIGGERED [NEW FILE]
	HRROI A,[ASCIZ /SAV/]
	CALL COUTFN
	 JRST CERR
	CONFIRM
	PUSH P,[0]
	HRL A,FORK
	HRR A,CJFN1
	SETZ C,
	SSAVE
	CALL RLJFNS
	JRST CMDIN4

;STOPS N,N,N...
;SETS TERMINAL TAB STOPS TO INDICATED COLUMNS

.STOPS:	SETZB B,C		;CLEAR 3 AC'S IN WHICH TO ACCUMULATE
	SETZ D,			;...TAB STOP BITS IN SYSTEM FORMAT.
STOPS1:	CALL DECIN		;INPUT DECIMAL NUMBER
	 JRST CERR
	CAILE A,^D107
	 JRST CERR
	ALLOW TCOM+TEOL+TSPC+TALT
	MOVE E,A
	IDIVI E,^D36		;DIVIDE INTO WORD AND BIT NUMBERS
	HRLZI A,B0
	MOVN F,F
	LSH A,(F)		;POSITION BIT
	IORM A,B(E)		;MERGE INTO PROPER WORD
	TRNE CBT,TCOM
	JRST STOPS1		;AFTER COMMA GET ANOTHER
	CONFIRM
STOPS2:	MOVE A,COJFN
	STABS			;SET TABS FROM B, C, D.
REPEAT 0,<		; BUG FIX RLW 7/3/79
	MOVEI B,0		;EXEC'S TELETYPE MODES BLOCK
	CALL STOPS8
	MOVEI E,IFKBLK		;PROGRAM INITIAL TTY BLOCK
	CALL STOPS8
	SKIPG A,CIFORK
	RET
STOPS8: > ; END OF REPEAT 0
REPEAT 1,<		; BUG FIX RLW 7/3/79
	SETZ	E,		; USE MFEXEC'S FORK BLOCK
	CALL	STOPS8
	MOVEI	E,IFKBLK	; INITIAL FORK BLOCK
	CALL	STOPS8
	SKIPG	A,CIFORK
	RET
	TRZ	A,.FH		; TURN OFF 400000 BIT
> ; END OF REPEAT 1
	MOVEI E,SFKBLK		;SIZE OF FKBLK
	IMULI E,(A)
REPEAT 1,<		; BUG FIX RLW 7/3/79
STOPS8: >
	MOVEM B,FK.STP(E)	;AND PROGRAM TELETYPE MODES
	MOVEM C,FK.STP+1(E)
	MOVEM D,FK.STP+2(E)
	RET

;START
;DECODE AND CHECK SUBROUTINE ALSO USED BY REDIRECT/DETACH

$START:	SKIPGE A,FORK		;HANDLE OF INFERIOR FORK, OR -1
	ERROR <No current fork>
	GEVEC
	HLRZ B,B
	CAIE B,<JRST>B53
	JRST [	CAIGE B,1
		ERROR	<No start address>
		CAIL B,1000		;MAX THAT SFRKV CAN HANDLE
		ERROR	<Illegal entry vector length>
		RET]
	MOVEI A,.JBSA
	CALL MAPPF
	TLNN A,B5
	ERROR <No page 0>
	TLNN A,B2
	ERROR <Page 0 read-protected>
	MOVE A,.JBSA+PAGEN
	TRNN A,-1
	ERROR <No start address>
	RET

;START COMMAND DISPATCHES HERE

.START:	CALL GFRKNM		;GET FORK
	CALL $START
	CONFIRM
;"RUN" JOINS HERE
;REDIRECT/DETACH...(AND) START  JOINS HERE

..STRT:	MOVNI B,1		;START CODE FOR PA1050
	CALL CHKPAT
	JUMPG B,.+2		;PA1050 START IF POSITIVE
	SETZ B,			;ENTRY VECTOR INDEX 0 FOR START

;START FORK WHOSE HANDLE IS IN "FORK" USING ENTRY VECTOR INDEX IN B.
;"REENTER" JOINS HERE.
;"EDIT" ENTRY

START1:
	SETO A,		;DON'T WANT ANY MAPPED PAGES WHILE RUNNING PROG,
	CALL MAPPF		;SO CLEAR BUFFER "PAGEN".
	MOVE A,FORK
	CAIL B,1000		;PROPER ENTRY VECTOR DISPATCH?
	JRST [	TLNN B,1	;DON'T START IF LH NON-0
		SFORK		;NO, PA1050 OR OTHER SPECIAL START
		JRST START2]
	SFRKV		;START FORK USING ENTRY VECTOR (USES A,B)
	 ERJMP SFVILI
START2:
	CALL IFORK		;PREPARE FORK(S) AND SETUP LFORK
	CAME A,FORK		;SAME FORK STILL?
	JRST [	MOVEM A,FORK	;NO, CONTINUE IT
		JRST ..CONT]
	CALL SFKTTM##
	TLO Z,RUNF

;START AND REENTER...
;CONTINUE AND GOTO JOIN HERE.
;ANY OF THE ABOVE WITH REDIRECT OR DETACH ALSO GET HERE.
;WAIT FOR FORK TO TERMINATE, AFTER DETACHING TERMINAL IF "DTACHF" ON.

$WAIT:	TLNE Z,DTACHF		;"DETACH" COMMAND?
	DTACH			;YES, DETACH CONTROLLING TERMINAL.

	RFORK
	MOVE B,FKFLG-.FH(A)
	TLNE B,FK%BAK
	JRST $WAIT1		;DON'T WAIT ON BACKGROUND FORKS
FEATUR %BAKTRP,<
	NOINT
	TLZE	B,FK%TRP	; FORK JSYS TRAPPED?
	JRST	[HRLI	1,(1B1)	; REMOVE TRAPS
		 TFORK
		  CALL	JERR
		 MOVEM	B,FKFLG-.FH(A)
		 PUSH	P,A
		 MOVE	A,FKTRAP-.FH(A)
		 UTFRK		; UNTRAP THE TRAPPED FORK
		 POP	P,A
		 HLLI	A,
		 PUSH	P,B
		 MOVE	B,FKTIW-.FH(A) ; GET BACK FORK'S TIW
		 MOVE	C,FKDIM-.FH(A) ; AND DIM
		 TLO	A,B0		; SETTING DIM
		 STIW
		 TLZ	A,B0
		 POP	P,B
		 JRST	.+1]
	OKINT
>
	WFORK
	FFORK
	CALL RFKTTM##		;SAVE TTY MODES
$WAIT1:	TLZ Z,RUNF		;SAY NO LONGER IN EFFECT
	MOVEI A,.FHSLF
	CALL SFKTTM##
	JRST CMDIN2

IFORK:
	PUSH P,B
	PUSH P,C
	PUSH P,D
	MOVE A,FORK
	CALL FNDFSB
	CALL FTPFKB
	HRRZ A,1(B)		;HANDLE
	TRZ A,.FH		;NUMBER
	MOVSI B,FK%STD+FK%ACT
FEATUR %BAKTRP,<
	MOVE	D,FKFLG(A)
	TLNE	D,FK%TRP	; FORK JSYS TRAPPED?
	TLZ	B,FK%ACT	; YES, DON'T MARK IT AS ACTIVE!
>
	IORB B,FKFLG(A)
	SKIPGE CIFORK
	MOVEM A,CIFORK
	TRO A,.FH
	TLNN B,FK%BAK		;DON'T SET LFORK FOR BACKGROUND FORKS
	MOVEM A,LFORK
	POP P,D
	POP P,C
	POP P,B
	RET

SFVILI:	CALL LSTERR
	CAIN A,SFRVX1	;BAD ENTRY VECTOR?
	ERROR <File has bad format>
	JRST ILITRP##

;ROUTINE TO SETUP FORK IF PA1050 HAS BEEN INVOKED. START, REENTER,
; GOTO, AND DDT ALL GO TO PA1050 INSTEAD OF THE PROGRAM.
; THE PREVIOUS FORK PC IS ALSO GIVEN TO PA1050, AND IT IN TURN
; FINDS THE PROGRAM'S OLD PC, SETS UP .JBOPC, AND STARTS THE PGM.
; WORD 6 OF THE PA1050 ENTRY VECTOR IS THE START LOCATION FOR THIS.
; LH OF WORD 7 IS WHERE TO STORE FUNCTION CODE: -1 START, -2 REENTER,
;  -3 DDT, +N GOTO N
; RH OF WORD 7 IS WHERE TO STORE FORK'S OLD PC

CHKPAT:	PUSH P,B		;SAVE CODE WORD
	PUSH P,C
	MOVE A,FORK
	GCVEC			;PA1050 ENTRY VECTOR
	HLRZ C,B		;CHECK FOR LENGTH GREATER THAN 8
	CAIGE C,1000		;WHICH ELIMINATES OLD PA1050 VERSIONS
	CAIGE C,10		;AS WELL AS NON-PA1050 PGMS.
	JRST [	POP P,C
		POP P,B
		RET]
	MOVEI A,6(B)
	CALL LOADF		;GET PA1050 RESTART LOC
	EXCH A,-1(P)		;SAVE IT, GET CODE WORD
	PUSH P,A
	MOVEI A,7(B)
	CALL LOADF		;GET PTRS FOR RESTART DATA
	PUSH P,A
	MOVE A,FORK
	RFSTS			;GET FORK'S OLD PC
	HLRZ A,A
	CAIE A,400002		;HALT OR FORCE TERM?
	CAIN A,400003
	JRST [	MOVE A,FORK	;YES, MUST RESTART FORK
		SFORK
		JRST .+1]
	HRRZ A,0(P)		;PTR TO CELL FOR IT
	CALL STOREF		;STORE OLD PC IN PA1050 VARIABLE AREA
	POP P,A
	HLRZ 1,1		;PTR TO CELL FOR CODE WORD
	POP P,B			;CODE WORD
	CALL STOREF		;STORE IT
	POP P,C
	POP P,B			;RETURN PA1050 RESTART LOC IN B
	MOVNI A,0(B)		;IF RH OF WD 6 IS .L. 36, IT IS
	CAMG A,[-^D36]		;PSI CHANNEL TO BE GOOSED RATHER THAN
	RET			;A RESTART LOCATION
	MOVSI B,(1B0)		;COMPUTE PROPER BIT
	LSH B,0(A)
	MOVE A,FORK
	AIC			;BE SURE CHANNEL ON AND PSI ON
	EIR
	IIC
	MOVSI B,1		;RETURH LH NON-0 TO PREVENT SFORK
	RET

;SUSPEND (fork)

.SUSPE:	NOISE (fork)
	MOVE A,FORK
	CALL GETFH
	ALLOW TSPC+TALT+TEOL
	SKIPG A
	ERROR <No current fork>
	CONFIRM
	MOVSI B,FK%ACT
	ANDCAM B,FKFLG-.FH(A)
	FFORK
	RET

;"TYPE" AND "LIST" ARE IN A SEPARATE FILE BELOW.

;UNDELETE <DELETED FILE NAMES>

.UNDEL:	NOISE (files)
	MOVE A,[XWD 2,2]	;DEFAULT NAME AND EXT TO PRECEDING ONES IN GRP
	MOVEI B,B2+B8+B11+B15+B16 ;"MUST BE NEW" AND "IGNORE DELETED BIT"
	CALL SPECFN		;INPUT FILE NAME USING GTJFN FLAGS IN B
	 JRST CERR		;NO DEFAULT FOR NULL INPUT
	ALLOW TSPC+TALT+TEOL
	CONFIRM
UNDEL1:	HRRZ A,@INIFH1		;JFN
	DVCHR
	TLNN B,B4		;MULT DIR DEVICE?
	ERROR <You can't undelete non-disk files>
	HRRZ A,@INIFH1
	MOVE B,[1,,FDBCTL]	;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
	TLNN C,<FDBDEL>B53	;"FILE IS DELETED" BIT
	JRST [	TLNN Z,GROUPF	;SKIP IF GROUP BEING PROCESSED
		UERR [ASCIZ /Not deleted/]; ERROR IF NOT GROUP
		JRST UNDEL8]	;IN GROUP JUST SKIP THOSE ALREADY DLTED
	CALL TYPIF		;TYPE NAME IF GROUP
	HRLI A,FDBCTL		;1: DISPLACEMENT,,JFN
	HRLZI B,<FDBDEL>B53	;MASK OF BITS TO CHANGE
	SETZ C,			;VALUE TO CHANGE TO: OFF.
	CHFDB			;CHANGE FILE DESCRIPTOR BLOCK
UNDEL8:	CALL GNFIL		;GET JFN OF NEXT FILE OF GROUP
	JRST RLJFNS		;NO MORE, RELEASE JFN, GO GET NEXT COMMAND.
	JRST UNDEL1		;HAVE ANOTHER

;UNMOUNT <DEVICE>

.UNMOU:	NOISE (device)
	CALL DEVN
	TLNN B,B7
	ERROR <%1H: Not a mountable device>
	TLNN B,B5
	JRST [	TLNN B,B6
		UERR [ASCIZ /%1H: Not available/]
		UERR [ASCIZ /%1H: Assigned to job %3Q/]]
	TLNN B,B8
	ERROR <%1H: Not mounted>
	CONFIRM
	DSMNT
	 CALL JERR
	RET

;UNLOAD AND REWIND COMMANDS

.UNLOA:	MOVEI F,11		;MTOPR UNLOAD FUNCTION
	CAIA
.REWIN:	MOVEI F,1		;MTOPR REWIND FUNCTION
	NOISE (device)
	CALL DEVN		;GET A DEVICE NAME
	TLNN B,B5		;AVAILABLE?
	JRST [	TLNN B,B6
		UERR [ASCIZ /%1H: Not available/]
		UERR [ASCIZ /%1H: Assigned to job %3Q/]]
	LDB C,[POINT 9,A,17]	;GET DEVICE TYPE
	CAIE C,3		;IS IT DECTAPE?
	CAIN C,2		;OR MAG TAPE?
	CAIA			;YES
	 ERROR < Must be DECTAPE or MAG. tape>
	CONFIRM
	TLO A,40000		;NO DIRECTORY (FOR DECTAPE)
	MOUNT
	 CALL JERR
	HRRZ D,A		;GET UNIT NUMBER
	LSH D,^D8
	IOR D,[ASCII /DTA0:/]	;FOR DEVICE NAME STRING
	CAIE C,3		;DECTAPE?
	TLO D,(<"MTA0:"-"DTA0:">_1)	;NO, MAKE IT MAG TAPE
	MOVSI A,1		;SHORT FORM GTJFN
	HRROI B,D		;NAME STRING POINTER
	MOVEI E,0		;MAKE NAME STRING ASCIZ
	GTJFN
	 CALL JERR
	MOVE B,[17B9+1B19]	;DUMP MODE, READ
	OPENF
	 CALL JERR
	MOVE B,F		;MTOPR FUNCTION
	MTOPR
	CLOSF
	 CALL JERR
	RET

;WHERE (IS USER) <NAME>

.WHERE:	NOISE <is user>
	CALL DIRNAM		;INPUT DIR (USER) NAME WITH RECOGINITION
	ALTYPE ( )
	ALLOW TEOL+TSPC+TALT
	CONFIRM		;NEEDED EVEN THOUGH ITS A NON-CONFIRMATION CMD!
	SETO C,			;Don't print "Not logged in"
	TLNN A,(1B0)		;If ok to login then
	TDZA C,C		; allow the message
	TYPE < [Files only]
>;				; else indicate it is files only
	PUSH P,A
	MOVE A,['JOBDIR']
	CALL $SYSGT		;GET LENGTH OF TABLE AND NUMBER
	JUMPE B,CERR		;LACKS GETAB CAP?
	HLLZ D,B		;NEG LENGTH FOR AOBJN
	MOVEI E,0(B)		;TABLE NUMBER
WHERE1:	GTB 0(E)		;GET AN ENTRY FROM TABLE
	SKIPGE 0(P)		;If files only
	HLRZS A			; just check connected
	XOR A,0(P)		;Compare
	TLZ A,-1		;Just right half
	JUMPN A,WHERE9
;MATCH FOUND, USE TABLE 0 TO CONVERT JOB # TO TTY #
	HRLZ A,D
	GETAB
	 CALL JERR
	MOVEI B,0(D)		;JOB NUMBER
	JUMPE B,WHERE9		;DONT SHOW JOB 0
	JUMPL A,[ETYPE < Detached, Job %2Q, >
		JRST WHERE7]
	HLRZ A,A
	ETYPE < TTY%1O%>
	CALL IFTACT		;Skip if TTY active
	 PRINT "*"		;Show as someone waiting
	ETYPE <, Job %2Q, >

;PRINT FOREIGN HOST NAME IF A NETWORK TTY
WHERE4:	PUSH P,A		;SAVE TTY# TO COMPARE AGAINST
	MOVE A,['LHOSTN']
	CALL $SYSGT
	JUMPE B,WHERE6		;TABLE DOES NOT EXIST??
	HRLI A,1		;TABLE INDEX
	HRR A,B			;TABLE NUMBER
	GETAB
	 JRST WHERE6
	HLRE B,A		;MINUS THE NUMBER OF NET TTY'S
	MOVMS B
	HRRZS A			;LOWEST NUMBERED NET TTY
	ADD B,A			;1 + HIGHEST NUMBERED NET TTY
	CAMG A,0(P)		;REJECT IF TTY# .LE. LOWEST NET TTY
	CAMG B,0(P)		;REJECT IF HIGHEST+1 .LE. TTY#
	 JRST WHERE6
	MOVE A,['NETBUF']
	CALL $SYSGT
	JUMPE B,WHERE6		;NO SUCH TABLE??
	HLLZ F,B		;MAKE AOBJN PTR
	HRRZ G,B		;SAVE TABLE NUMBER

WHERE5:	HRR A,G			;TABLE NUMBER
	HRL A,F			;INDEX UNDER CONSIDERATION
	GETAB
	 CALL JERR
	XOR A,0(P)		;COMPARE
	HRRZS A			;JUST RIGHT HALF
	JUMPN A,WHER58	;TTY# DOES NOT MATCH, TRY NEXT ENTRY

WHER51:	MOVE A,['NETSTS']
	CALL $SYSGT
	JUMPE B,WHERE6		;TABLE DOESN'T EXIST??
	HRR A,B			;TABLE NUMBER
	HRL A,F			;INDEX
	GETAB
	 CALL JERR
	TLC A,340000		;LOOK FOR 7 IN LEFT 4 BITS
	TLNE A,740000
	JRST WHER58		;NOT IN THE RIGHT STATE

WHER52:	MOVE A,['NETAWD']	;FOUND MATCH
	CALL $SYSGT		;NOW GET THE FOREIGN HOST NUMBER
	JUMPE B,WHERE6		;TABLE DOES NOT EXIST??
	HRR A,B			;TABLE NUMBER
	HRL A,F			;INDEX
	GETAB
	 CALL JERR
	LDB B,[POINT 9,A,17]	;FOREIGN HOST NUMBER

	MOVE A,COJFN		;OUTPUT JFN
	MOVEI C,^D10		;IN CASE NOUT IS NEEDED
	CVHST			;HOST TO STRING CONVERSION
	 NOUT			;DON'T KNOW THAT HOST, PRINT AS NUMBER
	  JFCL			;STRING PRINTED OR SCREWY NOUT(??)

; IF A TIP, OUTPUT THE PORT #
	PUSH P,B		;HOST#
	MOVE A,['HOSTN ']
	CALL $SYSGT
	 JUMPE B,WHERE6		;NO TABLE?
	PUSH P,B		;HOSTN TABLE INFO
	HLLZ C,B		;AOBJN PONTER
WHER53:	HRRZ A,0(P)		;TABLE INDEX
	HRL A,C			;INDEX TO TABLE
	GETAB
	 CALL JERR
	LDB B,[POINT 9,A,17]	;GET HOST#
	CAMN B,-1(P)		;SAME?
	 JRST WHER54		;YES
	AOBJN C,WHER53		;NO, LOOP THRU TABLE
	JRST WHER55		;DONE, NO ENTRY FOR HOST

;THIS HOST ENTRY, SEE IF TIP OR MTIP
WHER54:	LDB B,[POINT 4,A,8]
	CAIE B,4		;TIP?
	CAIN B,5		;MTIP?
	CAIA			;YES
	JRST WHER55		;NO, EXIT DOING NOTHING
	PRINT "#"
	MOVE A,[SIXBIT/NETFSK/]
	CALL $SYSGT
	JUMPE B,WHERE6		;NO TABLE?
	HRRZ A,B		;TABLE#
	HRL A,F			;INDEX ON CONNECTION
	GETAB
	 CALL JERR
	LSH A,-^D16		;CONVERT TO PORT#
	MOVE B,A
	MOVE A,COJFN
	MOVEI C,^D8
	NOUT
	 JFCL
WHER55:	SUB P,BHC+2		;HOSTN TABLE INFO
	TYPE	<, >
	JRST WHERE6		;DONE

WHER58:	AOBJN F,WHERE5		;TRY NEXT NETBUF TAB ENTRY

WHERE6:	SUB P,BHC+1		;FLUSH SAVED TTY#

;PRINT SUBSYSTEM NAME
WHERE7:	MOVE A,['JOBNM2']
	CALL $SYSGT
	MOVEI C,(D)
	JUMPN B,WHER71
	MOVE A,['JOBNAM']
	CALL $SYSGT
	JUMPE B,WHERE8
	HRR A,B
	HRL A,D
	GETAB
	 CALL JERR
	MOVE C,A
	MOVE A,['SNAMES']
	CALL $SYSGT
	 JUMPE B,WHERE8
WHER71:	HRR A,B
	HRL A,C
	GETAB
	 CALL JERR
	JUMPE A,[PRINT "?"
		JRST WHERE8]
	CALL SIXPRT	;PRINT IT

	GTB	(E)
	SKIPGE 0(P)		;Files only?
	MOVSS A			;Yes.
	HLRZ B,A
	CAIN B,(A)		;Connected same as login?
	JRST WHERE8		;Yes
	SKIPL 0(P)		;Skip if files only
	ETYPE <, <%2R%>>
	SKIPGE 0(P)		;Skip if normal user
	ETYPE <, User %2R%>

WHERE8:	PRINT EOL
	SETO C,			;SAY AT LEAST ONE FOUND
;AFTER TYPING CONTINUE LOOP IN CASE HE HAS SEVERAL JOBS.

WHERE9:	AOBJN D,WHERE1
	SKIPE	C
	JRST CMDIN4
	UTYPE	[ASCIZ/ Not logged in/]
	MOVEI A,400000
	RPCAP
	TRNN C,WHEEL!OPER	;IF WHEEL OR OPERATOR CAP ENABLED,
	JRST WHER10
	HRRZ A,(P)		;PRINT LAST LOGIN DATE AND TIME
	MOVEI B,CSBUF
	HRROI C,CSBUF+15
	GTDIR
	MOVE A,CSBUF+12
	JUMPE A,[TYPE	< ever>
		JRST .+2]
	ETYPE	< since %1D %E>
WHER10:	UTYPE	[BYTE (7) 15,12]
	JRST CMDIN4

IFTACT:	PUSH P,A		;TTY number
	PUSH P,B
	MOVE A,['TTYJOB']
	CALL $SYSGT
	JUMPE B,IFTAC1
	HRLZ A,-1(P)		;Use tty as index
	HRR A,B
	GETAB
	 JRST IFTAC1
	TLZ A,-1		;Clear left half
	CAIN A,-1		;Active?
	AOS -2(P)		;Yes
IFTAC1:	POP P,B
	POP P,A
	RET

LIT1C:	LIT		;LITERALS HERE TO REDUCE WORKING PAGE SET --
		;CODE FOLLOWING IS RELATIVELY RARELY USED.

