Google
 

Trailing-Edge - PDP-10 Archives - AP-D348E-SM - sources/execin.mac
There are 47 other files named execin.mac in the archive. Click here to see a list.
;<3-EXEC-SNARK>EXECIN.MAC.50, 20-Apr-78 11:22:28, Edit by FORTMILLER
;<3-EXEC>EXECIN.MAC.49, 10-Nov-77 09:32:42, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-EXEC>EXECIN.MAC.48,  2-Nov-77 02:29:53, Edit by LCAMPBELL
;FIX ADDRESS BREAK
;<3-EXEC>EXECIN.MAC.47, 28-Sep-77 16:18:05, EDIT BY HURLEY
;<3-EXEC>EXECIN.MAC.46, 10-Sep-77 16:37:19, Edit by LCAMPBELL
;<3-EXEC>EXECIN.MAC.45, 21-Aug-77 15:17:33, Edit by LCAMPBELL
;<3-EXEC>EXECIN.MAC.44, 21-Aug-77 15:12:08, Edit by LCAMPBELL
;<3-EXEC>EXECIN.MAC.43, 21-Aug-77 15:10:36, Edit by LCAMPBELL
;MAKE "INFO ADDRESS-BREAK" SAY RIGHT THINGS
;<3-EXEC>EXECIN.MAC.42, 16-Aug-77 11:13:56, EDIT BY OSMAN
;MOVE "GFRKS" TO SUBROUTINE SO "FORK" COMMAND CAN DO IT TOO
;<3-EXEC>EXECIN.MAC.41, 10-Aug-77 16:54:19, EDIT BY HURLEY
;<3-EXEC>EXECIN.MAC.40, 10-Aug-77 16:51:58, EDIT BY HURLEY
;<3-EXEC>EXECIN.MAC.39, 10-Aug-77 13:11:56, Edit by LCAMPBELL
;<3-EXEC>EXECIN.MAC.38, 10-Aug-77 12:34:43, EDIT BY HURLEY
;<3-EXEC>EXECIN.MAC.37,  9-Aug-77 16:20:32, EDIT BY HURLEY
;CLEAN UP FOR RELEASE 3 DOCUMENTATION
;<3-EXEC>EXECIN.MAC.36,  8-Aug-77 20:05:50, Edit by LCAMPBELL
;<3-EXEC>EXECIN.MAC.35,  3-Aug-77 13:43:00, Edit by LCAMPBELL
;Make text messages for INFO ADDR be in proper case
;<3-EXEC>EXECIN.MAC.34,  3-Aug-77 13:23:50, Edit by LCAMPBELL
;<3-EXEC>EXECIN.MAC.33,  3-Aug-77 13:16:18, Edit by LCAMPBELL
;ADD INFORMATION (ABOUT) ADDRESS-BREAK
;<3-EXEC>EXECIN.MAC.32,  3-Aug-77 12:27:07, EDIT BY OSMAN
;MAKE "INFO SYS" TELL WHETHER ACCOUNT VALIDATION IS IN EFFECT
;<3-EXEC-NSW>EXECIN.MAC.1, 28-Jul-77 21:50:07, EDIT BY CLEMENTS.CALVIN
; Added "JSYS/UUO trap" for fork status 6
;<3-EXEC>EXECIN.MAC.31, 26-Jul-77 23:11:14, EDIT BY CROSSLAND
;ADD % TO NO INFO AVAILABLE RESPONSE TO I NETWORK COMMAND
;<3-EXEC>EXECIN.MAC.30, 21-Jul-77 20:32:00, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.29, 21-Jul-77 17:01:56, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.28, 21-Jul-77 15:48:30, EDIT BY OSMAN
;FIX "INFO STR *", IN WHICH COMND SAW "*" INSTEAD OF STRUCTURE NAME,
;BUT SINCE "*" IS A BREAK CHARACTER, THE STRUCTURE NAME INPUT WAS THE
;NULL STRING, SO COMND SUPPLIED THE DEFAULT WHICH THE EXEC HAD SET UP
;AS THE CONNECTED STRUCTURE.  FIX IS TO CHECK FOR "*" BEFORE CHECKING
;FOR STRUCTURE NAME
;<3-EXEC>EXECIN.MAC.27,  4-Jul-77 21:16:30, EDIT BY CROSSLAND
;<3-EXEC>EXECIN.MAC.26, 30-Jun-77 20:54:29, EDIT BY CROSSLAND
;<3-EXEC>EXECIN.MAC.25, 17-Jun-77 05:22:58, EDIT BY CROSSLAND
;<3-EXEC>EXECIN.MAC.24, 16-Jun-77 20:55:02, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.23, 13-Jun-77 02:28:09, EDIT BY CROSSLAND
;ADD INFO ABOUT MAIL AND NETWORK COMMANDS
;<3-EXEC>EXECIN.MAC.22,  3-Jun-77 15:45:31, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.21,  2-Jun-77 13:45:54, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.20,  1-Jun-77 12:13:13, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.19, 25-May-77 14:49:21, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.18, 25-May-77 14:37:18, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.17, 19-May-77 10:32:03, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.16, 13-May-77 10:49:14, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.15, 12-May-77 16:40:13, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.14, 12-May-77 16:19:17, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.13, 12-May-77 16:13:09, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.12, 12-May-77 15:14:43, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.11, 12-May-77 14:51:14, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.10, 12-May-77 14:43:44, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.9, 12-May-77 13:33:56, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.8,  4-May-77 15:15:13, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.7, 26-Apr-77 17:00:10, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.6, 10-Apr-77 17:46:18, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.5, 10-Apr-77 17:10:03, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.4, 10-Apr-77 17:05:57, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.3, 10-Apr-77 17:02:49, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.2, 10-Apr-77 16:57:45, EDIT BY OSMAN
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE


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

	SEARCH MONSYM,XDEF,COMSYM,MACSYM
	.REQUIRE SYS:MACREL
	TTITLE EXECIN

;THIS FILE CONTAINS
;INFORMATION COMMANDS
;EXCEPT INFORMATION (ABOUT) BATCH-REQUESTS AND
;INFORMATION (ABOUT) OUTPUT-REQUESTS, WHICH ARE IN EXECQU.MAC

.AVAIL::KEYWD $AVAIL
	 T DEVICES,	;[TAH] CHANGE DEFAULT TO DEVICES
	 JRST CERR
				;CAN'T CONFIRM HERE BECAUSE OF FUDGE-ENTRIES IN TABLE
	JRST (P3)

$AVAIL:	TABLE

T DEVICES,
T LINES,,..TERM
TA T		;"T" = "TERMINALS"
TA T	;"T" IS "TERMINALS"
T TELETYPES,,..TERM,CM%INV
.T:
.TE:
T TERMINALS,,..TERM,CM%INV
T TTYS,,..TERM,CM%INV

	TEND

;AVAILABLE TERMINALS

..TERM::CONFIRM
	HLLZ D,TTYJOB		;SETUP NUMBER OF TERMINAL LINES
