;<EXEC>X1CMD.MAC;41    16-DEC-75 16:46:15    EDIT BY PLUMMER
; 1.54
; ADD DOBE'S IN M..CHK AND P..CHK TO ENSURE MSG NOT LOST

;<EXEC>X1CMD.MAC;39    30-SEP-75 10:44:16    EDIT BY PLUMMER
; MAIL CHECK BUMPS CHECK TIME FOR MAIL WATCH
;<EXEC>X1CMD.MAC;37    19-SEP-75 10:22:26    EDIT BY PLUMMER
; REDO LOGIN NOTICES, AND SHUTDOWN WARNING CHECK STRATEGY
; FLUSH MESMES MESS
;<EXEC>X1CMD.MAC;33    17-SEP-75 16:02:36    EDIT BY PLUMMER
; MAIL, PRINTER, AND DOWNTIME CHECKS AT LOGOUT
; GIVE NICE ERROR FOR FAILING LGOUT(N)
; CHECK ENTRY VECTOR LENGTH OF IDDT/BDDT MORE CAREFULLY
;<EXEC>X1CMD.MAC;28    16-SEP-75 17:06:10    EDIT BY PLUMMER
; MAKE $START CHECK ENTRY VECTOR LENGTH TO AVOID SFRKV BLOW UP
; BEGIN WORRYING ABOUT LACK OF GETAB CAPABILITY
; PARC CHANGES ...
;  DEFAULT DIRECTORY FOR CONNECT.
;  SAVE USERS MODE BITS FOR WHATEVER USE YOU MAY WANT.
;  DEFAULT TO "MAIL WATCH ON"
;  STRINGS OF DIGITS ARE CONSIDERED NUMERIC ACCOUNT DESIGNATORS EVEN
;     EVEN THOUGH IT MAY BE A STRING ACCT USER. (IS THIS RIGHT?)
; BETTER JOB COUNTER
;<EXEC>X1CMD.MAC;23    14-JUL-75 14:15:04    EDIT BY PLUMMER
; USE JOBNM2 IN "WHERE"
;<EXEC>X1CMD.MAC;22     4-JUN-75 11:09:51    EDIT BY PLUMMER
; ADD USRCHK ROUTINE IN LOGIN
;<EXEC>X1CMD.MAC;21    31-MAR-75 11:34:29    EDIT BY PLUMMER
; FLUSH CHECK FOR PIE SLICE SYSTEM IN ACCT2+
;<EXEC>X1CMD.MAC;20    27-MAR-75 11:05:32    EDIT BY PLUMMER
; REPAIR ACCT.  DEFAULT CASE WHEN NO DEFAULT EXISTS
;<EXEC>X1CMD.MAC;19    27-MAR-75 10:26:51    EDIT BY PLUMMER
; FIX A $RESET4 BACK TO RESET4
;<EXEC>X1CMD.MAC;17    17-MAR-75 10:46:14    EDIT BY PLUMMER
; RESET BECOMES $RESET FOR MACRO 50
; WAIT BECOMES $WAIT FOR MACRO 50
; RFORK BECOMES LFORK FOR MACRO 50
;<EXEC>X1CMD.MAC;16     5-MAR-75 14:08:37    EDIT BY PLUMMER
; MOVE IN ..LOGO FROM X4CMD
;<EXEC>X1CMD.MAC;12    30-JAN-75 18:00:11    EDIT BY PLUMMER
; "CHANGE PASSWORD" REQUIRES NEW PASSWORD TO BE INPUT TWICE
;<EXEC>X1CMD.MAC;10    13-JAN-75 12:06:02    EDIT BY PLUMMER
; CHANGE MSG FOR FORK TERMINATION DUE TO CHN 20. INTERRUPT
;<EXEC>X1CMD.MAC;2     5-JAN-75 20:28:53    EDIT BY PLUMMER

;1.53
;<EXEC>X1CMD.MAC;7    31-DEC-74 10:46:02    EDIT BY PLUMMER
; USE SPRTR IN "ACCESS" (PARC)
; MESMES SETS DWNMSF (PARC)
;<EXEC>X1CMD.MAC;6    17-DEC-74 16:04:33    EDIT BY PLUMMER
; NEW "ACCT" ROUTINE
; "CHANGE ACCOUNT" TYPES PREVIOUS ACCOUNT
;<EXEC>X1CMD.MAC;3    17-DEC-74 10:13:18    EDIT BY PLUMMER
; REMOVE PRIVILEDGED COMMANDS TO X4
;<EXEC>X1CMD.MAC;1     2-DEC-74 10:17:24    EDIT BY PLUMMER

; 1.52
;<N-EXEC>X1CMD.MAC;52    25-NOV-74 11:39:45    EDIT BY PLUMMER
; CHANGE RECONF LOGIC IN ^ESET
;<N-EXEC>X1CMD.MAC;51    22-NOV-74 22:16:03    EDIT BY PLUMMER
; "BREAK" NO LONGER IMPLIES "REFUSE"
; "ENABLE" NO LONGER DOES "BREAK" OR "REFUSE"
;<N-EXEC>X1CMD.MAC;49    21-NOV-74 21:14:33    EDIT BY PLUMMER
; CONVERT TO $SYSGT
; CHECK OPNX3 IN GETILI
;<N-EXEC>X1CMD.MAC;47    18-SEP-74 14:20:41    EDIT BY PLUMMER
; ADD TEST FOR PIE SLICE IN ACCT
;<N-EXEC>X1CMD.MAC;46    11-SEP-74 16:09:12    EDIT BY PLUMMER
; EOL AT LOGIN7
;<N-EXEC>X1CMD.MAC;45     5-SEP-74 17:41:22    EDIT BY PLUMMER
; CROCK PIE SLICE STUFF
;<N-EXEC>X1CMD.MAC;43    13-JUL-74 19:29:49    EDIT BY PLUMMER
; CHANGE ACCOUNT INVALID ERROR TEXT
; ADD "DUE TO" TO "HALT", AND CHANGE DWNTIM ROUTINE
; "ACCOUNT" TAKES LIST OF FILES
; 2 PLACES TO LOOK FOR SYSTEM LOGIN MESSAGES
; "MAIL CHECK" AND "PRINTER CHECK" DEFAULT TO LOGIN DIRECTORY
;<N-EXEC>X1CMD.MAC;39    25-JUN-74 22:19:04    EDIT BY PLUMMER
; FIX CALLS TO PASWD IN ATTACH AND CONNECT
;<N-EXEC>X1CMD.MAC;37    21-JUN-74 15:57:55    EDIT BY PLUMMER
; REDO PASSWORD STUFF FOR CHANGE PASSWORD
;<N-EXEC>X1CMD.MAC;12    19-JUN-74 22:58:27    EDIT BY PLUMMER
; JOB COUNT IN LOGIN AND LOGOUT
;<N-EXEC>X1CMD.MAC;10    19-JUN-74 17:43:23    EDIT BY PLUMMER
; "ACCESS" COMMAND
;<N-EXEC>X1CMD.MAC;32    18-JUN-74 14:08:12    EDIT BY PLUMMER
; "PRINTER WATCH/CHECK"
;<N-EXEC>X1CMD.MAC;30    17-JUN-74 23:11:56    EDIT BY PLUMMER
; PRINT "PREVIOUS LOGIN" MSG (AN INSECURITY CONSIDERATION)
; CALL BREAK2 IN LOGOUT
; "LOGOUT" FROM INFERIOR EXEC (PARC)
; "CHANGE ACCOUNT" AND "CHANGE PASSWORD"
; MAKE "DELETE" AVOID PERPETUAL FILES
; "PERPETUAL <FILE LIST>" AND "NOT PERP ..."
; "BREAK" DOES AUTOMATIC "REFUSE"
; "ENABLE" DOES AUTO "BREAK" AND "REFUSE"
;<N-EXEC>X1CMD.MAC;23    11-JUN-74 23:35:39    EDIT BY PLUMMER
; SPELL RFRKH RIGHT IN "RESET"
; "MAIL WATCH ON/OFF", "MAIL CHECK <USER>"
;<N-EXEC>X1CMD.MAC;21     3-JUN-74 16:55:06    EDIT BY PLUMMER
; SWITCH TO <SYSTEM> FOR ARCHIVE-LOOKUP PROGRAM
;<N-EXEC>X1CMD.MAC;20    23-APR-74 10:52:19	EDIT BY PLUMMER
; CHANGE HALF DUPLEX PASSWORD MASK TO HAVE SPACE AFTER CR FOR NVT'S
;<N-EXEC>X1CMD.MAC;19    10-APR-74 13:05:04	EDIT BY PLUMMER
; "EXPUNGE ALL" AND "EXPUNGE DELETED" FLUSH NON-EXISTENT FILES TOO
;<PLUMMER>X1CMD.MAC;1    22-MAR-74 16:53:46	EDIT BY PLUMMER
; MAKE QURE "RESET" ACTUALLY RELEASE ALL FORK HANDLES
; FIX "NO MESSAGES YOU HAVE A MESSAGE" BUG
;<N-EXEC>X1CMD.MAC;16    19-MAR-74 14:15:35	EDIT BY PLUMMER
; USED EVECL PARAMETER IN .EDDT
;<N-EXEC>X1CMD.MAC;15    11-FEB-74 15:01:08	EDIT BY PLUMMER
; TAGS, ETC FOR SRI-ARC
;<N-EXEC>X1CMD.MAC;12    24-JAN-74 10:51:22	EDIT BY PLUMMER
; LOGIN CHECK
;<N-EXEC>X1CMD.MAC;10    14-NOV-73 11:50:30	EDIT BY PLUMMER
; REQUIRE CONFIRMATION FOR ^E SET IF SUSPICIOUS
;<N-EXEC>X1CMD.MAC;9     8-NOV-73 14:09:35	EDIT BY PLUMMER
; "RESET" USES KFORK(-4), DOES STATUS CHECK ON IO REDIR. JFNS
;<N-EXEC>X1CMD.MAC;8    31-OCT-73 10:37:57	EDIT BY PLUMMER
; ADD TIMPSC ROUTINE FOR ^T REDO
;<N-EXEC>X1CMD.MAC;7    16-OCT-73 21:15:55	EDIT BY PLUMMER
; "EDIT" AVOIDS CHANGING AUTHOR
;<N-EXEC>X1CMD.MAC;6    12-OCT-73 13:45:03	EDIT BY PLUMMER
; NEW "IDDT", "BDDT" COMMANDS, CHANGES TO $RESET
;<EXEC>X1CMD.MAC;72     2-OCT-73 13:09:31	EDIT BY PLUMMER

