;<MFEXEC>XMAIN.MAC;20239  7-Mar-81 13:15:44, Edit by MMCM
;[I4-TENEX]<MFEXEC>XMAIN.MAC;20238,  4-DEC-79 17:07:48, Ed: RLWSSD
; FIX TO MAIL NOTIFICATION MSGS.
;[I4-TENEX]<MFEXEC>XMAIN.MAC;20237, 13-NOV-79 14:37:28, Ed: RLWSSD
; ADDED "CALL CRIF" BEFORE "CALL MESS" TO READ SYSTEM MESSAGES.
;[I4-TENEX]<MFEXEC>XMAIN.MAC;20236, 16-OCT-79 11:18:55, Ed: RLWSSD
;[I4-TENEX]<MFEXEC>XMAIN.MAC;20235, 15-OCT-79 11:41:22, Ed: RLWSSD
; ADDED STARTUP TIME STUFF FOR TOP-LEVEL MFEXEC STARTED BY LOGIN
; JSYS.  FAKE "CREATED JOB" STUFF IN ORDER TO GET PROPER INITIALIZATION.
;[I4-TENEX]<MFEXEC>XMAIN.MAC;20234,  2-OCT-79 11:35:15, Ed: RLWSSD
; ADDED "CD" (CONNECT) COMMAND, REMOVED "NEW" AND "OLD" COMMANDS IN IAC SWITCH
;<MFEXEC>XMAIN.MAC;20233    10-AUG-79 11:46:04    EDIT BY RLWSSD
;<MFEXEC>XMAIN.MAC;20232     7-AUG-79 14:18:12    EDIT BY RLWSSD
; ADDED FCONTINUE COMMAND
;<MFEXEC>XMAIN.MAC;20231    18-JUL-79 15:16:39    EDIT BY WEISSMAN
;<MFEXEC>XMAIN.MAC;20230    18-JUL-79 14:47:46    EDIT BY WEISSMAN
; CHANGED MAIL WATCH FOR ANY USER
;<MFEXEC>XMAIN.MAC;20229    17-JUL-79 14:44:07    EDIT BY WEISSMAN
;<MFEXEC>XMAIN.MAC;20228    17-JUL-79 13:57:16    EDIT BY WEISSMAN
;<MFEXEC>XMAIN.MAC;20227    13-JUL-79 10:42:48    EDIT BY WEISSMAN
;<MFEXEC>XMAIN.MAC;20226    12-JUL-79 18:40:55    EDIT BY WEISSMAN
;<MFEXEC>XMAIN.MAC;20225    12-JUL-79 18:13:31    EDIT BY WEISSMAN
;<MFEXEC>XMAIN.MAC;20224    12-JUL-79 14:53:32    EDIT BY WEISSMAN
;<MFEXEC>XMAIN.MAC;20223    11-JUL-79 19:01:57    EDIT BY WEISSMAN
; ADDED MAP COMMAND
;<MFEXEC>XMAIN.MAC;20222    10-JUL-79 00:32:24    EDIT BY WEISSMAN
;<MFEXEC>XMAIN.MAC;20221     9-JUL-79 16:44:16    EDIT BY WEISSMAN
; ADDED IAC-STYLE "ERRSTAT" HANDLING
; REMOVED RESTRICTION FROM "STATISTICS" COMMAND
;<MFEXEC>XMAIN.MAC;20220    28-JUN-79 16:36:22    EDIT BY WEISSMAN
;<MFEXEC>XMAIN.MAC;20219    28-JUN-79 16:19:36    EDIT BY WEISSMAN
;<MFEXEC>XMAIN.MAC;20218    28-JUN-79 15:20:51    EDIT BY WEISSMAN
; ADDED CORRECT (SPELLING ERRORS) COMMAND
; ADDED JSYS TRAP INFORMATION AND LOGIC
;[I4B-TENEX]<MFEXEC>XMAIN.MAC;20204, 11-JUN-79 15:58:47, EDIT BY WEISSMAN
;<MFEXEC>XMAIN.MAC;20203    11-JUN-79 14:02:16    EDIT BY WEISSMAN
; CHANGES FOR I4-TENEX OPERATION
;<MFEXEC>XMAIN.MAC;20202   1-NOV-78 07:50:51  EDIT BY B-SMITH
;Use GCOTTY instead of COJFN for simple terminal type changes
;<MFEXEC>XMAIN.MAC;20201  17-OCT-78 16:15:06  EDIT BY B-SMITH
;Remove NOLOG from DA abriv. for DAYTIME.
;<MFEXEC>XMAIN.MAC;20200  27-SEP-78 08:52:10  EDIT BY B-SMITH
;Added BBN feature conditionals, more cleanup rearranging
;<MFEXEC>XMAIN.MAC;20103   6-JAN-78 09:26:26  EDIT BY B-SMITH
;No LOGIN.CMD on create job startup
;fix for FORKSTAT *
;<MFEXEC>XMAIN.MAC;20102   2-JAN-78 15:22:54  EDIT BY B-SMITH
;<MFEXEC>XMAIN.MAC;20101  29-DEC-77 08:54:19  EDIT BY B-SMITH
;2.01
;Generalized program running code (subsys,ephemerals, etc.)
;<MFEXEC>XMAIN.MAC;20000  25-SEP-76 05:27:53  EDIT BY DALE
; Conversion to new tables: FKBLK,FKFLG,FKNAM,FKNMT,FKNNB
; FORKSTAT [fork #/name]
; TERMINAL (type) logic from ISI EXEC;
;  Only set: type #, line width, page length
; Write symbols to MFEXEC.SYMBOLS (remove from core)
; General cleanup
;2.00

	TITLE MFEXEC
	SEARCH XSTG,STENEX

PRINTX Entering XMAIN

SALL


;TENEX Multiple Fork EXECutive

; @MACRO
; *XSTG=XSTG
; *XEC=XMAIN,X1CMD,X2CMD,X3CMD,X4CMD
; *XSUBRS=XSUBRS

; @LINK10
; *DSK:MFLNK/SAVE
; *XSTG /SET:.LOW.:BCODE
; *XEC,XSUBRS /G

; @RUN MFLNK.SAV  ;to cause MFEXEC to make a share save of itself, etc


;XMAIN.MAC -
;  Initialization
;  Main loop to read 1st word of command & dispatch
;  /, \, VERSION
;  Command tables
;  Other tables:  CHRTBL, CHNTAB, LEVTAB
;  Status commands:
;    DISCUSE, DSKSTAT, ERRSTAT, FILSTAT, FORKSTAT, IMPSTAT, JOBSTAT,
;    MEMSTAT, PISTAT, RUNSTAT, SYSTAT, STATISTICS, TRMSTAT, USESTAT
;  Terminal characteristics commands:
;    FULLDUPLEX, HALFDUPLEX, LENGTH, WIDTH
;    [NO] FORMFEED, FREEZE, INDICATE, LOWERCASE, RAISE, TABS
;  TERMINAL (type)
;  NETLOAD

;X1CMD.MAC -
;  Most other commands in alphabetical order

;X2CMD.MAC -
;  COPY/APPEND
;  LIST/TYPE
;  DETACH/REDIRECT

;X3CMD.MAC -
;  ARCHIVE
;  DIRECTORY/QFD/...

;X4CMD.MAC -
;  Privileged commands (^Exxx)

;XSUBRS.MAC -
;  UUO routines
;  PSI routines
;  Basic subroutines, utilities, etc

;XSTG.MAC -
;  Macros, Opdefs, and useful things
;  Memory assignments

;EXTERNS
; SEPARATELY ASSEMBLED SUBROUTINES

EXTERN DATEIN,SHTIME	;DATE AND TIME INPUT ROUTINES
EXTERN READY,READY2	;PRINT 1 OR 2 READY CHARS (@ OR !)
EXTERN %KEYW		;SERVICE ROUTINE FOR KEYWORD LOOKUP UUO (KEYWD)
EXTERN FSYM		;TABLE SCANNER
EXTERN %NOI		;SERV ROUTINE FOR NOISE WORD UUO ("NOISE" MACRO)
EXTERN %SBCOM		;UUO TO INPUT & DISPATCH ON SUBCOMMANDS
EXTERN %INHEL		;UUO TO INPUT FIELD WITH HELP ("INHELP" MACRO)
EXTERN CSTR,MORE	;INPUT AND APPEND TO FIELD SUBROUTINES
EXTERN PASCOM		;PASS COMMENT
EXTERN %ALLOW		;CHECK FIELD TERMINATOR (ALLOW UUO)
EXTERN CONF		;TERMINATE AND CONFIRM COMMAND
EXTERN TCONF		;TRANSPARENT CONFIRM, USABLE DURING COMMANDS
EXTERN SPRTR		;ANALYZE SEPARATOR/TERMINATOR AFTER AN ARG
EXTERN CCHRI		;INPUT A CHARACTER OF COMMAND
EXTERN UBP		;REMOVE LAST CHARACTER FROM COMMAND STRING
EXTERN %TYPE,CTYPE,%$TYPE,$CTYPE,%ALTYP	;TYPE MESSAGE SUBRS & UUOS
EXTERN CINFN,COUTFN,SPECFN,CPFN	;GET IN, OUT, SPECIAL, PROG FILE NAMES
EXTERN CEDFN			;COLLECT EDIT FILE NAME
EXTERN .INFG,INFG,$INFG,DIRARG	;INPUT FILE GROUP DESCRIPTORS
EXTERN TYPIF,GNFIL,FRSTF,NEXTF	;ROUTINES TO STEP THRU FILES IN GROUP
EXTERN INTRM		;READ TERMINATING CHARACTER AFTER IDTIM, ETC.
EXTERN DEVN		;COLLECT DEVICE NAME
EXTERN DIRNAM,USER,DEFDIR ;COLLECT DIRECTORY NAME
EXTERN TTYNUM		;GET TTY NUMBER FROM USERNAME OR OCTAL NUMBER
EXTERN FPIN,DECIN,OCTAL,TOCT,OCTCOM ;NUMBER INPUT AND OUTPUT SUBRS
EXTERN BUFFF,BUFFS	;BUFFER LAST FIELD SUITABLY FOR USE AS JSYS ARG
EXTERN ALLBK,NALNBK,DOECEO,NOECHO,DOECHO	;TTY MODES ETC
EXTERN %PRINT		;PRINT CHARACTER FROM EFFECTIVE ADDRESS
EXTERN DWNTIM		;PRINT SYSTEM DOWNTIME
EXTERN CRIF		;TYPE EOL IF NOT AT LEFT MARGIN
EXTERN CCHRO		;OUTPUT CHARACTER (OF COMMAND IF "STCF" ON)
EXTERN MAPPF		;MAP PAGE OF FORK SUBR
EXTERN LOADF		;LOAD WORD FROM FORK SUBR
EXTERN STOREF		;STORE SINGLE WORD INTO FORK
EXTERN %GTB		;CONVENIENT GETAB CALL UUO
EXTERN DING,CERR,SCREWUP,JERR,JERRC  ;VARIOUS ERROR CONDITIONS
EXTERN NIYE,NIM		;NOT IMPLIMENTED YET ERRORS
EXTERN %TRAP		;ERROR PSI MESSAGE UUO ROUTINE
SRI <	EXTERN PCPUTL,JCPUTL>	;PRINT CPU UTILIZATION PERCENTAGE
EXTERN AUTOLO		;ROUTINE TO DO AUTOLOGOUT
EXTERN %ERR,%$ERR,%.$ERR ;GENERAL ERROR UUOS (MACROS "ERROR" ETC)
EXTERN RERET		;NORMAL AFTER-ERROR ROUTINE FOR CERET TO PT TO
EXTERN %ETYPE		;TYPE MESSAGE, EXPANDING %-CODES
EXTERN RLJFNS		;CLOSE AND RELEASE JFNS USED BY CURRENT COMMAND
EXTERN FLOAT		;FLOAT INTEGER IN A
EXTERN TOUT		;TYPE THE SECONDS IN A AS H:MM:SS
EXTERN $SYSGT		;FAST SYSGT
EXTERN $DIRST		;CASED DIRST
EXTERN UNMAP		;FLUSHES BUFFER PAGES
EXTERN $GETER		;GETS LAST ERROR, PERSERVES ACS

; IN "SUBRS" ASSEMBLY:
EXTERN NOINTR		;OKINT SERVICE ROUTINE
EXTERN CCPSI,DATPSI,EOFPSI,HUPSI,IITPSI,ILIPSI,USEPSI
; SPECIAL CHARACTER ROUTINES:
EXTERN $CTRLA,$CTRLR,$CTRLV,$CTRLW,$CTRLX,$FORMF,$EOL,$DASH,$CONT,$RUB
; OTHER CONSTANTS
EXTERN MINUS1,BITS,BHC
; READ ONLY MEMORY
EXTERN WHY

;TENEX ENTRY VECTOR

;N.B.  "MFEXEC" MUST BE THE FIRST SYMBOL IN RELOC SECTION

MFEXEC::JRST REE		;START ENTRY
	JRST REE		;REENTER ENTRY
	JRST CREATD		;CREATED JOB ENTRY
	JRST CREATD		;FOR COMPATABILITY
EVECL==.-MFEXEC


;MFEXEC VERSION, PRINTED ON STARTUP AND BY "VERSION" COMMAND
; NOTE THESE GET SETUP AUTOMATICALLY FROM THE EXTENSION OF
;  MFEXEC PUBLIC RESIDENCE WHEN STARTED THE FIRST TIME AFTER A
;  REASSEMBLY.  (NOTE: THE INPUT COMMAND FILE DOES THIS TO MOVE
;   SYMBOL POINTERS ALREADY).

VERSN:	^D203			;MAJOR AND MINOR VERSIONS
PATVER:	0			;# TIMES PATCHED


;PATCH AREA

	PAT			;POINTER TO NEXT FREE PATCH LOCATION
PATS:: PAT:: BLOCK 200


MFSAV::	MFSAVS			;<where>MFEXEC.SAV
MFSYM::	MFSYMS			;<where>MFEXEC.SYMBOLS

;UUO DISPATCH TABLE
;GENERATED BY EXPANDING "UUOS" LIST DEFINED IN XDEF

CUUOT:  EXPAND (UUOS,<EXP ITEM>)

;UUO DISPATCHER

CUUO::	PUSH P,A
        HLRZ A,40
        LSH A,-^D9
        HRRZ A,CUUOT-1(A)
        EXCH A,0(P)
	POPJ P,

;SUBROUTINE TO TYPE SYSTEM AND MFEXEC 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
	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

;"MFEXEC" AND ITS VERSION

VERSI2:	MOVE 1,VERSN
	IDIVI 1,^D100		;SEPARATE INTO MAJOR AND MINOR #'S
	ETYPE < MFEXEC %1Q.%2Q>	;TYPE THEM OUT
	SKIPE 1,PATVER		;TYPE PATCH VERSION, IF ANY.
	 ETYPE <.%1Q>
	PRINT EOL
	RET

;CREATED JOB ENTRY

CREATD:	MOVEM A,CJFLGS
	MOVEM B,CJFKSA
	SETOM CJINIT
	JRST EXEC0

;REENTER ENTRY

REE::	SKIPE CINITF		;IS MFEXEC INITIALIZED?
	JRST EXEC0B		;YES. SKIP FULL STARTUP CODE
IAC <	SETZ	16,		; ASSUME NOT TOP-LEVEL
	MOVEI	A,-2		; CHECK TOP-LEVEL FORK
	RFSTS
	HRRZS	2		; ISOLATE PC VALUE
	CAIE	2,.-1		; PC OF TOP FORK SAME AS OUR PC AT RFSTS TIME?
	JRST	EXEC0		; NO
	SETOB	16,CJINIT	; YES, WE ARE TOP-LEVEL; FAKE "CREATED" ENTRY
	MOVSI	(1B3)		; FAKE AC1 FLAGS
	MOVEM	CJFLGS		; STORE THEM
	SETZM	CJFKSA		; NO STARTUP FORK
	; FALL THRU TO EXEC0...
> ; END IAC CONDITIONAL

;EXEC COMMAND INTERPRETER IS INITIALLY STARTED HERE

EXEC0:

;ZERO WRITEABLE AREA NOT INCLUDING AUTO OR CREATED JOB STARTUP VARIABLES
        SETZM CSZ1
        MOVE A,[CSZ1,,CSZ1+1]
        BLT A,CSZ4

;SET UP 41 FOR UUO'S, P=17 FOR PUSHDOWN POINTER
	MOVE A,[CALL CUUO]
        MOVEM A,41
        MOVE P,[IOWD PDL,PD]

;CLEAR & SET FLAGS
	SETZ Z,			;AC FLAGS

;Setup for Primary I/O
	MOVEI A,100		;Set input and output JFNs
	MOVEM A,CIJFN		; to be the primary
	MOVEI A,101		; input and output JFNs..
	MOVEM A,COJFN

;Initialize fork tables for MFEXEC
	MOVE A,[INETTY##,,FKBLK] ;Init FKBLK for MFEXEC..
	BLT A,FKBLK+SFKBLK-1
	MOVE A,[ASCII "MFEXE"]	;Init FKNAM for MFEXEC..
	MOVE B,[ASCII "C"]
	MOVEM A,FKNAM+0
	MOVEM B,FKNAM+1
	MOVEI A,1		;Init fork name table to know about the one
	MOVEM A,FKNMT		; existing fork name, MFEXEC
	MOVE A,[FKNNB0##,,FKNAM]
	MOVEM A,FKNMT+1
	MOVSI A,FK%STD+FK%ACT+FK%PRO+FK%BLK+FK%NAM
	MOVEM A,FKFLG		;MFEXEC has some initial flags

;POINT THE EXEC AT A FORK, IF ANY
	HLRZ A,CJFKSA		;IN CASE THIS IS A CREATED JOB
	TRZ A,.FH		;(MAKE IT A FORK NUMBER)
	MOVSI B,B1+B2		;"FORK EXISTS" PASSED FROM CRJOB
	SKIPE CJINIT		;IF WE ARE NOT STARTING A CREATED JOB
	TDNN B,CJFLGS		;OR NO FORK SUPPLIED
	SETO A,
	MOVEM A,CIFORK

;INITIALIZE FREE SPACE

	MOVE A,[XWD <LFREP-MFFREE>/1000+1,MFFREE/1000]
	CALL RELPAG##		;Release all the pages

;INIT FUNCTION QUEUE

	MOVEI A,Q
	MOVEM A,QIN
	MOVEM A,QOUT

;RANDOM THINGS...
	MOVE A,["!",,"@"]	;DEFAULT HERALDS
	MOVEM A,HERALD
	MOVE A,[INITTY##,,FKBLK+IFKBLK] ;Setup proto-type FKBLK
	BLT A,FKBLK+IFKBLK+SFKBLK-1

	SETOM LFORK		;SAY NO FORK HAS BEEN RUN
	SETOM NPAGE		;SAY NO PAGE OF INFERIOR IS MAPPED
	SETZM MSGTIM		;DO "MAILWATCH"  (DEFAULT)
	SETOM PRNTIM		;DO "CANCEL PRINTERWATCH" (DEFAULT)

IAC <	JUMPN	16,[SETOM LOGINI	; SAY LOGIN.CMD NOT SEEN
		    CALL  GLSTLI	; GET LAST LOGIN TIME
		    MOVEM A,DOLGTM	; STORE IT
		    JRST  .+1]		; AND CONTINUE
> ; END IAC CONDITIONAL

;On the 1st start up (on the connected directory):
;  Write the defined and undefined symbols to MFEXEC.SYMBOLS
;  Share save the core image (minus symbols) to MFEXEC.SAV

	CALL SETVN		;Check version definition, test for save
	 JRST EXEC0B		; No save needed, proceed with startup.
	CALL WTSYM
	 TYPE < Symbol file not written
>
	CALL WTSAV0
	 TYPE < SSAVE file not written
>
	JRST EXEC0B

SETVN::	MOVEI A,MFEXEC		;Get access of first MFEXEC code page..
	LSH A,-^D9		; Will want to modify PATVER
	HRLI A,.FHSLF		; (if 1st run, or patch save)
	RPACS
	TLNE B,(1B10)		; Private page?
	TLNN B,(1B3+1B9)	; Write or copy-write?
	 RET			; No, no-skip
	AOS 0(P)		;OK to save. Check for correct patch number
	MOVSI A,(1B2!1B17)	;Get a handle on the public version
	HRROI B,MFSAV		; of MFEXEC.SAV
	GTJFN
	 RET
	MOVE B,[1,,FDBVER]	;Get its version number
	MOVEI C,C
	GTFDB
	HLRZS C
	IDIVI C,^D100		;Split off the patch number
	ADDI D,1
	CAMN C,VERSN		;New version of old MFEXEC?
	MOVEM D,PATVER		; yes, save incremented PATVER
	RLJFN
	 JFCL
	RET

WTSAV::	CALL SETVN		;Select proper version
	 RET			; Problems, don't make save file
WTSAV0:	MOVEI A,.FHSLF		;Make sure the entry vector is correct
	MOVE B,[EVECL,,MFEXEC]
	SEVEC
	HRROI B,[ASCIZ /MFEXEC.SAV/]
	CALL MFGTJ
	 RET
	HRLI A,.FHSLF		;A/ fork.self,,JFN
	SKIPN C,.JBSYM		;Compute last page to save,
	MOVEI C,764000		; beginning of symbol table, or beginnig of DDT
	ADDI C,777
	MOVEI B,BCODE		;Compute first page to save
	LSHC B,-^D9
	ANDI C,777
	SUBM B,C		;RH(C)/ negative number of pages to save
	IORI B,120000		;Read Execute only
	HRL B,C
	SETZ C,
	SSAVE
	AOS 0(P)
	RET

WTSYM::	SKIPN .JBSYM		;Symbols present?
	 RET			; nothing to save
	HRROI B,[ASCIZ "MFEXEC.SYMBOLS"]
	CALL MFGTJ
	 RET
	PUSH P,A		;Remember JFN
	MOVE B,[44B5+1B20]	;Open to write full words
	OPENF
	 JRST [	EXCH A,0(P)
		RLJFN
		 JFCL
		POP P,A
		RET]
	MOVE B,.JBSYM		;1st word contains symbol pointer for
	BOUT			; defined symbols
	HRLI B,444400		;Followed by the symbols and values,
	HLRE C,.JBSYM
	SOUT
	MOVE B,.JBUSY		;Then the symbol pointer for
	BOUT			; undefined symbols
	HRLI B,444400		;Followed by those symbols
	HLRE C,.JBUSY
	CAIGE C,0		; (if any)
	SOUT
	CLOSF
	 JFCL
	SUB P,BHC+1
	HRRZ B,.JBSYM		;Zero out symbol table that falls on
	MOVSI A,0(B)		; the bottom part of the last code page..
	HRRI A,1(B)
	IORI B,777
	SETZM -1(A)
	BLT A,B
	AOS 0(P)
	RET

;CALL BY WTSAV AND WTSYM

MFGTJ:	MOVE A,VERSN		;Compute proper version number
	IMULI A,^D100
	ADD A,PATVER
	HRLI A,(1B0+1B17)
	GTJFN			;Get JFN for symbol or save file
	 RET
	AOS 0(P)
	RET

EXEC0B:

;SET UP PRIMARY INPUT AND OUTPUT JFN'S
;THESE REMAIN CONSTANT AT LEAST AT PRESENT.

	MOVEI A,.FHSLF
	GPJFN			;SAVE OLD PRIMARYS
	MOVEM B,PRIMRY		; FOR ^C ETC.
	MOVEI A,100
	MOVEM A,CIJFN
	MOVEI A,101
	MOVEM A,COJFN

;INITIALIZE PROCESS PSI SYSTEM,
; DONE EARLY SO ERRORS IN REST OF INITIALIZATION WILL BE HANDLED.
;ENABLE ALL ERROR CHANNELS BUT OVERFLOW,
; ALSO CHANNEL 1 FOR ASSIGNMENT TO ^C BELOW.

	MOVEI A,.FHSLF		;SAY THIS FORK
	MOVE B,[LEVTAB,,CHNTAB]
	SIR			;SET UP TABLE ADDRESSES
FEATUR -%BAKTRP,<
	MOVE B, [250777740004]	;CHANNELS 1, 3, 5, 9-21, 33.
>
FEATUR %BAKTRP,<
	MOVE B,[250777750004] ; CHANNELS 1, 3, 5, 9-21, 23, 33.
>
	AIC			;ACTIVATE SPECIFIED CHANNELS
	SETCA B,		;DEACTIVATE ALL OTHERS.
	DIC			; MINI SHOULDN'T BE EFFECTED.
	EIR			;ENABLE PROCESS PSI SYSTEM

FEATUR %BAKTRP,<
	MOVSI	1,(1B6)		; RESET JSYS TRAPS
	SETZ	2,
	TFORK
	 CALL	JERR
	MOVSI	1,(1B3)		; SET JSYS TRAP CHANNEL
	MOVSI	2,^D23		; TO 23.
	TFORK
	 CALL	JERR
>

;INITIALIZE THE EXEC AND PROGRAM TTY MODE BLOCKS
; FK.MOD IS USED AS FLAG TO INDICATE WHETHER OR NOT WE
; HAVE A TTY.  CALLS TO LTTYMD OPERATE ONLY ON SUBSYS
; NAME IF FK.MOD IS ZERO.  THIS WILL BECOME NON-ZERO AS
; SOON AS WE HAVE A TTY.  NOTE: THIS CAN HAPPEN HERE, IF
; THE "GET" DURING AUTOSTARTUP IS BAD, OR IN RTTYMD
; DUE TO ^C OUT OF AUTOSTARTED JOB WHICH WAS STARTED DETACHED.

EXEC0C:	GETNM			;SUPERIOR-SET SUBSYS NAME
	MOVEM A,SUPSUB		;SAVE FOR "QUIT"
	GJINF
	MOVEM A,CUSRNO
IAC <	SKIPN	MWUSER
	HRRZM	A,MWUSER	; INITIAL MAIL WATCH FOR LOGIN DIR >
	CAME 4,MINUS1		;ARE WE DETACHED?
	SKIPE FK.MOD+0		; OR IS MODE WORD ALREADY INIT'D
	JRST CMDIN1		;Yes, leave FK.MOD as is
	MOVEI A,101
	RFMOD
	TRZ B,77B23+3B25+3B29	;Clear MODE fields
	TRO B,17B23+2B25+1B29
	MOVEM B,FK.MOD+0
	MOVEM B,FK.MOD+IFKBLK

CMDIN1:	SKIPE CINITF		;ARE WE INITIALIZING?
	JRST CMDIN2		;NO, NO SIGN-ON HEARLD
	SKIPE CJINIT		;CREATED JOB?
	SKIPL CJFLGS		;AND BIT 0 ON ?
	 SKIPA			;NO, PRINT SIGN-ON HEADER
	JRST CMDIN2		;YES -- OMIT SIGN-ON HEARLD
SCRC <
	GJINF
	SKIPN A
	 CALL BLANK1
>
	PRINT EOL
	CALL .VERSI		;PRINT SYS AND EXEC VERSION

;COMMANDS THAT RUN PROGRAM RETURN HERE WHEN IT STOPS.
;START, CONT, REENTER, RUN, <SUBSYSTEM NAME>, GOTO.

CMDIN2:

;^C AND COMMAND ERRORS COME BACK HERE.
;AFTER ^C IT IS NECESSARY TO EXECUTE CODE TO FIND OUT WHETHER LOGGED IN,
; HAVE INFERIOR FORK, UPDATE CAPABILITIES, KILL AUTOLOGOUT FORK,
; ETC IN CASE INTERRUPTED COMMAND WAS LOGIN, RUN, ETC.

ERRET::

	MOVEI A,RERET##		;SAY WHERE TO GO ON ERROR WHILE TYPING
	MOVEM A,CERET		; ...LOGIN MESSAGE

;BE SURE CONTROL C CHANNEL IS ACTIVE.  IT IS TURNED OFF IN
;TRAP HANDLING CODE

	MOVEI A,.FHSLF
	MOVSI B,(1B1)
	AIC

	SKIPE CJINIT
	JRST CMDN2B
	HRLZI A,B0!B1		;"FACT FILE OR LOGGING TTY" ENABLED
	TMON			;SKIP IF EITHER EXISTS
	TYPE < *****Accounting off*****
>
	CALL LGNCHK		;WARN IF LOGIN PROHIBITED
	JUMPE A,CMDN2B		;LGNCHK SAID OK TO LOGIN
	TYPE < "ATTACH" to existing job is permitted>
	PRINT EOL

;SAY INITIALIZATION HAS COMPLETED SUCCESSFULLY.
;UNTIL CINITF><0, ERROR ROUTINES HALT RATHER THAN TYPE MESSAGES,
; AND "REENTER" DOES A "START".

CMDN2B:	SETOM CINITF

;FIND OUT IF THIS JOB IS LOGGED IN. (MIGHT BE AT STARTUP IF SUBSIDIARY,
;  OR A SUBSYSTEM COULD LOG JOB IN.)
	GJINF			;LOGIN DIR # IN A, 0 IF NOT LOGGED
	MOVEM A,CUSRNO		;SAVE LOGIN DIR # OR 0

;KILL AUTOLOGOUT FORK IF IT EXISTS BUT LOGGED IN.
	SKIPLE CUSRNO		;SKIP IF NOT LOGGED IN
	SKIPG A,ALOFH		;FORK THAT LOGS OUT ABANDONED JOBS
	JRST CMDN2D
	SETOM ALOFH		;SAY ITS KILLED (DON'T RETRY ON FAILURE)
	CAIE A,.FHSLF		;NOT IF USING TIMER JSYS (IIT)
	KFORK			;KILL IT

;ENABLE SPECIAL CAPABILITIES

CMDN2D:	MOVEI A,.FHSLF		;SAY THIS FORK
	RPCAP			;GET SPECIAL CAPABILITIES POSSIBLE IN 2
	HLLZ C,B		;ENABLE ALL PROCESS (LH) CAPABILITIES
	SKIPE PRVENF		;IF "ENABLE" COMMAND IS IN EFFECT,
	HRR C,B			;ALSO ENABLE RH (USER) CAPABILITIES.
	EPCAP

	MOVEI 1,.FHSLF
	CIS

	MOVE A,[CTRLC,,1]
	TLNE C,B0		;TEST SPEC CAP BIT 0
	ATI			;ASSIGN ^C TO CHAN 1

	MOVE A,[CTCODE,,3]
	ATI			;ASSIGN ^T TO CHAN 3

	MOVE A,[HUCODE,,5]
	ATI			;ASSIGN CARRIER OFF TO CHAN 5

;Release any temporary free space assignments

	CALL RELFLT##

;THE FOLLOWING IS REALLY FOR DEBUGGING AND SHOULD BE REMOVED
;AFTER CONFIDENCE IS GAINED.

	MOVSI D,-NFKS		;LOOP THROUGH ALL FORKS
CMDN2E:	SKIPN FKFLG(D)
	JRST CMDN2F
	MOVSI A,.FH(D)		;FOR ALL FORKS WE KNOW ABOUT
	RFSTS			;GET ITS STATUS
	HLRZ B,A
	CAIE B,-1		;IS IT STILL A VALID HANDLE
	JRST CMDN2F		;YES.  INTERNAL TABLES OK
	MOVEI A,.FH(D)		;NO. CLEAR INTERNAL REFERENCES
	ETYPE < %1F disappeared!
>
	CALL CLRFKT
CMDN2F:	AOBJN D,CMDN2E

;HERE WHEN READY TO INPUT A COMMAND.
;ALL COMMANDS RETURN HERE OR ABOVE HERE WHEN DONE.

CMDIN4::MOVEI A,.FHSLF		;Set EXECs modes
	CALL SFKTTM##		; in case last command didn't restore it
	MOVE A,[1B0+.FHSLF]	;GET/SET DEFERRED FOR THIS FORK
	RTIW
	MOVSI C,(1B<CTRLC>)
	AND C,B
	STIW
	SETO A,
	CAME A,NPAGE
	CALL MAPPF##		;DON'T LEAVE FORK PAGES MAPPED
	SETZM CSZ1		;ZERO STORAGE
	MOVE A,[CSZ1,,CSZ1+1]
	BLT A,CSZ2


;Dump any queued messages
	MOVEI A,.FHSLF
	MOVEI B,1B<FNCCHN>
	IIC

;KILL ANY INACTIVE EPHEMERALS
	MOVSI D,-NFKS
CMDN4B:	MOVE B,FKFLG(D)
	TLNE B,FK%EPH
	TLNE B,FK%ACT
	JRST CMDN4C
	PUSH P,D
	MOVEI A,.FH(D)		;FORK HANDLE OF FORK TO KILL
	CALL $KFORK
	POP P,D
CMDN4C:	AOBJN D,CMDN4B

;INITIALIZE WHAT NEEDS INITIALIZING
	CALL PATHIN		;BE SURE SEARCH PATH IS INITALIZED
	MOVE BFP,[POINT 7,CBUF]	;BYTE POINTER INTO COMMAND BUFFER,
				;IN WHICH ENTIRE LINE IS ACCUMULATED.
				;STAYS IN BFP.
	MOVE P,[IOWD PDL,PD]	;INIT PD POINTER

	MOVE A,[IOWD JBUFL,JBUF] ;INIT PTR INTO JFN BUFFER
	MOVEM A,JBUFP
	MOVE A,[POINT 7,CSBUF]	;INIT PTR INTO STR BUF FOR JSYS ARGS
	MOVEM A,CSBUFP

	MOVEI A,RERET##		;REGULAR ERROR RETURN ADDRESS
	MOVEM A,CERET		;SAY WHERE TO GO AFTER PRINTING ERR MSG

	MOVE A,CIFORK		;CURRENT FORK
	TRO A,.FH		;MAKE FORK HANDLE (OK FOR -1 TOO!)
	MOVEM A,FORK		;USE IT IN COMMANDS

;CLEAR SOME FLAGS
	MOVSI A,(777B17)	;Clear temporary command privileges
	ANDCAM A,PSPRIV

	SETZ Z,			;CLEARS PUNCTF, STCF, BAKFF, ETC.

	SETZB KWV1,KWV		;NO SPECIAL BITS ON IN COMMAND KEYWORD
				; TABLE VALUE. THIS IS IN CASE SOME
				; SPECIAL SYNTAX
				; NEVER SETS KWV1 BUT CALLS "CONF".
				; THE ONLY SUCH CASES ARE
				; <SUBSYSTEM NAME> AND INPUTTING
				; DATE AND TIME.  6/30/70.

;REQUEST DATE AND TIME IF SYSTEM DOESN'T HAVE THEM.
;THIS MUST BE INSIDE COMMAND LOOP SO IT WILL BE REPEATED IF ERROR
; OR ^C ABORTS FIRST ATTEMPT.

	SKIPN CJINIT		;Don't get time if created job
	SKIPE DTSF		;NON-0 IF HAVE DATE AND TIME
	JRST CMDN5B		; AND HAVE BEEN HERE BEFORE
	GTAD			;FLAG NOT SET YET, GET DATE AND TIME
	CAME A,MINUS1		;-1 SAYS SYSTEM DATE & TIME NOT SET
	JRST CMDN5B		;SYSTEM HAS DATE AND TIME.

;SYSTEM HAS NO DATE AND TIME, GET SAME. SUBR INDT (WITH ^E SET IN
;X4CMD.MAC) INPUTS, CONFIRMS, AND SETS TIME & DATE. KWV1 MUST BE 0 NOW!
	MOVE 1,CIJFN
	SIBE			;INPUT ALREADY TYPED?
	JRST [	TYPE < Tad= >	;YES, GIVE SHORT MESSAGE
		JRST .+2]
	TYPE < Enter date and time as dd-mmm-yy hh:mm = >
	CALL INDT

CMDN5B:	SETOM DTSF		;SAY SYSTEM HAS DATE AND TIME.
				; THIS AVOIDS
				; DOING GTAD EVERY TIME THRU LOOP.

;NOW THAT SYSTEM DEFINITELY HAS DATE & TIME, INITIALIZE "AUTOLOGOUT"
;STUFF IF NECESSARY.
	SKIPLE CUSRNO		;IF ALREADY LOGGED IN
	 JRST CMDN5E		; NOT RELEVANT.
	SKIPE ALOFH		;ALO FORK STARTED?
	JRST CMDN5D		;YES, ALO INITIALIZATION ALREADY DONE.
	TIME			;SAVE STARTUP TIME FOR USE IN
	MOVEM A,STRTIM		;"ALOTST" SUBR

FEATUR %IIT,<			;IF AN IIT SITE:
	MOVEI C,AUTOL3		;Autologgout test interval
	IMULM B,C		;Convert to jiffies
	ADD A,C
	MOVEM A,ITIMER
	MOVEI A,.FHSLF
	MOVEM A,ALOFH
	MOVSI B,(1B<IITCHN>)
	IIT
>

FEATUR -%IIT,<			;IF NOT AN IIT SITE:

;START UP FORK TO WATCH FOR ABANDONED JOB (NO TTY ACTIVITY FOR
;N SECONDS) AND PSI THIS FORK IF THAT OCCURS.
	MOVE A,[1B0+1B4+ALOFRK]	;Set map and start fork at ALOFRK
	CFORK			;FORK WHICH LOOKS FOR NO TTY ACTIVITY
	 CALL [	SETOM ALOFH	;ON ERROR THIS PREVENTS INFINITE
		JRST JERR##]	;...RETRY LOOP.
	MOVEM A,ALOFH		;SAVE HANDLE FOR KILLING LATER.
>

;JOB ISN'T LOGGED IN, SEE IF ITS TIME TO AUTO-LOGOUT IT.
CMDN5D:	CALL ALOTST

CMDN5E:	SKIPN CJINIT		;CREATED JOB?
	JRST CMDN6		;NO
	SETZM CJINIT		;CANCEL CREATED JOB INIT STATE
	MOVSI A,(1B3)		;"FAKE LOGIN TYPEOUT" FROM CRJOB
	TDNE A,CJFLGS		;SUPPOSED TO?
	SKIPG CUSRNO		;SKIP IF LOGGED IN
	 JRST CMDN5G		;CAN'T FAKE LOGING TYPEOUT IF NOT
	ETYPE < Job %J on line %L %D %E>
	PRINT EOL
	CALL GLSTLI		;GET DATE OF LAST LOGIN TO A
	ETYPE< Previous login %1D %E>
	CALL JOBCNT		;WARN OF OTHER JOBS
	PRINT EOL
	CALL DWNTIM##
	CALL CHKDAL
	MOVE B,CJFKSA		;AC PARAMETER
	MOVE A,CJFLGS		;FLAGS AGAIN
	TLNE A,(1B17)		;SYSTEM LOGIN MESSAGES REQUESTED?
	MOVEM B,DOLGTM		;YES, DATE GIVEN IN AC

CMDN5G:	MOVE A,CJFLGS		;FLAGS FROM CRJOB ENTRY
	SKIPL FORK		;IF THERE IS A FORK
	TLNN A,(1B2)		;"START INFERIOR" BIT
	 JRST CMDN6		;NO FORK, OR NO START COMMAND

	HRRZ B,CJFKSA		;ENTRY VECTOR OFFSET
	JRST START1		;RUN IT


;GET DATE OF LAST LOGIN

GLSTLI:	MOVE A,['LGNPAR']
	SYSGT
	SKIPN A,B
	 RET			;RETURN 0 IF NO SUCH TABLE
	HRLI A,1		;SET TABLE INDEX
	GETAB
	 MOVEI A,0
	RET

CMDN6:	SKIPLE CUSRNO		;If job is not yet logged in
	SKIPGE CREDOF		; or output is redirected
	JRST CMDN7		; then skip periodic checks
	SKIPGE CREDIF		;Skip checks if input is redirect too.
	JRST CMDN7

	TIME
	CAMGE A,ITIMER
	JRST CMDN6B		;NOT YET TIME FOR PERIODIC CHECKS
	MOVEI A,.FHSLF
	MOVSI B,(1B<IITCHN>)
	IIC
CMDN6B:!

;Check for automatic command files

	CALL TAKCOM

	CALL TAKLOG

	CALL SYSMSG

;Temporary mail check (should be put in IIT channel service routine)
	CALL PMSGCK

;A printer check needs to be reeinstalled here
IAC <
	SKIPN	PRNTIM		; AND HERE IT IS!!
	CALL	PRIWAT
>

;Check to see if it time to run the Daemon

FEATUR %DAEMON,<CALL CKDAEM>	;Returns to CMDIN2 if the Daemon ran

	JRST CMDN7		;Continue with command loop

TAKCOM:	SKIPE FILINI		;NON ZERO IF COMAND.CMD IS PROCESSED
	RET
	SETOM FILINI		;SAY ALREADY DONE
	HRROI B,[ASCIZ /MFEXEC.CMD/] ;Try this first
	CALL TAKEIT		;Won't return if it is there
	HRROI B,[ASCIZ /COMAND.CMD/]
	JRST TAKEIT

TAKLOG:	SKIPN LOGINI		;NON ZERO IF LOGIN DONE AND LOGIN.CMD NOT DONE
	RET
	SETZM LOGINI		;FLAG AS THO ITS DONE
	HRROI B,[ASCIZ /LOGIN.CMD/]

TAKEIT:	PUSH P,B		;SAVE MAIN STRING POINTER
	MOVE A,CSBUFP		;PLACE TO STORE STRING
	MOVE B,CUSRNO		;LOGIN DIR
	MOVEI C,"<"		;
	IDPB C,A		;
	DIRST			;EXPAND NAME
	 CALL JERR		;ON LOGIN DIRECTORY ?
	MOVEI C,">"		;END DIRECTORY FIELD
	IDPB C,A		;
	MOVE B,A		;
	POP P,A			;
	SETZ C,			;TERMINATE ON NULL
	SIN			;TACK ON ORIGINAL STRING
	MOVE B,CSBUFP		;
	CALL TRYGTJ		;JFN TO CJFN1 IF SUCCESSFUL
	 RET			;DONE IF NO FILE
	HRROI B,[ASCIZ /NIL:/]	;REDIRECT OUTPUT TO NIL
	CALL TRYGTJ		;GET JFN ON NIL (STACKED TO CJFN2)
	 SETOM CJFN2		;NO OUTPUT REDIRECT ON FAILURE (?)
	MOVEI KWV,[XWD CMDIN2,0] ;WHERE TO RETURN (IN LH)
	JRST REDI0		;JOIN REDIRECT.

SYSMSG:	SKIPN A,DOLGTM		;FLAG FOR SYSTEM MESSAGES
	RET
	MOVE B,DOLGBT		;BITS FROM LOGIN
	TLNE B,B2		;REPEAT LOGINS?
	SETZ A,
	MOVE B,[POINT 7,[ASCIZ /<SYSTEM>MESSAGE.TXT/]]
	SETZM DOLGTM
	SETZM DOLGBT
IAC <	CALL	CRIF		; PUT TTY AT LEFT MARGIN >
	CALL MESS
	JRST CMDIN2		;REINIT THE COMMAND LOOP

PMSGCK:	SKIPGE A,MSGTIM		;IF LESS THAN ZERO THEN NO CHECK
	RET
	TIME
	CAMG A,MSGTIM		;Check to see if it is time to check mail
	RET
NOIAC <	MOVE A,CUSRNO >
IAC <	MOVE	A,MWUSER >
	CALL CHKMSG
	 JRST [	JUMPGE B,PMSGC1	;No new mail, just reset time
		SETOM MSGTIM	;No local mailbox, shutoff mail watch
		RET]
	CALL CRIF
	SKIPG B			;NET mail?
	ETYPE <[Net mail at %3D %E]>
NOIAC <	CAIN B,1		;SYSTEM directory? >
IAC <	SKIPE B >
	ETYPE <[Mail from %2R at %3D %E]>
NOIAC <	CAILE B,1
	ETYPE <[Mail from %2R]> >
	PRINT EOL
	MOVE A,COJFN
	DOBE
PMSGC1:	TIME
NOIAC <	ADD A,[^D600000]	;Ten minutes of miliseconds >
IAC <	ADD	A,[^D300000]	; 5 MINS AT IAC >
	MOVEM A,MSGTIM
	RET

;PRINT READY CHARACTER

CMDN7:	CALL READY##		;PRINTS CURRENT "HERALD"

;BEGIN INPUTTING AND DECODING A COMMAND

;FIRST, INPUT FIRST FIELD. MUST INPUT WHOLE FIELD SO EDITING WORKS!
; DISTINGUISH 3 CASES:
;	COMMAND BEGINS WITH A SPECIAL CHARACTER
;	COMMAND BEGINS WITH A WORD
;	COMMAND BEGINS WITH AN OCTAL NUMBER

	TLO Z,NEOLF	;SAY DON'T ECHO EOL'S, BECAUSE THIS INPUT
			;FIELD MAY BE A SUBSYSTEM NAME, AND GTJFN
			;PRINTS AN EOL IF THERE IS AN EOL IN STRING,
			;AND WE DON'T WANT TWO EOL'S PRINTED.
			;THE FOLLOWING INPUTS A FIELD (IE TO A
			;NON-ALPHANUMERIC CHARACTER), EDITS,
			;AND IF INPUT WAS "?",
			;TYPES GIVEN MESSAGE AND INPUTS AGAIN.
			;"%Z" IN MESSAGE EXPANDS TO ALL
			;KEYWORDS IN TABLE.

	MOVEI A,CTBL1		;COMMAND TABLE ADDRESS FOR %Z
	SKIPN SECURE		;If logged in and not in secure mode
	SKIPG CUSRNO		; add conditional string to help printout
	TDZA D,D		;No extra help
	HRROI D,[ASCIZ "
 Subsystem name
 Save file name
 Number/
 Number\ Number
"]
	INHELP <
Commands are:
%1Z%%4W ;Comment

>

	CAIG CNT,1		;IS FIELD COUNT (INCL. TERMINATOR) > 1?
	JRST CIN1A		;NO, COMMAND BEGINS WITH SPECIAL CHAR
	MOVE B,.BFP		;BYTE PTR TO BEGINNING OF FIELD
	HRREI D,-1(CNT)
CIN0A:	ILDB A,B		;GET CHARACTER OF FIELD
	MOVE C,CHRTBL(A)	;GET INFO ABOUTSAID CHARACTER
	TRNN C,OCTDIG		;TEST OCTAL DIGIT BIT
	JRST CIN1C		;COMMAND MUST BEGIN WITH A WORD
	SOJG D,CIN0A		;CHECK ALL CHARACTERS OF FIELD
	JRST CIN6		;COMMAND BEGINS WITH AN OCTAL NUMBER

;HANDLE CASES WHERE A NON-ALPHANUMERIC CHARACTER BEGINS COMMAND

CIN1A:	CAIN TRM,CTRLE		;^E PREFIXES PRIVILEGED COMMANDS
	JRST [	SKIPN PRVENF	;ARE PRIV COMMANDS ENABLED?
		 JRST CERR	;NO
                KEYWD CTBL2     ;SEARCH SPECIAL TABLE
		 0		;NO DEFAULT
		 JRST CERR	;NOT FOUND
		JRST CIN2]	;WIN
	CAIN TRM,"<"		;BEGIN DIR NAME FOR "RUN"?
	JRST CIN3C		;YES.
	SKIPN SECURE		;UNSECURE?
	SKIPGE A,CIFORK		;IS THERE A CURRENT FORK?
	JRST CIN1B		;NO.  FORGET SPECIAL COMMANDS
	HRRZ A,FKFLG(A)		;GET CURRENT EXAMINE LOCATION
	MOVE KWV,[EASUB,,CSLSH]	;SETUP FOR POSSIBLE EXAMINE
	CAIN TRM,"/"
	JRST [	PUSH P,A
		JRST CIN2]
	TRNE CBT,TLF		;CAIN TRM,LF -- .+1/
	 JRST [	MOVEI A,1(A)
		PUSH P,A
		JRST CIN2]
	CAIN TRM,"^"		;.-1/
	 JRST [	MOVEI A,-1(A)
		PUSH P,A
		JRST CIN2]
	MOVE KWV,[EASUB,,CBKSL]	;Check for memory write..
	CAIN TRM,"\"		;.\
	 JRST [	PUSH P,A
		JRST CIN2]

CIN1B:	TLZE Z,EOLNEF
	PRINT EOL		;IF THE CHARACTER WAS EOL, NOW ECHO IT
	CALL PASCOM		;IF LINE IS JUST A COMMENT, CHEW IT UP.
	TRNE CBT,TEOL		;EOL, SEMICOLON, OR FORMFEED?
	JRST CMDIN4		;YES, NULL LINE, GO GET ANOTHER LINE.
;HAVEN'T RECOGNIZED IT YET.
;THIS SHOULD FALL THRU TO WORD CASE RATHER THAN ERROR OUT IF
;  NULL IS TO BE DEFAULTED TO SOME COMMAND SUCH AS "HELP".
	JRST CERR		;TYPE " ?" AND INPUT NEXT COMMAND. 

;COMMAND BEGINS WITH A WORD.
;SEARCH COMMAND TABLE, THEN SUBSYSTEM DIRECTORY,
;THEN GO TO USER'S ERROR ROUTINE.

CIN1C:	CAIE TRM,"."		;PERIOD TERMINATOR PRODUCES ERROR IN
	CAIN TRM,"F"-100	; "KEYWD", (CONTROL-F ALSO),
	JRST CIN3		;BUT IS MEANINGFUL IN SUBSYSTEM NAMES.
	CAIN TRM,":"		;RUN FROM DEVICE?
	JRST CIN3C
	TLO Z,BAKFF+NEOLF	;SAY RE-USE THIS FIELD, DON'T ECHO EOL
	KEYWD CTBL1		;SEARCH FOR COMMAND
	 0			;NO DEFAULT
	 JRST [	SKIPLE CUSRNO	;IF LOGGED IN
		JRST CIN4	;THEN LOOK FOR SUBSYSTEM NAME
		CALL LGNCH0	;Skips if logins not permitted
		 TLOA Z,F1	;Say special login
		JRST CERR	;Just give a question mark 
		CALL .LOGIN	;TRY SHORT FORM LOGIN (GEOFF HACK)
		JRST CMDIN4]
;FOUND, FALL INTO CIN2.

;HAVE VALID FIRST KEYWORD IN COMMAND
;OR HAVE DECODED A SPECIAL SYNTAX SUCH AS "<OCTAL #>/".
;VALUE WORD FROM TABLE IS IN AC "KWV".
;MAKE PRE-DISPATCH CHECKS

CIN2::	TLZE Z,EOLNEF
	PRINT EOL		;IF IT ENDED IN UNECHOED CR, NOW ECHO IT
				;ABOVE IS NEEDED DESPITE THE FACT
				;THAT "CONF" DOES IT FOR
				;MULTILINE COMMANDS SUCH AS "LOGIN"
	MOVE KWV1,KWV      	;1ST KW'S VALUE WD STAYS IN KWV1.
	TLNE KWV1,NOLOG
	JRST .+3
	SKIPG CUSRNO
	 ERROR <Login please>
	SKIPE SECURE		;Secure mode?
	TLNE KWV1,SECOK		;Yes, is it ok?
	SKIPA			;Yes
	ERROR <Secure>
	TLNE KWV1,EASUB		;DOES CMND EXAMINE, ALTER, OR RUN PROG?
	CALL PROPCK		;YES.  CHECK FOR PROPRIETARY PROGRAM
	TLNE KWV1,ONEWD 	;IS IT A ONE-WORD COMMAND?
        CONFIRM         	;YES, HANDLE CONFIRMATION NOW.

;DISPATCH TO ROUTINE TO DECODE REST OF (NON-ONE-WORD) COMMAND THEN
;EXECUTE COMMAND.
;IF "INFILN" BIT WAS ON, JFN IS STILL IN A, AS WELL AS "CJFN1".

CIN2B:  CALL (KWV1)		;DISPATCH WITH PUSHJ,
				;CAN RETURN WITH POPJ
				;OR JRST CMDIN2,3,4.
	JRST CMDIN4		;WHERE MOST COMMANDS SHOULD RETURN.

PROPCK:	SKIPGE A,CIFORK		;WILL BE THE FORK IN QUESTION!
	RET			;NO FORK, RETURN
	MOVE A,FKFLG(A)		;BITS
	TLNN A,FK%PRO		;IS IT PROPRIETARY?
	RET			;NO. JUST RETURN
	MOVEI A,.FHSLF		;YES.  SEE IF WE CAN MEDDLE
	RPCAP
	HRRZS C			;Reserve LH(C) for MFEXEC privilege bits
	SKIPE PRVENF		;If enabled,
	HLL C,PSPRIV		; then get them.
	TDNN C,[WHEEL+OPER+CONFI] ;ARE THEY THE CORRECT BITS?
	 ERROR <%F is proprietary!>
	RET			;HAS ENOUGH. LET HIM DO IT

;FIRST KEYWORD IS AN ATOM, BUT NOT A COMMAND NAME AND ENDED WITH
;NORMAL CHARACTER
CIN4:
SCRC <
	TRNN CBT,TEOL+TALT
	 JRST CIN3
	TLO Z,BAKFF+NEOLF
	KEYWD FKNMT
	 0
	 JRST CIN3
	MOVSI C,FK%KPT		;Lazy continue for kept forks only
	TDNN C,FKFLG(KWV)
	 JRST CIN3
	TLZ Z,NEOLF
	CONFIRM
	HRREI A,(KWV)
	MOVEM A,FORK
	TYPE <[Continuing]
>
	CALL $CONTI
	JRST ..CONT
>

;FIRST KEYWORD IS NOT A COMMAND NAME,
; SEE IF ITS A SUBSYSTEM NAME
;ALSO GET HERE ON OCTAL NUMBER NOT FOLLOWED BY /, \, ETC.

CIN3:	TLOA Z,BAKFF+NEOLF+F3	;SAY REUSE FIELD, DON'T ECHO EOL
				;F3 SAYS TO TRY CONN AND LOGIN
				; AFTER SUBSYS
;DIRECTORY SPECIFIED (OPEN ANGLE BRKT. SEEN).  SEARCH ONLY IT.
CIN3C:	TLO Z,BAKFF+NEOLF
	MOVEI A,0		;NO DEFAULT
	TLNE Z,F3		; IF F3 IS CLEAR
	MOVEI A,[ASCIZ /SUBSYS/]	;DEFAULT DIRECTORY NAME
	SKIPN SECURE		; unless in secure mode
	CALL CPFN##		;COLLECT PROGRAM FILE NAME
	 JRST CIN5		;NOT A SUBSYSTEM NAME
	CALL DIRNOI		;TELL DIRECTORY IF USING SEARCH PATH
	MOVEI KWV,SRUN		;SETUP DISPATCH TO RUN A SUBSYS
	JRST CIN2


;NOT A SUBSYSTEM NAME,
; GO TO SPECIAL ERROR PROCESSOR IF THIS USER HAS ONE
;4/30/70: AT THIS POINT WE DON'T KNOW THE WHOLE INPUT TEXT
;	BECAUSE WE HAVEN'T CAPTURED CHARACTERS READ BY GTJFN.

CIN5:	;BRANCH TO PROCESSOR IF ANY
	;(NOT IMPLEMENTED YET)
FEATUR -%CORECT,<
	JRST CERR		;STANDARD ERROR PROCESSING, "?" TEXT.
>
FEATUR %CORECT,<
	JRST	IACERR##	; TRY SPELLING CORRECTION
>

;COMMAND BEGINS WITH OCTAL NUMBER

CIN6:	CAIE TRM,"."		;IF IT ENDS WITH ".", OR
	TRNE CBT,TEOL+TSPC+TALT	;IF IT ENDS WITH EOL, SPACE, OR ALTMODE,
	JRST CIN3		;TAKE AS A SUBSYSTEM NAME.

;DECODE SPECIAL SYNTAXES FOR / AND \ COMMANDS.
	TLO Z,BAKFF		;UN-INPUT THIS FIELD
	CALL OCTAL##		;INPUT 18-BIT OCTAL NUMBER
	 CALL SCREWUP##		;NULL INPUT CAN'T OCCUR
	PUSH P,A		;SAVE VALUE OBTAINED
;THE TERMINATOR OF THE OCTAL NUMBER IDENTIFIES THE COMMAND.
;GET A DUMMY "TABLE VALUE WORD" APPROPRIATE FOR THE COMMAND AND
; GO THROUGH THE REGULAR CHECK AND DISPATCH CODE TO CHECK FOR
; NOT LOGGED IN, PROPRIETARY PROGRAM, ETC.
	MOVE KWV,[EASUB,,CSLSH]
	CAIN TRM,"/"
	JRST CIN2
	MOVE KWV,[EASUB,,CBKSL]
	CAIN TRM,"\"
	JRST CIN2
	JRST CERR##
;NOTE: "CIN2" DISPATCHES WITH PUSHJ, SO WHEN COMMAND ROUTINE IS
;ENTERED, THE VALUE SAVED ABOVE IS AT -1(P), NOT 0(P).

;EXECUTE "/" COMMAND (EXAMINE)
;DECODING AND CHECKS ARE COMPLETE, CONFIRMATION ISN'T USED.

CSLSH:	MOVE A,-1(P)		;ADDRESS
	CALL MAPPF##		;MAP THAT PAGE & GET ACCESS INFO
	TLNN A,B5
	 ERROR <No such page>
	TLNN A,B2
	 ERROR <Can't read that page>
	MOVE A,-1(P)		;GET ADDRESS AGAIN
	MOVE C,CIFORK		;Current fork
	HRRM A,FKFLG(C)		;Remember addr (as in DDT's .)
	ANDI A,777		;GET REL ADDRESS IN PAGE
	PRINT TAB		;OUTPUT A TAB
	HLRZ B,PAGEN(A)		;LH OF WORD IN PAGE BUFFER
	JUMPE B,.+3		;LH NON-0?
	CALL TOCT##		;YES, TYPE IT IN OCTAL
	TYPE <,,>
	HRRZ B,PAGEN(A)		;RH
	CALL TOCT##		;TYPE IT
	PRINT EOL		;TYPE CARRIAGE RETURN
	JRST CMDIN4		;DONE, GET NEXT COMMAND

;FINISH DECODING AND EXECUTE "\" COMMAND (DEPOSIT)
;SYNTAX IS <ADDR>\<VALUE>
;       OR <ADDR>\<LH><SPACE, TAB, ALT MODE, COMMA, OR 2 COMMAS><RH>

CBKSL:	SKIPGE CIFORK		;FORK EXISTS?
	CALL ECFORK		;NO, CREATE ONE
CBKSL1:	MOVE A,-1(P)		;NOTE: COMMAND RETURN ADDRESS IS AT 0(P)
	CALL MAPPF##		;MAP THAT PAGE AND GET ACCESS INFO
	MOVEM A,-1(P)		;SAVE ACCESS INFO WITH ADDRESS
	TLNN A,B5
	JRST [	TYPE < [New] >	;ADVISORY MESSAGE
		JRST .+3]		;DON'T TEST WRITE BIT HERE!
	TLNN A,B3
	JRST [	TLNN A,B9		;COPY-ON-WRITE BIT
		UERR [ASCIZ /Can't write that page/]
		TYPE < [Shared] >
		JRST .+1]
;GET VALUE
	CALL OCTCOM##		;INPUT VALUE, ACCEPTING LH,,RH ETC,
	 JRST CERR##		;R1: NULL.   ...AND CHECKS TERMINATOR.
	CONFIRM
	MOVE B,-1(P)		;Address
	MOVE C,CIFORK		;Current fork number
	HRRM B,FKFLG(C)		;Remember addr (as in DDT's .)

;STORE A AT B IN FORK. ASSUME WE STILL HAVE THE PAGE.

CBKSL5:	ANDI B,777		;MASK OFF PAGE # PART OF ADDRESS
	MOVEM A,PAGEN(B)	;STORE INTO PAGE BUFFER

;EXECUTION OF "\"...
;IF ADDRESS < 20, SET FORK AC'S. NON-AC PAGES HANDLE THEMSELVES.
	HRRZ C,FKFLG(C)		;Full address
	MOVE A,FORK
	MOVEI B,PAGEN
	CAIGE C,20
	SFACS
	JRST CMDIN4

;SUBROUTINE TO "AUTOLOGOUT" THIS JOB IF NOT LOGGED IN AND MORE
; THAN "AUTOL1" SECONDS HAVE ELAPSED SINCE STARTUP.
;ONE CALL IN CMDIN4 AREA.

ALOTST:	PUSH P,A
	PUSH P,B
	TIME
	SUB A,STRTIM
	IDIVI A,(B)
	SUBI A,AUTOL1
	JUMPG A,AUTOLO##	;DO AUTOLOGOUT (XSUBRS.MAC)
	POP P,B
	POP P,A
	RET

FEATUR -%IIT,<

;ROUTINE FOR FORK TO AUTO-LOGOUT ABANDONED JOBS.
;IF NO TTY ACTIVITY FOR N SECONDS, LOGOUT, ELSE REPEAT, UNTIL LOGGED IN.
;THIS FORK IS KILLED IN "LOGIN" CODE AND "ERRET" CODE
; IN MAIN FORK.

ALOFRK:	MOVEI A,AUTOL2*^D1000	;NUMBER OF SECONDS TO WAIT BEFORE
	DISMS			;...DOING ANYTHING HERE
;LOOP TO LOOK FOR INACTIVE TTY

ALF1:
ALF2:	MOVE C,TTYACF		;AOS'D FOR EVERY CHAR IN/OUT
	MOVEI A,AUTOL3*^D1000	;NUMBER OF SECS DURING WHICH THERE
	DISMS			;... MUST BE NO ACTIVITY
	CAME C,TTYACF		;HAVE ANY CHARS BEEN TRANSFERRED?
	JRST ALF1		;YES, WAIT AND CHECK AGAIN
ALF3:	SETZM STRTIM		;CAUSES AUTOLOGOUT AT COMMAND INPUT IF
				;AN ERROR OR ^C PREVENTS IT FROM
				;COMPLETING AFTER PSI.
	MOVEI A,.FHSUP		;MAIN EXEC FORK,
	HRLZI B,B14		;CHANNEL 14
	IIC			;GOOSE TO SAY AUTOLOGOUT NEEDED
	HALTF
>

;COMMAND TABLES

;FORM:
;       LABEL:  NUMBER OF ENTRIES
;               [VALUE],,[ASCIZ @TEXT@]  FOR EACH ENTRY, ALPH ORDER
;   VALUE IS GENERALLY  BITS,,ADDRESS
;   MAY BE FOLLOWED BY A "PRIVILEGES REQUIRED" WORD
;       SEE "DEFINITIONS" FILE FOR BIT SYMBOLS AND MACRO DEFINITIONS

;MACROS USED TO GENERATE TABLES (DEFINED IN "DEFINITIONS" FILE)
;
;	T TEXT[,PRIVBITS,BITS[,ADDRESS]];HERE []'S MEAN OPTIONAL
;		SETS UP ENTRY. DEFAULTS ADDRESS TO ".TEXT", OR IF
;		THAT IS UNDEFINED, TO "NOT IMPLEMENTED" ERROR ROUTINE
;
;	X TEXT
;		CREATES A SPECIAL FAKE ENTRY, TO MAKE AN OTHERWISE
;		UNIQUE SUBSET AMBIGUOUS (EVEN THE EXACT TEXT GIVEN TO X 
;		MACRO WILL BE TREATED AS AMBIGUOUS).  USED WHERE ACTUAL
;		AMBIGUITY IS WITH AN ENTRY IN ANOTHER TABLE SEARCHED
;		LATER.
;
;	TABLE	RESERVES WD FOR # ENTRIES AT TOP OF TABLE
;
;	TEND	FILLS IN # OF ENTRIES SINCE LAST "TABLE" MACRO
;		IN LOCATION RESERVED BY THAT "TABLE" MACRO

;COMMANDS NOT PREFIXED BY ^E.
;SECOND FIELD OF MACRO CONTAINS PRIVILEGES REQUIRED.  BLANK FIELD
;COMMANDS ARE AVAILABLE TO ALL USERS.

CTBL1::  TABLE
	T ACCESS,,LPROK+LANOK		;ACCESS (of files)--(to)--(is)--
	T ACCOUNT,,LPROK		;ACCOUNT (of file)--(is)--
	TE ADVISE,,LPROK+ALTCON		;ADVISE (user)
FEATUR %ALERT,<T ALERT,,LPROK>		;ALERT (at time)
	T APPEND,,LANOK+CONMAN+LPROK	;APPEND <FILE> (to) <FILE>
	T ARCHIVE
	T ASSIGN,,LPROK			;ASSIGN <DEVICE> (as) <NAME>
	T ATTACH,,NOLOG+LPROK+ALTCON	;ATTACH (to job) <JOBNO>
SCRC <	T AUTOKEEP,,LANOK >		;AUTOKEEP (FILES)
	TE AVAILABLE,,NOLOG+NOCONF	;AVAILABLE LINES/DEV
	TE BACKGROUND,,LPROK		;(fork) - (infil) - (outfil) - (and) -
IAC <	TE BCONTINUE,,LPROK		; "BACKGROUND CONTINUE" >
NOIAC <	T BDDT,,ONEWD+ALTCON+EASUB	;START BDDT>
IAC <	T BDDT,,ONEWD+ALTCON+EASUB+INVIS >
NOIAC <
NOBBN <	T BLANK,,SECOK+NOLOG+LPROK+EOLOK> ;BLANK SCREEN>
	TE BREAK,,SECOK+NOLOG+LPROK+ALTCON ;BREAK (links)
NOBBN <	TE BYE,,SECOK+NOLOG+LPROK+ALTCON,.BREAK> ;BYE (links)
	TE C,,NSPALT+INVIS,<[
		UALTYP [ASCIZ /ONTINUE /]
		JRST .CONTINUE]>	;C = CONTINUE
	TE CANCEL			;CANCEL ALERT, MAILWATCH ETC.
NOIAC <	TE CAPABILITIES,ENAPOS,LPROK>	;CAPA..(mask) <Privs> (enabled) <Privs>
IAC <	TE CAPABILITIES,ENAPOS,LPROK+INVIS >
NOIAC <	TE CAPSTAT,ENAPOS >
IAC <	TE CAPSTAT,ENAPOS,INVIS >
SRI <	TE CD,,LPROK,.CONNECT		; SRI SYNONYM FOR CONNECT >
IAC <	TE CD,,LPROK,.CONNECT		; AT IAC TOO >
SCRC <	TE CD,,LPROK,.CONNECT		; AT SCRC TOO >
	TE CHANGE,,ALTCON		;CHANGE ACCOUNT OR PASSWORD
	T CLEAR,,LPROK+CONMAN		;CLEAR DEVICE DIRECTORY
	T CLOSE,,LPROK,.JFNCL		;CLOSE (file) <NAME>
	TE CO,,NSPALT+INVIS,<[
		UALTYP [ASCIZ /NTINUE /]
		JRST .CONTINUE]>	;CO = CONTINUE
	TE CON,,NSPALT+INVIS,<[
		UALTYP [ASCIZ /TINUE /]
		JRST .CONTI]>		;CON = CONTINUE
	TE CONNECT,,LPROK		;CONNECT (to directory) <NAME>
	TE CONTINUE			;CONTINUE
	T COPY,,LANOK+CONMAN+LPROK	;COPY <FILE> (to) <FILE>
FEATUR %CORECT,<
EXTERN .CORRECT
	TE CORRECT,,LPROK		; CORRECT SPELLING ERRORS
>
SRI <	T CT,,LPROK>			;GIVE ^T INFO ON ANY JOB
FEATUR %DAEMON,<
	TE DA,,NSPALT+NOCONF+INVIS,<[
		UALTYP [ASCIZ "YTIME"]
		CONFIRM
		JRST .DAYTIME]>		;DA = DAYTIME
	T DAEMON,,LPROK+LANOK>		;DEFINE A DAEMON
	T DAYTIME,,SECOK+NOLOG+ONEWD+NOCONF ;DAYTIME
	T DDT,,ONEWD+ALTCON+EASUB	;START DDT
	T DEASSIGN,,LPROK		;DEASSIGN <LDEV/DEVICE>
	T DELETE,,LANOK			;DELETE <FILE>
	TE DETACH,,LPROK+LANOK+ALTCON	;DETACH JOB
	TE DI,,COMOK+LANOK+ALTCON+NSPALT+INVIS,<[
		UALTYP [ASCIZ "RECTORY "]
		JRST .DIRECTORY]>	;DI = DIRECTORY
	TE DIRECTORY,,COMOK+LANOK+ALTCON ;DIRECTORY (of files)
	TE DIS,ENAREQ+ENAPOS,NSPALT+INVIS,<[
		UALTYP [ASCIZ "ABLE "]
		CONFIRM
		JRST .DISABLE]>		;DIS = DISABLE
	T DISABLE,ENAREQ+ENAPOS,ONEWD	;DISABLE PRIV CMNDS
	T DISCUSE,,NOLOG+ONEWD+NOCONF	;SYSTEM DISK TOTALS
SRI <	X DO
	T DOWNTIME,,NOLOG+ONEWD+NOCONF>	;PRINT DOWNTIME FILE
	T DSKSTAT,,ONEWD+NOCONF		;DISK STATUS
NOIAC <	T E,,LANOK+LPROK+NSPALT+INVIS,<[
		UALTYP [ASCIZ "RUN "]
		JRST .ERUN]>>		;E = ERUN
	TE EDIT,,LANOK+ALTCON		;EDIT <FILE>
	TE ENABLE,ENAPOS		;ENABLE PRIV CMDS
	T ENTRY,,LPROK			;SET ENTRY VECTOR
	T EPHEMERAL,,LANOK		;MARK AS AN EPHEMERON
	T ER,,LANOK+LPROK+NSPALT+INVIS,<[
		UALTYP [ASCIZ "UN "]
		JRST .ERUN]>		;ER = ERUN
	T ERRSTAT,WHEEL+OPER+CONFI+MAINT,ONEWD+NOCONF
	T ERSTR,,LPROK+NOCONF		;PRINT ERROR STRING FOR #
	T ERUN,,LANOK+LPROK		;RUN PROGRAM AS EPHEMERON
	TE EX,,NSPALT+INVIS,<[
		UALTYP [ASCIZ /EC /]
		JRST .EXEC]>
	TE EXEC				;EXEC (run separately from fork)
	TE EXPUNGE,,LPROK		;EXPUNGE (deleted files)
IAC <	T FCONTINUE,,LPROK		; FOREGROUND/CONTINUE >
SCRC <	TE F,,NSPALT+NOLOG+NOCONF+INVIS,<[
		UALTYP [ASCIZ "INGER "]
		JRST .FINGE]>		;F = FINGER
	TE FI,,NSPALT+NOCONF+INVIS,<[
		UALTYP [ASCIZ "LSTAT "]
		CONFIRM
		JRST .FILST]>>		;FI = FILSTAT
SRI <	TE FI,,NSPALT+NOCONF+INVIS,<[
		UALTYP [ASCIZ "LSTAT "]
		CONFIRM
		JRST .FILST]>>		;FI = FILSTAT
	T FILSTAT,,ONEWD+NOCONF		;FILE STATUS
SRI <	TE FINGER,,SECOK+NOLOG+NOCONF>	;FINGER USER
SCRC <	TE FINGER,,SECOK+NOLOG+NOCONF>	;FINGER USER
	T FOREGROUND,,LPROK		;FOREGROUND (fork)
	T FORK				;FORK <N>. AFFECTS /, \, ETC.
	TE FORKSTAT			;FORKSTAT [fork #/name]
	T FORMFEED,,NOLOG+ALTCON+ONEWD	;SAYS TTY HAS FORMFEED
FEATUR %FREEZ,< T FREEZE,,NOLOG>	;FREEZE <CHARACTER>
	X FU				;REQUIRE 3 CHARS FOR FULLDUPLEX
	T FULLDUPLEX,,NOLOG+ONEWD+ALTCON ;SAYS TTY IS FULL DUPLEX
	T GET,,LANOK+LPROK		;GET <FILE>
	T GOTO,,EASUB+LPROK		;GOTO <OCTAL>
	X HA
	T HALFDUPLEX,,NOLOG+ONEWD+ALTCON
SRI <	TE HALT,WHEEL+OPER+MAINT,INVIS+COMOK,..HALT> ;HALT TENEX
	T HERALD,,NOLOG			;SET THE HERALD CHARACTER
	T IDDT,,ONEWD+ALTCON+EASUB	;START AN IDDT
	T IMPSTAT,,SECOK+NOLOG+ONEWD+NOCONF ;TYPE STATUS OF IMP
	TE INDICATE,,NOLOG+LPROK	;INDICATE (formfeed)
	TE INTERROGATE,,LPROK+LANOK+ALTCON ;CHECK ARCHIVE
	T JFNCLOSE,,LPROK		;JFNCLOSE <JFN>
	T JOBSTAT,,SECOK+ONEWD+NOCONF	;JOB STATUS
	TE KEEP,,LPROK			;KEEP (fork as) <FORKNAME>
NOBBN <	TE KJOB,,NOLOG,.LOGOUT		;LOGOUT
	T KKJOB,,NOLOG+ONEWD>		;KKJOB - QUIET LOGOUT
	T LABEL,,LPROK			;LABEL (device) DTAn: (as)
NOIAC <
NOSRI <	T LCOPY,,LPROK+LANOK+ALTCON>	;LCOPY (files) [COPY TO LPT:]>
	T LENGTH,,NOLOG+LPROK,.LLENG	;LENGTH (of page is)
	T LINK,,NOLOG+LPROK		;LINK (to)
NOIAC <	T LIST,,LPROK+LANOK+ALTCON	;LIST (file list)
NOISI <	T LLIST,,LPROK+LANOK+ALTCON>	;LLIST (files) [COPY TO LPT:] >
	TE LOG,,NOLOG+NSPALT+LPROK+INVIS
	TE LOGIN,,NOLOG+LPROK+ALTCON	;LOGIN <USER> <PASSWD> <ACCT>
	TE LOGOUT,,NOLOG		;LOGOUT
	T LOWERCASE,,NOLOG+ONEWD+ALTCON	;SAYS TTY HAS LOWER CASE
IAC <	TE MA,,SECOK+NOLOG+NSPALT+INVIS,<[
		UALTYP	[ASCIZ /IL /]
		JRST	.MAIL]>>
	TE MAIL,,SECOK+NOLOG		;MAIL CHECK/WATCH
IAC <	T MAP,,LANOK+LPROK		; MAP A FILE TO A FORK >
	T MEMSTAT,,ONEWD+NOCONF+EASUB	;MEMORY STATUS
	T MERGE,,LANOK+EASUB		;MERGE <FILE>
	T MOUNT				;MOUNT <DEVICE>
BBN <	T MOVE,,NOLOG>			;BBN's command PTIP moving
IAC <	TE MSYSTAT,,SECOK+NOLOG+NOCONF	; MEDIUM-SIZED SYSTAT >
	T NAME,,LPROK+NOCONF,.XNAME	;NAME (for directory number)
	T NETLOAD,,SECOK+NOLOG+ONEWD+NOCONF ;PRINT NETWORK LOAD AVS
ISI <	T NEW,,LPROK+LANOK>
ECL <	T NEW,,LPROK+LANOK>
	T NO,,NOLOG+ALTCON		;NO TABS/FORMFEED/LOWERCASE
	T NOT,,ALTCON			;NOT EPHEMERAL
	T NUMBER,,LPROK+NOCONF		;NUMBER (of user)
IAC <	X O				; "O" NOT ENOUGH FOR "OEXEC" >
NOSCRC <T OEXEC,,NOLOG+ONEWD		;REPLACE MFEXEC WITH <SYSTEM>EXEC.SAV>
ISI <	T OLD,,LPROK+LANOK>
ECL <	T OLD,,LPROK+LANOK>
	TE PAGE,,LPROK+EASUB		;PAGE (access from page) N (to) N (is)
	T PERMANENT,WHEEL+OPER+ENAREQ,LPROK+LANOK+ALTCON
	T PERPETUAL,,LPROK+LANOK+ALTCON	;MAKE A PERMANENT FILE
	T PISTAT,,ONEWD+NOCONF		;PISTAT
	T POP,,ONEWD			;Exit to superior fork
	TE PRINTER,,SECOK+NOLOG,.PRNTR
	T PROTECTION,,LPROK+LANOK	;PROTECTION (of file)--(is)--
	TE PUSH,,,.EXEC
	TE QD,,COMOK+LANOK+ALTCON	;DIRECTORY OF DELETED
	TE QFD,,COMOK+LANOK+ALTCON	;QUICK FILE DESCRIPTION
	TE QR,,COMOK+LANOK+ALTCON	;DIRECTORY BY READ DATE
	TE QSYSTAT,,SECOK+NOLOG+NOCONF	;QUICK SYSTAT
	T QUIT,,ONEWD,.POP		;QUIT: EXIT TO SUPERIOR EXEC
	TE QV,,COMOK+LANOK+ALTCON	;DIRECTORY VERBOSE
	TE QW,,COMOK+LANOK+ALTCON	;DIRECTORY BY WRITE DATE
NOIAC <	TE R,,NSPALT+INVIS,<[
		UALTYP [ASCIZ "EENTER"]
		JRST .REENTER]>>		;R = REENTER
	T RAISE,,NOLOG+ONEWD+ALTCON	;RAISE L.C. INPUT TO UPPER CASE
	TE RE,,NSPALT+INVIS,<[
		UALTYP [ASCIZ "ENTER "]
		JRST .REENTER]>		;RE = REENTER
	TE RECEIVE,,LPROK+ALTCON	;RECEIVE (links or advice)
	TE REDIRECT,,LPROK+LANOK+INVIS	;REDIRECT PRIMARY I/O
	TE REENTER			;REENTER
	TE REFUSE,,LPROK+ALTCON		;REFUSE (links or advice)
	T RELEASE,,LPROK		;RELEASE (fork handles)
	T RENAME,,LPROK+LANOK+CONMAN	;RENAME (file) -- (to be) --
	TE RESET			;RELEASES MEMORY & CLOSES FILES
	T REWIND,,LPROK+LANOK		;REWIND <DEVICE>
	T RUN,,LANOK+LPROK		;RUN <FILE>. STARTS ENV FILE.
	T RUNSTAT,,ONEWD+NOCONF		;RUN STATUS: IO WAIT, ETC.
NOIAC <	TE S,,NSPALT+INVIS,<[
		UALTYP [ASCIZ "TART "]
		JRST .START]>>		;S = START
	X SA				;"SAIL" MIGHT BE A SUBSYS
	T SAVE,,CONMAN+LPROK+LANOK+EASUB ;SAVE ... (on) <FILE>.
FEATUR %SCHED,<
	T SCHEDULER,,LPROK>		;SPECIAL SCHEDULER PRIORITY
	T SECURE,,ONEWD
	TE SET,,,..SET			;SET PATH ETC.
	TE SHOW				;SHOW PATH ETC.
SCRC <	T SPEED,,NOLOG+LPROK>		;SPEED OF TERMINAL IS
	T SPLICE,,LPROK			;SPLICE (fork) - (below fork) -
	T SSAVE,,CONMAN+LPROK+LANOK+EASUB ;SHARABLE SAVE
	TE ST,,NSPALT+INVIS,<[
		UALTYP [ASCIZ /ART /]
		JRST .START]>		;ST = START
	TE STA,,NSPALT+INVIS,<[
		UALTYP [ASCIZ /RT /]
		JRST .START]>		;STA = START
	TE START			;START PROGRAM
NOIAC <	TE STATISTICS,ENAPOS,ONEWD+NOCONF ;SYSTEM STATISTICS >
IAC <	TE STATISTICS,,ONEWD+NOCONF	; LET EVERYONE LOOK AT IAC >
	T STOPS,,ALTCON			;SET SOFTWARE TAB STOPS
	T SUSPEND,,LPROK		;SUSPEND (fork)
	T SYSTAT,,SECOK+NOLOG+ONEWD+NOCONF ;SYSTEM STATUS PRINTOUT
SRI <	TE T,,INVIS,.CONTINUE>		;T = CONTINUE
	T TABS,,NOLOG+ONEWD+ALTCON	;SAYS TTY HAS HDWE TABS
NOIAC <
NOSRI <	T TCOPY,,LPROK+LANOK+ALTCON>	;COPY TO TTY (TTYPE)>
	T TERMINAL,,NOLOG+LPROK		;TERMINAL TYPE IS N
	T TRMSTAT,,SECOK+ONEWD+NOCONF	;TERMINAL STATUS TYPEOUT
NOISI <	T TTYPE,,LPROK+LANOK+ALTCON>	;COPY TO TTY (TCOPY)
	T TYPE,,LPROK+LANOK+ALTCON	;LIST FILE TO TTY
	T UNDELETE,,LPROK+LANOK		;UNDELETE <FILE>
	T UNLOAD,,LPROK			;UNLOAD <DEVICE>
	T UNMOUNT			;UNMOUNT <DEVICE>
	T UNSECURE,,SECOK
	T USESTAT,,ONEWD+NOCONF		;TYPES TIME USED, ETC.
	T VERSION,,SECOK+NOLOG+ONEWD+NOCONF ;IN XMAIN.MAC
FEATUR %ALERT,<T WAKEUP,,LPROK>		;WAKEUP (in) //ALERT
	T WHERE,,SECOK+NOLOG+LPROK+NOCONF ;WHERE (is user) <NAME>
	T WIDTH,,NOLOG+LPROK,.LWIDTH	;WIDTH (of line is)
        TEND
REPEAT	5,<0>				;ROOM TO BLT TABLE DOWN FOR PATCHING

;PRIVILEGED COMMANDS PREFIXED WITH ^E
;ONLY LEGAL FOR PRIV USERS WHO HAVE "ENABLE"D PRIV COMMANDS

CTBL2:  TABLE
	;T ACCOUNT,WHEEL+OPER,ONEWD,..ACCO  ;TURNS ON ACCOUNTING
	;T ASSIGN,WHEEL+OPER,,..ASSI	;^EASSIGN <DEVICE>
	;T BROADCAST,WHEEL+OPER,ONEWD	;SEND MSG TO ALL TERMINALS
	T CREATE,WHEEL+OPER,LPROK	;CREATE/MODIFY DIRECTORY
	TE CYCLE,WHEEL+OPER,LPROK	;CYCLE THE NETWORK
	T DISK,WHEEL+OPER,LPROK,...DSK	;SET PANIC LEVELS
	T EDDT,WHEEL,NOLOG+ONEWD	;GO TO DDT LOOKING AT EXEC
	TE HALT,WHEEL+OPER+MAINT,COMOK,..HALT ;HALT TENEX
	T INITIALIZE,WHEEL+OPER		;INITIALIZE SOMETHING
	T KFACT,WHEEL,LPROK		;KFACT (FACTOR) IS ...
	TE LOAD,WHEEL+OPER,LPROK		;LOAD (EDDT)
	T NETWORK,WHEEL+OPER,LPROK	;TURN OFF/ON NETWORK
	;T NOACCOUNT,WHEEL+OPER,ONEWD	;TURNS OFF SYSTEM ACCOUNTING
	T OFFLINE,WHEEL+OPER,LPROK	;REMOVE CORE PAGES
	T ONLINE,WHEEL+OPER,LPROK	;ADD CORE PAGES
	TE PAUSE,WHEEL+OPER,LPROK,..PAUS	;DCHKSW CONTROL
	TE PERMIT,WHEEL+OPER,LPROK	;PERMIT LOGINS
	T PRINT,WHEEL+OPER,LPROK	;PRINT DIRECTORY INFORMATION
	TE PROCEED,WHEEL+OPER,LPROK	;PROCEED AT BUGCHK
	TE PROHIBIT,WHEEL+OPER,LPROK	;PROHIBIT LOGINS
	TE QUIT,WHEEL+OPER,LPROK	;Quit to MINI EXEC
	T SET,WHEEL+OPER,LPROK+CONMAN	;SET DATE AND TIME
	T SYSTEM,WHEEL+OPER,LPROK	;DEBUGSW CONTROL
	T TRAPS,WHEEL+OPER,LPROK	;JSYS TRAPS ON/OFF
	TE UNLOAD,WHEEL+OPER,LPROK,..UNLOA ;UNLOAD (EDDT)
	;T UNHANG,WHEEL+OPER		;^E UNHANG <DEVICE>
	TEND

;CHARACTER TABLE

;ONE WORD PER CHARACTER:
;	DESCRIPTIVE BITS IN RIGHT HALF
;	LH: SPECIAL CASE DISPATCH FOR SUBROUTINE "CCHRI" (XSUBRS.MAC).
;WORD FROM "CHRTBL" FOR LAST CHARACTER IS GENERALLY IN THE AC "CBT".

;BITS IN RIGHT HALF (VALUES DEFINED IN FILE "D")
; ALPHAN	ALPHANUMERIC CHARACTERS, - # '
; OCTDIG		0-7
; PUNBIT	MOST OTHERS EXCEPT FILE NAME FIELD TERMINATORS
; TEOL		EOL, SEMICOLON, FORMFEED
; TSPC		SPACE, TAB
; TALT		ALT MODE
; TCOM		COMMA
; TLPR		LEFT PAREN
; TRPR		RIGHT PAREN
; TCOL		COLON
; TLAN		LEFT ANGLE BRACKET
; TRAN		RIGHT ANGLE BRACKET
; HERCHR	POSSIBLE HERALD CHARACTER

CHRTBL::
	FRZC		;NULL
NOSCRC <
 $CTRLA##,,0		;^A  DELETE CHARACTER
>
SCRC <	0		;^A >
	0		;^B
	0		;^C
	FRZC		;^D
	FRZC		;^E
	0		;^F "RECOGNIZE FIELD" FOR FILE NAMES
	HERCHR		;^G
 $CTRLA##,,0		;^H - BACKSPACE -  MAKE IT DELETE A CHAR
	HERCHR+TSPC	;^I = TAB. TREATED LIKE SPACE.
 $LINF##,,TEOL+TLF	;^J = LINE FEED
	FRZC		;^K
 $FORMF##,,TEOL		;^L FORM FEED
	0		;^M = CR. CR-LF BECOMES EOL B4 CHRTBL REFERENCE
	FRZC		;^N PRINT LOAD AVG PSI CHARACTER
	FRZC		;^O
	FRZC		;^P
	0		;^Q
 $CTRLR##,,0		;^R RETYPE LINE
	0		;^S
	0		;^T PRINT RUNTIME PSI CHARACTER
 $RUB##,,FRZC		;^U
 $CTRLV##,,0		;^V QUOTE NEXT CHARACTER
 $CTRLW##,,0		;^W DELETE FIELD
 $CTRLX##,,0		;^X DELETE WHOLE COMMAND
	FRZC		;^Y
	0		;^Z MEANS EOF FROM TTY TO COPY CMD
	TALT		;33: ALT MODE
	FRZC		;34: ^\
	FRZC		;35: ^]
	FRZC		;36: ^^
 $EOL##,,TEOL		;37: EOL (REPRESENTS CR-LF)
	HERCHR+TSPC	;40: SPACE
	HERCHR+PUNBIT	;!
	HERCHR+PUNBIT	;"
	HERCHR+ALPHAN	;# "ALPHANUMERIC" FOR NOISE WDS, EG "JOB #"
	HERCHR+PUNBIT	;$
	HERCHR+PUNBIT	;%
 $CONT##,,HERCHR+PUNBIT	;&: CONTINUE ON NEXT LINE, TREATED AS SPACE
	HERCHR+ALPHAN	;'
	HERCHR+TLPR	;(
	HERCHR+PUNBIT+TRPR	;)
	HERCHR+PUNBIT	;*
	HERCHR+PUNBIT	;+
	TCOM		;,
 $DASH##,,HERCHR+ALPHAN	;- "ALPHANUMERIC" BECAUSE IT'S FIELD-NULLER
	HERCHR		;.
	HERCHR+PUNBIT	;/
REPEAT 10,<ALPHAN+OCTDIG> ;0 THRU 7
	ALPHAN		;8
	ALPHAN		;9
	HERCHR+TCOL	; : ACCEPTABLE TERMINATOR FOR DEVICE NAMES
	PUNBIT+TEOL	;SEMICOLON: TREAT AS EOL WHEN USED AS TERMINATOR
	HERCHR+TLAN	;<
	HERCHR+PUNBIT	;=
	HERCHR+TRAN	;>
	HERCHR+PUNBIT	;?
	HERCHR+PUNBIT	;100: @
REPEAT ^D26,<ALPHAN>	;A THRU Z = 101 THRU 132
	HERCHR+PUNBIT	;[
	HERCHR+PUNBIT	;\
	HERCHR+PUNBIT	;]
	HERCHR+PUNBIT	;^
	HERCHR+PUNBIT	;_
	HERCHR		;140=WHAT?
REPEAT ^D26,<ALPHAN>	;LOWER CASE A-Z = 141-172
	FRZC+HERCHR	;173: Left curly
	FRZC+HERCHR	;174: Vertical bar
	FRZC+HERCHR	;175: Right curly
	FRZC		;176: Tilde
NOSCRC <
 $RUB##,,0		;177: Rubout
>
SCRC <	$CTRLA##,,0	;177: Rubout >
IFN .-CHRTBL-200,<PRINTX CHRTBL screwed up
>

;PSEUDO-INTERRUPT SYSTEM TABLES

;LEVEL TABLE: WHERE TO STORE PC'S FOR VARIOUS LEVELS

LEVTAB:	LEV1PC
	LEV2PC
	LEV3PC

;CHANNEL TABLE
;INDEXED BY CHANNEL NUMBER. LEVEL,,ADDRESS FOR EACH.

CHNTAB:	
 0		;0: Not used
 1,,CCPSI##	;1: ASSIGNED BY PROGRAM TO ^C
 0		;2: Not used
 2,,USEPSI##	;3: ASS BY PROG TO CHAR TO PRINT RUNTIME (^T)
 0		;4: Not used
 2,,HUPSI##	;5: ASS BY PROG TO DATAPHONE HANGUP
 0		;6: APR overflow (includes NODIV). Not enabled
 0		;7: APR Floating overflow (includes FXU). Not enabled
 0		;8: Not used
 1,,[UTRAP [ASCIZ /Pushdown Overflow/]] ;9: PDL OVERFLOW
 1,,EOFPSI##	;10: END OF FILE
 1,,DATPSI##	;11: FILE DATA ERROR
 1,,[UTRAP [ASCIZ /File err 3/]]  ;12: "FILE COND 3" (AS YET UNDEF)
 1,,[UTRAP [ASCIZ /File err 4/]]  ;13: "FILE COND 4" ( " " " )
 2,,IITPSI##	;14: TIME OF DAY.
 1,,ILIPSI##	;15-18: I, MR, MW, MX
 1,,[UTRAP [ASCIZ /Illeg mem read/]]
 1,,[UTRAP [ASCIZ /Illeg mem write/]]
 1,,[UTRAP [ASCIZ /Illeg mem execute/]]
 2,,FKTPSI##	;19: SUBSIDIARY FORK TERMIATED
 1,,[UTRAP [ASCIZ /System Storage size exceeded/]]  ;20: DRUM,DISK
 1,,[UTRAP [ASCIZ /Unexpected Trap to User/]]	;21:TRAP TO USER
 0		;22: NON-EXISTANT PAGE (NOT ENABLED)
FEATUR -%BAKTRP,<
	0		;23:
>
FEATUR %BAKTRP,<
	1,,JSYTRP##	;23: JSYS TRAP CHANNEL
>
 REPEAT ^D9,<0> ;24-32: General
 3,,FNCPSI##	;33: MFEXEC function
 0		;34: monitor
 0		;35: monitor
IFN .-CHNTAB-^D36,<PRINTX CHNTAB screwed up
>

CCCHN==^D1		;CONTROL C CHANNEL
USECHN==^D3		;CONTROL T CHANNEL
HUCHN==^D5		;HANG UP CHANNEL
IITCHN==^D14
FNCCHN==^D33

;JOBSTAT

.JOBSTAT:
	ETYPE < TSS Job %J, User %N%>
	GJINF
	CAME A,B		;LOGIN SAME AS CONNECT?
	ETYPE <, <%G%>>		;NO.  TYPE CONNECT DIR
	ETYPE <, %L%>
	PRINT EOL
	SKIPE SECURE
	RET
	MOVEI A,.FHTOP		;Print out entire job fork structure..
	MOVEI B,FKSTC
	SETZM FKSTCF		;Invalidate FKSTC
	GFRKS
	 JFCL			; (ignore error, probably "out of handles")
	MOVEI D,FKSTC
	MOVEI E,0
	JRST FSTRUC


;FORKSTAT [fork #/name]

.FORKSTAT:			;TYPE FORK STRUCTURE
	MOVSI B,(FH%ALL+FH%MF)	;Allow MFEXEC and * [ALL]
	IORM B,PSPRIV
	MOVEI B,FKSTC
	SETZ A,
	CALL GETFH		;User will specify where to start..
	CAIE A,.FHINF
	JUMPG A,[TLO B,B0	;Specfied inferior start, assign handles
		JRST FORKS1]
	MOVEI A,.FHSLF		;Default is MFEXEC's inferiors
	MOVEM A,FORK
	TLO Z,F1		;  but don't show it in the printout.
FORKS1:	CONFIRM			;Really mean it?
	SETZM FKSTCF		;Invalidate FKSTC
	GFRKS			;GET FORK STRUCTURE
	 JFCL			; (ignore error, probably "out of handles")
	MOVEI D,FKSTC		;BEGINNING OF STRUCTURE IN D
	MOVEI E,0
	TLNN Z,F1		;If silent MFEXEC start,
	 JRST FSTRUC
	HRRZ D,0(D)		; start with inferiors
	ADDI E,1		; indenting one level.
	JUMPN D,FSTRUC
	TYPE < No structure>
	JRST EOLRET

;FSTRUC
;RECURSIVE SUBR TO TYPE FORK STRUCTURE OF JOB.
;FOR EACH FORK, TYPES HANDLE AND STATUS.
;  FILE NAME OR "PROGRAM" WOULD ALSO BE DESIRABLE IF IT WERE AVAILABLE.
;STRUCTURE INDICATED BY PUTTING A FORK'S INFERIORS RIGHT AFTER IT,
;  INDENTING 3 COLUMNS PER LEVEL.
;THUS PARELLEL FORKS ARE THOSE WHICH APPEAR AT SAME INDENTATION WITH
;  NO LESS-INDENTED ENTRIES BETWEEN THEM.
;TAKES: D: POINTER TO GFRKS TABLE, SET UP BY CALLER.
;	E: LEVEL COUNTER, ZEROED BY TOP LEVEL CALLER.

;ENTRY POINT IS AT END BUT COMES RIGHT HERE.
;TYPE STUFF FOR THIS FORK.

FSTR1:	SKIPLE A,E
	TYPE <   >;		;INDENT 3 SPACES PER LEVEL BELOW FIRST.
	SOJG A,.-1
	HRRZ A,1(D)		;GET THIS FORK'S HANDLE FROM TABLE
	JUMPE A,[TYPE < Fork **> ;No handle assigned
		JRST FSTR4]
	ETYPE < %1F:>		;Name fork
	TLZ Z,F1		;Clear BEFORE flag
	TRZ A,.FH		;Make fork handle into index
	MOVE B,FKFLG(A)		;Fork flags
	CAME A,CIFORK		;Current fork?
	 JRST .+3
	CALL BEFORE
	TYPE <Current>
	TLNN B,FK%KPT		;Kept fork?
	 JRST .+3
	CALL BEFORE
	TYPE <Kept>
	TLNN B,FK%BAK		;Background fork?
	 JRST .+3
	CALL BEFORE
	TYPE <Background>
	TLNN B,FK%ACT		;Active?
	 JRST .+3
	CALL BEFORE
	TYPE <Active>
	TLNN B,FK%EPH		;Ephemeral
	 JRST .+3
	CALL BEFORE
	TYPE <Ephemeral>
FSTR3:	CALL BEFORE
	HRRZ A,1(D)		;HANDLE AGAIN
	CALL FSTAT		;TYPE ITS STATUS
FSTR4:	PRINT EOL

;NOW DO ALL OF THE FORK'S INFERIORS, BY RECURSION.
	PUSH P,D
	HRRZ D,0(D)		;INFERIOR PTR FROM GFRKS TABLE.
	ADDI E,1		;DOWN LEVEL
	CALL FSTRUC		;RECURSIVE CALL TO DO ENTIRE SUBTREE
	SUBI E,1		;UP LEVEL
	POP P,D
	HLRZ D,0(D)		;PARALLEL PTR FROM GFRKS TABLE

;ENTRY POINT.  NOP IF 0 PTR GIVEN.
FSTRUC:	JUMPN D,FSTR1
	RET

;RUNSTAT

.RUNSTAT:
	SKIPGE B,CIFORK
	JRST [	TYPE < No program>
		JRST RUNST8]
	MOVE A,FKFLG(B)
	TLNN A,FK%STD
	JRST [	TYPE < Never started>
		JRST RUNST8]
	ETYPE < %F: >		;TYPE "FORK N:"
	MOVEI A,.FH(B)		;FORK HANDLE IN A:
	CALL FSTAT		;TYPE STATUS OF THE FORK
	MOVEI A,.FH(B)
	ETYPE <, Used %1V%>
RUNST8:	PRINT EOL
	CALL LAPRNT
	JRST EOLRET


;SUBROUTINE TO PRINT THE LOAD AVERAGE.
;USED BY ^T INTERRUPT

LAPRNT::MOVE A,['SYSTAT']
	CALL $SYSGT##
	SKIPN A,B
	 CALL SCREWUP##		;NO SUCH TABLE??
	HRLI A,14		;INDEX OF 1 MIN. AV.
	GETAB
	 CALL SCREWUP##
	ETYPE < LA = %1Q>
	RET

;FORK STATUS TYPEOUT SUBR FOR "RUNSTAT", "FORKSTAT", AND ^T.
;TAKES HANDLE IN A, CLOBBERS A.
;USED IN FSTRUC (JOBSTAT,FORKSTAT), RUNSTAT

FSTAT::	PUSH P,B
	PUSH P,C
	PUSH P,D
	MOVE C,A		;SAVE FORK HANDLE
	RFSTS			;GET STATUS IN A, PC IN B
	HRL B,C			;PUT HANDLE IN LH B FOR ILL. INST (%X)
FSTAT1:	HLRZ C,A		;B1-17 = STATUS
	CAIN C,-1		; -1 = UNASSIGNED HANDLE. (OR SUPERIOR?)
	JRST [	MOVEI D,[ASCIZ "Disappeared!"]
		JRST FSTAT8]
	TRZ C,B0		;FLUSH FROZEN BIT
	CAIN C,6		;BREAKPOINT?
	JRST FSTAT4		;YES
	CAIE C,2		;HALT OR FORCED TERM?
	CAIN C,3
FSTAT4:	TLZ A,B0		;YES, WASN'T RESULT OF ^C
	SKIPGE A		;"frozen" bit on?
	TYPE <Suspended from >	;Ok to indicate ^C
	UTYPE @[[ASCIZ /Running/]
		[ASCIZ /IO wait/]
		[ASCIZ /Halt/]		;INCLUDES NEVER STARTED
		[ASCIZ /Halt: /]
		[ASCIZ /Fork wait/]
		[ASCIZ /Sleep/]
		[ASCIZ /Breakpoint/]](C)	;NOTE INDEX!
	MOVEI D,[ASCIZ / at %2P/]	;%2P TYPES PC FROM B
	CAIE C,3
	JRST FSTAT8		;GO OUTPUT "AT <PC>"
				;AFTER ERROR STOP, TYPE REASON AS GIVEN
				;BY PSI CHAN # IN RH OF A.  USE TEXT
				;FROM "START" COMMAND'S ERROR MSG TAB.
	MOVE D,@WHY		;SEE "START". USES A.
FSTAT8:	UETYPE (D)		;TYPE MSG. INCLUDES PC FROM B.
FSTAT9:	POP P,D
	POP P,C
	POP P,B
	RET

;PISTAT
;PSI IS OFF, LEVTAB=NNNNNN, CHNTAB=NNNNNN, CHN MASK=NNNNNNNNNNNN, BIP=N

.PISTAT:
	SKIPGE FORK
	JRST [	TYPE < No program>
		JRST EOLRET]
	MOVE 1,FORK
	TYPE < PSI is >
	MOVEI 5,[ASCIZ /on/]
	SKPIR
	MOVEI 5,[ASCIZ /off/]
	UTYPE 0(5)
	RIR
	HLRZ 4,2		;LEVTAB
	HRRZ 5,2		;CHNTAB
	RCM
	MOVE 6,1		;CHN MASK
	MOVE 1,FORK
	RWM
	MOVE 7,1		;BREAKS WAITING
	MOVE 10,2		;BREAKS IN PROGRESS
	AND 10,[17B3]
	MOVE 1,FORK
	RTIW
	MOVE 11,2		;USER TIW
	MOVNI 1,5
	RTIW
	MOVE 12,2		;JOB TIW
	ETYPE <, LEVTAB at %4O, CHNTAB at %5O
 Channels active:	%6U
 Breaks waiting:	%7U
 Levels in progress:	%10U

 Fork TIW:	%11O
 Job TIW:	%12O>
	RET

; "IMPSTAT"

.IMPSTAT:
	MOVE A,['NETRDY']
	CALL READT		;READ INTO 4, 5, ...
	SUBI C,4		;NEW SYSTEMS HAVE LENGTH .GT. 4
	PUSH P,C		;NEW SYSTEM FLAG
	PUSH P,13		;NETRDY[7]: TIME OF IMP-GOING-DOWN MSG
	PUSH P,12		;NETRDY[6]: TIME OF READY LINE ON
	PUSH P,11		;NETRDY[5]: TIME OF READY LINE OFF
	PUSH P,10		;NETRDY[4]: IMP-GOING-DOWN HEADER
	PUSH P,7		;NETRDY[3]: TIME OF LAST NCP RESET
	PUSH P,6		;NETRDY[2]: NCP FLAGS (N.A.)
	PUSH P,5		;NETRDY[1]: NETON
	PUSH P,4		;NETRDY[0]: IMPRDY
	MOVE 1,COJFN		;NEEDED FOR ODTIM'S BELOW

IMPST0:	CALL CRIF##		;TYPE CARRIAGE RETURN IF NEEDED
	TYPE <Host-IMP Interface is >
	SKIPN 0(P)
	TYPE <Off>
	SKIPE 0(P)
	TYPE <On>

IMPST1:	CALL CRIF##
	TYPE <Tenex-Network service is >
	SKIPN -1(P)		;NETRDY[1] SAYS WHICH
	TYPE <Disabled>
	SKIPE -1(P)
	TYPE <Enabled>

IMPST2:	SKIPG -8(P)		;NEW SYSTEM?
	 JRST IMPSTX		;NO

IMPST3:	SKIPN -1(P)		;NCP RESET RELEVANT ONLY IF NETON
	 JRST IMPST4		;NOT AVAILABLE
	CALL CRIF##
	SKIPG 2,-3(P)		;NETRDY[3] HAS LAST NCP RESET
	TYPE <Tenex has not reset network tables since last restarted>
	JUMPLE 2,IMPST4		;0 IS AMBIGUOUS
	TYPE <Tenex reset network tables at >
	SETZ 3,			;STANDARD FORMAT
	ODTIM

IMPST4:	SKIPN 2,-7(P)		;GTAD OF IMP-GOING-DOWN MSG ARRIVAL
	 JRST IMPST5		;NONE HAS ARRIVED
	CALL CRIF##
	SKIPG 2
	TYPE <While Tenex was restarting the IMP said it would go down>
	 JUMPL 2,IMPS45		;-1 MEANS SYSTEM DIDN'T HAVE TIME
	TYPE <At >
	SETZ 3,			;STANDARD FORMAT
	ODTIM
	TYPE <, the IMP said it would go down at >
	MOVE 1,2
	LDB 2,[POINT 4,-4(P),21];HOW SOON IN 5 MIN. UNITS
	IMULI 2,5
	CALL TIMPMN		;GTAD IN 1 PLUS MINUTES IN 2
	MOVE 2,1		;SET FOR ODTIM
	MOVE 1,COJFN
	SETZ 3,			;STANDARD FORMAT
	ODTIM

IMPS45:	CALL CRIF##
	TYPE <   For >
	LDB 2,[POINT 10,-4(P),31];HOW LONG IN 5 MIN. UNITS
	IMULI 2,5
	MOVEI 3,^D10
	NOUT
	 CALL JERRC##
	TYPE < minutes due to >
	LDB 2,[POINT 2,-4(P),17];REASON FIELD
	CAIN 2,0
	TYPE <panic>
	CAIN 2,1
	TYPE <scheduled hardware pm>
	CAIN 2,2
	TYPE <scheduled software reload>
	CAIN 2,3
	TYPE <emergency restart>

IMPST5:	CALL CRIF##
	SKIPN 2,-5(P)		;NETRDY[5] IS READY LINE OFF TIME
	TYPE <The Ready line has not gone off since Tenex was restarted>
	JUMPE 2,IMPST6
	TYPE <Most recent Ready line off was >
	SKIPG 2
	TYPE <when Tenex was restarting>
	SETZ 3,			;STANDARD FORMAT
	SKIPL 2
	 ODTIM

IMPST6:	CALL CRIF##
	SKIPN 2,-6(P)		;NETRDY[6] IS READY LINE ON TIME
	TYPE <The Ready line has not come on since Tenex was restarted>
	JUMPE 2,IMPSTX
	TYPE <Most recent Ready line on was >
	SKIPG 2
	TYPE <when Tenex was restarting>
	SETZ 3,			;STANDARD FORMAT
	SKIPL 2
	 ODTIM


IMPSTX:	SUB P,[9,,9]		;FLUSH TEMPS
	PRINT EOL
	PRINT EOL
	RET

;USESTAT

.USESTAT:
	ADD P,BHC+10		;WON'T OVERFLOW
	MOVEI A,-7+0(P)		;POINTER TO BLOCK FOR STRING ACCT
	SETO B,			;SAY THIS JOB
	GACTJ			;GET ACCOUNT OF JOB
	 CALL JERR##
	ETYPE < Used %V% in %C%, Acct: %1M.>
	CALL PIE.P		;PIE SLICE SYSTEM?
	 JRST USEST1		;NO
	TYPE < (>
	MOVE A,COJFN		;JFN FOR OUTPUT
	GPSGN			;CONVERT PIE SLICE GROUP NAME, THIS JOB
	 CALL JERR##
	PRINT ")"
USEST1:	SUB P,BHC+10		;FLUSH LOCALS
	;ADD CODE TO TYPE USAGE OF RTI, E&S, ETC., IF USED
	RET

;DSKSTAT

.DSKSTAT:
	GJINF
	CAME A,B		;Connected same as login?
	ETYPE <	<%G>
>
	CALL DSKCNT		;COUNT PAGES
	SKIPE A,F
	HRROI A,[ASCIZ/total /]
	ETYPE < %7Q %1W%pages in use>
IFN <DSKUP>,<
	SKIPN PRVENF
	CAMLE G,E
>	;IF CAN'T GO OVER ALLOCATION, TELL HIM HIS!
	ETYPE < - %5Q Allowed>
	CAME D,G
	ETYPE <, %4Q Undeleted, %6Q Deleted>
NOIAC <	TLNE Z,B3
	ETYPE <
 Excluding file(s) that are list protected from you> >
	CALL RLJFNS##
	HRLOI A,600000	;DSK: DESIGNATOR
	GDSKC
	CAIL B,DSKLL		;LOWER LIMIT
	RET			;ABOVE IT RETURN, BELOW - DISCUSE
	PRINT EOL

;DISCUSE

.DISCUSE:
	HRLOI A,600000  ;DSK: DESIGNATOR
	GDSKC
	ETYPE < System total: %2Q Pages left, %1Q Used>
	RET

DSKCNT:	SETZB D,F		;FOR SUMS OF TOTAL AND DELETED PAGES
	SETO A,
	MOVE C,JBUFP
	PUSH C,A
	MOVEM C,JBUFP
	HRLZI A,B2+B8+B11+B17	;OLD, *'S, SHORT CALL, INCL. DELETED
	HRROI B,[ASCIZ /*.*;*/]
	GTJFN
	 CALL [	CAIE A,GJFX20
		CAIN A,GJFX32
		JRST [	SUB P,BHC+1	;FOR NO FILES IN DIRECTORY,
			SETZ G,		;CLEAR TOTAL
			JRST DSKST5]	;TYPE "0 PAGES"
		JRST JERR##]
	MOVEM A,(C)		;STACK JFN FOR RELEASING ON
	MOVE E,A		; ERR OR COMPLETION

;LOOP OVER FILES WITH GNJFN
DSKST1:	TLZ Z,B1		;RESET DELETED BIT
	HRRZ A,E		;JFN ONLY
	MOVE B,[1,,FDBCTL]	;CONTROL BITS WORD OF FDB
	MOVEI C,C		;TO BE PUT IN C
	CALL $GTFDB		;GET IT
	JRST DSKST2		;COULDN'T
	TLNE C,(FDBDEL)		;DELETED?
	TLO Z,B1		;YES, SAY SO
	MOVE B,[1,,FDBBYV]	;# PAGES IN RH
	MOVEI C,C
	CALL $GTFDB		;DO GTFDB JSYS, NO SKIP IF NO ACCESS
DSKST2:	TLOA Z,F3		;SAY ACCESS ERROR AND SKIP ADD
	 JRST DSKST4		;GO ADD UP PAGES
DSKST3:	MOVE A,E		;JFN AND FLAGS
	GNJFN			;STEP TO NEXT FILE
	 JRST .+2		;NO MORE FILES
	JRST DSKST1
	MOVE G,D		;FORM SUM
	ADDI G,(F)		;OF DELETED AND UNDELETED
DSKST5:	MOVEI 1,0		;SAY CONNECTED DIRECTORY
	GTDAL			;GET ALLOCATION FOR CONN DIR
	MOVE 5,1		;SAVE FOR PRINTING
	RET			;PRINT RELEVANT NUMS, RELEASE JFN

DSKST4:	TLNE Z,B1		;SUM DELETED OR UNDELETED
	JRST .+3
	ADDI D,(C)		;UNDELETED TOTAL
	JRST DSKST3
	ADDI F,(C)		;DELETED TOTAL
	JRST DSKST3



;CHECK CONNECTED DIRECTORY FOR EXCEEDING DISK ALLOCATION
;BUT DON'T HARRASS HIM UNLESS HE'S A BOTHER
;I. E.  HE EITHER EXCEEDS HIS ALLOCATION BY A PERCENTAGE
;OR HIS EXCESS EXCEEDS A PERCENTAGE OF THE REMAINING SPACE.
; (CURRENTLY 25% AND 10%)
;USED BY LOGIN, LOGOUT, CONNECT

CHKDAL:	MOVEI A,0		;SAY CONNECTED DIRECTORY
	GTDAL
	SUB B,A
	JUMPLE B,[RET]		;NOT OVER
	PUSH P,C
	PUSH P,D		;SAVE ACS
	MOVE D,B
	IDIV A,B		;RATIO OF USED TO OVER
IFN DSKUP,<
	CAIG A,<^D100/DSKUP>	;CHANGE THIS NUMBER TO SAY WHEN TO TYPE
	JRST CKDAL1		; NASTY MESSAGE.
>
	HRLOI A,600000
	GDSKC
	IDIV B,D		;RATIO OF SYSTEM PAGES LEFT TO OVER
IFN DSKSPC,<
	CAIGE B,<^D100/DSKSPC>	;CHECK FOR SIGNIFICANT PART OF FREE
>				; DISC SPACE OVER ALLOCATION
CKDAL1:	ETYPE < [%G over allocation by %4Q pages]
>				;(OH BOTHER!)
CKDAL2:	POP P,D
	POP P,C
	RET

;MEMSTAT
;TYPES, FOR CURRENT FORK, # PAGES, ENTRY VECTOR,
;AND A TABLE GIVING IDENTITY OF EACH PAGE IN FORK.

.MEMSTAT:
	SKIPGE FORK
	JRST [	TYPE < No program>
		JRST EOLRET]
;FIRST TYPE TOTAL # PAGES
	HRLZ A,FORK
	MOVEI E,1000
	SETZ D,
MEMS1:	RPACS
	TLNE B,B5
	AOS D
	AOS A
	SOJG E,MEMS1
	MOVE E,FORK
	CAIN D,1
	JRST [	ETYPE < %5F: One page>
		JRST MEMS2]
	ETYPE < %5F: %4Q pages>

;PRINT ENTRY VECTOR

MEMS2:	MOVE A,FORK
	GEVEC
	JUMPE B,MEMS3		;NONE
	HRRZ A,B
	HLRZ B,B
	CAIN B,<JRST>B53
	JRST [	ETYPE <, 10-50 start address at %1O>
		JRST	MEMS3]
	ETYPE <, Entry vector loc. %1O len. %2O>
MEMS3:	PRINT EOL
	JUMPE D,[RET]		;DONE IF NO PAGES
	PRINT EOL

	;NOW FALL INTO "MMAP" TO TYPE MAP

;SUBROUTINE TO TYPE MEMORY MAP FOR CURRENT FORK, FOR MEMSTAT.
;ACS:	D: PAGE #
;	E & F: IDENTITY OF CURRENT PAGE, A LA RMAP A & B.
;	KWV, KWV1: SAVED IDENTITY OF 1ST PAGE OF GROUP.
;	G: INCREMENT FOR PAGE # IN GROUP OF CONSECUTIVE PAGE IDENTITIES.

MMAP:	SETZ D,

;FIND EXISTING PAGE (TREAT INDIRECT POINTERS AS EXISTING)
MMAP1:	HRL A,FORK
MMAP2:	CAIL D,1000
	JRST EOLRET		;NO MORE PAGES, DONE
	HRR A,D
	RPACS
	TLNN B,B5+B6
	AOJA D,MMAP2		;DOESN'T EXIST, TRY NEXT

;FOUND ONE, PRINT NUMBER
	PUSH P,[^D10]		;10. columns for memory page #s (w/ formatting)
	CALL PAGID		;GET FULL IDENTITY
	 JRST .+2		;3-RETURN SUBR, BUT IRRELEVANT HERE.
	 JRST .+1
	MOVE KWV,E		;SAVE IDENTITY FOR LATER COMPARISONS
	MOVE KWV1,F		;...AND PRINTING
	SETZ G,			;INIT # CONSECUTIVE IDENTITIES
	PRINT " "		;Don't print in first column
	HRRZ B,D
	CALL MMAP7N		;Print 1st page number in octal

;LOOK AT IDENTITY OF NEXT PAGE
	CALL NPAGID		;STEPS D AND GETS IDENTITY
	 SOJA G,MMAP10		;DIFFERENT, GO TYPE IDENTITY
	 JRST MMAP6		;NEXT HIGHER IN SAME FILE OR FORK

;IDENTICAL, SEE HOW MANY MORE ARE
	CALL NPAGID
	 JRST .+3		;DIFFERENT
	 JRST .+2		;NEXT HIGHER
	JRST .-3		;IDENTICAL, KEEP LOOKING
	SETZ G,			;SAY IDENTICAL NOT CONSECUTIVE GROUP
	JRST MMAP7		;GO PRINT "-# <FILE OR FORK> #

;NEXT HIGHER OF SAME FILE OR FORK, SEE HOW MANY MORE ARE CONSECUTIVE
MMAP6:	CALL NPAGID
	 JRST .+2		;DIFFERENT
	 JRST .-2		;CONSECUTIVE, KEEP LOOKING

;PRINT "-#" FOR GROUP OF IDENTICAL OR CONSECUTIVE PAGES
MMAP7:	PRINT "-"
	MOVEI B,-1(D)		;LAST IN GROUP WAS THE PREVIOUS PAGE
	CALL MMAP7N		;TYPE IN OCTAL

;PRINT IDENTITY OF PAGES WHOSE #'S WE HAVE JUST PRINTED:
;TYPICALLY FORK OR FILE NAME, # FOR A SINGLE PAGE OR IDENTICAL GROUP,
; #-# FOR CONSECUTIVE GROUP. ALL PRECEDED BY @ IF INDIRECT.

MMAP10:	POP P,C			;Number of columns left to space out
	PRINT " "
	SOJG C,.-1
	TLNE KWV1,B6
	TYPE <@ >		;INDICATE INDIRECT POINTER
	TLNN KWV1,B5		;DOES PAGE EXIST?
	JRST [	TYPE <No page>	;CAN HAPPEN WITH INDIRECT.
		JRST MMAP13]
	TLNE KWV1,B10
	JRST [	TYPE <Private>
		JRST MMAP13]
	CAMN KWV,MINUS1		;RMAP RETURNS -1 IF NO JFN FOR FILE
	JRST [	TYPE <Forgotten file>
		JRST MMAP13]
	LDB B,[POINT 9,KWV,17]	;JFN OR FORK #
	TLNE KWV,B0		;ON IF FORK
	JRST [	ETYPE <%2F>
		JRST MMAP11]
	MOVE A,COJFN
	SETZ C,
	JFNS			;PRINT FILE NAME
MMAP11:	PRINT " "
	HRRZ B,KWV
	CALL TOCT##		;PAGE # IN FILE OR FORK
	JUMPLE G,MMAP13		;0 INDICATES ONE PAGE ONLY
	PRINT "-"
	ADDI B,-1(G)		;DON'T COUNT LAST PAGE TESTED!
	CALL TOCT##		;PRINT LAST PAGE OF CONSECUTIVE GROUP
MMAP13:	TYPE <  >
	TLZ Z,F1		;USED BY "BEFORE"
	TLNN KWV1,B8
	JRST .+3
	CALL BEFORE
	TYPE <Trap>
	TLNN KWV1,B2
	JRST .+3
	CALL BEFORE		;TYPE COMMA OR EOL BETWEEN ITEMS
	PRINT "R"
	TLNN KWV1,B3
	JRST .+3
	CALL BEFORE		;SUBR WITH "AVAIL DEVICES"
	PRINT "W"
	TLNN KWV1,B9
	JRST .+3
	CALL BEFORE
	TYPE <CW>;		;COPY-ON-WRITE
	TLNN KWV1,B4
	JRST .+3
	CALL BEFORE
	PRINT "E"
	TLNN KWV1,B7
	JRST .+3
	CALL BEFORE
	PRINT "L"		;PAGE LOCKED
	PRINT EOL
	JRST MMAP1		;GO BACK FOR ANOTHER PAGE OR GROUP

MMAP7N:	CALL TOCT##		;Type octal number
	MOVNI C,2		;Typed prefix and at least one digit,
	TRNE B,070
	MOVNI C,3		; No, two digits
	TRNE B,700
	MOVNI C,4		; No, three digits
	ADDM C,-1(P)
	RET

;SUBROUTINE FOR MMAP TO GET AND COMPARE IDENTITY OF PAGE
;TAKES IN D: PAGE #, IN KWV, KWV1: IDENTITY OF FIRST PAGE IN GROUP,
; IN G: PAGE # INCREMENT FOR CONSECUTIVE GROUP.
;RETURNS: E, F: IDENTITY OF PAGE, A LA RMAP.
;	+1: DIFFERENT IDENTITY FROM FIRST PAGE OF GROUP
;	+2: NEXT HIGHER PAGE # (THAN KWV1+G, G), G INDEXED
;	+3: IDENTICAL
;IF D .GT. 777, BEHAVES AS THOUGH CURRENT PAGE IS NON-EXISTENT.
;CLOBBERS A,B.

NPAGID:	ADDI D,1		;ENTRY FOR NEXT PAGE
	ADDI G,1
PAGID:	MOVE A,D		;ENTRY TO NOT INDEX PAGE #
	SETZB E,F
	CAIL A,1000
	JRST PAGID8
	HRL A,FORK
	RPACS
	HLLZ F,B		;RETURN RPACS INFO IN F
	TLNE B,B5		;DOESN'T EXIST?
	TLNE B,B10		;PRIVATE?
	JRST PAGID8		;THIS IS ALL THE INFO WE NEED.
	RMAP			;GET FILE/FORK HANDLE AND PAGE # THEREIN
	MOVE E,A		;...INTO E.

;COMPARISON TO DETERMINE WHETHER SAME AS PREVIOUS PAGE
;COMPARE THAT INFO WHICH IS PRINTED:
; ALL E, F BITS 2-10.
PAGID8:	MOVE A,E
	XOR A,KWV
	TLNE A,-1
	JRST PAGID9		;DIFFERENT FILES OR FORKS, R1
	MOVE B,F		;RMAP'S ACCESS IS WRONG (1/22/71)
	XOR B,KWV1
	TLNE B,(777B10)
	JRST PAGID9		;DIFFERENT ACCESS, R1.
	TRNE A,-1
	JRST [	MOVE A,G
		ADD A,KWV
		SUB A,E
		TRNE A,-1
		JRST .+3	;REALLY DIFFERENT PAGE, R1
		JRST .+2]	;NEXT HIGHER PAGE #, R2
	AOS (P)			;SAME IDENTITY INCLUDING PAGE #, R3.
	AOS (P)
PAGID9:	RET

;FILSTAT

.FILSTAT:
	GJINF
	CAME A,B		;COMPARE LOGIN AND CONNECTED DIRECTORIES
	ETYPE < Connected to <%G%>. >

;JFNS
	TYPE < JFNS:
>
	MOVEI D,MAXJFN		;JFN AND COUNTER
	CALL JSTAT		;TYPE INFO IF JFN ASSIGNED
	SOJGE D,.-1
	PRINT EOL

;DEVICES ASSIGNED TO THIS JOB
	PUSH P,[[TLNE Z,F1	;SET RETURN FOR ASTTJ
		PRINT EOL
		RET]]


;"AVAILABLE DEVICES" ALSO COMES HERE TO TYPE DEVS ASS TO THIS JOB.
ASTTJ:	GJINF			;GET JOB # IN C
	MOVE E,C
	TLZ Z,F1
	CALL DEVLUP		;GET NAME & CHARACTERISTICS FOR EACH
				;DEVICE AND EXECUTES THE NEXT LOCATION.
	 CALL [	CAME C,E	;ASSIGNED TO THIS JOB?
		RET		;NO.
		TLNN Z,F1	;FIRST ONE? ("BEFORE" SETS F1)
		TYPE < Devices assigned to this job:>
		CALL BEFORE	;COMMA OR CR OR NIL. AFTER "AVAIL DEV".
		JRST SIXPRT]	;PRINT SIXBIT NAME FROM A.
	TLNE Z,F1
	PRINT EOL
	RET

;TYPE STATUS OF JFN IN RH OF D.
;NOP IF UNASSIGNED.
;IF ASSIGNED, TYPE <JFN> <NAME>
;AND WHAT OPEN FOR AND "NOT OPEN" OR "DATA ERROR" OR "EOF" IF PERTINENT.
;DESTROYS A, B, C, E.  USED IN "FILSTAT".

JSTAT:	HRRZ A,D
	GTSTS
	TLNN B,200
	RET			;UNASSIGNED, RETURN.
	MOVE E,B		;STATUS FOR USE BELOW
	PRINT " "
	MOVE A,COJFN
	HRRZ B,D
	MOVE C,[4,,10]
	NOUT			;JFN, LEFT ADJ IN 4 COLS
	 CALL JERRC##
	HRRZ B,D
	SETZ C,			;DEFAULT FORMAT

	MOVE A,COJFN		;PRIMARY OUTPUT JFN
	JFNS			;PRINT NAME OR TRAP
	 ERJMP ILIJFN

;TYPE "NOT OPEN" OR LIST OF "READ", "EXECUTE", ETC.
;IF B0 ON AND B1-3 & 5-6 OFF, TYPES NOTHING. CAN THIS HAPPEN? ______ 

JSTAT2:	PRINT TAB
	TLZ Z,F1		;TELL "BEFORE" NOTHING HAS BEEN PRINTED
	TLNN E,B0
	TYPE < Not opened>;
	TLNN E,B1
	JRST JSTAT3
	CALL BEFORE		;TYPE SPACE OR COMMA-SPACE OR EOL-SPACE
	TYPE <Read>;
JSTAT3:	TLNN E,B2		;OK TO WRITE
	JRST JSTAT4
	CALL BEFORE
	TLNN E,B4		;ALSO OK TO CHANGE POINTER?
	TYPE <Append>;		;NO
	TLNE E,B4
	TYPE <Write>;		;YES
JSTAT4:	TLNN E,B3		;EXECUTE
	JRST JSTAT5
	CALL BEFORE
	TYPE <Execute>;
JSTAT5:	TLNN E,B5		;AS SPECIFIED BY PAGE TABLE
	JRST JSTAT6
	CALL BEFORE
	TYPE <Per page table>;
JSTAT6:	TLNN E,B6		;CALL AS PROCEDURE
	JRST JSTAT7
	CALL BEFORE
	TYPE <Procedure>;
JSTAT7:
IAC <	TLNN	E,B14
	JRST	JSTA11
	CALL	BEFORE
	TYPE	<Thawed>
JSTA11: >
	TLNN E,B9
	JRST JSTAT8
	CALL BEFORE
	TYPE <Data error>;
JSTAT8:	TLNN E,B8
	JRST JSTAT9
	CALL BEFORE
	TYPE <EOF>;
JSTAT9:	TLNE E,B1!B2
	TLNN E,B0
	 JRST JSTA10
	TLNE E,B3!B6
	JRST JSTA10
	HRRZ A,D
	RFPTR
	 CALL [	CAIE A,DESX3
		JRST JERR##
		SUB P,BHC+1
		JRST JSTA10]
	CALL BEFORE
	MOVE A,COJFN
	MOVEI C,12
	NOUT
	 CALL JERRC##
	MOVEI B,"."
	BOUT			;INDICATE DECIMAL
JSTA10:	PRINT EOL
	RET


;HERE IF JFNS TRAPS

ILIJFN:	TLNN E,(1B17)		;LOOK AT STATUS WORD
	 JRST ILITRP##		;TRAPPED FOR SOME OTHER REASON
	TYPE <Restricted to some other fork>
	PRINT EOL
	RET

;SYSTAT

.QSYSTAT:
	CALL CRIF##
	MOVE A,['SYSTAT']
	MOVEI B,14
	CALL MORET		;GET LOAD AVERAGES
	ETYPE <Load %4Q %5Q %6Q  Up %K  %I  %D  %E>
	CALL LGNCHK		;TYPE MESSAGE IF NOT PERMITTING LOGINS
	CALL DWNTIM##		;PRINT SHUTDOWN WARNING, IF ANY
	RET

IAC <
.MSYSTAT:
	CALL	.QSYSTAT
	CALL	CRIF
	HRROI	B,[ASCIZ /<SUBSYS>MSYSTAT.SAV/]
	CALL	TRYGTJ
	 RET
	JRST	ERUN2
>

.SYSTAT:CALL .QSYSTAT		;PUT OUT HEADER
	CALL CRIF##
	PUSH P,MINUS1		;FLAG TO SAY WHICH PASS

SRI <	TYPE <
 Job TTY   User       Subsys   PGFLTS   Runtime  Connected  Foreign host
>>
NOSRI <	TYPE <
 Job TTY   User       Subsys   Runtime  Connected  Foreign host
>>

;LOOP TO TYPE TSS JOB #, TTY #, USER  FOR EACH JOB
SYST1:	SETO D,
	GTB 1			;GET # POSSIBLE JOBS
	HRLZ D,A		;AOBJN COUNT,,JOB #

;TOP OF LOOP
SYST2:	GTB 1			;TABLE 1: POSITIVE IF JOB EXISTS
	JUMPL A,SYST9

;HAVE A REAL JOB #. PRINT IT.
	GTB 0
	JUMPL A,[GTB 3		;DET, CHECK FOR SYSTEM
		HRREI B,0(A)	;LOGIN IN DIR
		JUMPL B,SYST9	;?
		CAIN B,1	;<SYSTEM> IS ALWAYS DIR # 1
		 JRST [	SKIPG 0(P)	;DET & <SYSTEM>, PASS 3?
			 JRST SYST9	;NO, IGNORE
			JRST SYST3]	;YES, PRINT
		SKIPL 0(P)	;DET & NOT <SYSTEM>, PASS 1?
		 JRST SYST9	;NO, SKIP IT
		JRST SYST3]	;PRINT
	SKIPE 0(P)		;NON DET JOB, PASS 2?
	 JRST SYST9		;NO, SKIP IT


;PRINT ONE JOB
SYST3:	PRINT " "
	HRRZ B,D
	MOVE A,COJFN
	MOVE C,[4,,^D10]	;LEFT ADJ IN 4 COLS, DECIMAL
	NOUT			;CONVERT AND PRINT JOB #
	 CALL JERRC##

;"DET" OR "TTY N"
	GTB 0			;TABLE 0: LH NEG OR LINE # FOR THIS JOB
	HLRZ B,A
	MOVEI F,(B)		;SAVE TTY NUMBER
	JUMPL A,[TYPE <Det  >
		JRST SYST4]
	MOVE A,COJFN
	MOVE C,[100003,,^D8]	;Right adjust in 3 cols, octal
	NOUT			;LINE #.
	 CALL JERRC##

;If idle print "*" else space
	MOVE A,B		;Line number
	CALL IFTACT
	 SKIPA B,["*"]
	MOVEI B,SPACE
	PRINT (B)
	PRINT SPACE

;USER NAME OR "?" IF CONVERSION FAILS.
SYST4:	GTB 3			;TABLE 3: RH: USER'S DIR #
	HLRZ E,A
	CAIN E,(A)		;IF LOGIN DIRECTORY,
	SETZ E,			;SUPPRESS CONNECTED DIRECTORY PRINTOUT
	HRREI B,(A)		;0 IF NOT LOGGED IN
	JUMPLE B,[TYPE <Not Logged in  >
		JRST SYST7]
	ETYPE <%2R%>

SYST5:	MOVE A,['JOBNM2']
	CALL $SYSGT##
	MOVEI C,(D)		;JOB NUMBER AS INDEX
	JUMPN B,SYST51		;IF JOBNM2 EXISTS...
	MOVE A,['JOBNAM']	;OTHERWISE, GET STUFF FROM OTHER TABLE
	CALL $SYSGT##
	JUMPE B,SYST8		;NO SUCH TABLE: NOT IMPLEMENTED YET
	HRR A,B			;TABLE NUMBER
	HRL A,D			;INDEX: TSS JOB #
	GETAB			;GET SNAMES INDEX INTO A
	 CALL JERR##
	MOVE C,A
	MOVE A,['SNAMES']
	CALL $SYSGT##		;GET # OF SUBSYSTEM NAMES TABLE
	JUMPE B,SYST8
SYST51:	HRR A,B
	HRL A,C
	GETAB
	 CALL JERR##
	PUSH P,A
		;POSITION CARRIAGE, TYPING A MAXIMUM OF 10 SPACES
	MOVEI C,12
SYST5A:	PRINT " "
	MOVE A,COJFN
	RFPOS			;VALID ONLY FOR TTYS
	MOVEI B,(B)		;MASK HORIZ POSITION
	CAIGE B,26
	SOJGE C,SYST5A
	POP P,A			;NAME AGAIN
	JUMPE A,[PRINT "?"
		JRST SYST8]
	CALL SIXPRT		;PRINT IT
				;SIXPRT IS WITH "AVAIL DEV" IN X1CMD.MAC
SYST6:
SRI <	PGFWID==11
	MOVE A,['JOBPGF']	;ONLY POSSIBLE AT SRI-AI
	CALL $SYSGT##
	JUMPE B,SYST6B-1	;JOBPGF NOT IMPLEMENTED, SKIP IT
	PUSH P,B
	MOVEI C,20
SYST6A:	PRINT SPACE
	MOVE A,COJFN
	RFPOS
	MOVEI B,(B)
	CAIGE B,35
	SOJGE C,SYST6A
	POP P,A
	HRL A,D
	GETAB
	 CALL JERR##
	MOVE B,A		;NUMBER OF PAGE FAULTS
	MOVE A,COJFN
	MOVE C,[1B2+8B17+^D10]
	NOUT
	 CALL JERR##
>
NOSRI <	PGFWID==0 >		;ELSEWHERE NOT EVEN A SLOT
	MOVEI C,12
SYST6B:	PRINT SPACE
	MOVE A,COJFN
	RFPOS
	MOVEI B,(B)		;RETURNS 0 FOR NON-TTY:
	CAIGE B,35+PGFWID
	SOJGE C,SYST6B
	GTB 1			;TABLE 1 IS JOBRT
	JUMPL A,SYST8
	MOVE C,A
	MOVE A,['TICKPS']
	CALL $SYSGT##
	JUMPE B,SYST8
	IDIVI A,^D10
	EXCH A,C
	IDIVI A,(C)
	MOVE B,A
	IDIVI B,^D36000
	MOVE G,C
	TLZ Z,F2
	MOVE A,COJFN
	JUMPE B,SYS6B1
	MOVEI C,^D10
	NOUT
	 CALL JERRC##
	PRINT ":"
	TLO Z,F2
	JRST SYS6B2
SYS6B1:	MOVEI C,3
	MOVE A,COJFN
	RFPOS
	MOVEI B,(B)
	CAIL B,37+PGFWID
	JRST SYS6B2
	PRINT SPACE
	SOJG C,SYS6B1+1
SYS6B2:	MOVE B,G
	IDIVI B,^D600
	MOVE G,C
	TLNN Z,F2
	JUMPE B,SYS6B3
	MOVE A,COJFN
	TLNN Z,F2
	SKIPA C,[1B2+2B17+^D10]
	MOVE C,[1B2+1B3+2B17+^D10]
	NOUT
	 CALL JERRC##
	PRINT ":"
	TLO Z,F2
	JRST SYS6B4
SYS6B3:	MOVEI C,4
	MOVE A,COJFN
	RFPOS
	MOVEI B,(B)
	CAIL B,42+PGFWID
	JRST SYS6B4
	PRINT SPACE
	SOJG C,SYS6B3+1
SYS6B4:	MOVE B,G
	IDIVI B,^D10
	MOVE G,C
	TLNN Z,F2
	JUMPE B,[TYPE <  >
		JRST SYS6B5]
	MOVE A,COJFN
	TLNN Z,F2
	SKIPA C,[1B2+2B17+^D10]
	MOVE C,[1B2+1B3+2B17+^D10]
	NOUT
	 CALL JERRC##
SYS6B5:	PRINT "."
	PRINT "0"(G)
SYST6C:	JUMPE E,SYST7
	MOVEI C,20
SYST6D:	PRINT SPACE
	MOVE A,COJFN
	RFPOS
	MOVEI B,(B)
	CAIGE B,50+PGFWID
	SOJGE C,SYST6D
	MOVEI B,(E)
	ETYPE <%2R%>
SYST7:
	MOVE A,['LHOSTN']
	CALL $SYSGT##
	JUMPE B,SYST8
	HRLI A,1
	HRRI A,(B)
	GETAB
	 JRST SYST8
	HLRE B,A
	MOVM B,B
	ADDI B,(A)
	CAIL F,(A)		;IF NOT BETWEEN LOWEST NET PTY
	CAIL F,(B)		;AND HIGHEST,
	JRST SYST8		;NOT NETWORK PTY
	MOVE A,['NETBUF']
	CALL $SYSGT##
	JUMPE B,SYST8
	HRRZ B,B
SYST7A:	MOVE A,B
	GETAB
	 JRST SYST8
	SUBI B,1
	CAIE A,(F)		;TTY #S MATCH?
	AOBJP B,SYST7A

SYST7B:	MOVS C,B		;INDEX TO C
	MOVE A,['NETSTS']
	CALL $SYSGT##
	JUMPE B,SYST8
	HRLI A,(C)
	HRRI A,(B)
	GETAB
	 JRST SYST8
	TLC A,(1B1!1B2!1B3)
	TLNE A,(17B3)
	JRST [	MOVS B,C
		AOBJP B,SYST7A]
	MOVE A,['NETAWD']
	CALL $SYSGT##
	JUMPE B,SYST8
	HRLI A,(C)
	HRRI A,(B)
	GETAB
	 JRST SYST8
	HLRZ E,A
	HRRZ F,C		;Remember internal index
	MOVEI C,^D40
SYST7C:	PRINT SPACE
	MOVE A,COJFN
	RFPOS
	MOVEI B,(B)
	CAIGE B,63+PGFWID
	SOJGE C,SYST7C
	MOVEI B,(E)
	ANDI B,777
	MOVEI C,^D10
	CVHST
	  NOUT
	 JFCL
;If a tip output port number
	PUSH P,B		;Host number
	MOVE A,['HOSTN ']
	CALL $SYSGT
	PUSH P,B		;HOSTN table number
	JUMPE B,SYST7F
	HLLZ C,B		;AOBJN pointer
SYST7D:	HRRZ A,0(P)
	HRL A,C
	GETAB
	 CALL JERR
	LDB B,[POINT 9,A,17]
	CAMN B,-1(P)		;Same host?
	JRST SYST7E		;Yes
	AOBJN C,SYST7D		;No, loop
	JRST SYST7F

SYST7E:	LDB B,[POINT 4,A,8]
	CAIE B,4		;TIP
	CAIN B,5		;MTIP
	SKIPA
	JRST SYST7F
	PRINT "#"
	MOVE A,['NETFSK']
	CALL $SYSGT
	JUMPE B,SYST7F
	HRRZ A,B
	HRL A,F			;Internal index
	GETAB
	 CALL JERR
	LSH A,^D-16
	MOVE B,A
	MOVE A,COJFN
	MOVEI C,^D8
	NOUT
	 JFCL
SYST7F:	SUB P,BHC+2

SYST8:	PRINT EOL
SYST9:	AOBJN D,SYST2
	MOVE A,COJFN
	DOBE			;WAIT IN CASE OF ^O
SYST10:	AOS 1,0(P)		;SWITCH PASSES
	CAIGE 1,2		;DONE ALL?
	 JRST SYST1		;NO, DO ANOTHER PASS
	SUB P,BHC+1
	PRINT EOL
	RET

;STATISTICS

.STATISTICS:
	MOVE A,['SYSTAT']
	CALL READT	;READ SYSTEM STATISTICS TABLE INTO AC'S 4-13
	ETYPE <
 Idle %4T  Waiting %5T  Core mgmt %6T  Pager traps %7T
 Drm Reads %10Q Writes %11Q  Dsk Reads %12Q Writes %13Q
>
	MOVE A,['NCPGS ']
	CALL $SYSGT##
	ETYPE < %1Q Pages of user core
>
	MOVE A,['SYSTAT']
	MOVEI B,10
	CALL MORET		;READ MORE OF TABLE
	TIME			;TOTAL UPTIME OF SYSTEM
	CALL FLOAT##
	EXCH 1,6
	CALL FLOAT##		;FLOAT NBAL TOTAL
	EXCH 1,7
	CALL FLOAT##		;FLOAT NRUN TOTAL
	EXCH 1,6
	FDVR 6,1		;NRUN AVERAGE
	FDVR 7,1		;NBAL AVERAGE
	ETYPE < %4Q Term wakeups  %5Q Term interrupts
 Nbal Av %7Q  Nrun Av %6Q
>
	MOVE A,['QTIMES']
	CALL READT
	ETYPE < Runtime of jobs on Q's 0-4 (Msec)
	%4Q	%5Q	%6Q	%7Q	%10Q
>
STAT3:	TYPE <
 Subsys       Time   PG Flts  Time/Flt  Av W-Set  Flt/Wake
>
	MOVEI 6,1(P)		;PLACE ON STACK TO STORE TABLE NUMBERS
	HRLI 6,5
	ADD P,[NSNAMS,,NSNAMS]
	MOVSI 5,-NSNAMS		;NUMBER OF TABLES TO EXAMINE
STAT51:	MOVE A,SNAMS(E)		;GET SIXBIT NAME OF TABLE
	CALL $SYSGT##
	MOVEM B,@6		;SAVE TABLE NUMBER
	AOBJN 5,STAT51
	HLLZ 4,0(6)		;LENGTH OF (FIRST) TABLE
STAT5A:	MOVSI 5,-NSNAMS		;TABLE COUNTER FOR EACH SUBSYS
	HRRZ A,@6
	GTB (A)			;GET NAME OF SUBSYSTEM IN THIS SLOT
	JUMPE A,STAT5Z		;0 MEANS NONE THERE
	PRINT " "
	CALL SIXPRT		;PRINT THE NAME
	PRINT TAB
	AOBJN 5,.+1

STAT6A:	HRRZ A,@6		;GET 2ND ENTRY
	GTB (A)			;GET TIME
	PUSH P,A		;SAVE FOR LATER
	MOVE B,A
	CALL STAT5N		;PRINT IT
	AOBJN 5,.+1		;KEEP POINTER UP TO DATE

STAT6B:	HRRZ A,@6		;GET FAULTS
	GTB (A)
	MOVE B,A
	CALL STAT5N		;PRINT IT
	AOBJN 5,.+1		;UPDATE

STAT6C:	MOVE A,B
	CALL FLOAT##
	EXCH A,0(P)		;FLTS TO PDL, TIME TO A
	CALL FLOAT##
	FDVR A,0(P)		;TIME PER FAULT
	ETYPE <    %1Q>		;PRINT IT

STAT6E:	HRRZ A,@6
	GTB (A)
	PUSH P,A		;WAKES & AV. WORKING SET SIZE
	LDB A,[POINT 15,A,14]	;THIS WORD HAS TWO FIELDS
	CALL FLOAT##		;FLOAT EACH FIELD
	EXCH A,0(P)		;WAKES TO PDL, WSET TO A
	TLZ A,(-1B14)
	CALL FLOAT##
	FDVR A,0(P)		;COMPUTE AVERAGE
	ETYPE <    %1Q>
STAT6F:	MOVE A,-1(P)		;FAULTS
	FDVR A,0(P)		;FAULTS/WAKEUP
	ETYPE <    %1Q>

STAT6G:	SUB P,BHC+2		;FLUSH JUNK
	AOBJP 5,STAT5Y		;ANYMORE TABLES TO PRINT?

STAT5C:	HRRZ A,@6		;TABLE NUMBER
	GTB (A)			;GET DATA
	MOVE B,A
	CALL STAT5N		;PRINT DECIMAL VALUE
	AOBJN 5,STAT5C
STAT5Y:	PRINT EOL

STAT5Z:	AOBJN 4,STAT5A
	SUB P,[NSNAMS,,NSNAMS] ;REMOVE TEMP STORAGE
STAT6:	JRST EOLRET

;PRINT FORMATTED NUMBER

STAT5N:	MOVE A,COJFN
	MOVE C,[1B0+1B2+1B4+12B17+^D10]
	NOUT
	JRST [	CAIE A,NOUTX2	;CHECK FOR COLUMN OVERFLOW ERROR CODE
		CAIN C,NOUTX2	;IN A OR C
		RET		;ALLOW IT
		JRST JERR##]	;REPORT ANY OTHER ERROR
	RET

;TABLES TO BE PRINTED IN STATISTICS FOR SUBSYSTEMS

SNAMS:	'SNAMES'		;MUST BE FIRST
	'STIMES'		;MUST BE SECOND
	'SPFLTS'		;MUST BE THIRD
	'SWAKES'		;MUST BE FOURTH
;***  OTHERS MAY BE INSERTED HERE ***
NSNAMS==.-SNAMS

;ERRSTAT: PRINT VARIOUS ERROR INFORMATION

.ERRSTAT:
NOIAC <
ERRST1:	MOVE A,['DSKERR']
	CALL READT		;READ DISK ERRORS TABLE INTO AC'S D + .
	JUMPN D,.+2
	JUMPE 11,[TYPE <
 No Disk errors
>
		JRST ERRST2]
	ETYPE <
 Disk errors: %4Q Recoverable  >
	JUMPE D,.+2
	ETYPE <
 Command words for last recoverable error:
  %5O  %6O  %7O
 Error Bits: %10O
>
	ETYPE < %11Q Irrecoverable
>
	JUMPE 11,.+2
	ETYPE < Command words for last irrecoverable error:
  %12O  %13O  %14O
 Error bits: %15O
>

ERRST2:	MOVE A,['DRMERR']
	CALL READT
	JUMPE D,[TYPE <
 No Drum errors
>
		JRST ERRST3]
	ETYPE <
 %4Q Drum errors
 Command words for last error:
  %5O  %6O
  Error bits: %7O
>

ERRST3:	JRST EOLRET
>

IAC <
	HRROI	B,[ASCIZ "<SUBSYS>ERRSTAT.SAV"]
	CALL	TRYGTJ
	 ERROR	<No Error Statistics program>
	JRST	ERUN2		; HANDLE AS EPHEMERON
>

;SUBROUTINE TO READ SYSTEM TABLE WHOSE NAME IS IN A INTO AC'S 4-16.
;USED IN SYSTAT, ERRSTAT.

READT:	SETZ B,			;NORMAL ENTRY: START AT BEGINNING OF TABLE
MORET:	MOVE D,B		;ENTRY FOR TABLE INDEX IN B
	CALL $SYSGT##
	SKIPN B
	 CALL SCREWUP##		;NO SUCH TABLE
	HLLZ C,B		;FORM AOBJN INDEX
	SOJGE D,[AOBJP C,[RET]	;PASS UNWANTED ENTRIES
		JRST .]
	PUSH P,[D]		;INIT PTR TO AC'S TO STORE VALUES IN
READT1:	HRR A,B			;TABLE #
	HRL A,C			;INDEX
	GETAB			;READ A WORD OF TABLE INTO A
	 CALL JERR##
	MOVEM A,@(P)
	AOS A,(P)
	CAIGE A,P		;STOP BEFORE OVERWRITING P!
	AOBJN C,READT1		;END-OF-TABLE TEST AND LOOP
	SUB P,BHC+1
	RET

;TERMINAL STATUS COMMAND  "TRMSTAT"


.TRMSTAT:
	SKIPGE G,CIFORK
TRMSTA:	SETZ G,
	IMULI G,SFKBLK
	SKIPE FK.MOD(G)
	JRST TRMST0
	JUMPN G,TRMSTA
	CALL CRIF##
	TYPE <Terminal status not yet defined>
	RET

TRMST0:	SKIPE G
	ETYPE < %F>
	MOVE 1,COJFN
	RFMOD
	MOVE 3,[7B3!177B10!177B17!3B27!1B30!3B33] ;STPAR BITS
	SETCM 3,[77B23!3B25!3B29] ;NOT SFMOD BITS
	ANDCAM C,FK.MOD(G)	;FLUSH FROM STORED MODE WORD
	IORM B,FK.MOD(G)	;UPDATE
	GTTYP
	CALL CRIF##
	ETYPE <Terminal Type: %2Q.>
	PRINT EOL

TRMST1:	MOVSI 1,(1B1)
	TDNN A,FK.MOD(G)
	TYPE < Lacks>
	TDNE A,FK.MOD(G)
	TYPE < Has>
	TYPE < mechanical formfeed>
	PRINT EOL

TRMST2:	MOVSI 1,(1B2)
	TDNN A,FK.MOD(G)
	TYPE < Lacks>
	TDNE A,FK.MOD(G)
	TYPE < Has>
	TYPE < mechanical tabs>
	PRINT EOL

TRMST3:	MOVSI 1,(1B3)
	TDNN A,FK.MOD(G)
	TYPE < Lacks>
	TDNE A,FK.MOD(G)
	TYPE < Has>
	TYPE < lowercase>
	PRINT EOL

TRMST4:	LDB 2,[POINT 7,FK.MOD(G),10]
	ETYPE < Page length is: %2Q.>
	PRINT EOL

TRMST5:	LDB 2,[POINT 7,FK.MOD(G),17]
	ETYPE < Line width is: %2Q.>
	PRINT EOL

TRMST6:	TLZ Z,F1		;COMMUNICATE WITH "BEFORE"
	TYPE < Wake-up set: >
	LDB 1,[POINT 2,FK.MOD(G),21]
	CAIE 1,3
	 JRST TRMS60
	CALL BEFORE
	TYPE <All controls>
	JRST TRMS62
TRMS60:	MOVEI 1,1B20
	TDNN A,FK.MOD(G)
	 JRST TRMS61
	CALL BEFORE
	TYPE <Formatting controls>
TRMS61:	MOVEI 1,1B21
	TDNN A,FK.MOD(G)
	 JRST TRMS62
	CALL BEFORE
	TYPE <Non-formatting controls>
TRMS62:	MOVEI 1,1B22
	TDNN A,FK.MOD(G)
	 JRST TRMS63
	CALL BEFORE
	TYPE <Punctuation>
TRMS63:	MOVEI 1,1B23
	TDNN A,FK.MOD(G)
	 JRST TRMS64
	CALL BEFORE
	TYPE <Alphanumerics>
TRMS64:	PRINT EOL

TRMST7:	LDB 2,[POINT 2,FK.MOD(G),25]
	TYPE < Echo mode is: >
	CAIN 2,0
	TYPE <None>
	CAIN 2,1
	TYPE <Immediate>
	CAIN 2,2
	TYPE <Immediate or Deferred>
	CAIN 2,3
	TYPE <Immediate and Deferred>
	PRINT EOL

TRMST8:	TYPE < Links are being >
	MOVEI 1,1B26
	TDNN A,FK.MOD(G)
	TYPE <refused>
	TDNE A,FK.MOD(G)
	TYPE <accepted>
	PRINT EOL

TRMST9:	TYPE < Terminal data mode is: >
	MOVEI 1,1B29
	TDNE A,FK.MOD(G)
	TYPE <Ascii>
	TDNN A,FK.MOD(G)
	TYPE <Binary>
	PRINT EOL

TRMS10:	TYPE < Lowercase output is being >
	MOVEI 1,1B30
	TDNN A,FK.MOD(G)
	TYPE <sent to terminal>
	TDNE A,FK.MOD(G)
	TYPE <indicated by %X>
	PRINT EOL

TRMS11:	TYPE < Lowercase input is being >
	MOVEI 1,1B31
	TDNN A,FK.MOD(G)
	TYPE <accepted>
	TDNE A,FK.MOD(G)
	TYPE <converted to uppercase>
	PRINT EOL

TRMS12:	LDB 2,[POINT 2,FK.MOD(G),33]
	CAIN 2,0
	TYPE < Full duplex>
	CAIN 2,2
	TYPE < Character half duplex>
	CAIN 2,3
	TYPE < Line half duplex>
	CAIN 2,1
	TYPE < Undefined duplexity>
	PRINT EOL

TRMS13:	TLZ Z,F1		;INITIALIZE "BEFORE"
	TYPE < Tab stops:>
	MOVE B,[POINT 1,FK.STP(G)]
	MOVEI 3,0		;COLUMN TO PRINT
	MOVEI 4,^D<3*36>	;HOW MANY TO TEST
TRM131:	ILDB 1,2
	JUMPE 1,TRM132		;NO TAB IN THIS COLUMN
	CALL BEFORE
	ETYPE <%3Q>
TRM132:	ADDI 3,1		;BUMP COLUMN NUMBER
	SOJG 4,TRM131

TRMS14:	MOVEI 3,3		;TYPE BEING SCANNED FOR, THIS PASS
TRM141:	MOVE D,[POINT 2,FK.COC(G)] ;INITIAL POINTER TO CCOC BYTES
	MOVEI 5,100		;CHARACTER TO PRINT
	MOVEI 6,40		;HOW MANY TO CHECK
	TLZ Z,F1!F2		;FOR "BEFORE" AND HEADING PRINTER

TRM142:	ILDB 1,4		;PICK UP CCOC BYTE
	CAIE 1,0(3)		;SAME AS THAT BEING SCANNED FOR?
	 JRST TRM145		;NO
TRM143:	TLOE Z,F2		;HAS HEADING BEEN OUTPUT?
	 JRST TRM144		;YES
	CAIN 3,0
	TYPE <
 Ignored controls:>
	CAIN 3,1
	TYPE <
 Indicated controls:>
	CAIN 3,2
	TYPE <
 Sent controls:>
	CAIN 3,3
	TYPE <
 Simulated controls:>
TRM144:	CALL BEFORE		;PRINT COMMA IF NEEDED
	PRINT "^"
	PRINT 0(5)
TRM145:	ADDI 5,1		;MOVE TO NEXT CHARACTER
	SOJG 6,TRM142		;CONTINUE THIS SCAN
	SOJGE 3,TRM141		;MOVE TO NEXT TYPE
	RET

;TERMINAL CHARACTERISTICS COMMANDS GROUP
;	LOWERCASE, FORMFEED, TABS, NO LOWERCASE, NO FORMFEED, NO TABS,
;	RAISE, NO RAISE, HALFDUPLEX, FULLDUPLEX, INDICATE.

;THESE COMMANDS CHANGE THE FILE MODE WORD AND THE CONTROL CHARACTER
;OUTPUT CONTROL (CCOC) WORDS FOR THE PRIMARY OUTPUT FILE,
;AND ALSO THE THREE SETS OF THESE VALUES KEPT IN STORAGE.

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


.FULLD:	TLC Z,F1		;"FULLDUPLEX" = "NO HALFDUPLEX".
.HALFD:	MOVEI C,3B33		;"HALFDUPLEX". "HALF DUPLEX" MODE BIT.
	JRST CMOD		;CHANGE FILE MODE WORD

.FORMF:	HRLZI C,B1		;"FORMFEED". "HAS MECH. FF" MODE BIT
	MOVE D,[POINT 2,(E),25]	;POINTER TO ^L CCOC BYTE
	JRST TABS1

.TABS:	HRLZI C,B2		;"TABS". "HAS HARDWARE TABS" MODE BIT
	MOVE D,[POINT 2,(E),19]	;PTR TO ^I CCOC BYTE
TABS1:	CALL CMOD		;CHANGE FILE MODE WORD
	JRST CCCOC		;CHANGE CONT. CHAR. OUTPUT CONT. WORDS

;LOWERCASE: CONTROLS LOWER CASE OUTPUT.
;IT MAY ALSO BE NECESSARY TO CLEAR "INDICATE WITH %" BIT,
;BUT PREFERABLE NOT TO IF IT HAS NO EFFECT WHEN B3 ON.

.LOWER:	HRLZI C,B3		;"LOWERCASE".  "HAS LOWER CASE" MODE BIT.
	JRST CMOD		;CHANGE FILE MODE WORD

;RAISE: CONTROLS CONVERSION OF LOWER CASE TO UPPER ON INPUT.

.RAISE:	MOVEI C,1B31		;"CONVERT LOWER CASE TO UPPER" MODE BIT


;CHANGE TELETYPE MODE WORD SUBR
;CHANGES MODE IN EFFECT
;TAKES: C: MASK INDICATING BITS TO CHANGE.
;	AC Z LH BIT F1: ON TO CLEAR BIT(S), OFF TO SET THEM.
;PRESERVES D, DESTROYS A, B.

CMOD:	CALL GCOTTY		;Get a good tty to use
	 RET			; can't, noop
	RFMOD
	ANDCAM C,B
	TLNN Z,F1
	IORM C,B
	STPAR			;THESE ARE ALL TERMINAL PARAMETERS
	RET



;LENGTH (of page is) <DECIMAL NUMBER>

.LLENG:	NOISE (of page is)
	CALL DECIN##
	 JRST CERR##
	ALLOW TSPC+TALT+TEOL
	CONFIRM
	CAIL A,4
	CAILE A,^D127
	 JRST CERR##
	MOVE C,A
	CALL GCOTTY		;
	 RET
	RFMOD
	DPB C,[POINT 7,2,10]
	STPAR
	RET


;WIDTH (of line is) <DEC NUM>

.LWIDTH: NOISE (of line is)
	CALL DECIN##
	 JRST CERR##
	ALLOW TSPC+TALT+TEOL
	CONFIRM
	CAILE A,177	;127. IS MAX
	 JRST CERR##
	MOVE C,A
	CALL GCOTTY		;
	 RET
	RFMOD
	DPB C,[POINT 7,B,17]
	STPAR
	RET


;INDICATE (FORMFEED)

.INDIC:	NOISE (formfeed)
	CONFIRM
	TLO Z,F2
	MOVE D,[POINT 2,(E),25]

;SUBR TO CHANGE CCOC BYTE TO SIMULATE (IF F1 ON & F2 OFF)
; OR SEND (IF F1 AND F2 OFF) OR INDICATE (IF F2 ON).
;BYTE TO CHANGE IS INDICATED BY A BYTE PTR IN D, INDEXED BY E.
;DESTROYS A, B, C, E.

CCCOC:	MOVE A,COJFN
	RFCOC
	MOVEI E,B
	CALL CCCOCS		;OPERATE ON CCCOC WORDS IN B,C
	MOVE A,COJFN
	SFCOC			;PUT NEW VALUE INTO EFFECT
	MOVSI C,-NFKS		;All forks including MFEXEC
	MOVEI E,FK.COC
CCCOC1:	MOVE A,FKFLG(C)		;Does this fork have a valid FKBLK?
	TLNE A,FK%BLK		; ..
	 CALL CCCOCS		; Yes, make appropriate change
	ADDI E,SFKBLK
	AOBJN C,CCCOC1
	MOVEI E,FK.COC+IFKBLK	;Now change proto-type FKBLK

;SUBSUBROUTINE TO OPERATE ON BYTE IN WORDS E POINTS TO

CCCOCS:	MOVEI A,2		;2 = SEND CODE
	TLNE Z,F1
	MOVEI A,3		;3 = SIMULATE
	TLNE Z,F2
	MOVEI A,1		;1 = INDICATE BY ^X
	DPB A,D
	RET

GCOTTY:	MOVE A,COJFN		;Command output JFN
	CAIN A,101		;Primary?
	CALL GPRIO		;Get primary output JFN
	CAIN A,-1		;Controlling TTY?
	JRST GCTTY		;CALLRET controlling tty desg.
	PUSH P,B		;
	PUSH P,C		;
	DVCHR			;Get characteristics
	TLNN A,-1		;TTY type desg?
	JRST GCOTT1		;MUST BE!
	HLRZ B,A		;get general descriptor
	CAIE B,600012		;TTY?
	JRST GCTTY1		;No.  Join GCTTY to get cont TTY
	MOVEI A,400000(A)	;Make it a TTY designator
GCOTT1:	POP P,C			;
	POP P,B			;
	AOS 0(P)		;Skip with TTY dsg in A
	RET			;

GCTTY:	PUSH P,B		;
	PUSH P,C		;
GCTTY1:	PUSH P,D		;
	GJINF			;
	SKIPL A,D		;
	AOS -3(P)		;Skip w/ cont TTY in A
	TRO A,400000		;Make it a TTY desg.
	POP P,D			;
	POP P,C			;
	POP P,B			;
	RET			;

GPRIO:	PUSH P,B		;
	MOVEI A,.FHSLF		;THIS FORK
	GPJFN			;
	HRRZ A,B		;OUTPUT ONLY
	POP P,B			;
	RET			;

;FREEZE (character is) <CHARACTER> [CONFIRM]

FEATUR %FREEZ,<
.FREEZE:
	ALTYPE <(character is) >;;Can't allow NOISE here
	CALL ALLBK		;All characters break
	MOVE .BFP,BFP
	SETZ CNT,
FRZC1:	CALL CCHRI		;Get a character
	TLNN Z,CTRLVF		;If not Control-V'ed
	CAIE CHR,"?"		; and is a question mark
	JRST FRZC2
	CALL UBP##
	ETYPE < Freeze character%Y>;; give some help
	JRST FRZC1
FRZC2:	TRNN CBT,FRZC
	TYPE < [Not recommended]>
	PUSH P,CHR		;Save it from CONFIRM
	ETYPE < [Confirm]>
	CONFIRM
	POP P,A			;OK, set freeze character
	SFRZC
	RET
>

;TERMINAL (type is)

;NOTE:	GET SOMEBODY AT BBN TO ASSIGN NEW (UNIQUE) TERMINAL NUMBERS
;	IN THE MONITOR.  THIS AVOIDS CONFUSION WITH OTHER SITES.
;	LOCAL STTYP NUMBERS SHOULD BE NEGATIVE NUMBERS.


.TERMINAL:
	NOISE (type is)
	KEYWD $TERMI
	 0
	 JRST CERR##
	MOVEI B,1000(KWV)	;Type number or dispatch?
	CAIL B,2000		; Allow type numbers between -1000 to 1000
	JRST 0(KWV)		; Dispatch
	HRREI B,(KWV)		; Type number

	CONFIRM
	CALL GCOTTY		;Terminal designator
	 RET
	STTYP			;Set terminal type
	RET

TERM1:	CONFIRM
	CALL GCOTTY		;Get controlling output terminal
	 JRST [	SUB P,BHC+3	;Forget stacked values
		RET]
	POP P,B			;Set terminal type.
	STTYP
	RFMOD			;Get present width & length,
	POP P,C			; set width,
	DPB C,[POINT 7,B,17]
	POP P,C			; set length,
	DPB C,[POINT 7,B,10]
	STPAR			; Then effect change.
	RET


$TERMI:	TABLE
	TE 33,,NOLOG,00
	TE 35,,NOLOG,01
	TE 37,,NOLOG,02
	TE 4023,,NOLOG,.DATA100
IAC <	TE ADM,,NOLOG,.ADM	; ADM-1, ADM-3, ADM-3A>
	TE AJ,,NOLOG,03
	TE AMBASSADOR,,NOLOG
	TE ANDERSON-JACOBSON,,NOLOG,03
NOSRI <	TE BACKSPACE,,NOLOG,..BACK>
	TE BEEHIVE,,NOLOG
	TE BENDIX,,NOLOG
	TE COMPUTER-DEVICES,,NOLOG,03
	TE CONCEPT-100,,NOLOG,.CONCE
	TE DATA100,,NOLOG
	TE DM2500,,NOLOG
	TE EXECUPORT,,NOLOG,03
	TE HAZELTINE,,NOLOG
	TE HEATH,,NOLOG
	TE HP,,NOLOG
	TE INFOTON,,NOLOG
	TE ISI,,NOLOG
	TE LA30,,NOLOG,10
	TE LINEPROCESSOR,,NOLOG,13
	TE LOGIPORT,,NOLOG,.BENDIX
	TE MINI,,NOLOG,-1
	TE MINI2,,NOLOG
	TE NCR,,NOLOG,03
NOSRI <	TE NOBACKSPACE,,NOLOG>
	TE NVT,,NOLOG,07
	TE OMRON,,NOLOG,14
	TE PLASMA,,NOLOG
	T SCOPE,,NOLOG
	TE TEKTRONIX,,NOLOG
	TE TERMINET,,NOLOG,10
	TE TI,,NOLOG,03
	TE TI733,,NOLOG,11
	TE VT06,,NOLOG
	TE VT52,,NOLOG
	TE VTS,,NOLOG
	TEND


NOSRI <
.NOBACK:TLO Z,F1
..BACK:	NOISE (on character delete)
	CONFIRM
	TLNN Z,F1
	SETOM BSFLG
	TLZE Z,F1
NOBAK1:	SETZM BSFLG
	RET
>


IAC <
.ADM:	SETOM	BSFLG		; DEFAULT TO BACKSPACE-DELETE
	JRST	.VT52		; SAME SCREEN SIZE AS VT52
>

.CONCE:	PUSH P,[^D24]
	PUSH P,[^D80]
	PUSH P,[17]
	JRST TERM1

.AMBAS:	PUSH P,[^D48]
	PUSH P,[^D80]
	PUSH P,[25]
	JRST TERM1

.DM250:	PUSH P,[^D24]
	PUSH P,[^D80]
	PUSH P,[14]
	JRST TERM1

.HEATH:	PUSH P,[^D24]
	PUSH P,[^D80]
	PUSH P,[23]
	JRST TERM1 

.BEEHI:	PUSH P,[^D20]
	PUSH P,[^D72]
	JRST SCOPE1


.BENDI:	PUSH P,[^D16]
	PUSH P,[^D72]
	JRST SCOPE1


.DATA1:	PUSH P,[^D24]
	PUSH P,[^D72]
	JRST SCOPE1


.HAZEL:	PUSH P,[^D27]
	PUSH P,[^D73]
	JRST SCOPE1


;TERMINAL (type is) HP [NO-PAUSE, PAUSE]

.ISI:
.HP:	KEYWD $HP
	 TE PAUSE,,NOLOG,16
	 JRST CERR##
	PUSH P,[^D24]
	PUSH P,[^D79]
	MOVEI B,(KWV)
	PUSH P,B
	JRST TERM1

$HP:	TABLE
	TE NO-PAUSE,,NOLOG,17
	TE PAUSE,,NOLOG,16
	TEND


.INFOT:	PUSH P,[^D23]
	PUSH P,[^D72]
	JRST SCOPE1


.MINI2:	PUSH P,[^D8]
	PUSH P,[^D41]
	JRST SCOPE1


.PLASM:	PUSH P,[^D50]
	PUSH P,[^D80]
	PUSH P,[20]
	JRST TERM1


;TERMINAL (type is) SCOPE (page length) <DEC NUM> (page width) <DEC NUM>

.SCOPE:	ALLOW TSPC+TALT
	NOISE (page length)
	CALL DECIN##
	 JRST CERR##
	ALLOW TSPC+TALT
	CAIL A,4
	CAILE A,^D127
	 JRST CERR##
	PUSH P,A
	NOISE (page width)
	CALL DECIN##
	 JRST CERR##
	ALLOW TSPC+TALT+TEOL
	CAILE A,^D127
	 JRST CERR##
	PUSH P,A

SCOPE1:	PUSH P,[12]
	JRST TERM1


;TEKTRONIX (type is) TEKTRONIX [4023, NARROW-COLUMN, WIDE-COLUMN]

.TEKTR:	KEYWD $TEKTR
	 TE WIDE-COLUMN,,NOLOG,.TEKTW
	 JRST CERR##
	JRST (KWV)

$TEKTR:	TABLE
	TE 4023,,NOLOG,.DATA1
	TE NARROW-COLUMN,,NOLOG,.TEKTN
	TE WIDE-COLUMN,,NOLOG,.TEKTW
	TEND

.TEKTW:	SKIPA B,[^D73]
.TEKTN:	MOVEI B,^D36
	PUSH P,[^D35]
	PUSH P,B
	JRST SCOPE1


.VT06:	PUSH P,[^D25]
	PUSH P,[^D72]
	JRST SCOPE1


.VT52:	PUSH P,[^D24]
	PUSH P,[^D80]
	JRST SCOPE1


.VTS:	PUSH P,[^D43]
	PUSH P,[^D72]
	JRST SCOPE1

SCRC <
;SPEED (OF TERMINAL IS) N

.SPEED::
	NOISE (of terminal is)
	KEYWD $SPEED
	 0
	 JRST CERR##
	CONFIRM
	MOVEI A,-1
	MOVEI B,26		;SET TERMINAL SPEED
	MOVEI C,(KWV)
	MTOPR
	RET

$SPEED:	TABLE
	TE 110,,NOLOG,^D110
	TE 1200,,NOLOG,^D1200
	TE 150,,NOLOG,^D150
	TE 2400,,NOLOG,^D2400
	TE 300,,NOLOG,^D300
	TE 4800,,NOLOG,^D4800
	TE 9600,,NOLOG,^D9600
	TEND
>

;NETLOAD

;PRINTS THE 5 MIN. LOAD AVERAGES FROM
; ALL COOPERATING TENEX SITES.  THIS INFORMATION IS KEPT IN
; THE FILE <SYSTEM>RSYSTAT.;1   PAGE 0.

;WORD-0 OF THE PAGE RSSER VERSION # OR -1 IF BEING UPDATED
;WORD-1 IS N,,PTR  WHERE  N  IS THE LENGTH OF THE BLOCK ASSOCIATED
; WITH EACH SITE, AND PTR IS THE RELATIVE ADDRESS OF THE FIRST
; SITE BLOCK.
;WORD-5 IS GTAD FORMAT TIME OF LAST UPDATE
;WORD-10 (IF PTR .GE. 10) HAS SIZE,,OFFSET OF SITE INFO

;EACH SITE BLOCK HAS THE FOLLOWING THINGS OF INTEREST IN IT
; (OFFSET IS 6 FOR OLD FORMAT (N .LE. 10):

;WORD-0:	SITE NUMBER
;WORD-4:	-1 IF DATA IS GOOD FOR THIS SITE
;WORD-(0 + OFFSET):	AMOUNT OF USER CORE (IF N .GT. 10)
;WORD-(1 + OFFSET):	1 MIN. LOAD AV.
;WORD-(2 + OFFSET):	5 MIN. LOAD AV.
;WORD-(3 + OFFSET):	15 MIN. LOAD AV.
;WORD-(4 + OFFSET):	NUMBER OF USERS
;WORD-(5 + OFFSET):	NUMBER OF DISK PAGES IN USE
;WORD-(6 + OFFSET):	NUMBER OF FREE DISK PAGES


.NETLOAD:
	HRROI 2,[ASCIZ /<SYSTEM>RSYSTAT.;1/]
	CALL TRYGTJ		;ASSIGN AND STACK JFN
NETLO0:	 ERROR <Network load statistics not available>
	MOVE 2,[44B5+1B19+1B25]	;READ, THAWED
	OPENF
	 JRST NETLO0		;GO TYPE ERROR
	HRLZS 1			;FROM FILE PAGE 0
	MOVE 2,[.FHSLF,,<NSBUF/1000>]	;TO ADDRESS SPACE
	MOVSI 3,(1B2!1B9)	;READ, COPY ON WRITE
	PMAP
	MOVES NSBUF		;MAKE PAGE PRIVATE (STROBE DATA)
	SKIPGE NSBUF+0		;CHECK VERSION NUMBER
	 UERR [ASCIZ / Data base being updated/]

; INSPECT TIME OF LAST UPDATE TO SEE IF DATA IS VALID

NETLO2:	GTAD			;NOW
	SUB 1,NSBUF+5		;MINUS LAST UPDATE
	TRNE 1,1B18		;SECONDS WRAPPED AROUND?
	ADD 1,[-1,,^D<24*60*60>];YES, BORROW A DAY
	SKIPE NSBUF+1		;PARANOIA
	CAIL 1,^D<5*60>		;UPDATED WITHIN LAST 5 MINUTES?
	 UERR [ASCIZ / Server dead/]
NETLO4:	HRRZ 1,NSBUF+1		;CHECK PTR
	CAILE 1,10		;TEST FOR NEW FORMAT
	TLOA Z,F1		;YES, REMEMBER THAT
	TLZ Z,F1		;NO

NETL41:	TLNE Z,F1
	 JRST NETL43
NETL42:	TYPE <  Site		 Load  Users
>
	JRST NETL44
NETL43:	TYPE <  Site		 Load  Users  Disk Av.
>

NETL44:	HRRZ D,NSBUF+1		;PTR TO FIRST SITE BLOCK
	MOVEI E,6		;OFFSET FOR OLD FILES
	TLNE Z,F1		;NEW FORMAT?
	HRRZ E,NSBUF+10		;YES, USE IT
	ADDI E,0(D)		;D AND E DIFFER BY OFFSET

NETLO5:	MOVE 1,COJFN
	SKIPN NSBUF(D)		;END OF ALL SITES?
	 JRST NETLOX		;YES, DONE.
	MOVE 3,NSBUF+4(D)
	CAME 3,MINUS1		;DO WE HAVE GOOD DATA FOR THIS ONE?
	 JRST NETLO9		;NO SKIP IT
	MOVEI 2," "
	BOUT
	MOVE 2,NSBUF+0(D)	;GET BACK SITE NUMBER
	MOVEI 3,^D10
	CVHST			;PRINT HOST NAME, OR ...
	 NOUT			;NUMBER IF THAT FAILS
	  JFCL

;BE APPROPRIATELY SUSPICIOUS OF THE FILE FORMAT
NETL55:	PRINT TAB
	RFPOS
	MOVEI 2,0(2)
	CAIG 2,^D10		;WAS FIRST TAB ENOUGH?
	PRINT TAB		;NO
	SKIPGE 2,NSBUF+2(E)	;THAT SITE'S 5 MIN. LOAD AV
	JRST NETL57		;MUST BE POSITIVE
	MOVE 3,2
	TLZN 3,(1B1)
	JRST NETL56		;LOAD LESS THAN 0.5 -- OK
	TLNN 3,370000		;EXPONENT TOO BIG?
	TLNN 3,400		;NOT NORMALIZED FLOATING NUMBER?
	 JRST NETL57		;YES.
NETL56:	MOVE 3,[1B4+1B6+2B23+2B29] ;FORCE, WITH ".", 2 BEFORE AND AFTER
	FLOUT
NETL57:	 TYPE <  ?  >
	TYPE <  >
	MOVE 3,[1B2+3B17+12]	;RIGHT JUST, 3 COLS, DECIMAL
	SKIPL 2,NSBUF+4(E)	;NUMBER OF USERS ON THAT SYSTEM
	NOUT
	 TYPE <  ?>


NETLO6:	TLNN Z,F1
	 JRST NETL69		;OLD FORMAT
	MOVE 2,NSBUF+6(E)	;DISK SPACE AVAILABLE
	MOVE 3,[1B2!11B17!^D10]	;RIGHT JUSTIFIED, 9 COLS, DECIMAL
	NOUT
	 CALL JERRC##
NETL69:	PRINT EOL


NETLO9:	HLRZ 1,NSBUF+1		;SITE BLOCK LENGTH
	ADDI D,0(1)		;BUMP TO NEXT BLOCK
	ADDI E,0(1)
	JRST NETLO5		;AND DO IT

NETLOX:	SETOM 1
	MOVE 2,[.FHSLF,,<NSBUF/1000>]
	PMAP			;FLUSH PAGE
	PRINT EOL
	JRST RLJFNS##		;GO RELEASE THE JFN