TERMI1:	HRRZI A,.TTDES(D)	;TERMINAL DESIGNATOR
	DVCHR			;GET ITS STATUS
	TXNN B,DV%AV		;IS IT AVAILABLE
	JRST TERMI9		;NO - TRY NEXT
	CALL BEFORE		;TYPE COMMA OR MAYBE EOL
	HRRZ B,D
	CALL TOCT		;TYPE LINE NUMBER

;SEE IF SEVERAL CONSECUTIVE LINES TO BE GROUPED, E.G. 21-26

	PUSH P,D		;SAVE ONE JUST TYPED
	AOBJN D,TERMI7		;PEEK AT NEXT ONE
	POP P,D			;NO MORE, WRAP UP
	JRST TERMI9

TERMI7:	HRRZI A,.TTDES(D)	;FORM TERM DESIGNATOR
	DVCHR			;GET CHARACTERISTICS
	TXNE B,DV%AV		;AVAILABLE?
	AOBJN D,TERMI7		;YES, KEEP LOOKING
	POP P,C			;FOUND NOT AVAIL OR AND OF LIST
	SUB D,[1,,1]		;GET BACK TO LAST AVAIL ONE FOUND
	CAMN D,C		;SAME AS LAST ONE PRINTED?
	JRST TERMI9		;YES, NO GROUPING TO BE DONE
	PRINT "-"		;FIRST OF GROUP HAS BEEN PRINTED, NOW
	HRRZ B,D		; PRINT DASH AND LAST OF GROUP
	CALL TOCT
TERMI9:	AOBJN D,TERMI1
	TLNN Z,F1
	TYPE < All lines in use>
EOLRET::ETYPE<%_>		;COME HERE TO TYPE CRLF AND POPJ.
	RET
;AVAILABLE DEVICES
;DOES NOT LIST TTYS
;ALSO LISTS SEPERATELY DEVICES ALREADY ASSIGNED TO THIS JOB.

.DEVIC::CONFIRM
	TLZ Z,F1+F2		;SAY NOTHING TYPED YET
	MOVEI P3,-3		;SAY NO PREVIOUS GROUP ITEM
	MOVEI Q1,0		;LAST DEVICE NAME PRINTED

;"DEVLUP" EXECUTES CALLER+1 FOR EACH DEVICE, WITH NAME IN A,
;DVCHR WORD IN B.

	CALL DEVLUP
	 CALL DEVIC1		;DO THIS FOR EACH DEVICE
	TLZE Z,F2		;GROUP STARTED?
	CALL AVD1		;YES, FINISH IT
	TLNN Z,F1
	TYPE <No devices currently available to this job>
	ETYPE<%_>
	JRST ASTTJ		;LIST DEVS ASSIGNED TO THIS JOB. WITH FILSTAT.

DEVIC1:	TXNN B,DV%AV		;SKIP IF DEVICE AVAILABLE TO THIS JOB
	RET
	LDB C,[POINT 9,B,17]	;GET DEVICE TYPE
	CAIN C,.DVTTY		;SKIP TTYS
	RET
	AND B,[DV%TYP!777777]	;MASK TO JUST DEVICE TYPE AND UNIT #
	CAIN C,.DVDSK		;A MOUNTABLE STRUCTURE (DISK)?
	JRST DEVIC9		;YES, ALWAYS SEPERATE
	LDB C,[360600,,A]	;GET FIRST LETTER OF DEVICE
	LDB D,[360600,,Q1]	;GET FIRST LETTER OF LAST DEVICE
	CAME C,D		;SAME?
	JRST DEVIC9		;NO, CAN'T POSSIBLY BE IN SEQUENCE
				;WHY ALL THE BRUHAHA, YOU MUST ASK!
				;WELL AT THIS TIME (10/26/76), PLPT0:
				;AND LPT0: ETC. YIELD EXACT SAME
				;DEVICE DESIGNATOR
	MOVE C,P3		;SEE IF DEVICE IS NEXT IN SEQUENCE
	HRRI C,1(C)		;18BIT ADD
	CAMN B,C		;NEXT UNIT OF SAME DEVICE?
	JRST [	TLO Z,F2	;YES, NOTE GROUP BEING PROCESSED
		MOVEM B,P3	;UPDATE UNIT NUMBER
		MOVEM A,Q1	;REMEMBER NEW LAST NAME
		RET]
DEVIC9:	TLZE Z,F2		;NOT IN SEQUENCE, PREVIOUS SEQUENCE?
	CALL AVD1		;YES, FINISH IT
	MOVEM B,P3		;REMEMBER LAST DEVICE PRINTED
	MOVEM A,Q1		;REMEMBER NAME PRINTED
	TLNN Z,F1		;FIRST ONE?
	TYPE <Devices available to this job:
>
	CALL BEFORE		;DO SEPARATING CHARACTER
	CALLRET SIXPRT		;PRINT NAME AND RETURN

AVD1:	PUSH P,B
	MOVEI B,"-"		;FINISH UP GROUP
	CALL CCHRO
	HRRZ B,P3		;GET LAST UNIT NUMBER
	CALL TOCT		;PRINT IT
	POP P,B
	RET

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

BEFORE::ATSAVE
	MOVE A,COJFN
	movei b,.morlw
	MOVEI C,^D72		;USE 72 COLUMNS IF NOT A TERMINAL
	mtopr			;get line width
	 ERJMP .+1		;IF NOT, USE 72(PRESUMABLY NOT A TERMINAL)
	RFPOS
	MOVEI B,(B)		;MASK COLUMN POSITION
	CAIL B,-7(C)		;WITHIN 7 CHARS OF END OF LINE?
	JRST [	ETYPE<%_>	;YES, START NEW LINE
		JRST BEFO1]
	TLOE Z,F1		;SUPPRESS COMMA BEFORE FIRST ONE
	PRINT ","
BEFO1:	PRINT " "		;SPACE AFTER COMMA OR EOL
	RET
;SUBROUTINE TO LOOP OVER ALL DEVICES FOR "AVAIL DEVICES" AND "FILSTAT".
;FOR EACH DEVICE, EXECUTES LOCATION AFTER CALL WITH SIXBIT NAME IN A
;    DEVICE CHARACTERISTICS WORD IN LH B
;    UNIT NUMBER IN RH OF B
;    -1 OR JOB # ASSIGNED TO IN C.
;RETURNS +2.
;DESTROYS A, B, C, D.

DEVLUP::SETO D,
	GTB DEVNAM		;GET # DEVICES FROM TABLE 6
	HRLZ D,A		;XWD AOBJN COUNT, TABLE INDEX
DEVL1:	CALL .DVCHR		;GET DEVICE CHARACTERISTICS
	 JRST DEVL2		;SKIP THIS ONE IF UNKNOWN DEVICE
	HRR B,C			;GET UNIT NUMBER
	HLRE C,C
	GTB DEVNAM		;GET DEVICE NAME IN SIXBIT FROM TABLE 6
	JUMPE A,DEVL2		;SKIP NULL ENTRIES
	PUSH P,D
	XCT @-1(P)
	POP P,D
DEVL2:	AOBJN D,DEVL1
	RETSKP

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

SIXPRT::ATSAVE
	MOVE C,A
SIXPR1:	SETZ B,
	LSHC B,6
	ADDI B,40
	CALL CCHRO
	JUMPN C,SIXPR1
	RET