; 1.51
;<N-EXEC>X1CMD.MAC;36    28-SEP-73 15:30:11	EDIT BY PLUMMER
; "WHERE" TYPES UNKNOWN HOST NUMBER IN DECIMAL
; SWITCH TO NEW "INTERROGATE" CODE
; "ACCOUNT" DEFAULTS TO DEFAULT ACCT OF LOGIN DIR
; MAKE INVALID ACCOUNTS AN ERROR
; CHKDAT DOES GTJFN RATHER THAN CALL TRYGTJ SO ERROR ARE HANDLED RIGHT
; USE %M TO TYPE DEFAULT ACCOUNT
; ADD CHECK OF DATE INPUT VS FACT FILE WRITE IN ^E SET AND MAIN LOOP
; REPAIR STRING ACCT LOGIC
; FIX BUGS IN NEW USER-ACCT VALIDATION STUFF
; SWITCH TO .JBXXX FOR 10/50 JOB DATA AREA
; ^E EDDT PASSES UNDEFINED TABLE TO DDT
; INSERT "NO" ROUTINE
; MAKE "IDDT" ROUTINE LOOK AT F1 FOR "NO"
; ACCOUNT VALIDATION
; "BREAK" CLEARS ADVISE LINKS ALSO
; "QUIT" FROM TOP-LEVEL EXEC USES JSYS 777 TO CALL MINI-EXEC
; TEST OF INFERIORNESS USES GFRKH  IF IMPLEMENTED
; MAX "FORK" NUMBER IS 17 (BUGFIX)
; INSTALL ADVISE STUFF
; MOVE TTY NUMBER STUFF OUT OF LINK AND INTO XSURBS
; ADDED GRACEFUL ERROR COMMENTS TO RENAME FAILURES
; ADD SUBCOMMANDS TO "EXPUNGE"
; ERROR MESSAGE FORK FAILING CFORK
; CHANGE NOISE ON "GET", "MERGE", AND "RUN"
; REDO "EXEC" TO USE EPHEMERAL MECHANISM
; ADD "EPHEMERAL", "NOT EPHEMERAL"
; ALL STUFF NEEDED FOR EPHEMERONS, SUCH AS IN $RESET
; INCLUDE ARCHIVE-PENDING CHECK IN "DELETE" (SHOULD BE DELF)
; UPDATE "INTERROGATE"
; "LOGOUT" DOES "EXPUNGE" BEFORE DISC ALLOCATION CHECK

; 1.50
; CLEAN UP COMMENTS IN "GET" SO SOME INSTRUCTIONS SHOW THRU
; FIX LIMIT ON NUMBER OF RELATIVE FORK HANDLES IN "FORK"
; FIX FOR ^A AND ^R DURING OR AFTER PASSWORD INPUT
; MAKE "^E EDDT" RESET ENTRY VECTOR WITH LEN 3
; TTY MODE CONTROL CHANGE
; FIX TYPEOUT IN "LINK"
; "IDDT" DOES A SETNM EVEN THOUGH PROBABLY NOT NEEDED
; GETAB LOSSAGE IN WHERE HANDLED GRACEFULLY
; BEFORE FOLDS LINE AT 65 INSTEAD OF 55
; RESTORE TTY MODES AND SUBSYS NAME OF SUPERIOR AT "QUIT"
; CLEANUP XWD'S

; 1.49
;<PLUMMER>X1CMD.MAC;12    14-JAN-73 15:06:09	EDIT BY PLUMMER
; ADDED UFORK TO REMEMBER WHICH INFERIOR HAS THE USER
; NEW "NO IDDT"
; "IDDT" AND "NO IDDT", MODS TO "RESET" AND $WAIT ROUTINES
; SETNM FOR PROGRAMS RUN FROM <SYSTEM>.  FOR AUTO STARTUP
; FIXED EXTRANEOUS [CONFIRM] FROM SAVE AND SSAVE -- NEW
;  GTJFN HANDLING OF EOL AGAIN.
; FIX "PROTECTION"
; DOWN TIME MESSAGE FORMAT CHANGES

; 1.48
; DATE INPUT ROUTINE MOVED TO XSUBRS
; USE READMAIL.SAV TO PRINT SYSTEM LOGIN MESSAGE
; "YOU HAVE A MESSAGE" PRINTED ONLY IF WRITTEN SINCE LAST LOGIN
; "WHERE" NO LONGER SYSTEM DEPENDENT -- REQUIRES 'LHOSTN' GETAB
; "REWIND" AND "UNLOAD" COMMANDS
; A FEW NOISE WORDS ADDED
; HALT COMMAND -- AGAIN
; SHUTDOWN WARNING ROUTINE

; 1.47
; "INTERROGATE" COMMAND

; 1.46
; "WHERE" PRINTS FOREIGN HOST IF NET TTY.  
; WIPE PASSWORD ON HALF DUPLEX SCOPE TERMINALS (LOGIN, ETC)
; EDIT COMMAND
; NEW LINK ROUTINE
; HALT COMMAND
; CONTROL-C TURNED OFF DURING $RESET
; LINK TO USER/TERMINAL
; WHERE UPDATED

; PDP-10 TENEX EXECUTIVE COMMANDS ROUTINES
	.DIRECTIVE XSRCVN %X1
	%X1==%X1

;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 TLPR!TALT!TSPC
	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		;ANALYZE 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

	MOVEI A,ACCE.T
	MOVEM A,ILIDSP		;SET TO CATCH BAD CHFDB

	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
	JRST NEXTF		;GET NEXT FILE, RETURN TO ACCES4


;CHFDB WILL TRAP TO HERE

ACCE.T:	SETZM ILIDSP		;CANCEL THE TRAPPER
	ERROR <ACCESS VIOLATION>



$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
	T NONE,COMOK!EOLOK,00
	T NORMAL,COMOK!EOLOK,52
	T PAGE-TABLE,COMOK!EOLOK,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:	GJINF
	MOVE B,A		;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 SCREWUP]
	JRST NEXTF		;GNJFN, TYPE NAME, GO TO ACCOU3

;"APPEND" IS WITH "COPY" IN X2CMD.MAC.

;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

;ASSIGN <DEVICE> (AS) <LOGICALNAME>

.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]
	CAIN C,12		;DEVICE TYPE TTY?
	JRST [	MOVEI E,(A)	;MASK TTY #
		GJINF		;JOB'S CONT TTY # TO D
		CAMN D,E
		UERR [ASCIZ /YOU CAN'T ASSIGN YOUR CONTROLLING TERMINAL/]
		;DVCHR B5 & B6 CLEAR FOR TTY THAT IS ANOTHER JOB'S
		; CONTROLLING TTY. 11/25/70.
		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 C,A
		MOVE A,-1(P)	;DEV DESIG FOR ERROR MESSAGES
		CAIN C,-1
		JRST .+1	;TTY IS FREE IF -1 IN LH TBL WD
  JUMPG C,[UERR [ASCIZ /%1H: IS THE CONTROLLING TERMINAL FOR JOB %3Q/]]
						;POSITIVE: JOB #
		UERR [ASCIZ /%1H: BUSY/]]	;-2: BEING ASSIGNED
				;B0+JOB # ASSIGNED TO ALSO GETS THIS
				;IF FOR SOME REASON ABOVE CHECKS FAIL.
	SETZ B,			;INDICATES NO SYNONYM
	TRNE CBT,TEOL
	JRST ASSIG3		;CR, NO SYNONYM FIELD
	NOISE <AS>

;ASSIGN...
;NEXT FIELD, IF NOT NULL, IS LOGICAL NAME (SYNONYM).
	TLO Z,PUNCF
	CALL CSTR
	CAIG CNT,1
	JRST [	TLO Z,BAKFF		;NULL, NO LOG NAME. B 0.
		JRST ASSIG3]
		;MAKE SURE THE STRING IS NOT ALREADY A SYNONYM
		;(ACCEPT PHYSICAL DEVICE NAMES).
	CALL BUFFF		;OR IS .BFP OK?
	MOVE B,A
	CAIN TRM,ALTM
	CALL UBP
	ALTYPE <:>
	ERROR <SYNONYMS NOT IMPLEMENTED YET>; _______ 8/28/70
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:	MOVE A,(P)		;DEVICE DESIGNATOR
	ASND
	 CALL JERR
	POP P,A		;DEVICE DESIG AGAIN
	JUMPE B,.+3		;B CONTAINS 0 OR LOGICAL NAME PTR
	CSYNO
	 CALL JERR
	JRST CMDIN4


;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>
	CALL USERN		;INPUT USER (DIRECTORY) NAME
	TLNE A,B0
	ERROR <THAT'S A FILES-ONLY DIRECTORY NAME>
	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		;GET MAX JOB # AS LENGTH OF SYSTEM 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		;SYSTEM TABLE 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,EOLOK,..TERM
	 JRST CERR
		;CAN'T CONFIRM HERE BECAUSE OF FUDGE-ENTRIES IN TABLE
	JRST (KWV)

$AVAIL:	TABLE
	T DEVICES,EOLOK
	T LINES,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,		;WORD -1 OF A TABLE IS ALWAYS LENGTH
	GTB 4		;SYSTEM TABLE 4 IS LINE STATUSES
	HRLZ D,A		;D IS AOBJN COUNT,,LINE #
		;TLZ Z,F1	;CLEAR TO SAY NOTHING PRINTED YET
TERMI1:	GTB 4		;LINE # = TABLE INDEX. 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, AND FILSTAT.
;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		;GET DEVICE CHARACTERISTICS WORD FROM 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]

;BREAK (LINKS)

.BREAK:	NOISE <LINKS>
BREAK1:	CONFIRM
	INTOFF
	HRLOI 1,(1B0+1B1)	;BREAK TO AND FROM CONTROLLING
	JRST BREAK3


;BREAK2 IS CALL BY ^ECREATE AND ^EPRINT

BREAK2:	INTOFF			;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 A,(1B0)		;BREAK ADVISE LINKS
	ADVIZ
	 CALL JERR
	INTON
	RET

;"CHANGE" COMMAND

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

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


;"CHANGE ACCOUNT (TO) ..."

C.ACCT:
;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.
	TLNN A,B1		;NOISE DEPENDS ON WHETHER USER TAKES...
	NOISE <# TO>		;NUMERIC ACCOUNT,
	TLNE A,B1
	NOISE <TO>		;OR STRING.
	CALL ACCT		;INPUT, CHK, CNVT ACCT INTO A (USES A )
	CONFIRM
	CALL PIE.P		;SKIP IF PIESLICE SYSTEM
	 JRST C.ACC2
	PUSH P,A		;SAVE NEW ACCOUNT
	ADD P,[10,,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,[10,,10]
	POP P,A			;NEW ACCOUNT
	JRST C.ACC3

C.ACC2:	ETYPE < TIME USED ON PREVIOUS ACCT: %B IN %C>

C.ACC3:	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
	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		;INPUT NEW PASSWORD (AGAIN)
	ALLOW TSPC+TALT+TEOL
	MOVE B,0(P)		;POINTER TO 1ST COPY
	ILDB C,A		;GET A CHR FROM 2ND STRING
	ILDB D,B		;AND ONE FROM 1ST STRING
	CAME C,D		;SAME?
	 ERROR <PASSWORD COPIES DO NOT AGREE>
	JUMPN C,.-4		;LOOP THRU ASCIZ STRING
	CONFIRM

C.PSW1:	MOVEI A,C.PSWT
	MOVEM A,ILIDSP		;SET TRAP RETURN FOR CRDIR
	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
	 CALL JERR
	SETZM ILIDSP		;CANCEL ILLEGAL INSTR TRAP
	SUB P,[5,,5]		;FLUSH JUNK
	RET


;CRDIR TRAPS TO HERE

C.PSWT:	SETZM ILIDSP		;DISABLE TRAPPER
	CAIN 1,CRDIX1
	 ERROR <OWNERSHIP RIGHTS REQUIRED>
	JRST ILIPSI

;CLEAR (DIRECTORY OF DEVICE) <DEVICE NAME>
;FORCED CONFIRMATION

.CLEAR:	NOISE <DIRECTORY OF DEVICE>
	CALL DEVN
	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		;INITILIZE DIRECTORY (DESIGNATOR IN A)
	 CALL JERR
	RET

;CLOSE (FILE) <OPEN FILE NAME>

.CLOSE:	NOISE <FILE>
	JRST NIYE		;_________________________ 

;COMMANDS (FROM FILE) <FILE NAME>

.COMMA:	NOISE <FROM FILE>
	JRST NIYE		;_________________________ 

;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:	NOISE <TO DIRECTORY>
	HRRZ A,CUSRNO		;DEFAULT TO LOGIN DIRECTORY
	CALL DEFDIR		;INPUT & CHECK DIRECTORY NAME
	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)		;DIR NUM
	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]
	CALL CHKDAL		;CHECK NEW DIRECTORY
	JRST CMDIN4