;THIS ROUTINE TAKES DEVICE INDEX IN D AND DOES DVCHR, RETURNING
;DVCHR'S INFO IN A,B,C.  NOTHING ELSE IS CHANGED.
;RETURNS:
;	+1:	NO SUCH DEVICE
;	+2:	SUCCESS

.DVCHR:	PUSH P,P1		;WE'LL NEED THESE, BUT DON'T HURT THEM
	PUSH P,P2
	GTB DEVNAM		;GET SIXBIT NAME INTO A
	MOVE B,[440600,,A]	;PREPARE TO READ THE SIXBIT NAME FROM A
DV1:	TLNN B,770000		;ARE WE DONE?
	JRST DV2		;YES, GO LEFT-JUSTIFY
	ILDB C,B		;GET SIXBIT CHARACTER FROM NAME
	CAIE C,0		;LEAVE 0'S AS 0'S!
	ADDI C,"A"-'A'		;CHANGE TO ASCII
	LSHC P1,7		;MAKE ROOM FOR THE CHARACTER
	IOR P2,C		;PUT IN THE CHARACTER
	JRST DV1		;GO DO NEXT CHARACTER
DV2:	LSHC P1,2*^D36-6*7-1	;LEFT JUSTIFY
	LSH P1,1		;^D36=1(MOD 5*7)
	HRROI A,P1		;POINT TO THE ASCII NAME OF THE DEVICE
	STDEV			;GET A DEVICE DESIGNATOR FOR THIS DEVICE
	 ERJMP DEVOUT		;JUST RETURN IF CAN'T
	MOVE A,B		;PUT DESIGNATOR IN A
	DVCHR			;GET CHARACTERISTICS
	AOS -2(P)		;WE WANT TO SKIP RETURN
DEVOUT:	POP P,P2
	POP P,P1
	RET
;help *, help <cr>, help foo

.help::	noise (ON SUBJECT)
	call maklst		;make list of things there's help on
	movei b,[flddb. .cmkey,,$HELP,,,[
		 flddb. .cmtok,,<-1,,[asciz /*/]>,,,[
		 flddb. .cmcfm,,,,,]]]
	call field		;get some input
	txne a,cm%nop		;make sure good input got typed
	error <Invalid HELP request, try "HELP<RET>">
	LDB C,[331100,,.CMFNP(C)]	;SEE WHAT GOT TYPED
	CAIN C,.CMCFM		;CR?
	JRST BLURB		;YES, GO TYPE GENERAL HELP BLURB
	CONFIRM			;GET COMMAND CONFIRMATION
	CAIN C,.CMTOK		;*?
	JRST TYPLST		;YES, TYPE OUT THE LIST

	PUSH P,B		;SAVE POINTER TO ITEM HELP DESIRED ABOUT
	MOVE A,CSBUFP		;PREPARE TO CREATE FILENAME STRING
	HRROI B,[ASCIZ /HLP:/]
	MOVEI C,0		;WE WANT NULL AFTER FILENAME
	SOUT			;PUT IN DEVICE NAME
	POP P,B			;GET POINTER TO FILENAME STRING
	HLRO B,(B)		;MAKE BYTE POINTER
	SOUT			;PUT IN FILENAME
	HRROI B,[ASCIZ /.HLP/]	;NOW WE'LL HAVE HLP:MUMBLE.HLP
	SOUT
	MOVE B,CSBUFP		;POINTER TO FILENAME
HLP3:	MOVX A,GJ%OLD+GJ%SHT	;OLD FILE ONLY, SHORT FORM
	GTJFN			;GET HANDLE ON HELP FILE
	 ERROR <No help available on that subject>
	MOVEI Q1,1		;SO "TYPE" LOGIC WILL KNOW IT'S US
	CALL JFNSTK		;REMEMBER THE JFN
	MOVE A,JBUFP		;GET POINTER TO JFN CELL
	HRRZM A,INIFH1
	HRRZM A,INIFH2		;COPY CODE NEEDS THIS
	JRST TYPE1		;FINISH COMMAND BY COPYING HELP FILE TO TERMINAL

;HELP<CR> JUST TYPES OUT "HLP:HELP.HLP"

BLURB:	HRROI B,[ASCIZ /HLP:HELP.HLP/]
	JRST HLP3		;GO TYPE OUT CONTENTS OF FILE

;HELP * LISTS ALL SUBJECTS FOR WHICH HELP IS AVAILABLE

TYPLST:	HLRZ Q1,$HELP		;GET NUMBER OF ENTRIES FOR WHICH THERE'S HELP
	JUMPE Q1,NOHELP		;SPECIAL CASE IF NONE
	TYPE <Help is available on these subjects:
>
	MOVEI Q2,0		;KEEPS TRACK OF HOW MANY ITEMS WE'VE PRINTED ON THIS LINE
	MOVN Q1,Q1
	HRLZ Q1,Q1		;MAKE AOBJN POINTER
LST1:	TRNN Q2,7		;ENOUGH ITEMS BEEN PRINTED YET?
	ETYPE<%_>		;YES, START NEW LINE
	HLRO A, $HELP+1(Q1)	;GET ASCII POINTER TO ENTRY
	ETYPE <%1M	>	;TYPE ENTRY WITH TAB AFTER IT
	AOJ Q2,			;COUNT ITEMS ON LINE
	AOBJN Q1,LST1		;LOOP FOR REST OF ITEMS
	ETYPE<%_>		;FINISH WITH CARRIAGE RETURN
	JRST ENDHLP		;DONE

NOHELP:	TYPE <No help available
>
	JRST ENDHLP

;DONE DOING HELP COMMAND, CLEAN UP AND RETURN

ENDHLP:	CALL RLJFNS		;RELEASE JFNS USED
	CALL UNMAP		;UNMAP PAGES USED
	RET			;RETURN

;SPECIAL BUFFER ASSIGNMENTS FOR HELP COMMAND

$HELP==BUF0			;TABLE OF HELP CATEGORIES
HLPLEN==BUF1-BUF0-1			;MAXIMUM NUMBER OF SUBJECTS AVAILABLE

;ROUTINE TO MAKE LIST OF SUBJECTS THERE'S HELP ON.  THE LIST IS
;GENERATED BY THE FILENAMES OF ALL THE .HLP FILES ON THE HLP:
;DEVICE.

MAKLST:	MOVEI A,HLPLEN		;MAXIMUM LENGTH OF TABLE
	MOVEM A,$HELP		;INITIALIZE TABLE OF ITEMS THERE'S HELP ON
	HRROI Q1,BUF1		;INITIALIZE POINTER TO NAME STORAGE AREA
	HRROI B,[ASCIZ /hlp:*.HLP/]	;HANDLE ON HELP FILES
	call hlplst		;accumulate help file names in table
	RET

;routine to accumulate help file names in table

hlplst:	stkvar <hlpjfn>		;holds jfn of help files
	MOVX A,GJ%OLD+GJ%IFG+GJ%SHT	;OLD FILE ONLY, ALLOW STARS, SHORT FORM
	GTJFN			;GET HANDLE ON FIRST HELP FILE
	 ERJMP r		;no help files
	movem a,hlpjfn		;remember the jfn
	CALL JFNSTK		;REMEMBER JFN SO IT GOES AWAY LATER
HLP2:	MOVE A,Q1		;POINTER TO AREA IN WHICH TO STORE NAME
	HRRZ B,HLPJFN		;GET JFN OF HELP FILE
	MOVX C,1B8		;WE WANT JUST THE FILENAME
	JFNS			;GET FILENAME (ENTRY FOR TABLE)
	MOVEI A,BUF0		;TELL SYSTEM WHERE TABLE BEGINS
	HRLZ B,Q1		;GET ENTRY FOR TABLE (POINTS TO FILENAME)
	TBADD			;PUT NEW ENTRY IN TABLE
	ADDI Q1,8+8		;POINT TO NEXT FILENAME ENTRY
	move a,hlpjfn		;get jfn again
	gnjfn			;step to next help file
	 erjmp r		;no more in this set
	jrst hlp2		;got another, go process it
;INFO (ON)

.INFOR::NOISE <ABOUT>
	KEYWD $INFO
	 0
	 JRST CERR
	TLNN P3,NOLOG		;NEED TO BE LOGGED IN?
	SKIPE CUSRNO		;YES, ARE WE?
	CAIA			;OK
	ERROR <LOGIN please>
	TLNE P3,ONEWD		;THESE NEED CONFIRMING
	CONFIRM
	JRST (P3)

$INFO:	TABLE
T ADDRESS-BREAK,ONEWD,.ADBRK
T AVAILABLE,NOLOG
T BATCH-REQUESTS,,.IBR
;T CARD-READER-INPUT-SET,ONEWD,CRDINF
T COMMAND-LEVEL,NOLOG+ONEWD,.EXECM
T DIRECTORY		;PRINT DIRECTORY PARAMETERS
T DISK-USAGE,,.DSKST
T FILE-STATUS,,.FILST
T JOB-STATUS,ONEWD,.JOBST
T LOGICAL-NAMES,,.LNLIS
T MAIL,NOLOG,.MALST
T MEMORY-USAGE,ONEWD,.MEMST
T MONITOR-STATISTICS,ONEWD,MONSTA
T NETWORK-STATUS,NOLOG+ONEWD,.NTSTS
T OUTPUT-REQUESTS,,.IPR
T PROGRAM-STATUS,ONEWD,.RUNST
T PSI-STATUS,ONEWD,.PISTA
T SPOOLED-OUTPUT-ACTION,ONEWD,SPLINF
T STRUCTURE,,.STRST
T SUBSYSTEM-STATISTICS,ONEWD,SUBSTA
T SYSTEM-STATUS,ONEWD,SYSINF
T TAPE-PARAMETERS,ONEWD,TAPINF
T TERMINAL-MODE,NOLOG+ONEWD,TRMPNT
T VERSION,NOLOG+ONEWD
TEND
;INFORMATION (ABOUT) ADDRESS-BREAK

ALLFLG==AB%RED!AB%WRT!AB%XCT	;ALL ADDR BREAK BITS

.ADBRK:	SKIPG A,FORK		;GET FORK HANDLE
	JRST [	TYPE < No program>
		RET]
	HRLI A,.ABRED		;FUNCTION TO READ ADDRESS BREAK INFO
	ADBRK			;GET IT
	SKIPE C			;ANYTHING THERE?
	TXNN C,ALLFLG		;ANY BITS SET?
	JRST [	TYPE <Address break not set.>
		RET]		;NO
	ETYPE <Address break at %2P on>
	TXC C,ALLFLG		;FIRST CHECK FOR COMMON CASE OF
	TXCN C,ALLFLG		;ALL BITS BEING SET
	JRST [	TYPE < all types of references.>
		RET]		;THAT WAS EASY!
	TXNE C,AB%RED		;READ
	TYPE < read>
	TXNE C,AB%WRT		;WRITE
	TYPE < write>
	TXNE C,AB%XCT		;EXECUTE
	TYPE < execute>
	TYPE <.>
	RET			;AND RETURN
;INFORMATION (ABOUT) DIRECTORY (NAME)
;SAME AS ^EPRINT

.DIREC:	JRST EPRINT		;USE SAME CODE

;GET HERE ON "INFORMATION (ABOUT) COMMAND-LEVEL"
.EXECM:
	TYPE < SET >
	SKIPN CIDLYF
	TYPE <NO >
	TYPE <LATE-CLEAR-TYPEAHEAD
>
	RET
;"INFORMATION (ABOUT) SYSTEM-STATUS"
SYSINF:	MOVEI A,.SFOPR
	TMON
	TYPE < Operator is >
	SKIPN B
	TYPE <not >
	TYPE <in attendance
>
	MOVEI A,.SFRMT
	TMON
	TYPE < Remote logins >
	SKIPN B
	TYPE <Are not >
	TYPE <allowed
>
	MOVEI A,.SFLCL
	TMON
	TYPE < Local logins >
	SKIPN B
	TYPE <are not >
	TYPE <allowed
>
	MOVEI A,.SFPTY
	TMON
	TYPE < Pseudo-terminal logins >
	SKIPN B
	TYPE <are not >
	TYPE <allowed
>
	MOVEI A,.SFNVT
	TMON
	TYPE < ARPANET terminal logins >
	SKIPN B
	TYPE <are not >
	TYPE <allowed
>
	MOVEI A,.SFCTY
	TMON
	TYPE < Console terminal login >
	SKIPN B
	TYPE <is not >
	TYPE <allowed
>
	MOVEI A,.SFFAC
	TMON
	TYPE < Accounting is >
	SKIPN B
	TYPE <not >
	TYPE <being done
>
	MOVEI A,.SFCDE
	TMON
	SKIPE B
	TYPE < CHECKD found errors
>
	MOVEI A,.SFCDR
	SKIPE B
	TYPE < CHECKD is running
>
	MOVEI A,.SFAVR		;SEE IF ACCOUNT VALIDATION IN EFFECT
	TMON
	TYPE < Account validation is >
	SKIPE B
	TYPE <enabled
>
	SKIPN B
	TYPE <disabled
>
	MOVE A,COJFN		;CURRENT OUTPUT JFN
	MOVEM A,OUTDSG		;FOR SPECIAL ROUTINE
	CALLRET SYSDWN		;PRINT INFO AND EXIT
TAPINF:	MOVNI A,1
	MOVE B,[-1,,C]
	MOVEI C,.JIDEN
	GETJI
	 CALL JERR
	SETZ B,
	CAMN C,[.SJDN2]
	MOVEI B,[ASCIZ /200/]
	CAMN C,[.SJDN5]
	MOVEI B,[ASCIZ /556/]
	CAMN C,[.SJDN8]
	MOVEI B,[ASCIZ /800/]
	CAMN C,[.SJD16]
	MOVEI B,[ASCIZ /1600/]
	CAMN C,[.SJD62]		;IS IT 6250 BPI?
	MOVEI B,[ASCIZ /6250/]	;YES, 6250
	JUMPE B,[ETYPE < Unknown default tape density, value = %3O
>
		JRST ILLDEN]
	TYPE < SET TAPE DENSITY >
	UTYPE (B)
	TYPE <
>
ILLDEN:	MOVNI A,1
	MOVE B,[-1,,C]
	MOVEI C,.JIPAR
	GETJI
	 CALL JERR
	SETZ B,
	CAMN C,[.SJPRE]
	MOVEI B,[ASCIZ /EVEN/]
	CAMN C,[.SJPRO]
	MOVEI B,[ASCIZ /ODD/]
	JUMPE B,[ETYPE < Unknown default tape parity, value = %3O
>
		JRST ILLPAR]
	TYPE < SET TAPE PARITY >
	UTYPE (B)
	TYPE <
>
ILLPAR:	MOVNI A,1
	MOVE B,[-1,,C]
	MOVEI C,.JIDM
	GETJI
	 CALL JERR
	SETZ B,
	CAMN C,[.SJDMC]
	MOVEI B,[ASCIZ /CORE-DUMP/]
	CAMN C,[.SJDMA]
	MOVEI B,[ASCIZ /ANSI-ASCII/]
	CAMN C,[.SJDM8]
	MOVEI B,[ASCIZ /INDUSTRY-COMPATIBLE/]
	CAMN C,[.SJDM6]
	MOVEI B,[ASCIZ /SIXBIT/]
	CAMN C,[.SJDMH]		;IT IT HIGH DENSITY MODE?
	MOVEI B,[ASCIZ /HIGH-DENSITY/]
	JUMPE B,[ETYPE < Unknown default tape format, value = %3O
>
		JRST ILLFMT]
	TYPE < SET TAPE FORMAT >
	UTYPE (B)
	TYPE <
>
ILLFMT:	MOVNI A,1
	MOVE B,[-1,,C]
	MOVEI C,.JIRS
	GETJI
	 CALL JERR
	ETYPE < SET TAPE RECORD-LENGTH %3Q
>
	RET

SPLINF:	MOVNI A,1
	MOVE B,[-1,,C]
	MOVEI C,.JIDFS
	GETJI
	 CALL JERR
	SETZ B,
	CAMN C,[.SJSPD]
	MOVEI B,[ASCIZ /DEFERRED/]
	CAMN C,[.SJSPI]
	MOVEI B,[ASCIZ /IMMEDIATE/]
	JUMPE B,[ETYPE < Unknown spooled-output-action, value = %3O
>
		RET]
	TYPE < SET SPOOLED-OUTPUT-ACTION >
	UTYPE (B)
	TYPE <
>
	RET

;TYPE CURRENT TERMINAL MODES
TRMPNT:
;CHECK TERMINAL TYPE AND INTERPRET SOME CODES
	MOVEI A,.CTTRM
	GTTYP
	JUMPL B,ILTTYP
	CAIGE B,TTYPLN
	SKIPA A,B
ILTTYP:	MOVEI A,TTYPLN		;THIS INDEX DOES "ETYPE < TERMINAL TYPE %2Q>"
	XCT TTYPTB(B)
	ETYPE<%_>
;PRINT SPEED INFO
	MOVEI A,.CTTRM
	MOVEI B,.MORSP		;SPEED INFO
	MTOPR
	 ERJMP NOSPD
	CAME C,[-1]		;SPEEDS RECEIVED?
	JRST TISP1		;YES
	TYPE < !Terminal speed indeterminate!>
	JRST TISP2
TISP1:	HLRZ A,C		;INPUT SPEED
	HRRZS C
	ETYPE < TERMINAL SPEED %1Q>
	CAME A,C		;INPUT = OUTPUT
	ETYPE < %3Q>
TISP2:	ETYPE<%_>		;TERMINATE LINE
NOSPD:
	MOVEI A,.CTTRM
	RFMOD			;GET TERMINAL MODES
;CHECK LINKS BIT
	TXNE B,TT%ALK
	TYPE < RECEIVE LINKS
>
	TXNN B,TT%ALK
	TYPE < REFUSE LINKS
>
;CHECK ADVICE BIT
	TXNE B,TT%AAD
	TYPE < RECEIVE ADVICE
>
	TXNN B,TT%AAD
	TYPE < REFUSE ADVICE
>
	PUSH P,A
	PUSH P,B
	PUSH P,C
	MOVEI A,.CTTRM
	MOVEI B,.MORNT
	MTOPR
	CAIN C,0
	TYPE < RECEIVE SYSTEM-MESSAGES
>
	CAIE C,0
	TYPE < REFUSE SYSTEM-MESSAGES
>
	POP P,C
	POP P,B
	POP P,A
;CHECK PAGE MODE
	TYPE < TERMINAL >
	TXNN B,TT%PGM
	TYPE <NO >
	TYPE <PAGE
>
;PAGE LENGTH
	PUSH P,A
	PUSH P,B
	PUSH P,C
	MOVEI A,.CTTRM
	MOVEI B,.MORLL			;PREPARE TO READ LENGTH
	MTOPR				;DO IT
	ETYPE < TERMINAL LENGTH %3Q
>
;PAGE WIDTH
	MOVEI B,.MORLW			;READ WIDTH
	MTOPR
	ETYPE < TERMINAL WIDTH %3Q
>
	POP P,C
	POP P,B
	POP P,A

;CHECK LOWER CASE
	TYPE < TERMINAL >
	TXNN B,TT%LCA
	TYPE <NO >
	TYPE <LOWERCASE
>
;CHECK RAISE
	TYPE < TERMINAL >
	TXNN B,TT%LIC
	TYPE <NO >
	TYPE <RAISE
>
;CHECK OUTPUT FLAGING
	TYPE < TERMINAL >
	TXNN B,TT%UOC
	TYPE <NO >
	TYPE <FLAG
>
;CHECK INDICATE FORMFEED FLAG
	TYPE < TERMINAL >
	PUSH P,B
	MOVEI A,.CTTRM
	RFCOC
	LDB A,[POINT 2,B,25]
	POP P,B
	CAIE A,1
	TYPE <NO >
	TYPE <INDICATE
>
;CHECK MECHANICAL FORMFEED
	TYPE < TERMINAL >
	TXNN B,TT%MFF
	TYPE <NO >
	TYPE <FORMFEED
>
;CHECK MECHANICAL TAB
	TYPE < TERMINAL >
	TXNN B,TT%TAB
	TYPE <NO >
	TYPE <TABS
>
;ECHO MODE
	TYPE < TERMINAL >
	TXNN B,TT%ECM
	TYPE <NO >
	TYPE <IMMEDIATE
>
;CHECK DUPLEX CONTROL
BT.DUM==^L<TT%DUM&-TT%DUM>
SZ.DUM==BT.DUM-^L<TT%DUM>+1
	LDB A,[POINT SZ.DUM,B,BT.DUM]
	CAIN A,.TT0DX
	JRST [	TYPE < Duplexing in reserved state
>
		JRST DPLXDN]
	TYPE < TERMINAL >
	CAIN A,.TTFDX
	TYPE <FULLDUPLEX
>
	CAIN A,.TTHDX
	TYPE <HALFDUPLEX
>
	CAIN A,.TTLDX
	TYPE <LINE
>
DPLXDN:
;ALL DONE
	RET

TTYPTB:	TYPE < TERMINAL 33>	;0
	TYPE < TERMINAL 35>	;1
	TYPE < TERMINAL 37>	;2
	TYPE < TERMINAL TI>	;3
REPEAT 4,<XCT TTYNTY	>	;4-7
	TYPE < TERMINAL SYSTEM-DEFAULT> ;8
	XCT TTYNTY		;9
	TYPE < TERMINAL VT05>	;10
	TYPE < TERMINAL VT50>	;11
	TYPE < TERMINAL LA30>	;12
   NOSHIP,<
	TYPE < TERMINAL GT40>	;13
   >;NOSHIP
   SHIP,<
	XCT TTYNTY		;13 (NOT SUPPORTED)
   >;SHIP
	TYPE < TERMINAL LA36>	;14
	TYPE < TERMINAL VT52>	;15

TTYPLN==.-TTYPTB
TTYNTY:	ETYPE < TERMINAL TYPE %2Q>
;LIST LOGICAL NAMES

.LNLIS::TLZ Z,F2+F3		;EVERYTHING OFF SO WE CAN DEFAULT LATER
	NOISE <OF>
	KEYWD $LNLIS
	  T JOB,,.LNJB		;DEFAULT
	  JRST CERR		;ERROR
	CONFIRM
	JRST (P3)		;DISPATCH

.LNALL:	TLOA Z,F2!F3
.LNJB:	TLOA Z,F3
.LNSYS:	TLO Z,F2
	TLNN Z,F3		;JOB-WIDE?
	JRST .LNSY1
	TLNE Z,F2
	TYPE <Job-wide logical names:

>
	MOVE A,[.INLJB,,.LNSJB]
	CALL .LNTYL
	TLNE Z,F2
	TYPE <
System-wide logical names:

>
.LNSY1:	TLNN Z,F2
	RET
	MOVE A,[.INLSY,,.LNSSY]
;FALL INTO .LNTYL
.LNTYL:	HRRZM A,SYSJNM
	HLLZS A
.LNTY1:	MOVEM A,SYSDIR
	MOVE B,CSBUFP		;PUT IN UNUSED PORTION OF STRING BUFFER
	INLNM
	 JRST [	CAIE A,INLNX1
		 CALL JERR
		RET]		;ALL DONE
	IBP B
	MOVEM B,SYSTNM
	MOVE B,CSBUFP
	MOVE C,SYSTNM
	MOVE A,SYSJNM
	LNMST
	JRST [	CAIE A,LNSTX1
		 CALL JERR
		JRST .LNTY2]
	MOVE A,CSBUFP
	CALL CTYPE
	UTYPE [ASCIZ /: => /]
	MOVE A,SYSTNM
	CALL CTYPE
	ETYPE<%_>
.LNTY2:	MOVE A,SYSDIR
	AOJA A,.LNTY1

$LNLIS:	TABLE
	T ALL,,.LNALL
	T JOB,,.LNJB
	T SYSTEM,,.LNSYS

TEND
;INFORMATION (ABOUT) STRUCTURE <NAME>

GSUBLK==BUF0+<BUFL-BUF0+1>/2	;USE DEEP HALF OF AVAILABLE AREA
				;FOR JOB LIST.  THIS ALLOWS STARTING
				;USER LIST AT BEGINNING OF AREA WITHOUT
				;FEAR OF COLLISION, DESPITE FACT THAT
				;EACH USER ENTRY REQUIRES TWO WORDS
GSUALS==GSUBLK+.MSUAL		;ALIAS FOR GETTING USERS OF STRUCTURE
GSUFLG==GSUBLK+.MSUFL		;FLAGS,,LENGTH OF RESULTANT LIST
GSULST==GSUBLK+.MSUJ1		;BEGINNING OF JOB LIST
GSULEN==BUFL-GSUBLK+1		;TOTAL DATA BLOCK SIZE
GSUJLN==GSULEN-.MSUJ1+1	;MAXIMUM NUMBER OF USERS WE CAN LIST

.STRST::	STKVAR <DEFNAM>		;CELL TO HOLD POINTER TO DEFAULT NAME
	NOISE <NAME>
	CALL CONST		;GET DESIGNATOR OF CONNECTED STRUCTURE
	MOVE A,CSBUFP		;POINT TO SOME FREE SPACE
	MOVEM A,CMDEF		;SET UP POINTER TO DEFAULT VALUE FOR FIELD
	MOVEM A,DEFNAM		;REMEMBER POINTER TO DEFAULT
	DEVST			;CREATE DEFAULT VALUE
	 CALL JERR		;GETTING NAME OF CONNECTED STRUCTURE SHOULD NEVER FAIL
	IBP A			;LEAVE NULL AFTER NAME
	MOVEM A,CSBUFP		;REMEMBER NEW BEGINNING OF FREE SPACE AREA
	STARX <Name of structure or * for all>
	 CAIA			;"*" NOT TYPED
	JRST STRSTR		;"*" TYPED
	MOVE A,DEFNAM
	MOVEM A,CMDEF		;SET UP DEFAULT AGAIN
	DEVX <Name of structure or * for all>
	 CMERRX <"*" or mounted structure name required>
	CONFIRM			;WAIT FOR CONFIRMATION
	MOVEM B,ALIAS		;STORE DEVICE DESIGNATOR
	CALLRET STRST1		;DO THE WORK AND RETURN

;ROUTINE THAT DOES THE REAL WORK OF PRINTING STRUCTURE STATUS

STRST1:	MOVE A,ALIAS		;GET DEVICE DESIGNATOR
	MOVEM A,GSSALS		;STORE FOR GETTING STRUCTURE STATUS
	CALL MSGSS		;GET STRUCTURE STATUS
	 CALL CJERRE		;FAILED, GO SAY WHY AND QUIT THE COMMAND
	MOVE A,GSSMC		;GET MOUNT COUNT
	MOVE B,GSSOFC		;AND OPEN FILE COUNT
	MOVE C,GSSNUS		;NUMBER OF UNITS IN STRUCTURE
	MOVE D,ALIAS		;GET POINTER TO NAME
ETYPE <Status of structure %4H:
Mount count: %1Q, open file count: %2Q, units in structure: %3Q
>
	MOVE A,GSSSTA		;GET STATUS BITS
	TXNE A,MS%PPS		;SKIP IF NOT THE PRIMARY PUBLIC STRUCTURE
	TYPE <Public >
	TXNE A,MS%DOM		;SKIP IF NOT DOMESTIC
	TYPE <Domestic >
	TXNN A,MS%DOM		;SKIP IF DOMESTIC
	TYPE <Foreign >
	TXNN A,MS%INI		;SKIP IF NOT "BEING INITIALIZED"
	TXNE A,MS%DIS		;SKIP IF "BEING DISMOUNTED"
	TYPE <Unavailable for mounting >
	ETYPE<%_>
	LDF A,MS%GTM+MS%GTA+MS%GTC	;REQUEST CONNECTORS, ACCESSORS, AND MOUNTERS
	MOVEM A,GSUFLG
	MOVE A,GSSALS		;GET ALIAS
	MOVEM A,GSUALS		;STORE FOR GETTING STRUCTURE USERS
	DMOVE A,[EXP <GSULEN>B17+.MSGSU,GSUBLK]
	MSTR			;GET LIST OF USERS FOR THIS STRUCTURE
	 ERCAL CJERRE		;COULDN'T, SAY WHY AND DIE
	HRRZ A,GSUFLG		;GET LENGTH OF USER LIST
	JUMPN A,STRSTU		;NON-ZERO MEANS THERE'S A LIST TO PRINT
	TYPE <There are no jobs currently using this structure
>
	RET
STRSTU:	CAIL A,GSUJLN		;ARE WE SURE WE GOT THE WHOLE LIST?
	TYPE <%Couldn't get entire user list for structure
>
	push p,p1
	push p,p2
	push p,p3
	push p,p4		;get some ac's
	PUSH P,P5
	PUSH P,Q1
	movn p1,a		;get neg of number of jobs in list
	hrlz p1,p1		;make aobjn pointer
	movei p2,0		;length of user list
	movei c,.jiuno		;specify we want user number
str1:	HRRZ a,gsulst(p1)	;pick up a job number
	hrroi b,p3		;we'll read user number into p3
	getji			;get it's user number into p3
	 jrst strx1		;couldn't, check why
	move p4,p2		;get length of user list
str3:	sojl p4,str2		;jump if we've scanned the whole list
	SOJ P4,			;SECOND WORD IS INFO BITS
	CAME P3,BUF0(P4)	;FOUND IT IN LIST YET?
	jrst str3		;no, keep looking
	HLLZ A,GSULST(P1)	;FOUND IT, GET INFO BITS
	IORM A,BUF0+1(P4)	;PERHAPS MORE BITS ON FOR THIS JOB
str4:	aobjn p1,str1		;loop for rest of jobs
	move d,p2		;save final length of user list
	LDF P3,MS%GTM		;FIRST WE'LL LIST MOUNTERS
	MOVEI P4,[ASCIZ /Users who have SMOUNTed %2H: /]
	MOVEI P5,[ASCIZ /No users have %2H: SMOUNTed/]
	CALL REPORT		;PRINT THE MOUNTERS OF THE STRUCTURE
	LDF P3,MS%GTA		;LIST ACCESSERS
	MOVEI P4,[ASCIZ /Users ACCESSing %2H: /]
	MOVEI P5,[ASCIZ /No users are ACCESSing %2H:/]
	CALL REPORT
	LDF P3,MS%GTC		;NOW LIST CONNECTERS
	MOVEI P4,[ASCIZ /Users CONNECTed to %2H: /]
	MOVEI P5,[ASCIZ /No users CONNECTed to %2H:/]
	CALL REPORT
	POP P,Q1
	POP P,P5
	POP P,P4
	POP P,P3
	POP P,P2
	POP P,P1		;RESTORE THESE LITTLE DEVILS
	ret

;GET TO HERE ON "INFO STR *" OR "INFO STR *:"

STRSTR:	CONFIRM
	CALL DEVLUP		;LOOP THROUGH ALL DEVICES
	 CALL STRWRK		;DO THE WORK FOR EACH ONE
	RET			;DONE

STRWRK:	PUSH P,D		;DEVLUP ROUTINE NEEDS "D" AS INDEX
	CALL STRWK1
	POP P,D
	RET

STRWK1:	CAMN A,[SIXBIT /DSK/]	;IS IT STRUCTURE "DSK"?
	RET			;YES, FORGET IT, SINCE IT'LL COME UP AGAIN AS SPECIFIC STRUCTURE
	CALL .DVCHR		;GET INFO ON THIS DEVICE
	 RET			;SKIP THIS ONE IF UNKNOWN DEVICE
	MOVEM A,ALIAS		;STORE DESIGNATOR FOR STRUCTURE ALIAS
	LDB C,[221100,,B]	;GET DEVICE TYPE
	CAIE C,.DVDSK		;MAKE SURE IT'S A DISK
	RET
	CALL STRST1		;PRINT THE GOODS ON THIS STRUCTURE
	ETYPE<%_>
	RET

;ROUTINE TO LIST ELEMENTS FROM LIST STARTING IN BUF0.

REPORT:	MOVEI P1,0		;TELLS HOW MANY NAMES HAVE BEEN PRINTED ON THIS LINE
	SETOM Q1		;FLAG SAYING NO NAMES IN THIS LIST YET
	move a,cojfn		;get output jfn
	MOVEI B,.MORLW
	MOVEI C,^D72		;FOR NON-TERMINAL ASSUME 72 COLUMNS
	MTOPR			;GET LINE WIDTH
	 ERJMP .+1		;PROBABLY NOT A TERMINAL
	MOVE P2,C		;REMEMBER IN P2
	MOVN D,D		;GET NEGATIVE OF NUMBER OF ELEMENTS
	HRLZ D,D		;MAKE AOBJN POINTER
	MOVE B,ALIAS		;GET POINTER TO STRUCTURE NAME
str5:	TDNN P3,BUF0+1(D)	;THIS USER HAVE CORRECT ATTRIBUTES?
	JRST STR7		;NO
	AOSN Q1			;FIRST NAME BEING PRINTED?
	UETYPE @P4		;YES, PUT IN HEADING
	CAIE Q1,0		;FIRST NAME BEING PRINTED?
	TYPE <, >		;SEPARATE NAMES(NOT BEFORE FIRST ONE THOUGH!)
	MOVE B,BUF0(D)		;GET USER NAME
	CALL DIRRUM		;MAKE SURE THERE'S ENOUGH ROOM ON THIS LINE FOR ANOTHER NAME
	dirst			;print user name
	 erjmp str6		;go check error code
	AOJ P1,			;COUNT NAMES ON THIS LINE
str7:	AOBJN D,.+1
	AOBJN D,STR5		;LOOP FOR REST OF NAMES
	CAIGE Q1,0		;ANY NAMES PRINTED?
	UETYPE @P5		;NO, SO GIVE REMARK ABOUT LIST BEING EMPTY
	ETYPE<%_>		;put cr after list
	RET

str6:	call %geter		;get reason for failing dirst
	move b,ercod
	caie b,dirx1		;user go away?
	call cjerre		;no, so bomb out
	jrst str7		;yes, ignore and go on
str2:	movem p3,BUF0(p2)	;user not found, add to list
	HLL A,GSULST(P1)	;GET CONTROL BITS
	HLLM A,BUF0+1(P2)	;SAVE BITS
	AOJ P2,			;2 WORDS PER ENTRY IN USER LIST
	aoja p2,str4		;expand list and check rest of jobs
strx1:	caie a,gtjix4		;make sure error is "no such job"
	call cjerre		;no, so bomb out
	jrst str4		;yes, job logged off, so skip it

;ROUTINE USED WHEN PRINTING A LIST OF USER NAMES TO DECIDE WHETHER
;THE NEXT NAME WILL FIT ON THIS LINE.  IF NOT, A CRLF AND TAB IS PRINTED.
;THE ROUTINE ALWAYS ASSUMES THE NAME FITS, IF IT'S THE FIRST ONE ON THE
;LINE, NO MATTER HOW LONG IT IS.
;ACCEPTS:	B/	USER OR DIRECTORY NUMBER
;		P1/	NUMBER OF NAMES SO FAR ON THIS LINE
;		P2/	TERMINAL WIDTH
;RETURNS:	+1 ALWAYS, WITH P1 RESET TO 0 IF THERE WAS NO ROOM

DIRRUM:	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D		;CLOBBER NOTHING
	JUMPE P1,DIRUMX	;THERE'S ALWAYS ROOM FOR AT LEAST ONE NAME!
	JUMPE P2,DIRUMX		;IF 0 WIDTH, ASSUME INFINITE AND HENCE THERE'S ROOM!
	MOVE A,CSBUFP		;GET SOME FREE SPACE
	DIRST		;GENERATE THE STRING
	 ERJMP DIRUMX	;FAILED, SO JUST EXIT
	MOVEI B,0	;PUT NULL IN TO MARK END OF STRING
	IDPB B,A
	MOVE A,CSBUFP	;LOOK AT STRIN
	MOVEI D,0	;D HOLDS LENGTH OF STRING
DUM1:	ILDB C,A	;MORE CHARACTERS?
	CAIE C,0	;NO
	AOJA D,DUM1	;YES, COUNT 'EM
	ADDI D,2	;LEAVE ROOM FOR COMMA AND SPACE
	MOVE A,COJFN	;GET POINTER TO OUTPUT DEVICE
	RFPOS		;WHERE ARE WE ON LINE?
	ADD B,D		;WHERE WILL WE BE AFTER PRINTING THIS NAME?
	CAIGE P2,(B)	;OVER RIGHT MARGIN?
	JRST DUMNO	;YES, NO ROOM ON THIS LINE
DIRUMX:	POP P,D
	POP P,C
	POP P,B
	POP P,A
	RET

DUMNO:	TYPE <
	>
	MOVEI P1,0	;NOTE THAT WE'RE ON NEW LINE
	JRST DIRUMX


;JOBSTAT

.JOBST::ETYPE	< Job %J, User %N>
	GJINF
	CAME	B,LIDNO			;SKIP IF CONNECTED TO LOGGED-IN DIR
	UETYPE	[ASCIZ /, %G/]
	TYPE	<, Account >
	CALL	PRACCT			;PRINT ACCOUNT INFO
	ETYPE	<, %L
>
	HRROI A,-1		;CURRENT JOB
	HRROI B,CSBUFP		;USE FREE SPACE POINTER
	MOVE D,CSBUFP		;REMEMBER POINTER TO BEGINNING OF STRING
	MOVEI C,.JISRM		;SPECIFY WE WANT SESSION REMARK
	GETJI			;GET SESSION REMARK
	 ERJMP R		;IF FAILS, THERE'S NO REMARK
	MOVE A,D		;SUCCEEDED, GET POINTER TO REMARK
	ILDB A,A		;GET FIRST CHARACTER
	JUMPE A,R		;IF NULL STRING, THERE'S NO REMARK
	ETYPE <Session remark: %4M
>
	RET

;RUNSTAT

.RUNST::ETYPE < Used %B% in %C%
>
	CALL DGFRKS		;DO THE GFRKS TO GET FORK HANDLES
	 CALL [	CAIE A,GFKSX1	;RAN OUT OF SPACE?
		CAIN A,FRKHX6	;RAN OUT OF HANDLES?
		SKIPA		;YES - CONTINUE
		JRST CJERR	;NO, STRANGE
		TYPE <% >
		CALL $ERSTR	;PRINT SYSTEM MESSAGE
		ETYPE<%_>	;ADD CRLF
		TYPE <% Partial structure will be printed.
>
		RET]
	MOVEI A,.FHSLF		;REPORT ON CURRENT FORK FIRST
	ETYPE < TOPS-20: %1V
>
	TYPE < SET >
	SKIPE PAXLFL
	TYPE <NO >
	TYPE <UUO-SIMULATION (FOR PROGRAM)
>
	TYPE < SET >
	SKIPE CCFLAG
	TYPE <NO >
	TYPE <CONTROL-C-CAPABILITY (OF PROGRAM)
>
	SETZ Q1,
	HRRZ D,(C)
	CALL FSTRUC		;PRINT FORK TREE
	CALLRET UNMDIR		;UNMAP SPECIAL PAGES
;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.
;	Q1: LEVEL COUNTER, ZEROED BY TOP LEVEL CALLER.

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

FSTR1:	PRINT " "
	HRRZ B,1(D)
	CAMN B,FORK	;< TO MATCH FOLLOWING
	UTYPE [ASCIZ/=> /]
	CAME B,FORK
	TYPE <   >
	SKIPA A,Q1
	TYPE <   >		;INDENT 3 SPACES PER LEVEL BELOW FIRST.
	SOJGE A,.-1
	TYPE <Fork >
	HRRZ B,1(D)		;GET THIS FORK'S HANDLE FROM TABLE
	JUMPE B,[UTYPE [ASCIZ /**: /]
		MOVE A,2(D)	;GET STATUS FROM TABLE
		CALL FSTATA	;PRINT STATUS WITH 0 PC
		JRST FSTR2]
	TRZ B,B0		;PRINT IN FORM ## NOT 4000##
	MOVE A,COJFN
	MOVEI C,10
	NOUT			;FORK HANDLE, OCTAL
	 CALL JERRC		;JSYS ERROR ROUTINE FOR ERROR NUM IN C
	TYPE <: >
	HRRZ A,1(D)		;HANDLE AGAIN
	CAIN A,.FHSLF		;SELF?
	JRST [	TYPE <EXEC>
		JRST FSTR2A]
	CALL FSTAT		;TYPE ITS STATUS
FSTR2A:	HRRZ A,1(D)		;AND AGAIN
	ETYPE <, %1V>		;RUNTIME OF FORK
FSTR2:	ETYPE<%_>

;NOW DO ALL OF THE FORK'S INFERIORS, BY RECURSION.

	PUSH P,D
	HRRZ D,(D)		;INFERIOR PTR FROM GFRKS TABLE.
	AOS Q1			;DOWN LEVEL
	CALL FSTRUC		;RECURSIVE CALL TO DO ENTIRE SUBTREE
	SOS Q1			;UP LEVEL
	POP P,D
	HLRZ D,(D)		;PARALLEL PTR FROM GFRKS TABLE

;ENTRY POINT.  NOP IF 0 PTR GIVEN.

FSTRUC:	JUMPN D,FSTR1
	RET

;FORK STATUS TYPEOUT SUBR FOR "RUNSTAT" AND "JOBSTAT".
;TAKES HANDLE IN A, CLOBBERS A.
;USED IN FSTRUC (JOBSTAT), RUNSTAT, ^T PSI ROUTINE (XSUBRS.MAC)

FSTATA:	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSH P,[0]	;NO FORK HANDLE
	SETZ B,			;GIVE ZERO PC HERE
	JRST FSTAT0

FSTAT::	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSH P,A		;SAVE FOR %X LATER
	RFSTS			;GET STATUS IN A, PC IN B
FSTAT0:	HLRZ C,A		;B1-17 = STATUS
	CAIN C,-1		; -1 = UNASSIGNED HANDLE. MAYBE A SUPERIOR
	JRST [	MOVEI D,[ASCIZ /Program disappeared/]; ..KILLED PROGRAM
		JRST FSTAT8]
	TRZ C,B0		;FLUSH FROZEN BIT
	CAIE C,2		;HALT OR FORCED TERM