;CONTINUE
;RESUMES FROZEN INFERIOR FORKS
;DECODE AND CHECK SUBROUTINE ALSO USED BY REDIRECT/DETACH

$CONTI:	SKIPGE FORK		;HANDLE OF AN INFERIOR FORK
	ERROR <NO PROGRAM>;		;NO INFERIORS AT ALL
;"FORK" SAYS WHETHER A FORK EXISTS, AND SAYS WHICH FORK "START" AND
;"REENTER" USE, BUT SINCE IT CAN BE CHANGED WITH "FORK" COMMAND
;IT MAY NOT BE THE RIGHT ONE TO CONTINUE.
	SKIPGE A,LFORK		;HANDLE OF LAST RUN INFERIOR, IF ANY.
	ERROR <PROGRAM HASN'T BEEN RUN>;	NO FORK RUN SINCE RESET.
	RFSTS		;GET ITS STATUS (HANDLE IN A)
	TLNE A,077700		;DISTINGUISH -1 FROM 0-5,400000-400005
	ERROR <PROGRAM DISAPPEARED>;		;-1 = UNASSIGNED HANDLE.
;	JUMPGE A,[UERR [ASCIZ /NOT INTERRUPTED/]]	;B0 MEANS FROZEN
	RET

;"CONTINUE" COMMAND DISPATCHES HERE

.CONTI:	CALL $CONTI
	CONFIRM
;"REDIRECT/DETACH ... (AND) CONTINUE" JOINS HERE

..CONT:	SETOM A
	CALL MAPPF		;UNMAP ANY PAGE OF USER
	MOVEI E,PTTYMD
	CALL LTTYMD		;LOAD USER'S TTY MODE
	TLO Z,RUNF		;SAY SO.
	MOVE A,LFORK		;FORK WHICH RAN LAST
	RFSTS			;FIND OUT WHY IT STOPPED
	HLRZ 3,1
	TRZ 3,1B18		;FLUSH FROZEN BIT
	MOVE 1,LFORK
	CAIE 3,2		;FORK WAS HALTED OR FORCE TERM?
	CAIN 3,3
	SFORK			;YES. START IT
	JRST $WAIT		;GO RESUME FORK AND WAIT FOR IT

;"COPY" IS IN X2CMD.MAC.

;DAYTIME
;THIS AND ALL ONE-WORD COMMANDS ARE CONFIRMED BEFORE DISPATCH.

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

;DEFINE (NEW FILE) <NAME> (AS) <OLD OR NEW NAME>
;DECODER ONLY -- NOT TO BE IMPLEMENTED IN MINISYSTEM.

.DEFIN:	NOISE <NEW FILE>
	HRROI A,		;NO DEFAULT EXTENSION FOR FIRST FILE
	MOVEI B,B0+B1		;"FOR OUTPUT USE" AND "MUST BE NEW" BITS
	CALL SPECFN		;GET FILE NAME USING GTJFN FLAGS IN B
	 JRST CERR		;NO DEFAULT FOR "-" INPUT
	NOISE <AS>
	MOVE A,[2,,2]	;SAY DEFAULT NAME AND EXT TO THOSE OF 1ST FILE
	MOVEI B,B3		;SAY "TYPE OLD/NEW"
		;THESE GTJFN BITS ACCEPT AN OLD OR NEW NAME BUT DEFAULT
		;VERSION TO HIEST OLD RATHER THAN NEXT HIGHER AS "COUTFN" DOES.
	CALL SPECFN
	 JRST CERR
	CONFIRM
	JRST NIM		;TYPE "NOT IN MINISYSTEM"

;DELETE <FILE GROUP>

.DELET:	MOVE A,[2,,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 [	UTYPE [ASCIZ / CANNOT DELETE PERPETUAL FILE
/]
		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 [	UTYPE [ASCIZ / CANNOT DELETE ARCHIVE-PENDING FILE
/]
		JRST NEXTF]	;RETURNS TO FRSTF CALL +1

DELET1:	MOVE A,@INIFH1		;JFN(FLAGS TELL DELF WHETHER TO RELEASE)
	DELF
	 CALL [	CAIN A,DELFX1
		UERR [ASCIZ /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:	SKIPGE DDTFLG		;DDT ALREADY LOADED?
	JRST DDT4		;YES

;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 FORK
	JRST DDT2		;NO FORK

;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.
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
		;ENTRY TO "$LPT" SUBR NEAR "DIRECTORY"
	CALL $MERGE		;MERGE IT INTO FORK, CREATING FORK IF NONE,
		;AND RELEASE JFN

;DDT...
;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:	SETOM DDTFLG		;SAY DDT LOADED & SYM TAB PTR MOVED
;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.
		;MAY ALSO WRITE DIRECTORY IN SOME CASES (?)
	RELD
	 CALL JERR
		;DO WE HAVE TO DO ANYTHING TO FLUSH SYNONYMS HERE?
	JRST CMDIN4

;"DETACH" CODE IS WITH "REDIRECT" BELOW.


;DUMP (ON) <FILE NAME>.
;SAVES ENVIRONMENT.
;CAN'T BE FULLY IMPLEMENTED TIL ENVIRONMENT SAVE FILES ARE SPECIFIED.

.DUMP:	NOISE <ON>
	JRST NIYE		;____________________ 

;EDIT (FILE)

;FIRES UP TECO AT CCL ENTRY WITH JFN OF FILE SPECIFED IN AC1
; DEFAULT FILE IS MOST 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
	PUSH P,A		;SAVE THE JFN FOR STARTING TECO
	CONFIRM

	MOVE A,[EDFILE,,EDFILE+1]
	SETZM -1(A)		;CLEAR DEFAULT POINTERS WORD
	BLT A,EDFILE+EDFILL	;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
	TLNN C,(1B4)		;SEE IF FIRST WRITE HAS BEEN DONE
	 JRST EDIT3		;IT HAS. DON'T CHANGE AUTHOR
	MOVE B,[7B5+1B22]	;7-BIT, APPEND
	OPENF			;MAKE SURE IT EXISTS
	 JRST CERR
	TLO A,(1B0)		;DONT RELEASE THE JFN
	CLOSF			;TECO WILL OPEN IT
	 CALL SCREWUP

EDIT3:	HRROI B,[ASCIZ /<SUBSYS>TECO.SAV/]
	CALL TRYGTJ		;GTJFN, STACK FOR RELEASE AT ERROR, ^C
	 CALL CERR
	PUSH P,A		;SAVE FOR LATER

EDIT4:	CALL $RESET		;FLUSH OLD FORK, IF ANY
	CALL ECFORK		;GET A CLEAN ONE
	MOVE A,['TECO  ']
	MOVEM A,SUBSYS
	SETZM PROPSF		;SET "GET2B"
	MOVEI B,GETILI		;SETUP TO CATCH
	MOVEM B,ILIDSP		;ILLEGAL GET JSYS
	POP P,A			;JFN ON TECO
	HRL A,FORK
	GET			;AND RELEASE JFN
	SETZM ILIDSP		;TURN OFF SPECIAL ILL INSTR HANDLING

EDIT5:	MOVEI A,1		;REFERENCE AC1
	CALL MAPPF
	POP P,PAGEN(A)		;JFN FOR TECO TO GOBBLE DOWN
	MOVE A,FORK
	MOVEI B,PAGEN
	SFACS			;MAPFF WON'T DO THIS

EDIT6:	MOVEI B,2		;CCL ENTRY
	JRST START1		;START UP THE TECO


EDIT7:	SKIPN A,EDFILE		;IS THERE A SAVED FILE NAME.EXT?
	CALL CERR		;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 [	SETZM EDFILE	;FORGET PAST FILE
		UERR [ASCIZ /EDIT FILE HAS BEEN DELETED/]]
	MOVE B,JBUFP
	PUSH B,A		;SAVE FOR RELEASING ON ERROR,ETC
	MOVEM B,JBUFP
	PUSH P,A		;WHERE REST OF EDIT WANTS THE JFN
	CONFIRM
	JRST EDIT3		;FILE KNOWN TO EXIST, JUST GET TECO

;ENTRY (VECTOR LOCATION) <OCTAL> (LENGTH) <OCTAL>

.ENTRY:	SKIPGE FORK
	ERROR <NO PROGRAM>
	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
	CAILE A,777		;TOO LONG?
	JRST [	CAIN A,254000		;ALLOW JRST FOR COMPATIBLE
		JRST .+1
		JRST CERR]		;"?"
ENTRY5:	CONFIRM
	POP P,B		;LOCATION
	HRL B,A		;LENGTH
	MOVE A,FORK
	SEVEC
	RET

;"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
	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
	MOVSI 2,(FDBEPH)
	POP P,3
	CHFDB
	JRST RLJFNS		;RELEASE JFN AND RETURN

;'EXEC' - STARTS AN EXEC IN INFERIOR FORK SEPARATE FROM 'FORK'

.EXEC:	HRROI 2,[ASCIZ /<SYSTEM>EXEC.SAV/]
	CALL TRYGTJ		;GTJFN AND SAVE IT
	 CALL JERR
	ALLOW TSPC+TEOL+TALT
	CONFIRM
	JRST CIN4		;HANDLE AS AN EPHEMERON

;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
	T PERMANENT,INVIS+CONMAN+WHLUO+OPRUO+EOLOK+LPROK,..EXPE
	T SCRATCH,EOLOK+LPROK,..EXSC
	T TEMPORARY,EOLOK+LPROK,..EXTM
	TEND


..EXAL:	NOISE <DELETED, SCRATCH, AND TEMPORARY FILES>
	HRLZI 1,(1B12!1B13!1B15!1B16)
	JRST ..EXPU

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

..EXPE:	NOISE <FILES>
	HRLZI B,WHLUO+OPRUO
	CALL PRVCK		;SEE THAT REQUIRED CAPS ARE ENABLED
	HRLZI 1,(1B14)
	JRST ..EXPU

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

..EXTM:	NOISE <FILES>
	HRLZI 1,(1B16)

..EXPU:	PUSH P,1
	ALLOW TSPC+TALT+TEOL
	CONFIRM
	GJINF
	HRR 1,2
	HLL 1,0(P)
	DELDF
	SUB P,[1,,1]
	RET

;FORK <OCTAL FORK HANDLE>
;SETS FORK ACCESSED BY START, REENTER, GOTO, /, \, TEN50 DDT, SAVE.
;DOESN'T UPDATE SUBSYSTEM NAME (SUBSYS); MAYBE LATER IT SHOULD.

.FORK:	CALL OCTAL
	 JRST CERR
	ALLOW TALT+TSPC+TEOL
	TRO A,400000		;OK IF USER OMITS SIGN
	CAIN A,400000		;"SELF" IS LEGAL ONLY FOR WHEELS.
	JRST [	HRLZI B,WHLUO	;INDICATE WHEEL PRIV MUST BE ENABLED
		CALL PRVCK	;TEST SPECIAL CAPABILITIES
		 JRST FORK1	;NO ENABLE OR NO WHEEL CAPABILITY
		JRST FORK2]
	CAIL A,400001
	CAILE A,400017
FORK1:	ERROR <FORK HANDLE MUST BE BETWEEN 1 AND 17>
FORK2:	PUSH P,A
	RFSTS			;SEE IF THIS FORK HANDLE IS ASSIGNED.
	TLNE A,077700		;DISTINGUISH -1 FROM 0-5, 400000-400005.
	ERROR <NO SUCH FORK>	;-1 = UNASSIGNED HANDLE.
	CONFIRM
	POP P,FORK		;SAVE HANDLE FOR OTHER COMMANDS TO USE
	JRST CMDIN4

;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


;SUBROUTINE TO INPUT A PROGRAM NAME.
;FIRST PART OF GET, RUN, MERGE.
$GET1:	NOISE (FILE)
$GET11:	SETZ A,			;SAY DEFAULT TO CONNECTED DIRECTORY
	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
		JRST $GET11]	;GO RETRY.
	RET

;RUN <FILE> COMMAND = GET + START

.RUN:	PUSH P,[..STRT]		;SET RETURN TO JOIN "START" COMMAND,
				;FALL INTO "GET".



;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

;<SUBSYSTEM NAME> JOINS HERE AFTER CALLING CPFN AND SETTING
; RETURN TO JOIN START COMMAND (..STRT).
GET1:	ALLOW TSPC+TEOL+TALT
	CONFIRM
	CALL $RESET		;CLOSE FILES, KILL ALL INFERIOR FORKS.
				;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
	MOVE B,CJFN1		;JFN
	CALL SUBNAM		;SUBSYS NAME TO CELL "SUBSYS",
				;FOR USE WHEN FORK IS RUN (LTTYMD)
GET2B:	SETZM PROPSF		;"PROPRIETARY" FLAG, MAY BE SET IF
				;APPROPRIATE
			;NOW WHAT? TEST FILE'S PROTECTION? _____ 
	MOVEI A,GETILI		;SET SPECIAL IL INST TRAP DISPATCH
	MOVEM A,ILIDSP		;SO "GET" ERRORS CAN BE DETECTED
	HRR A,CJFN1
	HRL A,FORK
	GET
	SETZM ILIDSP		;CLEAR IL INST SPECIAL DISPATCH ADDRESS
	CALL RLJFNS		;RELEASE JFNS
			;ANYTHING ELSE?
	RET



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

GETILI:	PUSH P,A
	MOVE A,ERCOD		;SYSTEM ERROR CODE
	CAIN A,GETX1
	ERROR <BAD CORE SAVE FILE FORMAT>
	CAIN A,GETX2
	ERROR <SYSTEM SPECIAL PAGES TABLE FULL>
	CAIN A,OPNX3
	ERROR <PROGRAM PROTECTED>
	POP P,A
	JRST ILIPSI		;OTHER ERRORS TREATED IN GENERAL MANNER

;CREATE FORK FOR PROGRAM. USED HERE AND FOR "\"

ECFORK:	MOVEI A,-1		;NO OPTIONS, REDICULOUS PC
	CFORK
	 ERROR < NO FORKS AVAILABLE>
	MOVEM A,FORK		;HANDLE OF CURRENT INFERIOR
	FFORK			;LEAVE IT FROZEN
;TRANSMIT SPECIAL CAPABILITIES POSSIBLE TO NEW INFERIOR FORK,
; ENABLED IF ENABLED IN THIS EXEC.
;LATER SHOULD ONLY TRANSMIT RH, LH B0-B8 SHD COME FROM FILE __________
	MOVE A,FORK
	MOVE B,[777000,,777777]	;XMIT WHEEL, ETC.  BITS 0-8
				;WILL COME FROM FILE EVENTUALLY
	SKIPE LIMITC		;CAPABILITITES LIMITED?
	HLLZS B			;YES, DON'T PASS USER CAPABILITIES
	SKIPE C,PRVENF		;IF USER HAS "ENABLE"D IN THIS EXEC,
	MOVE C,B		;ENABLE TRANSMITTED CAPABILITIES
	EPCAP
	MOVE A,[INPTTY,,PTTYMD]
	BLT A,PTTYMD+NTTYMD-1	;SETUP INITIAL TTY MODES
	RET

;SUBNAM
;SUBR THAT CONVERTS JFN IN B TO APPROPRIATE SUBSYSTEM NAME WORD
;  FOR "SETNM" JSYS.
;STORES IN CELL "SUBSYS", DOESN'T "SETNM".
;TRANSPARENT, ONE USE IN "GET" CODE.

SUBNAM:	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
;GET STRING FOR GIVEN JFN
	MOVE A,CSBUFP
		;JFN IS IN B
	MOVE C,[1B2+1B5+1B8+1B35]
	JFNS		;DEVICE:<DIRECTORY>NAME
	SETZ A,			;CONV DIR NAME TO SIXBIT IN A
	MOVEI B,6
	MOVE D,[POINT 6,A,-1]
	ILDB C,CSBUFP
	CAIE C,"<"		;LOOK FOR START OF DIR NAME
	JRST .-2
	ILDB C,CSBUFP
	CAIE C,">"		;END OF DIR NAME?
	JRST [	SUBI C,40	;NO, CONV TO SIXBIT
		JUMPLE B,.-2	;DON'T STORE IF ALREADY 6 CHARS
		IDPB C,D
		SOJA B,.-2]
	CAME A,['SUBSYS'] ;BELIEVE SUBSYS OR HACKS DIRECTORY
	CAMN A,['HACKS ']
	JRST SUBN4
	CAMN A,['SYSTEM']
	JRST SUBN4			;BELIEVE SYSTEM, TOO
	MOVE A,['(PRIV)']	;PRIVATE DIRECTORY, USE (PRIV)
	JRST SUBN5
;COMPARE SUCCEEDED, PACK SUBSYSTEM FILE NAME INTO SIXBIT AND USE IT.

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:	MOVEM A,SUBSYS		;SUBSYS=PTTYMD+10
	JRST [	POP P,D
		POP P,C
		POP P,B
		POP P,A
		RET]

;GOTO <OCTAL #>

.GOTO:	CALL OCTAL
	 JRST CERR
	ALLOW TSPC+TALT+TEOL
	MOVE B,A		;ADDRESS INTO B FOR USE BELOW
	SKIPGE FORK		;CHECK HANDLE OF FORK KNOWN TO EXEC
	ERROR <NO PROGRAM>;		;NONE AT ALL
	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
	MOVEI E,PTTYMD		;SET UP PROGRAM'S TELETYPE MODES
	CALL LTTYMD		;..
	TLO Z,RUNF		;SAY PROGRAM'S TELETYPE MODES ARE IN EFFECT
	CALL IFORK		;PREPARE FORK(S) AND SETUP LFORK
	TLNN B,1		;DON'T START IF LH NON-0
	SFORK		;START FORK (USES A AND B)
	JRST $WAIT		;WAIT FOR IT TO TERMINATE

; "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
	SETOM A
	CALL MAPPF		;UNMAP ANY INFERIOR PAGE
	INTOFF			;WHILE THINGS ARE UP IN THE AIR
	MOVEI 1,BDFORK		;POINTER TO WHICH TO SETUP
	CALL CDBGFK		;CREATE DEBUGGER AND/OR USER FORKS
	 JRST BDDT5		;ALREADY EXISTS

BDDT1:	HRROI 2,[ASCIZ /<SUBSYS>BDDT.SAV/]
	MOVE 3,['BDDT  ']
	CALL LDRUND		;LOAD AND RUN IT, DO INTON
	JRST $WAIT

BDDT5:	CALL RSPLIC		;RESPLICE UFORK UNDER (DBFORK), REENTER
	JRST $WAIT




; "NO BDDT"   COMMAND
.NOBD:	INTOFF
	MOVEI 1,BDFORK		;OLD SUPERIOR
	MOVEI 2,IDFORK		;DESIRED NEW SUPERIOR
	CALL USPLIC		;DO THE UNSPLICE/RESPLICE
	INTON
	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
	SETOM A
	CALL MAPPF		;UNMAP ANY INFERIOR PAGE
	INTOFF			;WHILE THINGS ARE UP IN THE AIR
	MOVEI 1,IDFORK		;POINTER TO WHICH TO SETUP
	CALL CDBGFK		;CREATE DEBUGGER AND/OR USER FORKS
	 JRST IDDT5		;ALREADY EXISTS

IDDT1:	HRROI 2,[ASCIZ /<SUBSYS>IDDT.SAV/]
	MOVE 3,['IDDT  ']
	CALL LDRUND		;LOAD AND RUN IT, DO INTON
	JRST $WAIT

IDDT5:	CALL RSPLIC		;RESPLICE UFORK UNDER (DBFORK), INTON
	JRST $WAIT




; "NO IDDT"   COMMAND
.NOID:	INTOFF
	MOVEI 1,IDFORK		;OLD SUPERIOR
	MOVEI 2,BDFORK		;DESIRED NEW SUPERIOR
	CALL USPLIC		;DO THE UNSPLICE/RESPLICE
	INTON
	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
;VARIABLES INVOLVED ARE:

;	UFORK:	CONTAINS -1 OR HANDLE OF USER FORK
;	IDFORK:	-1 OR HANDLE OF FORK CONTAINING IDDT
;	BDFORK:	-1 OR HANDLE OF FORK CONTAINING BDDT
;	DBFORK:	CONTAINS THE ADDRESS (IDFORK, BDFORK, ETC) OF THE
;		DEBUGGER (OR WHATEVER) CURRENTLY SPLICED ABOVE THE USER.
;	FORK:	(NO CHANGE) THE FORK THE EXEC IS CURRENTLY CONSIDERING
;		FOR THINGS LIKE ^T, MEMSTAT, ETC.
;	LFORK:	(NO CHANGE) FORK WHICH WILL BE RESUMED BY CONTINUE.





;CREATE THE DEBUGGER FORK AND/OR USER

;	1:	POINTER TO CELL TO REMEMBER THE HANDLE
;	SKIPS IF NEW FORK WAS CREATED FOR DEBUGGER

CDBGFK:	SKIPL 0(1)		;IS THERE A DEBUGGER ALREADY?
	 RET			;YES, NO-SKIP RETURN
	PUSH P,1
	SKIPGE FORK		;IS THERE AN INFERIOR?
	CALL ECFORK		;NO, MAKE ONE
	PUSH P,FORK		;SAVE INFERIOR
	CALL ECFORK		;GET A NEW FORK
	MOVE 1,FORK		;NEW FORK
	POP P,FORK		;USER FORK
	MOVEM 1,@0(P)		;SETUPT IDFORK OR BDFORK, ETC
	POP P,1
	MOVEM 1,DBFORK		;REMEMBER AS SUPERIOR OF UFORK
	AOS 0(P)		;SKIP RETURN
	RET


;LOAD AND RUN THE DEBUGGER
;	1:	POINTER TO LOCATION CONTAINING THE HANDLE
;	2:	POINTER TO ASCIZ FILE NAME
;	3:	SETNM WORD


LDRUND:	PUSH P,1		;LOCATION CONTAINING HANDLE
	PUSH P,3		;SIXBIT OF 2
	MOVSI 1,(1B2!1B17)	;OLD, SHORT
	GTJFN
	 JRST [	SETOM 1
		EXCH 1,@-1(P)
		KFORK
		JRST CERR]
	HRL 1,@-1(P)		;FORM FORK.JFN
	GET
	MOVE 1,@-1(P)
	GEVEC
	HLRZS 2			;GET LENGTH
	CAIGE 2,8		;GENERAL SUSPICION
	CAIGE 2,3
	 JRST [	SETOM 1
		EXCH 1,@-1(P)
		KFORK
		UERR [ASCIZ /BAD ENTRY VECTOR/]]

LDRUN2:	MOVE 1,@-1(P)
	MOVE 2,FORK
	MOVEM 2,UFORK		;REMEMBER WHERE THE USER IS
	SPLFK			;MAKE B INFERIOR TO A
	 CALL [	PUSH P,1	;SAVE ERROR CODE
		SETO 1,
		EXCH 1,@-2(P)
		KFORK
		POP P,1
		JRST JERR]	;GO SAY ERROR FROM JSYS
LDRUN3:	MOVEM 1,PAGEN+1		;HANDLE BY WHICH DEBUGGER WILL KNOW INF.
	POP P,SUBSYS		;SIXBIT SUBSYSTEM NAME
	MOVEI 2,PAGEN
	MOVE 1,@0(P)
	SFACS
	INTON
	MOVE 1,@0(P)
	MOVEI 2,2
	MOVEI 3,SFVILI		;ROUTINE TO CATCH ILLEGAL INSTRUCTIONS
	MOVEM 3,ILIDSP		;TRAPS OUT OF SFRKV
LDRUN4:	SFRKV			;AT SPLICED ENTRY
	SETZM ILIDSP		;CANCEL TRAP
	MOVEM 1,LFORK		;FORK TO RUN IS DEBUGGER
	MOVEI E,PTTYMD		;RESTORE TTY MODES
	CALL LTTYMD
	TLO Z,RUNF		;TELL ^C ROUTINE WHAT TO DO
	POP P,1
	RET

;UNSPLICE

;	1:	POINTER TO CELL CONTAINING HANDLE OF OLD SUPERIOR
;	2:	POINTER TO CELL CONTAINING OF DESIRED NEW SUPERIOR

USPLIC:	SKIPG 0(1)		;ANY OLD SUPERIOR?
	 RET			;NO
	SKIPG UFORK
	 CALL SCREWUP		;DEBUGGER WITH NO INFERIOR?
	PUSH P,1
	SKIPG 1,0(2)		;NEW SUPERIOR SPECIFIED?
	 MOVEI 1,400000		;NO, USE THE EXEC ITSELF
	MOVE 2,UFORK		;GET HANDLE OF USER FORK
	MOVEM 2,FORK		;POINT THE EXEC AT HIM
	MOVEM 2,LFORK		;THAT IS THE FORK TO RESUME WITH A CONT.
	SPLFK
	 CALL SCREWUP
	POP P,2
	SETO 1,
	EXCH 1,0(2)
	KFORK
	RET



;RESPLICE THE USER FORK UNDER THE DEBUGGER FORK IF NEEDED

;	1:	POINTER TO CELL CONTAINING DEBUGGER FORK HANDLE

RSPLIC:	PUSH P,1		;SAVE POINTER TO HANDLE
	PUSH P,0(1)		;SAVE ACTUAL HANDLE
	CAMN 1,DBFORK		;USER ALREADY UNDER DEBUGGER?
	 JRST RSPLI5		;YES
	MOVE 1,0(P)		;GET DEBUGGER HANDLE
	MOVE 2,UFORK		;FORK CONTAINING THE USER
	SPLFK
	 CALL SCREWUP
RSPLI5:	INTON
	POP P,1
	MOVEI 2,1		;REENTER ADDRESS
	MOVEI 3,SFVILI		;SET TO TRAP ILLEAL SFRKV'S
	MOVEM 3,ILIDSP
	SFRKV
	SETZM ILIDSP
	MOVEM 1,LFORK
	MOVEI E,PTTYMD
	CALL LTTYMD		;LOAD PROGRAM'S TTY MODES
	TLO Z,RUNF
	POP P,DBFORK		;POINT AT WHICH DEBUGGER IS IN USE
	RET

;INTERROGATE (THE ARCHIVE)


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

.INTER:	ALLOW TSPC+TALT
	HRROI 2,[ASCIZ /<SYSTEM>ARCHIVE-LOOKUP.SAV/]
	CALL TRYGTJ
	 ERROR <NO LOOKUP PROGRAM>
	TLO KWV1,PROGX		;SAY CONFIRMATION TO BE DONE BY LOOKUP
	JRST CIN4		;GO HANDLE AS AN EPHEMERON

;JFNCLOSE <JFN>

.JFNCL:	CALL OCTAL
	 JRST CERR
	ALLOW TSPC+TALT+TEOL
	CAIG A,77
	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.

;LIMIT (ADDITIONAL) CORE/CPU/DISK/KILOCORESECS (TO) N

.LIMIT:	NOISE <ADDITIONAL>
	KEYWD $LIMIT
	 T CPU,LPROK		;IS CPU THE RIGHT THING TO DEFAULT TO?
	 JRST CERR
	NOISE <TO>
	CALL DECIN		;READ A NUMBER INTO A
	ALLOW TEOL+TALT+TSPC+TLPR
	JRST (KWV)		;DISPATCH

$LIMIT:	TABLE
	T CORE,LPROK
	T CPU,LPROK
	T DISK,LPROK
	T KILOCORESECS,LPROK
	TEND

.CORE:	NOISE <PAGES>
	CAILE A,1000
	ERROR <MORE THAN 512 PAGES !?>
	CONFIRM
		;NOW WHAT?
	JRST NIYE

.CPU:	NOISE <SECONDS>
	CAILE A,^D720
	ERROR <MORE THAN 12 HOURS ???>
	CONFIRM
	JRST NIYE

.DISK:	NOISE <DISK BLOCKS>
	CAILE A,^D2000		;?
	ERROR <TOO MUCH>;		;ETC
	CONFIRM
	JRST NIYE

.KILOC:	ALLOW TEOL+TALT+TSPC		;NO NOISE WORD
	CAILE A,^D1000		;?
	ERROR <TOO MUCH>
	CONFIRM
	JRST NIM		;SAY "NOT IN MINISYSTEM"

;LINK (TERMINAL/USER)

.LINK:	NOISE (TO)
	CALL TTYNUM		;GET LINE NUMBER, MAYBE FROM USER NAME
	MOVEI B,400000(A)	;FORM TTY DESIGNATOR
	HRLOI A,(1B2!1B3)	;TO AND FROM CONTROLLING TTY
	TLINK
	 ERROR <REFUSED>
	RET


;"LIST" IS WITH "TYPE" BELOW.

;LOGIN COMMAND
;LOGIN (USER) <NAME> (PASSWORD) <NOT ECHOED> (ACCOUNT [#]) <#>

.LOGIN:	SKIPLE CUSRNO
	ERROR <YOU ARE ALREADY LOGGED IN>
	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"
	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>
	CALL USRCHK		;FILTER OUT "ANONYMOUS" ETC.
	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
	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

	SETOM MESMSF		;SAY TYPE "YOU HAVE A MESSAGE" IF
				;APPROPRIATE, EVEN AFTER ^C'S
	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
	HLLZM B,MODES		;STORE USER MODE BITS
	PUSH P,A		;SAVE DATE & TIME OF LAST LOGIN
;UPDATE SPECIAL CAPABILITIES
	MOVEI A,B0
	RPCAP
	HLLZ C,B
	SKIPE PRVENF
	HRR C,B
	EPCAP
	TRNE B,1B18!1B19!1B20	;IF WHEEL, OPER, OR CONFI
	SETOM LIMITC		;DEFAULT TO LIMITED CAPS.

;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
	INTOFF
	MOVE A,ALOFH
	KFORK			;KILL THE FORK
	SETOM ALOFH		;SAY THE ALO FORK HAS BEEN KILLED
	INTON

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

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

;TYPE SYSTEM LOGIN MESSAGE IF THERE IS ONE

LOGIN7:	PRINT EOL
	POP P,A			;DATE & TIME OF LAST LOGIN
	POP P,B			;WHAT STDIR RETURNED
	TLNE B,B2		;B2 SAYS ALWAYS PRINT LOGIN MESSAGE
	SETZ A,			;SET DATE TO 0 TO FORCE PRINTING
	MOVE B,[POINT 7,[ASCIZ /<SYSTEM>MESSAGE.TXT/]]
	CALL MESS
;	MOVE B,[POINT 7,[ASCIZ /<SYSTEM>LOGIN.MESSAGES/]]
;	CALL MESS		;TYPE FILE IF IT IS NEW ENOUGH

;ADD VARIOUS OTHER THINGS OF INTEREST TO THE LISTING
;NOTE NEW MAIL IS CHECKED FOR AUTOMATICALLY AT CMDN6 BECAUSE WE ARE
;NOW LOGGED IN AND MSGTIM IS 0

LOGIN8:	CALL DWNTIM		;WARN OF PENDING SHUTDOWN, BUMP DEADLINE
	CALL CHKDAL		;CHECK FOR OVER DISK ALLOCATION

;GET DEFAULT SUBSYSTEM IF THIS USER HAS ONE (NOT IMPLEMENTED YET)
	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 LOGIN USER # FOR GOOD GUY.
;CURRENTLY DISALLOWS ONLY USER "ANONYMOUS"

USRCHK:	PUSH P,A		;SAVE BITS,,DIRNUM
	MOVEI A,1		;SUPPRESS RECOGNITION
	HRROI B,[ASCIZ /ANONYMOUS/]
	STDIR
	 SETZ A,		;NO SUCH DIRECTORY
	 SETZ A,		;AMBIGOUS
	HRRZ B,A		;GET JUST DIRNUM
	POP P,A
	CAIN B,0(A)		;COMPARE WITH ATTEMPTED LOGIN DIRNUM
	 ERROR <YOU CANNOT LOGIN UNDER THAT NAME>
	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:	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
	SKIPN 2,1
	 RET			;0 SAYS OK
	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

;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,[-1]	;IS THERE A DEFAULT?
		 JRST [	CALL DING	;NO
			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,[1,,1]
		JRST ACCTX]
	ALTYPE ( )
	MOVE B,.BFP		;SCAN STRING THAT WAS INPUT
	MOVEI C,-1(CNT)		;THIS MANY CHARACTERS
ACCT0A:	ILDB A,B
	CAIL A,"0"		;A DIGIT?
	CAILE A,"9"
	 JRST [	CALL BUFFF	;STRING CASE. SAVE IN BUFFER.
		JRST ACCT2]	;CHECK IT
	SOJG C,ACCT0A		;DIGIT, CHECK REST
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		;SKIP IF NOT ENABLED
	 JRST ACCTX		;VERIFY IF NOT ENABLED
	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,[10,,10]		;ROOM FOR AN AC BLOCK
	JUMPGE P,[SUB P,[10,,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,[10,,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,[10,,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

;PRINT THE SCHEDULED SHUTDOWN TIME
;AND EXPECTED RESTART TIME.
;FOR LOGIN AND SYSTAT

DWNTIM:	MOVE 1,['SYSTAT']
	CALL $SYSGT
	JUMPE 2,[RET]	;TABLE DOES NOT EXIST?
	PUSH P,2		;TABLE NUMBER
	MOVSI 1,27		;SHUTDOWN TIME CELL
	HRR 1,2			;TABLE NUMBER
	GETAB
	 CALL JERR
	JUMPE 1,[SUB P,[1,,1]
		RET]
	CALL CRIF
	TYPE <TENEX WILL GO DOWN >
	MOVE 2,1
	MOVE 1,COJFN
	MOVSI 3,(1B1+1B3+1B6+1B10+1B12+1B17)
	ODTIM
	MOVE 1,0(P)		;SYSTAT TABLE NUMBER
	HRLI 1,30		;RESTART TIME
	GETAB
	 CALL JERR
	JUMPE 1,DWNTI5		;NO UPTIME DECLARED
	TYPE < TIL >
	MOVE 2,1
	MOVE 1,COJFN
	MOVSI 3,(1B1+1B3+1B6+1B10+1B12+1B17)
	ODTIM
DWNTI5:	MOVE 1,0(P)	;SYSTAT TABLE #
	HRLI 1,31		;WHO,,REASON FOR SHUTDOWN
	GETAB
	 JRST DWNTI9		;MAY HAPPEN ON OLD SYSTEMS
	PUSH P,1		;SAVE FOR GETTING WHO
	ANDI 1,17
	CAIN 1,5
	 TYPE <
 DUE TO PREVENTIVE MAINTENANCE>
	CAIN 1,6
	 TYPE <
 DUE TO SCHEDULED HARDWARE WORK>
	CAIN 1,7
	 TYPE <
 DUE TO SCHEDULED SOFTWARE WORK>
	CAIN 1,8
	 TYPE <
 DUE TO EMERGENCY RESTART>
DWNTI6:	POP P,2
	HLRZS 2			;USER NUMBER WHO SUBMITTED IT
	JUMPE 2,DWNTI9		;NOT SET
	ETYPE < BY %2R>
DWNTI9:	PRINT EOL
	SUB P,[1,,1]
	SETOM DWNMSF		;SIGNAL DOWNTIME PRINTED SO DONT RECHECK
	RET


;TRYGTJ
;TAKES: B: POINTER TO STRING FOR GTJFN
;RETS:	+1: NO SUCH FILE
;	+2: JFN IN A
;USED IN "MESS", AND IN "LOGIN" WITH REGARD TO PRIVATE MESSAGES.

TRYGTJ:	PUSH P,B
	PUSH P,A
	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,[1,,1]
			POP P,A
			JRST TRYG9]
		CAIE A,GJFX19		;"NO SUCH EXTENSION"
		CAIN A,GJFX20		;"NO SUCH VERSION"
		JRST [	SUB P,[1,,1]
			POP P,A
			JRST TRYG9]
		CAIN A,GJFX35
		 ERROR <DIRECTORY PROTECTED>
		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		;..
	SUB P,[1,,1]		;FORGET SAVED A
	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.
;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

MESS2:	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
	MOVEI 1,400000		;THIS FORK
	RPCAP
	MOVEI 1,CTRLC		;^C TERMINAL CODE
	TLNE 3,(1B0)		;IF ^C CAP ENABLED
	DTI			;TURN OFF ^C
	MOVEI A,0		;NO SPECIAL CAPS.
	CFORK
	 CALL [	INTON
		JRST JERR]
	PUSH P,1		;FORK HANDLE
	MOVSI 1,(1B2+1B17)	;OLD, SHORT
	HRROI 2,[ASCIZ /<SUBSYS>READMAIL.SAV/]
	GTJFN
	 JRST MESS4		;READMAIL NOT AVAILABLE
MESS3:	HRL 1,0(P)		;MAKE FORK.JFN
	GET			;AND RELEASE READMAIL JFN
	MOVE 1,0(P)		;FORK HANDLE
	MOVEI 2,-4(P)		;WHERE GOODIES ARE
	SFACS			;FROM ON THE STACK
	GEVEC
	MOVEI 2,1(2)		;REENTER ADDR, EVEN IF OLD EV
	SFORK
	WFORK

MESS4:	POP P,1			;FORK HANDLE
	KFORK
MESS7:	MOVEI 1,400000
	RPCAP
	MOVE 1,[CTRLC,,1]	;^C ON CHANNEL 1
	TLNE 3,(1B0)		;IF THIS FORK HAS ^C CAP ENABLED
	ATI			;ALLOW ^C AGAIN
	POP P,1			;JUNK (COJFN)
	POP P,1			;JUNK (COPY OF DATE)
MESS8:	POP P,1			;MESSAGE FILE JFN
	RLJFN
	 CALL JERR
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
	INHELP <
EOL OR JOB NUMBER>
	ALLOW TEOL+TSPC+TALT
	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
	POP P,1
	LGOUT
	 ERROR <YOU CANNOT LOGOUT THAT JOB>
	JRST CMDIN4


LOGOU1:	CALL INFER		;SKIP IF INFERIOR
	 JRST LOGO14
	MOVEI 1,400000		;INFERIOR, GET CAPABILITIES
	RPCAP
	TLNN 2,(1B3)		;"LOG" CAPABILITY? (CHECK THIS___)
	 ERROR <NOT LEGAL IN INFERIOR EXEC>
	TYPE < [INFERIOR EXEC]>
	TLO KWV1,CONMAN		;REQUIRE CONFIRMATION
LOGO14:	CONFIRM
	MOVEI 1,HUCODE		;"HANG UP" INTERRUPT CODE
	DTI			;^C AND ERRORS ATI AT CMDN2D
	TLO Z,LOGOFF		;SAY LOGGING OUT (TELLS ERROR AND ^C
				;ROUTINES TO SAY "NOT LOGGED OUT").
	SKIPG CUSRNO		;NOW LOGGED IN?
	JRST LOGOU3		;NO, NO EXPUNGE OR CHKDAL, ETC.
LOGOU2:	GJINF
	MOVE 1,2		;CONNECTED DIRECTORY
	DELDF			;"EXPUNGE"
	CALL DWNTIM		;WARN OF PENDING SHUTDOWN
	HRRZ A,CUSRNO
	CALL CHKPRN		;CHECK THE PRINTER
	 JRST LOGO22
	CALL CRIF		;CAR. RET. IF NEEDED
	TYPE <[PRINTING IN PROGRESS]>
LOGO22:	HRRZ A,CUSRNO		;LOGIN DIRECTORY NUMBER
	CALL CHKMSG		;NEW MAIL?
	 JRST LOGO23		;NO
	CALL CRIF
	TYPE <[NEW MAIL EXISTS]>
LOGO23:	CALL CHKDAL		;YES, NOTE OVER ALLOC IF PRESENT
	CALL JOBCNT		;PRINT OTHER JOBS OF THIS USER
LOGOU3:	PRINT EOL
	MOVE A,COJFN
	DOBE			;WAIT TO GIVE HIM MAXIMUM CHANCE TO ^C.

	CALL $RESET
	CALL BREAK2		;DO "BREAK" AND "REFUSE"

	SETO A,			;SAY ITS SUICIDE
	LGOUT
	 CALL JERR
	;BETTER NOT RETURN IF SUCCESSFUL

;COUNT JOBS LOGGED IN UNDER THIS USER'S DIRECTORY

;IF MORE THAN ONE, PRINT INFORMATIVE MESSAGE

JOBCNT:	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.

	CALL JOBCNF		;FIND FIRST "OTHER JOB"
	 RET			;NONE FOUND
	MOVEI F,(D)		;GOT ONE, REMEMBER JOB #
	MOVE G,A		;REMEMBER WHETHER DETACHED

	CALL CRIF		;GO TO NEW LINE IF NEEDED
	CALL JOBCNN		;FIND NEXT "OTHER JOB"
	 JRST [	ETYPE <[JOB %6Q>;NO MORE, JUST PRINT THE ONE
		SKIPGE G	;DETACHED?
		 TYPE <(DET)>	;YES
		JRST JOBCN5]	;FINISH UP

	ETYPE <[JOBS %6Q>	;HAVE AT LEAST 2, PRINT FIRST
	SKIPGE G		;DETACHED?
	 TYPE <(DET)>		;YES

JOBCN2:	MOVEI F,(D)		;COPY JOB NUMBER
	ETYPE <, %6Q>		;PRINT IT
	SKIPGE A		;DETACHED?
	 TYPE <(DET)>
	CALL JOBCNN		;FIND NEXT "OTHER JOB"
	 JRST JOBCN5		;NO MORE
	JRST JOBCN2		;MORE, HANDLE THEM

JOBCN5:	ETYPE < ALSO LOGGED IN UNDER %5R]>
	PRINT EOL
JOBCNX:	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
	 0
	 JRST CERR
	JRST 0(KWV)

$MAIL:	TABLE
	T CHECK,EOLOK,M..CHK
	T WATCH,,M..WAT
	TEND

M..CHK:	NOISE <FOR USER>
	TLO Z,NEOLF		;SUPPRESS ECHO OF EOL
	HRRZ A,CUSRNO		;DEFAULT IS LOGIN DIR IF ANY
	CALL DEFDIR		;INPUT A USER NAME TO A
	ALLOW TSPC+TALT+TEOL
	TLO KWV1,NOCONF		;NO CONFIRMATION REQUIRED
	CONFIRM
	CALL CRIF
	CALL CHKMSG		;FOR USER # IN A
	 TYPE <NO >
	TYPE <NEW MAIL EXISTS>
	MOVE A,COJFN
	DOBE
	TIME
	MOVEI C,^D<10*60>	;TEN MINUTES OF SECONDS
	IMULI C,0(B)		;CONVERT TO TICKS
	ADDM C,A		;NEXT CHECK TIME
	SKIPL MSGTIM		;BUT IS MAIL WATCH ON?
	 MOVEM A,MSGTIM		;YES. SET NEW DEADLINE
	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

M.WA.N:	TDZA A,A
M.WA.F:	SETO A,
	ALLOW TSPC!TALT!TEOL
	ALTYPE ( )
	CONFIRM
	MOVEM A,MSGTIM
	RET

;CHKMSG

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

CHKMSG:	PUSH P,A
	PUSH P,B
	PUSH P,C
	HRROI A,CSBUF		;POINTER TO STRING AREA BEGINNING
	MOVEI B,"<"		;FORM <USER>MESSAGE.TXT
	BOUT
	MOVE 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 CHKMS9		;GIVE NO SKIP RETURN
	MOVE B,[2,,FDBWRT]	;WRITE AND READ DATES
	MOVEI C,B		;TO B AND C
	GTFDB
	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,[1,,1]		;REMOVE FROM STACK TOO
	ADDB A,JBUFP
	SETOM 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

;"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

;"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
	CONFIRM
	TLO Z,F1		;SAY NO
	JRST (KWV)		;GO TO .FORMF, .TABS, OR .LOWER.

$NO:	TABLE
	TE BDDT
	TE FORMFEED
	TE IDDT
	TE INDICATE
	TE LOWERCASE
	TE RAISE
	TE TABS
	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 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

;"PERPETUAL <FILE LIST>"     AND  "NOT PERPETUAL <FILE LIST>"

;SETS OR CLEARS FDBUND BIT IN FDBCTL

.NOTPE:	HRLI B,-2		;DEFAULT VERSION TO LOWEST
	TLOA Z,F1		;REMEMBER "NOT"
.PERPE:	HRLI B,0		;DEFAULT VERSION IS HIGHEST
	NOISE <FILES>
	MOVE A,[2,,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
	MOVSI B,(FDBUND)	;CHANGE "UNDELETABLE" BIT
	TLNE Z,F1		;"NOT PERP" ?
	TDZA C,C		;YES, CLEAR THE BIT
	MOVSI C,(FDBUND)
	CHFDB
	JRST NEXTF		;GET NEXT FILE, RET TO PERPE0

;"PRINTER"

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

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

P..CHK:	NOISE <FOR USER>
	TLO Z,NEOLF		;SUPPRESS ECHO OF EOL
	HRRZ A,CUSRNO		;DEFALT DIR IS LOGIN DIR IF ANY
	CALL DEFDIR		;INPUT DIRECTORY NAME WITH RECOG
	ALLOW TSPC!TALT!TEOL
	TLO KWV1,NOCONF		;NO CONFIRMATION REQUIRED
	CONFIRM
	CALL CRIF
	TYPE <PRINTING>
	CALL CHKPRN		;CHECK PRINTER FOR USER IN A
	 TYPE < NOT>
	TYPE < IN PROGRESS>
	MOVE A,COJFN
	DOBE
	TIME
	MOVEI C,^D<5*60>	;FIVE MINUTES OF SECONDS
	IMULI C,0(B)		;CONVERT TO TICKS
	ADDM C,A		;NEXT DEADLINE
	SKIPL PRNTIM		;IS PRINTER WATCH ON?
	 MOVEM A,PRNTIM		;YES.  SET NEW CHECK TIME FOR MAIN LOOP
	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.N:	TDZA A,A
P.WA.F:	SETO A,
	ALLOW TSPC!TALT!TEOL
	ALTYPE ( )
	CONFIRM
	MOVEM A,PRNTIM
	RET

;CHECK PRINTER ROUTINE

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

CHKPRN:	PUSH P,1
	PUSH P,2
	PUSH P,3
	HRROI 1,CSBUF		;STRING BUFFER AREA
	HRROI 2,[ASCIZ /<PRINTER>LPT./]
	SETZ 3,
	SOUT
	HRRZ 2,-2(P)		;USER #
	DIRST
	 CALL [	SETOM PRNTIM	;CANCEL THE WATCH
		JRST JERR]
CHKPR1:	MOVSI 1,(1B2!1B17)	;OLD, 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

;QUIT: EXIT TO SUPERIOR EXEC OR OTHER PROGRAM.
;IF TOP-LEVEL FORK, LEGAL ONLY FOR ENABLED WHEELS OR OPERS.

.QUIT:	CALL INFER		;SKIP IF INFERIOR
	 JRST [	HRLZI B,WHLUO+OPRUO
		SKIPE PRVENF
		CALL PRVCK
		UERR [ASCIZ /NOT LEGAL IN TOP-LEVEL EXEC/]
		JRST QUIT1]		;DON'T DISABLE ^C AT TOP LEVEL
;DEASSIGN SUPER-PANIC PSI CHARACTER ^C
		;IF POSSIBLE, TEST WHETHER ASSIGNED TO THIS FORK _______
		;MEANWHILE, JUST TEST SPEC CAP
	MOVEI A,B0
	RPCAP			;GETS ENABLED CAPS IN C
	MOVEI A,CTRLC
	TLNE C,B0
	DTI			;DEASSIGN TERMINAL INTERRUPT
QUIT1:	MOVEI A,CTCODE		;CHAR THAT PRINTS RUNTIME (^T)
	DTI
	MOVEI A,HUCODE		;DATAPHONE HANGUP CODE
	DTI
	MOVEI E,PTTYMD		;PASS BACK TTY LEFT BY PROGRAM
	CALL LTTYMD

QUIT2:	CALL INFER		;SKIP IF INFERIOR EXEC
	 JRST [	JSYS 777	;CALL MINI-EXEC
		JRST REE]	;AFTER  ^  TO MINI-EXEC
	MOVE 1,SUPSUB
	SETNM			;BUT RESTORE SUPERIOR'S SUBSYS
	HALTF
	JRST REE		;AFTER CONTINUE FROM SUPERIOR EXEC

;INFERIORNESS TEST SUBROUTINE: SKIP IF THIS FORK HAS A SUPERIOR
;USED IN LOGOUT, QUIT, ^E EDDT.

INFER:	PUSH P,A
	PUSH P,B
INFER0:	MOVEI A,INFER3		;SET TO CATCH TRAPS FROM GFRKH
	MOVEM A,ILIDSP		;ON MONITORS WITHOUT IT (BEFORE 1.31)
INFER1:	MOVEI 2,400000		;SELF
	MOVNI 1,1		;RELATIVE TO SUPERIOR
	GFRKH			;GET FORK HANDLE
	 JRST INFER3		;NO MORE HANDLES, OLD MONITOR, ETC
	SETZM ILIDSP		;NOT INTERESTED IN ILLEGAL INSTRS NOW
	CAIN 1,400000		;SELF MEANS WE ARE TOP FORK
	 JRST INFER6		;SO GIVE SKIP RETURN
	RFRKH
	JRST INFER9		;GIVE SKIP

INFER3:	SETZM ILIDSP		;NO LONGER INTERESTED IN ILLEGAL INSTRS.
	MOVEI A,-1		;SUPERIOR FORK HANDLE
INFRS:	RFSTS
	CAMN A,[-1]
INFER6:	 JRST [	POP P,B		;SUPERIOR HANDLE INVALID
		POP P,A		;MEANS NO SUPERIOR.
		RET]
;BUT RFSTS MAY RETURN THIS FORK'S STATUS IF NO SUPERIOR.
;ASSUME IT IS SELF (AND NO SUPERIOR) IF PC RETURNED
; IS THAT WHERE RFSTS IS.
	MOVEI B,(B)		;MASK PC
	CAIE B,INFRS+1
INFER9:	AOS -2(P)		;DIFFERENT, WE HAVE A SUPERIOR
	 JRST [	POP P,B
		POP P,A
		RET]

;PROTECTION (OF FILE) <EXISTING NAME> (IS) <18 BIT OCTAL>

.PROTE:	NOISE <OF FILE>
	HRROI A,
	CALL CINFN
	 JRST CERR
	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.
	TRNN A,1B22
	ERROR < YOU CAN'T MAKE PROTECTION INVISIBLE (20000-BIT)>
	CONFIRM
	TLO A,500000		;SAY THERE'S 18-BIT PROTECTION IN RH
	PUSH P,A
	MOVE A,CJFN1
	DVCHR
	TLNN B,B4		;MULTIPLE DIRECTORY DEVICE?
	ERROR <%1H: DOESN'T HAVE PROTECTED FILES>
	MOVE A,CJFN1
	POP P,C
	HRLI A,FDBPRT		;PROTECTION WORD IN FDB
	MOVEI B,-1		;CHANGE RH
	CHFDB			;THIS COULD ITRAP, SHOULD BE PROTECTED
	JRST RLJFNS

;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]
	JRST RLJFNS		;RELEASE JFNS AND POPJ TO CMDIN4.
>

;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
	INTOFF			;BE SURE BOTH ADVISE AND TLINK HAPPEN
	HRLOI 1,(1B4+1B5)
	TLINK
	 CALL [	INTON
		JRST JERR]
	MOVSI 1,(1B0)		;BREAK "ADVISE" LINK
	ADVIZ
	 CALL [	INTON
		JRST JERR]
	INTON
	RET

;REENTER
;DECODE AND CHECK SUBROUTINE ALSO USED BY REDIRECT/DETACH

$REENT:	SKIPGE A,FORK
	ERROR <NO PROGRAM>
	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>
	MOVEI A,.JBREN
	HRRZ A,PAGEN(A)
	JUMPE A,[UERR [ASCIZ /NO REENTER ADDRESS/]]
	RET

;REENTER COMMAND DISPATCHES HERE

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

..REEN:	MOVNI B,2		;REENTER CODE FOR PA1050
	CALL CHKPAT		;SETUP PA1050 IF THERE
	MOVEI E,PTTYMD		;SET TTY MODES TO PROGRAM'S
	CALL LTTYMD		;.. (EXEC'S MODES NEEDN'T BE STORED)
	JUMPG B,.+2		;PA1050 START IF POSITIVE
	MOVEI B,1		;ENTRY VECTOR INDEX 1 FOR REENTER
	JRST START2		;JOIN START COMMAND

;REFUSE (LINKS)
; REFUSES BOTH ORDINARY LINKS AND ADVISE LINKS


.REFUS:	NOISE <LINKS>
	CONFIRM
	INTOFF			;BE SURE BOTH HAPPEN
	HRLOI A,(1B4)		;CHANGE ACCEPT BIT TO 0
	TLINK
	 CALL JERR
	MOVSI 1,(1B0)		;"BREAK"
	ADVIZ
	 CALL JERR
	INTON
	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,[2,,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,RNAMX4
		 ERROR <NO ROOM>
		CAIN A,RNAMX5
		 ERROR <DESTINATION BUSY>
		CAIN A,RNAMX8
		 ERROR <NO ACCESS TO SOURCE>
		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:		;GET AND EDIT USE THE FOLLOWING AS A SUBROUTINE

$RESET:	INTOFF
RESET2:	SETOM A
	CALL MAPPF		;UNMAP ANY PAGE
	CALL UNMAP		;INCLUDING BUFFER PAGES, ETC
	MOVEI 1,-4
	KFORK			;KILL ALL INFERIORS
	SETOM UFORK
	SETOM IDFORK
	SETOM BDFORK
	SETOM LFORK		;SAY THERE'S NO INFERIOR THAT'S BEEN RUN
	SETOM FORK		;SAY EXEC IS NOT POINTED AT ANY FORK
	SETZM PROPSF		;SAY THERE'S NO PROPRIETARY SUBSYSTEM
	SETZM DDTFLG		;SAY THERE'S NO DDT IN FORK

RESE25:	MOVEI 1,400001		;SCAN THROUGH ALL POSSIBLE HANDLES
	RFRKH			;RELEASING THEM
	CAIGE 1,400017		;DID WE JUST DO THE LAST ONE?
	 AOJA 1,.-2		;NO, DO ANOTHER

RESET3:	SKIPG CREDIF		;ABANDONED PRIMARY INPUT FILE?
	 JRST RESE31		;NO
	HRRZ 1,CRJFNI
	GTSTS
	TLNN 2,(1B10)
	 JRST RESE30		;BAD JFN, FORGET IT
	TLNN B,(1B0)
	 JRST [	RLJFN		;NOT OPEN, JUST RELEASE IT
		 CALL JERR
		JRST RESE30]
	CLOSF
	 CALL JERR
RESE30:	SETZM CREDIF		;SAY INPUT NO LONGER REDIRECTED

RESE31:	SKIPG CREDOF
	 JRST RESET4
	HRRZ 1,CRJFNO
	GTSTS
	TLNN 2,(1B10)
	 JRST RESE32
	TLNN 2,(1B0)
	 JRST [	RLJFN
		 CALL JERR
		JRST RESE32]
	CLOSF
	 CALL JERR
RESE32:	SETZM CREDOF

;CLOSE ALL FILES OF INTERIOR FORKS
;AFTER KILLING FORKS, TO GET SHARED FILE JFN'S!
RESET4:	HRLI A,B1		;DON'T CLOSE THIS FORK'S FILES
	HRRI A,B0		;SELF
	CLZFF
	INTON
	RET

;"RUN" IS WITH "GET" ABOVE

;SAVE (CORE FROM) N (TO) N, (FROM) N (TO) N ... (ON) F

.SAVE:	SKIPGE FORK
	ERROR <NO PROGRAM>
	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 GNLY, ASSUME 20.
                U$TYPE [ASCIZ /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,-1
                U$TYPE [ASCIZ /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

;SHUT (ALL OPEN FILES)

.SHUT:	NOISE <ALL OPEN FILES>
	CONFIRM
;CLOSE ALL FILES BELONGING TO FORKS INFERIOR TO THIS EXEC.
	HRLI A,B1		;SAY DON'T CLOSE MY FILES
	HRRI A,B0		;SAY ME
	CLZFF
	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 PROGRAM>
	NOISE <PAGES FROM>
	MOVEI B,1(P)		;WHERE TABLE WILL BEGIN IN PUSHDOWN
SSAV1:	CALL OCTAL
	 JRST [	ALLOW TALT
		MOVEI A,0
		U$TYPE [ASCIZ /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
		U$TYPE [ASCIZ /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
	MOVE A,COJFN
	STABS		;SET TABS FROM B, C, D.
	MOVEM B,PTTYMD+1		;PROGRAM TELETYPE MODES
	MOVEM C,PTTYMD+2
	MOVEM D,PTTYMD+3
	MOVEM B,ETTYMD+1		;AND EXEC'S TELETYPE MODES BLOCK
	MOVEM C,ETTYMD+2
	MOVEM D,ETTYMD+3
	RET

;START
;DECODE AND CHECK SUBROUTINE ALSO USED BY REDIRECT/DETACH

$START:	SKIPGE A,FORK		;HANDLE OF INFERIOR FORK, OR -1
	ERROR <NO PROGRAM>
	GEVEC
	HLRZ B,B
	CAIE B,<JRST>B53
	 JRST [	CAIGE B,1
		UERR [ASCIZ /NO START ADDRESS/]
		CAIL B,1000	;MAX THAT SFRKV CAN HANDLE
		 UERR [ASCIZ /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>
	MOVEI A,.JBSA
	HRRZ A,PAGEN(A)
	JUMPE A,[UERR [ASCIZ /NO START ADDRESS/]]
	RET

;START COMMAND DISPATCHES HERE

.START:	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

;"EDIT" ENTRY
START1:	MOVEI E,PTTYMD
	CALL LTTYMD		;SET PGM TTY MODES

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

START2:	TLO Z,RUNF		;SAY PROGRAM'S TTY MODES ARE IN EFFECT
	SETO A,		;DON'T WANT ANY MAPPED PAGES WHILE RUNNING PROG,
	CALL MAPPF		;SO CLEAR BUFFER "PAGEN".
	CALL IFORK		;PREPARE FORK(S) AND SETUP LFORK
	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 $WAIT]
	MOVEI C,SFVILI		;ROUTINE TO CATCH PSI'S OUT OF SFRKV
	MOVEM C,ILIDSP		;SET TRAPPER
	SFRKV		;START FORK USING ENTRY VECTOR (USES A,B)
	SETZM ILIDSP		;CANCEL SPECIAL DISPATCH

;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.

	MOVE A,LFORK		;INFERIOR BEING RUN
	RFORK			;RESUME
	WFORK			;WAIT
	INTOFF
	MOVE A,LFORK
	FFORK			;FREEZE IT IMMEDIATELY
	MOVE B,[CALL CUUO]	;SET UUO DISPATCH TO FRUSTRATE
	MOVEM B,41		;MALICIOUS USERS

	MOVEI E,PTTYMD		;SAVE TTY MODES, AS MODIFIED BY PROGRAM
	CALL RTTYMD		;..
	TLZ Z,RUNF		;SAY PROG'S TTY MODES NOT IN EFFECT
	MOVEI E,ETTYMD		;RESTORE EXEC'S TTY MODES
	CALL LTTYMD		;..

;ANALYZE REASON FOR TERMINATION

	RFSTS
	TLZ A,(1B0)		;FLUSH FROZEN BIT
	CAMN A,[2B17]		;VOLUNTARY TERMINATION IS NORMAL
	 JRST [	INTON
		JRST CMDIN2]	;GO INPUT COMMAND
	TLNE A,077700		;DISTINGUISH -1 FROM 0-5, 400000-400005.
	 JRST [	SETOM FORK	;-1 = UNASSIGNED HANDLE, SAY NO FORK.
		SETOM LFORK	;..DOES THIS HAPPEN IF IT KFORKS ITSELF,
		INTON
		UERR [ASCIZ /PROGRAM KILLED ITSELF/]];OR IS IT SCREWUP?
	PUSH P,A
	INTON
	POP P,A

;START AND REENTER ETC...
;NON-VOLUNTARY TERMINATION
;ALSO USED FOR UNUSUAL TERMINATION OF EPHEMERON
INVOLT:	JUMPL A,[CALL SCREWUP]
	HLRZ C,A
	CAIE C,3		;FORCED TERMINATION (UNENABLED ERROR PSI)
	CALL SCREWUP
	MOVEI A,(A)		;MASK PSI CHANNEL THAT CAUSED IT
	CAIG A,^D35		;CHECK AGAINST TABLE LIMITS
	CAIGE A,0		;..
	CALL SCREWUP
;MESSAGE TABLE ADDRESSED BY FOLLOWING LOC ALSO USED BY "RUNSTAT".

WHY:	XCT .+1(A)		;ERROR MESSAGE FROM TABLE FOLLOWING
	 ERROR <CHAN %1Q INTERRUPT AT %2P>; CHAN 0. THESE HAPPEN IF
	 ERROR <CHAN %1Q INTERRUPT AT %2P>; PROGRAM ACTIVATES CHANNEL
	 ERROR <CHAN %1Q INTERRUPT AT %2P>; BUT DOES NO EIR OR SIR OR
	 ERROR <CHAN %1Q INTERRUPT AT %2P>; HAS 0 TABLE WD FOR CHANNEL.
	 ERROR <CHAN %1Q INTERRUPT AT %2P>; CHAN 4
	 ERROR <CHAN %1Q INTERRUPT AT %2P>; CHAN 5
	 ERROR <OVERFLOW AT %2P>; CHAN 6. %2P => TYPE PC FROM RH B OCTAL
	 ERROR <FLOATING OVERFLOW AT %2P>; CHAN 7
	 ERROR <CHAN %1Q INTERRUPT AT %2P>; CHAN 8
	 ERROR <PUSHDOWN OVERFLOW AT %2P>; CHAN 9
	 ERROR <END-OF-FILE AT %2P>; CHAN 10
	 ERROR <IO DATA ERROR AT %2P>;
	 ERROR <CHAN %1Q INTERRUPT AT %2P>; CHAN 12 "FILE CONDITION 3"
	 ERROR <CHAN %1Q INTERRUPT AT %2P>; CHAN 13 "FILE CONDITION 4"
	 ERROR <CHAN %1Q INTERRUPT AT %2P>; CHAN 14. TIME OF DAY.
	 ERROR <ILLEG INST %2X>; %X:INST "AT" PC, SYS MSG IF JSYS
	 ERROR <ILLEG MEM READ AT %2P>
	 ERROR <ILLEG MEM WRITE AT %2P>
	 ERROR <ILLEG MEM XCT AT %2P>
	 ERROR <FORK TERMINATION INTERRUPT AT %2P>; CHAN 19
	 ERROR <SYSTEM STORAGE CAPACITY EXCEEDED AT %2P>
	 REPEAT ^D15,<ERROR <CHAN %1Q INTERRUPT AT %2P>
>		;CHAN 21-35

;PREPARE INFERIOR FORK STRUCTURE, CALLED BY GOTO AND START

IFORK:	MOVE A,FORK
	MOVEM A,LFORK		;RETURN THIS  IN A
	RET


;TRAP OUT OF SFRKV COME HERE

SFVILI:	PUSH P,A
	MOVE A,ERCOD		;ERROR CODE FROM GETER
	CAIN A,SFRVX1		;BAD ENTRY VECTOR
	 ERROR <FILE HAS BAD FORMAT>
	POP P,A
	JRST ILIPSI		;LET THE EXEC WORRY ABOUT IT

;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

;"TYPE" AND "LIST" ARE IN A SEPARATE FILE BELOW.

;UNDELETE <DELETED FILE NAMES>

.UNDEL:	NOISE (FILES)
	MOVE A,[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

;SUBROUTINE TO TYPE SYSTEM AND EXEC VERSIONS.
;USED AT STARTUP TO PRINT SIGN-ON HEARLD, AND IS ALSO THE
; EXECUTION ROUTINE FOR "VERSION" COMMAND.

.VERSI:	PRINT " "
	MOVE A,['SYSVER']
	CALL $SYSGT		;SYSTEM NAME AND VERSION
	JUMPE B,VERSI2		;FORK LACKS GETAB CAPABILITY
	HLLZ D,B		;LENGTH,,INDEX
	HRRZ E,B		;TABLE #
VERSI1:	GTB (E)			;GET A DATA WORD FROM TABLE (USES D)
	MOVE B,A
	MOVEI C,5		;PRINT 5 CHARS FROM EACH WORD
	SETZ A,
	LSHC A,7
	JUMPE A,VERSI2		;END ON NULL
	PRINT (A)
	SOJG C,.-4
	AOBJN D,VERSI1		;ALSO END ON END OF TABLE

;"EXEC" AND ITS VERSION

VERSI2:	MOVE 1,VERSN
	IDIVI 1,^D100		;SEPARATE INTO MAJOR AND MINOR #'S
	ETYPE < EXEC %1Q.%2Q>	;TYPE THEM OUT
	SKIPE 1,PATVER		;TYPE PATCH VERSION, IF ANY.
	 ETYPE <.%1Q>
	PRINT EOL
	RET

;WHERE (IS USER) <NAME>

.WHERE:	NOISE <IS USER>
	CALL DIRNAM		;INPUT DIR (USER) NAME WITH RECOGINITION
	TLNE A,B0
	 JRST CERR		;NOT LOG-IN-UNDER-ABLE
	ALTYPE ( )
	ALLOW TEOL+TSPC+TALT
	CONFIRM		;NEEDED EVEN THOUGH ITS A NON-CONFIRMATION CMD!
	SETZ C,		;SETUP FOR NOT HERE
	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
	XOR A,(P)		;COMPARE
	MOVEI A,(A)		;...MASK 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%, 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(??)
	MOVEI B,","
	BOUT
	MOVEI B," "
	BOUT
	JRST WHERE6		;DONE

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

WHERE6:	SUB P,[1,,1]		;FLUSH SAVED TTY#

;PRINT SUBSYSTEM NAME
WHERE7:	MOVE A,['JOBNM2']	;THE OTHER JOB NAME TABLE
	CALL $SYSGT
	JUMPE B,WHER72		;NOT THERE. USE JOBNAM

WHER71:	HRR A,B
	HRL A,D
	GETAB			;GET ACTUAL NAME
	 CALL JERR
	JRST WHER73		;GO PRINT IT

WHER72:	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
	HRR A,B
	HRL A,C
	GETAB
	 CALL JERR

WHER73:	JUMPE A,[PRINT "?"
		JRST WHERE8]
	CALL SIXPRT	;PRINT IT
WHERE8:	PRINT EOL
	SETO C,		;SAY AT LEAT ONE FOUND
;AFTER TYPING CONTINUE LOOP IN CASE HE HAS SEVERAL JOBS.

WHERE9:	AOBJN D,WHERE1
	SKIPN C
	UTYPE [	ASCIZ / NOT LOGGED IN
/]
	JRST CMDIN4

LITC3:	LIT

