Google
 

Trailing-Edge - PDP-10 Archives - BB-M836B-BM - tools/sysdpy/sysdpy.mac
There are 31 other files named sysdpy.mac in the archive. Click here to see a list.
; UPD ID= 6, SNARK:<5.TOOLS-TAPE>SYSDPY.MAC.9,  31-Mar-82 14:57:33 by PURRETTA
;545 - TCO 5.1770 - Replace symbol references of UDBDDP with UDBDDD
; UPD ID= 2, SNARK:<5.TOOLS-TAPE>SYSDPY.MAC.6,  14-Oct-81 15:19:53 by PAETZOLD
;544 - Suppress available nodes (in DN display) if suppressing titles
; UPD ID= 1, SNARK:<5.TOOLS-TAPE>SYSDPY.MAC.5,  30-Sep-81 14:51:28 by GRANT
;543 - LL block
;<GRANT>SYSDPY.MAC.2, 21-Sep-81 10:52:43, EDIT BY GRANT
;542 - LL block growing again
;<5.TOOLS-TAPE>SYSDPY.MAC.2, 26-May-81 17:50:53, EDIT BY GRANT
;541 - LL block still growing, fix LLLIST
;<GRANT>SYSDPY.MAC.2, 24-Apr-81 13:23:22, EDIT BY GRANT
;540 - Add new LL state "CC sent"
;<GRANT.DECNET.5>SYSDPY.MAC.20, 13-Apr-81 09:18:35, EDIT BY GRANT
;537 - Add new DECnet object types
;	Rewrite XXLHST to reflect new DECnet information
;	Change LLLIST to reflect new DECnet data structure
;SNARK:<TCP.BUILD>SYSDPY.MAC.2 12-Mar-81 11:10:50, Edit by LYONS
;536 - Fix some of the bugs in the "re" display
;	Get rid if the "unused pool" line
;	Expand the "used" field to 5 digits.  Some people use more
;	than 10000 pages of drum space.
;SNARK:<5.UTILITIES>SYSDPY.MAC.13 19-Feb-81 12:51:49, Edit by LYONS
;535 - Add a DECSW to control DEC only features
;	Put slow down prohibit under this switch
;<5.UTILITIES>SYSDPY.MAC.12, 24-Dec-80 11:47:41, EDIT BY GRANT
;534 - DECnet logical link block has changed - LLSOB now word 25
;SNARK:<5.UTILITIES>SYSDPY.MAC.9,  22-Dec-80 14:57:27 by GRANT
;533 - Fix the resident free space output in the RES command
;<LYONS.PRIV>SYSDPY.MAC.5,  7-Oct-80 13:38:06, Edit by LYONS
;532 - Add the "RP" command for Run time Percentage
;<LYONS.ARPAMON>SYSDPY.MAC.3,  8-Sep-80 12:43:07, Edit by LYONS
;531 - Increase max sleep time to 3 min, start after 1 min, and slow
;	down faster.
;      Also, slow down default display speed to 15 seconds
;      Allow a refresh every 30 min by default
;      Bump number of terminals to 300 from 178
;      Move data pages up some, get rid of overlaps
;<LYONS>SYSDPY.MAC.2, 27-Aug-80 11:55:23, Edit by LYONS
;530 - Report quotas as +INF if the are
;<LYONS.PRIV>SYSDPY.MAC.2, 31-Jul-80 16:05:36, Edit by LYONS
;527 - SHIFT THE INDEX FOR FREE CORE BLOCKS AND FLAG TYPE 0 AS UNUSED
;<4.1.UTILITIES>SYSDPY.MAC.34, 24-May-80 22:22:48, EDIT BY DBELL
;526 - TELL ABOUT DOWNTIME IN INFORMATION LINE
;<4.1.UTILITIES>SYSDPY.MAC.30, 22-May-80 12:19:13, EDIT BY DBELL
;525 - DON'T SHOW SECONDS IN INFORMATION LINE
;524 - REMOVE TITLE LINE FOR HELP DISPLAY, ENFORCE INFO LINE FOR IT
;<4.1.UTILITIES>SYSDPY.MAC.29, 21-May-80 17:05:34, EDIT BY DBELL
;523 - DON'T DO AUTO-SCROLLING FOR HELP DISPLAY
;<4.1.UTILITIES>SYSDPY.MAC.28, 20-May-80 12:18:01, EDIT BY DBELL
;522 - USE FIXOUT ROUTINE INSTEAD OF FLOUT JSYS IN INFORMATION LINE
;<4.1.UTILITIES>SYSDPY.MAC.25, 18-May-80 20:37:16, EDIT BY DBELL
;521 - EAT LEADING SPACES IN HELP FILE TYPEOUT
;520 - ADD GENERAL INFORMATION LINE TO END OF DISPLAY IF DESIRED
;<4.1.UTILITIES>SYSDPY.MAC.23, 11-May-80 23:43:24, EDIT BY DBELL
;517 - MAKE CPYTXT ROUTINE ALLOW CONTROL-V FOR QUOTING ANY CHARACTER
;516 - MAKE "U" AND "PR" COMMANDS APPEND NAMES INSTEAD OF REPLACING THEM
;<4.1.UTILITIES>SYSDPY.MAC.21, 20-Apr-80 22:26:39, EDIT BY DBELL
;515 - MAKE VERSION OF "A" COMMAND SHOW ONLY ACTIVE ARPANET HOSTS
;514 - IF NO COMMANDS ARE BEING TYPED, SLOW DISPLAY RATE DOWN AFTER AWHILE
;<4.1.UTILITIES>SYSDPY.MAC.19, 12-Apr-80 17:05:18, EDIT BY DBELL
;513 - DON'T DO PHYSICAL ONLY GTJFN FOR DOING PUSH
;<4.1.UTILITIES>SYSDPY.MAC.18, 10-Apr-80 16:42:46, EDIT BY DBELL
;512 - TAKE CARE OF TYPE-AHEAD AFTER EXEC HAS TERMINATED
;<4.1.UTILITIES>SYSDPY.MAC.17,  6-Apr-80 15:08:13, EDIT BY DBELL
;511 - ADD TEMPORARY FEATURE TO SHOW FOREIGN HOST FOR DECNET NRTSRV PROGRAM
;510 - CHANGE IPCSIZ TO NOT CONFLICT WITH GALAXY DEFINITIONS
;<4.1.UTILITIES>SYSDPY.MAC.15, 23-Mar-80 22:45:38, EDIT BY DBELL
;507 - FIX UPTIME IN ARPANET DISPLAY, MAKE IDLE COLUMN LINE UP
;<4.1.UTILITIES>SYSDPY.MAC.12, 16-Mar-80 22:07:16, EDIT BY DBELL
;506 - ADD FOREIGN HOST COLUMN FOR JOB DISPLAY
;<4.1.UTILITIES>SYSDPY.MAC.10, 16-Mar-80 21:30:35, EDIT BY DBELL
;505 - IF CONTROLLED BY JOB ZERO JUST INSERT JSYS AND EXIT
;504 - FIX UP ARPANET DISPLAYS SOME
;<4.1.UTILITIES>SYSDPY.MAC.8, 14-Mar-80 14:15:46, EDIT BY DBELL
;503 - CALL SWPMWE AND SWPMWP WHEN CHANGING JSTAB
;<4.1.UTILITIES>SYSDPY.MAC.7, 15-Feb-80 17:01:22, EDIT BY DBELL
;502 - CHANGE NVT OBJECT TYPE FROM 200 TO 23
;<4.1.UTILITIES>SYSDPY.MAC.6, 20-Jan-80 11:57:21, EDIT BY DBELL
;501 - SET UP FR.END AS INITIAL FLAGS SO SPACE IN RSCAN LINE DOESN'T SCROLL
;<4.1.UTILITIES>SYSDPY.MAC.5, 16-Jan-80 21:29:38, EDIT BY DBELL
;500 - ADD RP20 DATA AND CODE TO HANDLE CONTROLLERS IN DISK DISPLAY
;<4.1.UTILITIES>SYSDPY.MAC.3, 14-Jan-80 19:34:03, EDIT BY DBELL
;477 - HAVE SPACE CHARACTER SCROLL THE SCREEN WITHOUT CARRIAGE RETURN NEEDED
;476 - MAKE DECNET CORE IN RESOURCE DISPLAY SHOW RIGHT VALUE
;<4.UTILITIES>SYSDPY.MAC.69, 28-Oct-79 12:16:19, EDIT BY DBELL
;475 - SPLIT UP ARPANET DISPLAY INTO TWO SEPARATE DISPLAYS
;474 - FIX SOME XLISTS SINCE NEW MACRO MAKES CREFS LOOK BAD NOW
;<4.UTILITIES>SYSDPY.MAC.68, 27-Oct-79 22:27:43, EDIT BY DBELL
;473 - SET UP AN INTERRUPT FOR FORK TERMINATIONS
;<4.UTILITIES>SYSDPY.MAC.67, 27-Oct-79 21:08:06, EDIT BY DBELL
;472 - DON'T KILL EXEC WHEN IT POPS BACK, ADD "KE" COMMAND TO KILL IT
;<4.UTILITIES>SYSDPY.MAC.65, 24-Oct-79 20:15:45, EDIT BY DBELL
;471 - CHANGE POPJ P, TO RET AND JRST CPOPJ1 TO RETSKP
;470 - TYPE +INFINITY FOR DISK QUOTAS IF INFINITE
;<4.UTILITIES>SYSDPY.MAC.64,  3-Sep-79 20:19:07, EDIT BY DBELL
;467 - DON'T SHOW AN OFN FOR A JFN WHICH IS NOT OPEN
;<4.UTILITIES>SYSDPY.MAC.63, 31-Jul-79 13:29:30, EDIT BY DBELL
;466 - SET FAILURE FLAG PROPERLY FOR UNKNOWN SYMBOLS AT UNKSYM+1
;<4.UTILITIES>SYSDPY.MAC.62, 30-Jun-79 14:38:48, EDIT BY DBELL
;465 - MAKE THE ENQ DISPLAY SCROLL AS IT SHOULD
;<4.UTILITIES>SYSDPY.MAC.61, 28-Jun-79 21:35:59, EDIT BY DBELL
;464 - DON'T DO A RLJFN AFTER A GET JSYS
;<4.UTILITIES>SYSDPY.MAC.60, 10-Jun-79 16:57:05, EDIT BY DBELL
;463 - CHANGE BUFSIZ TO BUFLEN SO DEFINITION IN ORNMAC ISN'T FOUND
;<4.UTILITIES>SYSDPY.MAC.59,  3-Jun-79 16:48:36, EDIT BY DBELL
;462 -	DON'T DO A RLJFN AFTER A CLOSF IN NEWDPY
;<4.UTILITIES>SYSDPY.MAC.58,  2-Jun-79 14:15:54, EDIT BY DBELL
;461 -	START USING STANDARD TOPS-20 EDIT HISTORY CONVENTIONS, AND
;	REMOVE OLD EDIT HISTORY.


	TITLE	SYSDPY	PROGRAM TO WATCH EVERYTHING
	SUBTTL	DEFINITIONS/DAVID I. BELL


;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,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.


;PROGRAM TO DISPLAY VARIOUS SORTS OF INFORMATION ABOUT THE SYSTEM
;SUCH AS GENERAL JOB STATUS, SPECIFIC JOB STATUS, THE QUEUES,
;DECNET INFORMATION, ETC.


	SEARCH	DPYDEF		;SEARCH DPY DEFINITIONS
	SEARCH	MACSYM,MONSYM,JOBDAT	;AND MONITOR DEFINITIONS
	SEARCH	GLXMAC,QSRMAC,ORNMAC	;AND GALAXY DEFINITIONS TOO
	.REQUES	DPY		;ASK TO LOAD DPY
	SALL			;MAKE FOR NICE MACROS


	VERSION==5		;VERSION NUMBER
	EDIT==545		;EDIT NUMBER
;ACCUMULATORS:


	F=0			;FLAGS
	T1=1			;TEMPORARY AC'S
	T2=2
	T3=3
	T4=4
	C=5			;CHARACTER HOLDING
	J=6			;JOB NUMBER CURRENTLY WORKING ON
	R=7			;ROUTINE TO CALL FOR DPYING
	I=10			;INDEX INTO RUNTIME TABLES
	P=17			;STACK


	FX==7			;MONITOR AC - MUST MATCH MONITOR!!
	P1==10			;ANOTHER ONE
	P2==11			;ANOTHER MONITOR AC
	P3==12			;ANOTHER ONE
	CX==16			;AND ANOTHER MONITOR AC



;FLAGS:


	FR.JSY==1B0		;WE CAN USE THE "MONRD% JSYS"
	FR.TAC==1B1		;ONLY SHOW ACTIVE TERMINALS
	FR.MOR==1B2		;MORE COLUMNS ARE AFTER THIS ONE
	FR.CPR==1B3		;THE CPU PERCENTAGE TABLE IS READY
	FR.RSN==1B4		;INPUT CHARACTER NEEDS REREADING
	FR.NEG==1B5		;NEXT COMMAND'S ACTION IS NEGATED
	FR.TMP==1B6		;TEMPORARY USE INSIDE VARIOUS LOOPS
	FR.NOC==1B7		;DON'T CONVERT THE LABEL CHARACTER
	FR.ACT==1B8		;SHOW ONLY ACTIVE DECNET LINKS
	FR.CMP==1B9		;REMOVE HEADER LINES TO COMPRESS OUTPUT
	FR.HDR==1B10		;HEADER LINE HAS BEEN GIVEN
	FR.OPR==1B11		;SHOW OPERATOR JOBS IN DISPLAY
	FR.EAT==1B12		;SET UP EATING AFTER HEADER TYPEOUT
	FR.END==1B13		;PREVIOUS SCREEN WAS LAST ONE OF DISPLAY
	FR.NDC==1B14		;CRLF IS NEEDED BEFORE NEXT DISPLAY
	FR.UDB==1B15		;UDB IS VALID TO LOOK AT
	FR.UDS==1B16		;SYMBOLS FOR UDB HAVE BEEN OBTAINED
	FR.INS==1B17		;WE ONLY WANT TO INSERT THE MONRD% JSYS
	FR.REF==1B18		;REFRESH THE SCREEN
	FR.RFC==1B19		;CLEAR THE SCREEN WHEN REFRESHING
	FR.NRT==1B20		;NRTSRV DATA FILE IS MAPPED INTO CORE
IFE DECSW,<
	FR.NOS==1B21		;DON'T SLOW DOWN THE UPDATE RATE
>
	FR.AAH==1B22		;ONLY SHOW ACTIVE ARPANET HOSTS
	FR.INF==1B23		;USER WANTS TO SEE INFORMATION LINE
;COLUMN DEFINITIONS:


	CL.TYP==0		;TYPE OF COLUMN THIS IS
	CL.VAL==1		;VALUE FOR ORDERING OUTPUT
	CL.DSP==2		;ROUTINE TO TYPE DATA FOR COLUMN
	CL.SIZ==3		;WIDTH OF COLUMN
	CL.TXT==4		;ASCIZ TEXT FOR HEADER TO COLUMN




;THE FOLLOWING SYMBOLS ARE DEFINED IN THE MONITOR IN SUCH A WAY THAT
;ONE CANNOT OBTAIN THEM BY SNOOPING OR LOOKING IN A TABLE (THEY ARE
;ONLY DEFINED IN A DEFSTR MACRO).  NONE OF THESE VALUES CHANGING WILL
;EVER CRASH THE MONITOR.  INCORRECT VALUES WILL ONLY MAKE THE DATA
;RETURNED BY THE MONRD% JSYS BE INCORRECT.



;FIELDS DEFINED IN HEADER BLOCKS OF IPCF MESSAGES:


	PD.CNT==POINT 9,0,35	;NUMBER OF OUTSTANDING MESSAGES
	PD.FLG==POINT 12,1,11	;FLAG BITS
	PD.FKW==POINT 18,1,35	;FORK WAITING FOR MESSAGE
	PD.FKO==POINT 18,2,35	;FORK WHICH OWNS THIS PID



;FLAG BITS IN THE IPCF HEADER:


	PD%DIS==4		;PID IS DISABLED



;FLAGS IN THE SYSFK TABLE:


	SFEXO==1B1		;FORK IS EXECUTE-ONLY
	SFNVG==1B2		;FORK IS NOT A VIRGIN
	SFGXO==1B3		;FORK IS DOING GET OF EXECUTE-ONLY PROG
;MACROS:


	DEFINE	$$(SYM,MOD),<	;;PRODUCES SYMBOL DATA FOR SNOOPING

	ADDR==.-1		;;GET LOCATION OF THIS INSTRUCTION
	XLIST			;;SUPPRESS LISTING
	RELOC			;;RETURN TO NORMAL RELOCATION
	EXP	ADDR		;;DUMP THE ADDRESS OF THE INSTRUCTION
	RADIX50	0,SYM		;;AND THE SYMBOL NAME
	RADIX50	0,MOD		;;AND THE MODULE NAME
	EXP	.FAIL.		;;AND ADDRESS TO SET IF SYMBOL LOOKUP FAILS
	LOC			;;RETURN TO ABSOLUTE CODE
	LIST			;;ALLOW LISTING AGAIN
>
	.FAIL.==0		;INITIALIZE FAILURE ADDRESS




	DEFINE	ND(SYM,VAL),<	;;DEFINES DEFAULT VALUES FOR SYMBOLS
	IFNDEF	SYM,<SYM==VAL>	;;IF NOT DEFINED YET, DO SO NOW
>




	DEFINE	STS(BIT,TEXT),<	;;GENERATES FORK STATUS INFORMATION
	<BIT>B0+[ASCIZ"TEXT"]
>




	DEFINE	IERR(TEXT),<	;;FOR ERRORS WHEN STARTING "MONRD%" JSYS
	JRST	[HRROI	T1,[ASCIZ/
? TEXT
/]				;;GET STRING
		 JRST	IERRTP]	;;THEN GO TYPE IT
>



;MACROS TO GENERATE MASKS AND OFFSETS FROM A BYTE POINTER:


	DEFINE	PW(PTR),<<<PTR>&^O777777>>
	DEFINE	PM(PTR),<<<<1_<<<PTR>_-^D24>&^O77>>-1>_<<PTR>_-^D30>>>
	DEFINE	SERR(TEXT),<	;;FOR ERRORS WHEN DOING SNOOPS
	JRST	[HRROI	T1,[ASCIZ/
? TEXT: /]			;;GET STRING
		JRST	SERRTP]	;;THEN GO TYPE IT
>



	DEFINE	UU(ARGS),<	;;GENERATE TABLE OF UUOS
	XLIST
	IRP	ARGS,<
	SIXBIT	/ARGS/
>
	LIST
>




	DEFINE	NOSKED,<	;;PREVENT SCHEDULING
	JSP	CX,$$(NOSKD0,SCHED)
>


	DEFINE	OKSKED,<	;;ALLOW SCHEDULING AGAIN
	JSP	CX,$$(OKSKD0,SCHED)
>


	DEFINE	NOINT,<		;;PREVENT CONTROL-C'S
	AOS	$$(INTDF,STG)
>


	DEFINE	OKINT,<		;;ALLOW THEM AGAIN
	XCT	$$(INTDFF,STG)
>


	DEFINE	RESCAN,<
	TXO	F,FR.RSN	;;SET THE REREAD FLAG
>
;DEFAULT PARAMETERS:

ND	DECSW,-1	;INCLUDE DEC ONLY FEATURES

ND	FTPRIV,-1	;-1 IF MONRD% JSYS IS TO BE PRIVILEGED
ND	.MSR20,24	;**TEMPORARY UNTIL IN MONSYM** RP20 UNIT TYPE
ND	NWFKPT,2433	;MONITOR VERSION FOR NEW FKPT FORMAT
ND	JSYNUM,717	;SPECIAL SYSTAT JSYS NUMBER
ND	TAKMAX,5	;MAXIMUM DEPTH OF NESTED TAKE COMMANDS
ND	LBLCHR,":"	;CHARACTER IN INDIRECT FILE FOR LABELS
ND	ACTTIM,1	;MINUTES TO CONTINUE SHOWING ACTIVE TERMINALS
ND	PERCOL,2	;COMPRESSION FACTOR FOR HISTOGRAM
ND	DFTLBL,'SYSDPY'	;DEFAULT LABEL TO LOOK FOR IN SYSDPY.INI
ND	NRTLOC,350000	;PAGE WHERE NRTSRV DATA FILE GOES
ND	DATLOC,351000	;PAGES FOR COLLECTION OF DATA
ND	DATSIZ,3000	;SIZE OF THE BLOCK
ND	SNPLOC,354000	;LOCATION OF CODE FOR SNOOP JSYS
ND	ERRNUM,^D30	;NUMBER OF ERROR STRINGS TO KNOW ABOUT
ND	ERRSIZ,^D15	;WORDS TO HOLD EACH ERROR STRING
ND	ENQSAF,^D55	;SAFETY MARGIN FOR BUFFER OVERFLOW
ND	PIDSIZ,^D100	;STORAGE FOR PIDS OF A JOB
ND	LCKMAX,^D100	;NUMBER OF ENQ LOCKS WE CAN SHOW
ND	UDBSIZ,^D50	;SIZE OF BLOCK TO READ UDB INTO
ND	PDLSIZ,40	;STACK SIZE
ND	TMPSIZ,^D50	;SIZE OF TEMPORARY USE BUFFER
ND	USRSIZ,^D500	;STORAGE FOR USER NAME STRINGS
ND	PRGMAX,^D100	;MAXIMUM NUMBER OF PROGRAM NAMES TO SPECIFY
ND	PSHSLP,^D30000	;SLEEP TIME DURING A PUSH
ND	DWNTIM,^D60	;MINUTES LEFT FOR SAYING SYSTEM GOING DOWN
ND	MAXJOB,^D150	;MAXIMUM JOBS WE CAN HANDLE
ND	MAXTTY,^D300	;MAXIMUM TERMINAL KNOWN
ND	MAXSYM,^D50	;MAXIMUM NUMBER OF MONITOR SYMBOLS KNOWN
ND	MAXSEP,^D10	;MAXIMUM COLUMN SEPARATION ALLOWED
ND	MAXCLS,^D20	;MAXIMUM CLASS FOR SCHEDULER
ND	TTYCHN,0	;TERMINAL INTERRUPT CHANNEL
ND	CPUINT,^D20	;SECONDS BETWEEN CPU COMPUTATIONS
ND	CPUAVG,3	;NUMBER OF INTERVALS TO AVERAGE
ND	DFTLAP,1	;DEFAULT NUMBER OF LINES SCREENS OVERLAP BY
ND	DFTSLP,^D15000	;DEFAULT SLEEP TIME BETWEEN UPDATES
ND	MAXSLP,^D180000	;MAXIMUM SLEEP TIME WHEN SLOWING DISPLAY DOWN
ND	SLWFAC,^D20	;SECONDS OF ELAPSED TIME PER SECOND OF SLOWING
ND	SLWGRC,^D60000	;TIME PERIOD BEFORE SLOWING DOWN DISPLAY
ND	DFTPAG,0	;DEFAULT SECONDS BETWEEN SCROLLING
ND	DFTIDL,.INFIN	;DEFAULT CUTOFF TIME FOR IDLE JOBS
ND	DFTRPL,^D0	;BY DEFAULT, SHOW JOBS WITH MORE THAN 0 % CPU USAGE
ND	DFTREF,^D30	;DEFAULT MINUTES BETWEEN REFRESHINGS
ND	MAXID,6		;MAXIMUM NUMBER OF ID'S TYPED FOR FORK
ND	BUFLEN,^D20	;NUMBER OF WORDS IN TTY BUFFERS
ND	BUFNUM,^D10	;NUMBER OF BUFFERS
ND	TXTLEN,^D8	;WORDS TO HOLD TEXT STRINGS
;OPDEFS:



	OPDEF	TAB	[CHI$ 11]	;TAB CHARACTER
	OPDEF	SPACE	[CHI$ 40]	;SPACE CHARACTER
	OPDEF	CRLF	[CHI$ 12]	;CRLF CHARACTER
	OPDEF	CALL	[PUSHJ P,]	;SUBROUTINE CALL
	OPDEF	RET	[POPJ P,]	;RETURN
	OPDEF	RETSKP	[JRST CPOPJ1]	;GO SKIP RETURN
	OPDEF	PJRST	[JRST]		;STANDARD
	OPDEF	GETCHR	[CALL RUNCHR]	;GET NEXT INPUT CHARACTER IN C
	OPDEF	MONRD%	[JSYS JSYNUM]	;SPECIAL "CUSTOM" SYSTAT JSYS
	OPDEF	XCTU	[XCT 4,]	;PREVIOUS CONTEXT EXECUTE
	OPDEF	IFIW	[1B0]		;FOR EXTENDED INDIRECT WORDS

	.NODDT	IFIW			;SUPPRESS OUTPUT TOO
	SUBTTL	INITIALIZATION



;THIS PROGRAM SHOWS A CONSTANTLY UPDATING DISPLAY OF ALL OF THE JOBS ON
;THE SYSTEM, A PARTICULAR JOB IN DETAIL, OR THE GENERAL STATUS OF THE
;MONITOR.  NO PRIVILEGES ARE REQUIRED IN GENERAL TO RUN THIS PROGRAM.



ENTRY:	JRST	SYSDPY		;START ADDRESS
	JRST	SYSDPY		;REENTER ADDRESS
	BYTE	(3)0(9)VERSION(6)0(18)EDIT	;VERSION


SYSDPY:	RESET			;RESET EVERYTHING
	MOVE	P,[IOWD	PDLSIZ,PDL]	;INITIALIZE STACK
	MOVX	F,FR.END	;SET UP INITIAL FLAGS
	MOVE	T1,[CALL DPYUUO]	;GET LUUO INSTRUCTION
	MOVEM	T1,.JB41	;SET IT
	SETZM	ERRCNT		;NO ERRORS ARE STORED
	SETZM	MYPID		;WE HAVE NO PID
	SETZM	QSRPID		;AND DON'T KNOW QUASARS
	SETZM	INFPID		;OR PID OF SYSTEM INFO
	SETZM	HLPJFN		;CLEAR HELP FILE JFN
	SETZM	TAKJFN		;CLEAR ANY INDIRECT FILE JFN
	SETZM	TAKLVL		;AND RESET DEPTH OF TAKE FILES
	SETZM	HANDLE		;NO FORK HANDLE EXISTS
	SETZM	REFLST		;CLEAR LAST TIME OF REFRESH
	SETZM	HLPDSP		;CLEAR OUT ANY HELP DISPATCH
	SETZM	PAGE		;CLEAR PAGE COUNTER
	CALL	GETARG		;GO CHECK FOR SPECIAL ACTIONS
	GTAD			;READ TIME AND DATE
	MOVEM	T1,NTIME	;INITIALIZE IT
	TIME			;GET THE UPTIME OF THE SYSTEM
	MUL	T1,[1,,0]	;CONVERT FROM MILLISECONDS
	DIV	T1,[^D<24*60*60*1000>]	;TO UNIVERSAL TIME
	SUB	T1,NTIME	;COMPUTE THE TIME THE SYSTEM STARTED
	MOVNM	T1,BEGTIM	;SAVE FOR LATER
	CALL	DEFALT		;SET UP ALL DEFAULT PARAMETERS
	MOVEI	R,DPYALL	;SET UP DEFAULT DISPLAY ROUTINE
	HRROI	T1,.JOBRT	;GET READY
	GETAB			;FIND NUMBER OF JOBS ON SYSTEM
	 ERJMP	DIE		;FAIL
	ADDI	T1,1		;ACCOUNT FOR JOB 0
	MOVMM	T1,HGHJOB	;SAVE MAXIMUM JOB NUMBER ON SYSTEM
	MOVEI	T1,MAXJOB	;GET NUMBER OF JOBS WE CAN HANDLE
	CAMG	T1,HGHJOB	;MAKE SURE SYSTEM DOESN'T HAVE MORE
	 JRST	TOOMNY		;YEP, GO COMPLAIN
	HRROI	T1,.TTYJO	;GET READY
	GETAB			;FIND THE NUMBER OF TTYS ON THE SYSTEM
	 ERJMP	DIE		;FAILED
	ADDI	T1,1		;ADJUST FOR TTY0
	MOVMM	T1,HGHTTY	;SAVE MAXIMUM TTY NUMBER
	MOVEI	T1,.PTYPA	;GET READY
	GETAB			;READ PTY DATA
	 ERJMP	DIE		;CAN'T
	MOVEI	T1,-1(T1)	;MAKE TTY NUMBER OF THE CTY
	MOVEM	T1,CTYNUM	;SAVE IT
	GJINF			;GET INFORMATION ABOUT MY JOB
	MOVEM	T1,MYUSER	;SAVE MY USER NUMBER
	MOVEM	T3,MYJOB	;AND MY JOB NUMBER
	GETNM			;READ MY PROGRAM NAME
	MOVEM	T1,MYNAME	;SAVE IT
	MOVX	T1,RC%EMO	;MATCH STRING EXACTLY
	HRROI	T2,[ASCIZ/OPERATOR/]	;THE OPERATOR
	RCUSR			;GET THE USER NUMBER FOR HIM
	TXNE	T1,RC%NOM+RC%AMB	;NO MATCH?
	SETO	T3,		;YES, CLEAR USER NUMBER
	MOVEM	T3,OPRUSR	;SAVE THE OPERATOR'S USER NUMBER
	CALL	TBLINI		;INITIALIZE TABLES
	CALL	BUFINI		;GO INITIALIZE TTY BUFFERS
	CALL	RDSTAT		;READ MONITOR STATISTICS
	CALL	STATCP		;THEN COPY AS OLD INFO
	CALL	ECHOOF		;TURN OFF ECHOING
	CALL	TAKINI		;GO SET UP TO READ SYSDPY.INI COMMANDS
	CALL	JSYTST		;SEE IF WE CAN USE "MONRD% JSYS"
	CALL	CMDINI		;DO RESCANNING OF COMMAND LINE
	SETOM	TTYFLG		;INITIALIZE INTERRUPT FLAGS
	SETOM	FRKFLG		;TO NICE STATES
	MOVEI	T1,.FHSLF	;GET SET
	MOVE	T2,[LEVTAB,,CHTAB]	;GET TABLE ADDRESSES
	SIR			;TELL MONITOR WHERE INTERRUPT TABLES ARE
	 ERJMP	DIE		;FAILED
	MOVX	T2,1B<TTYCHN>	;GET BIT FOR CHANNEL
	AIC			;ACTIVATE THE CHANNEL
	 ERJMP	DIE		;FAILED
	EIR			;ENABLE THE INTERRUPTS
	 ERJMP	DIE		;FAILED
	MOVE	T1,[.TICTI,,TTYCHN]	;SET UP FOR TYPEIN INTERRUPT
	ATI			;ACTIVATE INTERRUPT
	 ERJMP	DIE		;FAILED
	MOVEI	T1,.FHSLF	;GET READY TO INTERRUPT MY FORK
	IIC			;GO TAKE CARE OF TYPE-AHEAD
	INI$			;NOW INITIALIZE DPY AND CLEAR SCREEN
	SETOM	TTYFLG		;ACT LIKE SLEEPING IS OK NOW
	SUBTTL	MAIN LOOP FOR SHOWING SCREEN DATA



LOOP:	GTAD			;READ CURRENT TIME OF DAY
	MOVEM	T1,NTIME	;SAVE IT
	CALL	RUNCMD		;SEE IF ANY COMMANDS TO DO
	CALL	CHKDRM		;CHECK IDLE TIME OF JOBS
	CALL	CPUCMP		;COMPUTE CPU PERCENTAGES IF NEEDED
	TXZ	F,FR.EAT!FR.HDR!FR.NDC	;REINITIALIZE THE DISPLAY FLAGS
	SET$	[$SEEAT,,0]	;EAT NO LINES AT FIRST
	CALL	WINSET		;SET UP WHERE WINDOW FOR DISPLAY IS
	CALL	PAGCHK		;DO SCROLLING OF SCREEN
	CALL	(R)		;CALL THE PROPER DISPLAY ROUTINE
	CALL	FULL		;NOW SEE IF THIS WAS LAST SCREEN
	TXZA	F,FR.END	;NO, CLEAR FLAG FOR NEXT LOOP
	TXO	F,FR.END	;YES, SET FLAG TO SAY THAT
	SET$	[$SEEAT,,0]	;CLEAR EATING SO CAN SEE DASHES
	STR$	[ASCIZ/---/]	;FINISH THE DISPLAY
	TLNN	R,-1		;SHOWING HELP DISPLAY?
	TXNE	F,FR.INF	;OR SHOWING INFORMATION LINE?
	CALL	INFO		;YES, SHOW THAT
	MOVE	T1,NTIME	;GET CURRENT TIME
	SKIPN	REFLST		;SEE IF WE REFRESHED BEFORE
	MOVEM	T1,REFLST	;NO, THEN SET THE TIME
	SUB	T1,REFLST	;GET TIME SINCE LAST REFRESH
	MULI	T1,^D<60*24>	;CONVERT FROM UNIVERSAL TIME
	ASHC	T1,^D17		;INTO MINUTES
	CAML	T1,REFTIM	;REACHED TIME YET?
	TXO	F,FR.REF	;YES, REMEMBER TO DO IT
	TXNN	F,FR.REF	;WANTS TO REFRESH SCREEN?
	DPY$	DP$NOH		;NO, JUST SHOW CHANGES
	TXZN	F,FR.REF	;WELL?
	JRST	DOSLP		;NO, JUST GO SLEEP
	MOVE	T1,[REF$ RE$NOH]	;GET REFRESH INSTRUCTION
	TXZE	F,FR.RFC	;WANT TO CLEAR THE SCREEN?
	IORI	T1,RE$CLR	;YES, SET THE FLAG
	XCT	T1		;DO THE REFRESH
	MOVE	T1,NTIME	;GET CURRENT TIME
	MOVEM	T1,REFLST	;SET IT AS TIME WE REFRESHED LAST
DOSLP:	CALL	GETSLP		;GET THE SLEEP TIME
	JUMPLE	T1,LOOP		;IF ZERO, DON'T SLEEP AT ALL
	AOSN	TTYFLG		;CHECK AND SET SLEEP FLAG
	DISMS			;WAIT A WHILE
SLPINT:	SETOM	TTYFLG		;FLAG NO LONGER SLEEPING
	JRST	LOOP		;LOOP
	SUBTTL	ROUTINE TO SHOW ALL JOBS IN A "SYSTAT" DISPLAY




;THIS DISPLAY MODE SHOWS ALL JOBS IN A TYPE OF "SYSTAT" DISPLAY.
;IT WILL GIVE THE GENERAL STATUS OF THE JOBS.  NO EXTRANEOUS DATA
;IS GIVEN, SUCH AS SYSTEM DATA.  THIS MODE IS THE DEFAULT MODE
;WHEN THE PROGRAM IS STARTED.




DPYALL:	MOVEI	T1,TP.JOB	;THIS IS JOB OUTPUT
	CALL	HDRSET		;SO SET UP HEADER FOR IT
	TXO	F,FR.EAT	;SET UP EATING WHEN HEADER IS TYPED
	SETO	J,		;INITIALIZE FOR LOOP

JOBLOP:	ADDI	J,1		;MOVE TO NEXT JOB
	CAMG	J,HGHJOB	;DID ALL JOBS YET?
	CALL	FULL		;OR IS SCREEN FULL?
	 RET			;YES, DONE
	CALL	GETDAT		;READ DATA ON THIS JOB
	 JRST	JOBLOP		;NO SUCH JOB, GO ON
	CALL	SUPPRS		;SEE IF THIS JOB IS TO BE SHOWN
	 JRST	JOBLOP		;NO, GO TO NEXT ONE
	CALL	DOCOLS		;TYPE ALL REQUIRED COLUMNS
	JRST	JOBLOP		;LOOP




;HERE TO READ INFO ON A JOB, TO SEE IF IT IS TO BE SHOWN:


GETDAT:	MOVE	T1,J		;GET JOB NUMBER
	MOVE	T2,[-<.JISTM+1>,,BLK]	;AND PLACE TO PUT DATA
	SETZ	T3,		;START AT FIRST WORD
	GETJI			;READ INFORMATION ABOUT THE JOB
	 JRST	[CAIE T1,GTJIX1	;FAIL BECAUSE OF INVALID INDEX?
		 JRST NOTJOB	;NO, NO SUCH JOB
		 JRST .+1]	;YES, PROCEED WITH WHAT WE GOT
	MOVE	T1,BLK+.JIRT	;GET NEW RUNTIME OF JOB
	CALL	UPDORM		;COMPUTE IDLE TIME FOR THIS JOB
	MOVEM	T1,IDLE(J)	;THEN SAVE IT
	MOVE	T1,RUNDIF(J)	;GET RUNTIME JOB HAD IN LAST INTERVAL
	MOVE	T2,TIMDIF	;AND TIME DIFFERENCE
	MOVE	T4,T2		;SAVE THE DENOMINATOR
	MULI	T1,^D10000	;MULTIPLY BY HUNDREDS OF A PERCENT
	DIV	T1,T4		;THEN DIVIDE BY DENOMINATOR
	ADD	T2,T2		;DOUBLE THE REMAINDER
	CAMLE	T2,T4		;SHOULD WE ROUND UP?
	ADDI	T1,1		;YES, ADD TO HUNDREDS OF A PERCENT
	MOVEM	T1,CPUPER(J)	;SAVE TO DECIEDE TO DROP THIS ONE
	RETSKP			;GOOD RETURN
;FOLLOWING ARE THE ROUTINES TO OUTPUT THE VARIOUS COLUMNS.



XXJOB:	MOVE	T1,J		;GET JOB NUMBER
	CALL	DECSP2		;OUTPUT IT
	CAMN	J,MYJOB		;IS THIS MY OWN JOB?
	CHI$	"*"		;YES, MARK IT WITH A STAR
	RET			;DONE



XXTERM:	MOVE	T1,BLK+.JITNO	;GET TERMINAL NUMBER
	JRST	TTYOUT		;OUTPUT IT



XXPROG:	SKIPN	T1,BLK+.JIPNM	;GET PROGRAM NAME
	MOVE	T1,BLK+.JISNM	;IF NONE, USE SUBSYSTEM NAME
	JRST	SIXOUT		;GO OUTPUT IT



XXJSTA:	MOVE	T1,BLK+.JITNO	;GET TERMINAL NUMBER
	CALL	STATE		;USE IT TO RETURN THE STATE OF THE JOB
	STR$	T1		;THEN OUTPUT IT
	RET			;DONE



XXJRUN:	MOVE	T1,BLK+.JIRT	;GET RUN TIME
	IDIVI	T1,^D1000	;CONVERT TO SECONDS
	JRST	TIMSPC		;OUTPUT IT JUSTIFIED



XXCPU:	TXNN	F,FR.CPR	;IS THE CPU DATA READY YET?
	RET			;NO, DO NOTHING
	MOVE	T1,CPUPER(J)	;GET THE CPU PERCENTAGES
	IDIVI	T1,^D100	;GET PERCENTAGE AND FRACTION
	JRST	CENOUT		;GO OUTPUT IT
XXCDIR:	MOVE	T1,BLK+.JIDNO	;GET CONNECTED DIRECTORY
	MOVEI	T2,4		;ALLOW 4 WORDS OF OUTPUT
	JRST	USROUT		;GO OUTPUT IT



XXIDLE:	MOVE	T1,IDLE(J)	;GET BACK DORMANT TIME
	CAIGE	T1,^D60		;AN HOUR?
	STR$	[ASCIZ/   /]	;NO, SPACE OVER
	CALL	TMHSPS		;OUTPUT DORMANCY TIME
	SKIPGE	TIMRUN(J)	;HAS JOB NOT RUN SINCE WE STARTED?
	CHI$	"+"		;YES, APPEND A PLUS THEN
	RET			;DONE



XXUSER:	MOVE	T1,BLK+.JIUNO	;GET THE USER'S NUMBER
	MOVEI	T2,3		;GET WORDS OF OUTPUT WE WANT
	JRST	USROUT		;OUTPUT IT AND RETURN



XXCTIM:	SKIPN	T2,BLK+.JISTM	;GET TIME USER LOGGED IN
	RET			;CAN'T GET IT, FAIL
	SPACE			;SPACE OVER ONE TO LOOK NICE
	SKIPGE	T2		;KNOWN TIME?
	MOVE	T2,BEGTIM	;NO, USE SYSTEM STARTUP THEN
	MOVE	T1,NTIME	;GET TIME RIGHT NOW
	SUB	T1,T2		;SUBTRACT TO GET CONNECT TIME
	MULI	T1,^D<24*60>	;CONVERT FROM UNIVERSAL TIME
	ASHC	T1,^D17		;TO MINUTES
	JRST	TMHSPC		;OUTPUT IT AND RETURN




XXACCT:	MOVE	T1,J		;GET JOB NUMBER
	HRROI	T2,TEMP		;POINT TO STORAGE
	GACCT			;READ ACCOUNT STRING FOR JOB
	 ERJMP	CPOPJ		;FAILED, HE LOSES
	TXNE	F,FR.MOR	;MORE COLUMNS AFTER THIS ONE?
	SETZM	TEMP+3		;YES, THEN CUT OFF THE OUTPUT SOME
	STR$	TEMP		;OUTPUT IT
	RET			;DONE
XXLINK:	SKIPGE	T4,BLK+.JITNO	;GET TERMINAL NUMBER
	RET			;DETACHED, FAIL
	MOVEI	T1,.RDTTY	;FUNCTION TO GET TTY DATA
	MOVE	T2,['TTLINK']	;WANT THE LINK WORD
	SETZ	T3,		;NO OFFSET
	MONRD%			;READ THE DATA
	 ERJMP	CPOPJ		;FAILED
	JUMPL	T1,CPOPJ	;ALSO FAILED
	JRST	TELLNK		;GO OUTPUT THE DATA



XXFHST:	SKIPL	T1,BLK+.JICPJ	;ANY CONTROLLING JOB?
	JRST	FHDECN		;YES, GO SEE IF THIS IS A "NRTSRV" LINK
	SKIPL	T2,BLK+.JITNO	;GET TERMINAL NUMBER
	CAMG	T2,CTYNUM	;TERMINAL NUMBER IN RANGE OF ARPANET NVT'S?
	RET			;NO, THEN NOT FROM FOREIGN HOST
	MOVEI	T1,.GTNNI	;ARGUMENT IS INPUT SIDE OF NVT
	MOVEI	T3,T3		;LOCATION TO PUT RESULT
	HRROI	T4,.NCFHS	;WANT TO READ FOREIGN HOST NUMBER
	GTNCP%			;READ IT
	 ERJMP	CPOPJ		;FAILED, RETURN
	MOVEI	T1,.GTHNS	;NOW WANT TO CONVERT NUMBER TO STRING
	HRROI	T2,TEMP		;POINT TO STORAGE
	GTHST%			;STORE THE SITE NAME
	 ERJMP	[MOVE T1,T3	;FAILED, COPY HOST NUMBER
		JRST OCTTEL]	;AND OUTPUT IN OCTAL
	TXNE	F,FR.MOR	;MORE COLUMNS AFTER THIS ONE?
	SETZM	TEMP+3		;YES, CUT OFF THE STRING
	STR$	TEMP		;TYPE THE NAME
	RET			;DONE
FHDECN:	MOVE	T2,[-<.JIPNM+1>,,TEMP]	;WANT DATA ON CONTROLLING JOB
	SETZ	T3,		;FROM OFFSET ZERO
	GETJI			;OBTAIN THE INFORMATION
	 ERJMP	CPOPJ		;FAILED
	MOVE	T1,TEMP+.JIPNM	;GET PROGRAM NAME READY
	SKIPN	TEMP+.JIUNO	;JOB LOGGED IN?
	CAME	T1,['NRTSRV']	;OR HAS THE WRONG NAME?
	RET			;YES, NOT THE REAL DECNET "NVT" HACK PROGRAM
	TXNE	F,FR.NRT	;HAVE DATA FILE MAPPED ALREADY?
	JRST	FHDECG		;YES, SKIP ONWARD
	MOVX	T1,GJ%OLD!GJ%SHT!GJ%ACC	;NO, GET READY
	HRROI	T2,[ASCIZ/SYSTEM:NRTSRV-CONNECTIONS.DATA/]	;FILE NAME
	GTJFN			;TRY TO GET IT
	 ERJMP	CPOPJ		;FAILED
	MOVE	T4,T1		;REMEMBER JFN IN CASE OF FAILURE
	MOVX	T2,OF%RD	;WANT TO READ IT
	OPENF			;TRY TO DO SO
	 ERJMP	NODECV		;FAILED
	MOVSI	T1,(T1)		;WANT TO READ PAGE ZERO OF FILE
	MOVE	T2,[.FHSLF,,<NRTLOC/PAGSIZ>]	;WHERE TO MAP IT
	MOVX	T3,PM%RD	;WANT READ ACCESS
	PMAP			;DO IT
	 ERJMP	DIE		;FAILED
	TXO	F,FR.NRT	;WE NOW HAVE THE FILE MAPPED

FHDECG:	MOVE	T1,BLK+.JITNO	;GET TERMINAL NUMBER
	SUB	T1,CTYNUM	;REMOVE CTY OFFSET
	SOJL	T1,CPOPJ	;CREATE PTY NUMBER AND CHECK TO MAKE SURE
	IMULI	T1,2		;DATA FILE HAS TWO WORDS PER PTY
	CAIGE	T1,PAGSIZ	;VERIFY THE RANGE
	STR$	NRTLOC(T1)	;OK, TYPE THE FOREIGN HOST NAME
	RET			;DONE


NODECV:	MOVE	T1,T4		;GET BACK JFN
	RLJFN			;RELEASE IT
	 ERJMP	DIE		;FAILED
	RET			;RETURN
XXJCLS:	MOVEI	T1,3		;WANT THREE ARGUMENTS
	MOVE	T2,J		;GET JOB NUMBER
	DMOVEM	T1,TEMP		;STORE IN ARGUMENT BLOCK
	MOVEI	T1,.SKRJP	;GET FUNCTION
	MOVEI	T2,TEMP		;AND ADDRESS OF BLOCK
	SKED%			;READ INFO ON JOB
	 ERJMP	CPOPJ		;FAILED
	MOVE	T1,TEMP+.SAJCL	;GET THE CLASS
	JRST	DECSP3		;OUTPUT IT




XXFKS:	MOVE	T1,['FKCNT ']	;GET WORD
	CALL	GETJS0		;READ NUMBER OF FORKS IN THE JOB
	 RET			;CAN'T GET IT
	AOJA	T1,DECSP3	;ADD 1 FOR TOP FORK AND OUTPUT NUMBER
	SUBTTL	ROUTINE TO SEE IF A JOB IS TO BE SHOWN



;CALLED FOR EACH JOB TO SELECT WHETHER OR NOT WE WANT TO DISPLAY THE
;JOB.  THIS DOES NOT PREVENT ANY DATA COLLECTION FOR CPU TIMES.  CALLED
;AFTER READING THE JOB INFO BY GETJI.  SKIP RETURN IF JOB IS TO BE SHOWN.




SUPPRS:	MOVE	T1,IDLE(J)	;GET IDLE TIME FOR THIS JOB
	MOVE	T2,MAXIDF	;GET FLAG FOR WHICH CHECK TO MAKE
	XCT	[CAMLE	T1,MAXIDL
		 CAMG	T1,MAXIDL](T2)	;CORRECT SIDE OF THE CUTOFF VALUE?
	RET			;NO, RETURN
	TXNN	F,FR.CPR	;IS IT READY?
	JRST	SUPPR1		;NO, ALLOW TEH LINE IN ANY CASE
	MOVE	T1,CPUPER(J)	;GET THE CPU PERCENTAGE USED
	MOVE	T2,MAXRPF	;AND THE FLAG TO TEST
	XCT	[CAMGE	T1,MAXRPT
		 CAML	T1,MAXRPT](T2)	;TEST AGAINST CUTOFF
	RET			;IT FAILED THE TEST
SUPPR1:	MOVE	T1,J		;GET COPY OF JOB NUMBER
	ADJBP	T1,[POINT 1,BITS,0]	;CREATE PROPER BYTE POINTER
	LDB	T1,T1		;GET BIT FOR THIS JOB
	JUMPN	T1,CPOPJ	;RETURN FAILURE IF BIT WAS SET
	MOVE	T2,BLK+.JIUNO	;GET USER NUMBER
	CAMN	T2,OPRUSR	;IS THIS NOT THE OPERATOR?
	TXNE	F,FR.OPR	;OR WE WANT TO SHOW THEM ANYWAY?
	SKIPA			;YES
	RET			;NO, RETURN
	SKIPN	T1,BLK+.JIPNM	;GET PROGRAM NAME
	MOVE	T1,BLK+.JISNM	;OR SYSTEM NAME IF NONE
	CALL	PRGCMP		;SEE IF THE PROGRAM NAME MATCHES
	 RET			;NO, RETURN
	MOVE	T1,BLK+.JIUNO	;GET THE JOB'S USER NUMBER
	JRST	USRCMP		;SEE IF HE MATCHES WHO WE WANT TO SEE
	SUBTTL	ROUTINE TO DO DISPLAY OF A SINGLE JOB



;THIS DISPLAY WILL SHOW THE STATUS OF A PARTICULAR JOB IN DETAIL,
;INCLUDING THE OPEN JFNS AND THE FORKS.




DPYONE:	MOVEI	T1,TP.JOB	;THIS IS JOB OUTPUT
	CALL	HDRSET		;SET UP TAB STOPS AND HEADER
	TXO	F,FR.HDR	;BUT STOP HEADER FROM TYPING
	SKIPN	T1,THETTY	;SEE IF A PARTICULAR TTY IS TO BE SHOWN
	JRST	ONEHAV		;NO, THEN ALREADY HAVE THE JOB
	HRROI	T2,THEJOB	;ONE WORD STORED AT GIVEN LOCATION
	MOVEI	T3,.JIJNO	;WANT TO READ THE JOB NUMBER
	GETJI			;READ THE JOB NUMBER
	 ERJMP	LOSE		;FAILED
	SKIPGE	THEJOB		;IS A JOB ON THE TERMINAL?
	JRST	DPYONT		;NO, GO COMPLAIN

ONEHAV:	MOVE	J,THEJOB	;GET JOB TO DO
	CALL	GETDAT		;READ DATA ON THE JOB
	 JRST	DPYONN		;ISN'T THERE
	CALL	DOCOLS		;OK, SHOW DATA ON THE JOB
	CRLF			;THEN DO A CRLF
	CALL	SETEAT		;SET UP TO EAT LINES NOW
	TXZ	F,FR.NDC	;DON'T NEED A CRLF NOW
	CALL	DOFORK		;SHOW THE FORK STATUS
	CALL	DOJFN		;AND THE JFN STATUS
	JRST	JOBSUM		;OUTPUT SUMMARY STUFF AND RETURN



DPYONN:	STR$	[ASCIZ/Job /]	;TYPE SOME
	MOVE	T1,J		;GET JOB NUMBER
	CALL	DECOUT		;OUTPUT IT
	STR$	[ASCIZ/ is not in use
/]
	RET			;DONE


DPYONT:	STR$	[ASCIZ/No job is on line /]	;TYPE SOME
	MOVE	T1,THETTY	;GET THE TTY NUMBER
	SUBI	T1,.TTDES	;REMOVE OFFSET
	CALL	OCTOUT		;OUTPUT IT
	JRST	DOCRLF		;THEN FINISH WITH A CRLF
	SUBTTL	SUBROUTINE TO OUTPUT GENERAL INFORMATION ON A JOB




;THIS OUTPUTS STUFF AT THE END OF THE SINGLE JOB DISPLAY SUCH AS
;THE CONNECTED DIRECTORY, TIME LIMIT, DISK SPACE USED, ETC.



JOBSUM:	TXOE	F,FR.NDC	;CRLF NECESSARY?
	CRLF			;YES, TYPE ONE
	STR$	[ASCIZ/Job started: /]	;TYPE SOME TEXT
	SKIPN	T2,BLK+.JISTM	;GET JOB STARTUP TIME IF THERE
	MOVE	T2,BLK+.JILLN	;OTHERWISE GET LAST LOGIN TIME
	SKIPGE	T2		;IS THE TIME KNOWN?
	MOVE	T2,BEGTIM	;NO, USE SYSTEM STARTUP TIME
	HRROI	T1,TEMP		;POINT TO BUFFER
	SETZ	T3,		;NORMAL OUTPUT
	ODTIM			;CONVERT TO ASCIZ
	STR$	TEMP		;THEN OUTPUT IT
	STR$	[ASCIZ/      Time limit: /]	;MORE
	SKIPN	T1,BLK+.JIRTL	;ANY RUN TIME LIMIT?
	STR$	[ASCIZ/None/]	;NO, SAY SO
	IDIVI	T1,^D1000	;CONVERT TO SECONDS
	SKIPN	T1		;ANY TIME?
	SKIPE	T2		;OR EVEN REMAINDER?
	CALL	TIMOUT		;YES, OUTPUT IT
	CALL	DOCRLF		;TYPE A CRLF
	CALL	TYPRSC		;TYPE THE RSCAN BUFFER FOR THE JOB
	STR$	[ASCIZ/Connected directory: /]	;MORE OUTPUT
	MOVE	T1,BLK+.JIDNO	;GET CONNECTED DIRECTORY
	SETZ	T2,		;WANT ALL OF OUTPUT
	CALL	USROUT		;OUTPUT IT
	MOVE	T1,BLK+.JIDNO	;GET READY
	GTDAL			;READ DIRECTORY DATA
	 ERJMP	DOCRLF		;FAILED
	MOVEM	T1,TEMP		;SAVE WORKING QUOTA
	MOVEM	T3,TEMP+1	;AND PERMANENT QUOTA
	STR$	[ASCIZ/
Used pages: /]			;TYPE MORE
	MOVE	T1,T2		;GET CURRENT ALLOCATION
	CALL	DECOUT		;OUTPUT IT
	STR$	[ASCIZ/   Working quota: /]	;MORE
	MOVE	T1,TEMP		;GET QUOTA
	CALL	INFOUT		;OUTPUT IT
	STR$	[ASCIZ/   Permanent quota: /]	;MORE
	MOVE	T1,TEMP+1	;GET QUOTA
	CALL	INFOUT		;OUTPUT IT
	JRST	DOCRLF		;TYPE A CRLF
	SUBTTL	ROUTINE TO SHOW FORK STATUS




;THIS ROUTINE IS CALLED WITH A JOB NUMBER IN AC J, TO FIND THE
;FORKS IN THE JOB AND GIVE A STATUS OF EACH ONE.  THIS REQUIRES
;THAT THE MONRD% JSYS BE WORKING.




DOFORK:	TXNN	F,FR.JSY	;IS THE JSYS THERE?
	RET			;NO, RETURN
	MOVEI	T1,TP.FRK	;THIS IS FORK OUTPUT
	CALL	HDRSET		;SO SET UP HEADER AND TAB STOPS
	MOVE	T1,SKPFRK	;GET NUMBER OF FORKS TO SKIP
	MOVEM	T1,EATNUM	;REMEMBER NUMBER
	SETOM	JOBFRK		;INITIALIZE JOB FORK INDEX


FRKLOP:	AOS	T2,JOBFRK	;GET NEXT JOB FORK NUMBER
	CAMGE	T2,NUFKS	;DID THEM ALL?
	CALL	FULL		;OR IS SCREEN FULL?
	 RET			;YES, RETURN
	MOVE	T1,['SYSFK ']	;WANT TO READ SYSTEM FORK TABLE
	CALL	GETJSB		;READ WORD
	 JRST	FRKLOP		;FAILED, DO NEXT ONE
	JUMPL	T2,FRKLOP	;IF NEGATIVE, FORK NOT IN USE
	MOVEM	T2,SYSFK	;SAVE BITS FOR LATER USE
	HRRZ	T1,T2		;KEEP ONLY RIGHT HALF
	CAIE	T1,-1		;IS THIS FORK ASSIGNED?
	SOSL	EATNUM		;AND WE HAVE NO LINES TO EAT?
	JRST	FRKLOP		;NO, DO NEXT ONE
	MOVEM	T1,FORK		;SAVE SYSTEM FORK NUMBER
	SETZM	HAVPC		;WE NEED NEW PC'S FOR THE FORK
	SETZM	HAVID		;AND NEW ID'S FOR THE FORK
	CALL	DOCOLS		;DO ALL OF THE COLUMNS
	JRST	FRKLOP		;THEN DO NEXT FORK
;THE ROUTINES TO HANDLE THE VARIOUS COLUMN OUTPUTS:



XXFORK:	MOVE	T1,FORK		;GET FORK NUMBER
	JRST	OCTOUT		;OUTPUT IT AND RETURN


XXSUP:	MOVE	T1,JOBFRK	;GET JOB FORK NUMBER
	CALL	GETSUP		;FIND THE SUPERIOR
	 RET			;FAILED
	CAMN	T1,FORK		;IS OUR SUPERIOR US?
	STR$	[ASCIZ/--/]	;YES, INDICATE THAT
	CAME	T1,FORK		;WELL?
	JRST	OCTOUT		;NO, THEN OUTPUT THE FORK WHICH IS
	RET			;DONE


XXUPC:	CALL	GETPC		;READ ALL PC INFORMATION
	 RET			;FAILED
	MOVE	T1,USERPC	;GET THE USER PC
	JRST	PCOUT		;AND OUTPUT IT


XXMPC:	CALL	GETPC		;READ THE PC INFORMATION
	 RET			;FAILED
	MOVE	T1,PC		;GET THE PROCESS PC
	MOVE	T2,PCFLAG	;AND THE CORRESPONDING FLAGS
	TLNN	T2,(1B5)	;IS THE FORK IN MONITOR MODE?
	JRST	PCOUT		;YES, OUTPUT THE MONITOR PC
	STR$	[ASCIZ/      --/]	;OTHERWISE TYPE DASHES
	RET			;AND RETURN



XXSCHD:	MOVEI	T1,.RDFST	;GET FUNCTION FOR SCHEDULER TEST
	MOVE	T2,FORK		;AND FORK NUMBER
	MONRD%			;GET THE SCHEDULER TEST
	 ERJMP	CPOPJ		;FAILED
	JUMPL	T1,CPOPJ	;ALSO FAILED
	HRRZM	T2,TEMP		;SAVE THE ADDRESS
	HLRZ	T1,T2		;GET THE DATA
	CALL	OCTSP6		;OUTPUT IN A FIELD OF 6
	STR$	[ASCIZ/,,/]	;THEN SOME COMMAS
	MOVE	T1,TEMP		;GET BACK ADDRESS
	JRST	SYMOUT		;OUTPUT AS MONITOR SYMBOL
XXCORE:	CALL	GETID		;GO READ ALL PAGE IDENTIES
	 RET			;FAILED
	JRST	TYPID		;THEN TYPE IT OUT AND RETURN



XXPRIV:	JRST	GETPRV		;GO TYPE PRIVILEGES



XXCALL:	CALL	GETPC		;OBTAIN ALL PC INFO
	 RET			;FAILED
	MOVE	T1,PCFLAG	;GET THE PC FLAGS
	TLNN	T1,(1B5)	;WAS HE IN USER MODE?
	CHI$	"*"		;NO, TYPE A STAR
	TLNE	T1,(1B5)	;WELL?
	SPACE			;YES, TYPE A SPACE
	MOVE	T1,['KIMUU1']	;GET READY
	CALL	GETPS0		;READ FIRST PART OF MUUO
	 RET			;CAN'T
	MOVEM	T1,TEMP		;SAVE THE OPCODE PART
	MOVE	T1,['KIMUU1']	;GET READY AGAIN
	MOVEI	T2,1		;OFFSET OF 1
	CALL	GETPSB		;GET OTHER PART
	 RET			;FAILED
	HRL	T1,TEMP		;GET BACK OTHER PART OF MUUO
	JRST	UUOOUT		;OUTPUT IT AND RETURN



XXFFLG:	SPACE			;SPACE OVER FIRST
	MOVE	T1,SYSFK	;GET FORK FLAGS
	TXNN	T1,SFNVG	;VIRGIN FORK?
	CHI$	"V"		;YES, SAY SO
	TXNE	T1,SFEXO	;EXECUTE ONLY?
	CHI$	"E"		;YES, SAY SO
	TXNE	T1,SFGXO	;DOING A GET OF EXECUTE ONLY PROG?
	CHI$	"G"		;YES, SAY SO
	RET			;DONE
XXINTD:	MOVE	T1,['INTDF ']	;GET READY
	CALL	GETPS0		;READ THE INTERRUPT DEFER COUNTER
	 RET			;CAN'T
	JRST	DECSP3		;OUTPUT IT




XXTRPC:	MOVE	T1,['TRAPPC']	;GET READY
	CALL	GETPS0		;READ THE PC OF THE PAGE FAULT
	 RET			;FAILED
	MOVEM	T1,TEMP		;SAVE FOR AWHILE
	MOVE	T1,['TRAPPC']	;NOW GET READY TO READ FLAGS
	SETO	T2,		;WHICH ARE IN PREVIOUS WORD
	CALL	GETPSB		;GET THEM
	 RET			;FAILED
	TXNE	T1,1B5		;WAS THIS IN USER OR EXEC MODE?
	SPACE			;USER MODE, JUST SPACE
	TXNN	T1,1B5		;WELL?
	CHI$	"*"		;EXEC MODE, SAY SO
	MOVE	T1,TEMP		;GET BACK THE PC
	JRST	PCOUT		;AND OUTPUT IT



XXSTAT:	MOVEI	T1,.RDSTS	;GET READY
	MOVE	T2,FORK		;TO READ STATUS OF FORK
	MONRD%			;DO IT
	 ERJMP	CPOPJ		;FAILED
	JUMPN	T1,CPOPJ	;AS I SAID
	MOVE	T1,T2		;PUT RESULT IN RIGHT AC
	JRST	FRKSTS		;OUTPUT IT
XXTRAP:	MOVE	T1,['UTRPCT']	;GET READY
	CALL	GETPS0		;READ NUMBER OF PAGE TRAPS
	 RET			;CAN'T
	JRST	DECSP4		;OUTPUT THEM



XXRUN:	MOVE	T1,['FKRT  ']	;GET READY
	CALL	GETPS0		;READ FORK'S RUN TIME
	 RET			;FAILED
	IDIVI	T1,^D1000	;CONVERT TO SECONDS
	PUSH	P,T2		;SAVE REMAINDER
	CALL	TIMSPC		;OUTPUT IT
	POP	P,T1		;RESTORE REMAINDER
	IDIVI	T1,^D100	;GET TENTHS OF A SECOND
	CHI$	"."		;TYPE A DOT
	CHI$	"0"(T1)		;THEN GIVE TENTHS
	RET			;DONE



XXLERR:	MOVE	T1,['LSTERR']	;GET THE SYMBOL NAME READY
	CALL	GETPS0		;READ IT
	 RET	 		;FAILED
	JRST	ERROUT		;OUTPUT IT AND RETURN



XXWSIZ:	MOVEI	T1,.RDWSP	;GET FUNCTION CODE
	MOVE	T2,FORK		;AND FORK NUMBER
	MONRD%			;READ THE DATA
	 ERJMP	CPOPJ		;FAILED
	JUMPL	T1,CPOPJ	;ALSO FAILED
	HRRZ	T1,T2		;MOVE TO RIGHT AC
	CALL	DECSP3		;OUTPUT IT
	CALL	GETID		;THEN READ THE IDS OF THE FORK
	 RET			;CAN'T GET THEM
	CHI$	"/"		;TYPE A SLASH TO SEPARATE NUMBERS
	MOVE	T1,IDPGS	;GET TOTAL PAGES IN USE BY FORK
	JRST	DECOUT		;AND OUTPUT IT
	SUBTTL	SUBROUTINES TO READ JSB OR PSB WORDS OF OTHER JOBS




;SUBROUTINE TO READ A WORD FROM THE PSB OF A FORK.  CALLED WITH THE
;SIXBIT NAME OF THE WORD IN T1, THE OFFSET IN T2, AND THE FORK
;NUMBER IN FORK.  SKIP RETURN IF SUCCESSFUL, WITH VALUE RETURNED IN T1.
;CALL AT GETPS0 IF OFFSET IS ZERO.


GETPS0:	SETZ	T2,		;CLEAR OFFSET
GETPSB:	MOVE	T3,T2		;MOVE OFFSET TO RIGHT AC
	MOVE	T2,T1		;MOVE SIXBIT WORD TO RIGHT AC
	MOVEI	T1,.RDPSB	;SET UP FUNCTION CODE FOR PSB
	MOVE	T4,FORK		;GET FORK NUMBER

DOMONR:	MONRD%			;ASK MONITOR TO READ DATA
	 ERJMP	CPOPJ		;NO SUCH JSYS, FAIL RETURN
	SKIPN	T1		;DID IT WORK?
	AOS	(P)		;YES, SET FOR SKIP RETURN
	MOVE	T1,T2		;COPY DATA TO T1
	RET			;DONE



;SUBROUTINE TO READ WORDS FROM JSB.  SIXBIT NAME OF WORD GOES
;IN T1, THE OFFSET IN T2, AND THE JOB NUMBER IN J.  SKIP RETURN IF
;SUCCESSFUL, WITH VALUE RETURNED IN T1.  CALLED AT GETJS0 IF THE
;OFFSET IS ZERO.


GETJS0:	SETZ	T2,		;SET OFFSET TO ZERO
GETJSB:	MOVE	T3,T2		;MOVE TO RIGHT AC
	MOVE	T2,T1		;AND SYMBOL
	MOVEI	T1,.RDJSB	;READ JSB FUNCTION
	MOVE	T4,J		;JOB NUMBER TO READ
	JRST	DOMONR		;GO READ DATA
	SUBTTL	SUBROUTINE TO OBTAIN THE USER AND EXEC PC OF A FORK




;CALLED WITH THE FORK NUMBER IN LOCATION FORK, TO FIND THE
;USER MODE AND EXEC MODE PC OF A FORK.  SINCE THIS IS CALLED SEVERAL
;TIMES, WE DO NOT RECOMPUTE THE PC IF THE FLAG HAVPC IS SET.  SO
;THIS MUST BE CLEARED WHENEVER A NEW PC IS TO BE OBTAINED.
;VALUES RETURNED ARE:
;
;PC	 THE CURRENT PROCESS PC WITHOUT FLAGS (CAN BE EITHER USER OR EXEC MODE)
;PCFLAG	 THE FLAGS CORRESPONDING TO PC.  USER MODE SET IF THIS IS A USER PC.
;USERPC	 THE CURRENT USER MODE PC.  SAME AS PC UNLESS DOING A MONITOR CALL.



GETPC:	SKIPE	HAVPC		;DO WE ALREADY HAVE THE PC INFO?
	 RETSKP			;YES, SKIP RETURN
	MOVSI	T1,'PPC'	;GET READY TO READ PROCESS PC
	CALL	GETPS0		;DO IT
	 RET			;FAILED
	MOVEM	T1,PC		;SAVE THE PC
	MOVEM	T1,USERPC	;HERE TOO UNTIL PROVED WRONG
	MOVSI	T1,'PPC'	;NOW GET SET TO READ THE PC FLAGS
	SETO	T2,		;WHICH ARE JUST BEFORE THE PC
	CALL	GETPSB		;GET THEM
	 RET			;FAILED
	MOVEM	T1,PCFLAG	;SAVE THEM
	TLNE	T1,(1B5)	;IS THE PROCESS PC IN USER MODE?
	JRST	GETPCY		;YES, ALL DONE
	MOVE	T1,['UPDL  ']	;NO, THEN USER PC IS ON THE STACK
	CALL	GETPS0		;READ THE REAL USER PC
	 RET			;FAILED
	MOVEM	T1,USERPC	;SAVE IT
GETPCY:	SETOM	HAVPC		;ALL PC INFO OK NOW
	RETSKP			;GOOD RETURN
	SUBTTL	ROUTINE TO TYPE OUT A FORK'S CAPABILITIES




;CALLED WITH THE FORK INDEX IN FORK, TO TYPE OUT THE CAPABILITIES OF
;A FORK, WHETHER OR NOT THEY ARE ENABLED.  SKIP RETURN IF SUCCESSFUL.




GETPRV:	MOVE	T1,['CAPMSK']	;GET READY
	CALL	GETPS0		;READ POSSIBLE CAPABILITIES
	 RET			;ERROR
	HRRZM	T1,TEMP		;SAVE FOR LATER
	MOVE	T1,['CAPENB']	;GET READY
	CALL	GETPS0		;READ ENABLED CAPABILITIES
	 RET			;FAILED
	ANDCAM	T1,TEMP		;ZAP POSSIBLE CAPABILITES WHICH ARE ENABLED
	CALL	TYPPRV		;TYPE OUT ENABLED PRIVILEGES
	SKIPN	T1,TEMP		;NOW GET BACK POSSIBLE CAPABILITIES
	RET			;NONE, DONE
	CHI$	"/"		;SEPARATE WITH A SLASH
				;FALL INTO TYPEOUT ROUTINE



;TRIVIAL ROUTINE TO TYPE OUT LETTERS INDICATING WHICH PRIVS ARE THERE.
;ONLY THE MOST IMPORTANT PRIVILEGES ARE TYPED OUT HERE.


TYPPRV:	TRNE	T1,SC%WHL	;WHEEL?
	CHI$	"W"		;YES
	TRNE	T1,SC%OPR	;OPERATOR?
	CHI$	"O"		;YES
	TRNE	T1,SC%MNT	;MAINTAINANCE PRIVILEGES?
	CHI$	"M"		;YES
	TRNE	T1,-1-<SC%WHL!SC%OPR!SC%MNT>	;ANY OTHERS?
	CHI$	"+"		;YES, SAY SO
	RET			;DONE
	SUBTTL	SUBROUTINE TO FIND THE SUPERIOR OF A FORK




;CALLED WITH THE JOB NUMBER IN J, AND THE JOB FORK NUMBER IN T1, TO
;FIND OUT WHAT THE SUPERIOR OF THE FORK IS.  SKIP RETURN IF SUCCESSFUL,
;WITH SYSTEM FORK IN T1.  CALL AT FNDFRK TO CONVERT JOB FORK NUMBER
;TO SYSTEM FORK NUMBER.





GETSUP:	MOVE	T2,T1		;COPY TO RIGHT AC
	MOVE	T1,['FKPTRS']	;THE FORK STRUCTURE TABLE
	CALL	GETJSB		;READ WORD FROM JSB
	 RET			;FAILED
	LDB	T2,[POINT 12,T2,11]	;GET FORK NUMBER OF SUPERIOR


FNDFRK:	CAML	T2,NUFKS	;MAKE SURE IT IS LEGAL
	RET			;NO, ERROR
	MOVE	T1,['SYSFK ']	;WANT TO GET SYSTEM FORK NUMBER
	CALL	GETJSB		;READ IT
	 RET			;FAILED
	HRRZ	T1,T2		;KEEP ONLY RIGHT HALF
	CAIE	T1,-1		;A REAL FORK?
	AOS	(P)		;YES, GOOD RETURN
	RET			;DONE
	SUBTTL	SUBROUTINE TO FIND THE JOB NUMBER A FORK BELONGS TO




;CALLED WITH A FORK NUMBER IN T1, TO RETURN THE JOB NUMBER THAT FORK
;BELONGS TO.  TO SPEED UP SUCCESSIVE CALLS WITH THE SAME FORK NUMBER,
;WE ONLY DO THE WORK IF LOCATION KWNJOB IS NONNEGATIVE.  SKIP
;RETURN IF SUCCESSFUL.




FRKJOB:	SKIPL	KWNJOB		;DO WE ALREADY KNOW THE JOB NUMBER?
	JRST	FRKJBY		;YES, GO GET IT
	MOVEM	T1,FORK		;SAVE THE FORK NUMBER
	MOVE	T1,['JOBNO ']	;WORD CONTAINING THE JOB NUMBER
	CALL	GETPS0		;READ IT
	 RET			;FAILED
	MOVEM	T1,KWNJOB	;SAVE JOB FOR LATER USE
	RETSKP			;GOOD RETURN


FRKJBY:	MOVE	T1,KWNJOB	;GET THE JOB NUMBER
	RETSKP			;GOOD RETURN
	SUBTTL	SUBROUTINE TO COMPUTE WHAT A FORK'S PAGES ARE



;CALLED WITH FORK NUMBER IN LOCATION FORK, TO CONSTRUCT A TABLE AT
;IDTVAL WHICH CONTAINS THE IDENTITIES OF THE PAGES OF THE FORK.  THE
;TABLE WILL CONTAIN EITHER FORK NUMBERS OR NEGATIVE OFNS.  SKIP
;RETURN IF SUCCESSFUL, WITH NUMBER OF IDENTITIES IN IDNUM.  SINCE THIS IS
;CALLED SEVERAL TIMES, WE SAVE TIME IF WE HAVE BEEN CALLED BEFORE.




GETID:	SKIPE	HAVID		;ALREADY COLLECTED THE ID'S?
	 RETSKP			;YES, ALL DONE
	SETOM	IDPAG		;INITIALIZE CURRENT PAGE
	SETZM	IDNUM		;AND NUMBER OF DIFFERENT IDENTITIES
	SETZM	IDPGS		;AND TOTAL NUMBER OF PAGES


IDLOP:	AOS	T2,IDPAG	;INCREMENT TO NEXT PAGE
	TRNE	T2,777000	;WENT OFF OF END?
	JRST	IDDONE		;YES, HAVE ALL IDS THEN
	MOVEI	T1,.RDMAP	;FUNCTION TO READ MAP WORD OF FORK
	MOVE	T3,FORK		;GET FORK HANDLE
	MONRD%			;READ THE POINTER FOR THAT PAGE
	 ERJMP	CPOPJ		;FAILED
	JUMPL	T1,CPOPJ	;ALSO FAILED
	TLNN	T2,-1		;IS THIS PAGE NONEXISTANT?
	JRST	IDNONX		;YES, SEE WHAT TO DO
	TLC	T2,300000	;GET READY FOR CHECK
	TLCN	T2,300000	;IS THIS A PRIVATE OR SHARED PAGE?
	TRNE	T2,400000	;OR INDIRECT TO A FILE?
	AOS	IDPGS		;YES, COUNT UP TOTAL PAGES FOR FORK
	TLNN	T2,200000	;IS THIS A PRIVATE PAGE?
	SKIPA	T1,[1B0]	;YES, REMEMBER THAT
	HRREI	T1,(T2)		;NO, GET FORK OR -OFN BY ITSELF
	HRLZ	T2,IDNUM	;GET CURRENT NUMBER OF TABLE ENTRIES
	JUMPE	T2,IDNEW	;IF NONE, INSERT THIS ONE
	MOVN	T2,T2		;TURN INTO AOBJN POINTER
	CAME	T1,IDVALS(T2)	;FOUND THIS IDENTITY?
	AOBJN	T2,.-1		;NOT YET, KEEP LOOKING
	JUMPGE	T2,IDNEW	;NOT IN TABLE, GO INSERT IT
	AOS	IDCNTS(T2)	;FOUND IT, INCREMENT COUNTER
	JRST	IDLOP		;AND GO BACK TO LOOP
;HERE WHEN THE CURRENT PAGE IS NONEXISTANT:


IDNONX:	SUBI	T2,1		;DECREMENT PAGE SINCE AOS'D ABOVE
	MOVEM	T2,IDPAG	;SAVE NEW PAGE TO START LOOP AT
	JUMPGE	T2,IDLOP	;GO BACK TO LOOP IF NOT YET DONE
IDDONE:	SETOM	HAVID		;SAY WE HAVE THE ID'S
	RETSKP			;GOOD RETURN





;HERE WHEN THE IDENTITY WASN'T IN THE TABLE PREVIOUSLY, TO INSERT IT:


IDNEW:	MOVEM	T1,IDVALS(T2)	;SAVE THIS NEW IDENTITY
	MOVEI	T1,1		;GET AN INITIAL COUNT
	MOVEM	T1,IDCNTS(T2)	;AND SET IT
	AOS	IDNUM		;INCREMENT NUMBER OF IDENTITIES IN TABLE
	JRST	IDLOP		;AND LOOP
	SUBTTL	SUBROUTINE TO TYPE OUT THE PAGE ID'S OF A FORK




;CALLED AFTER COLLECTION OF THE PAGE IDENTITIES OF A FORK, TO SCAN
;THEM AND TYPE OUT THE MOST COMMON ONES.  THE TYPEOUT SHOWS WHICH
;FORKS WE ARE MAPPED INTO, AND WHICH OFNS WE ARE MAPPED TO.




TYPID:	MOVEI	T1,MAXID	;GET MAXIMUM NUMBER OF ID'S ALLOWED
	CAMGE	T1,IDNUM	;ACTUAL NUMBER LESS THAN THIS?
	TXNN	F,FR.MOR	;OR NO MORE COLUMNS COMING?
	MOVE	T1,IDNUM	;YES, GET ACTUAL NUMBER THEN
	JUMPE	T1,CPOPJ	;IF NONE THERE RETURN
	MOVEM	T1,IDYNM	;SAVE NUMBER TO BE TYPED
	TXZ	F,FR.TMP	;CLEAR FLAG


IDTYPL:	SETZB	T1,T2		;INITIALIZE INDEX AND MAXIMUM COUNT
	SOSL	IDYNM		;SEE IF TYPED ALL INDENTITIES YET
	JRST	IDSRCL		;NO, GO GET NEXT ONE
	TXNN	F,FR.MOR	;MORE COLUMNS COMING?
	RET			;NO, THEN WE TYPED EVERYTHING
	MOVE	T1,IDNUM	;GET TOTAL NUMBER OF ENTRIES
	CAILE	T1,MAXID	;MORE THAN WE TYPED?
	CHI$	"+"		;YES, SAY THERE ARE EVEN MORE
	RET			;DONE


IDSRCL:	CAML	T2,IDCNTS(T1)	;FOUND AN ENTRY WITH HIGHER COUNT?
	JRST	IDSRCN		;NO, KEEP LOOKING
	MOVE	T2,IDCNTS(T1)	;YES, REMEMBER NEW MAXIMUM
	MOVE	T3,T1		;AND INDEX OF THE ENTRY
IDSRCN:	ADDI	T1,1		;ADVANCE TO NEXT ENTRY
	CAMGE	T1,IDNUM	;LOOKED AT ALL ENTRIES?
	JRST	IDSRCL		;NO, KEEP LOOPING
	SETZM	IDCNTS(T3)	;CLEAR COUNT SO WON'T SEE THIS AGAIN
	TXOE	F,FR.TMP	;ALREADY TYPED ONE IDENTITY?
	CHI$	"+"		;YES, TYPE A COMMA FIRST
	SKIPL	T1,IDVALS(T3)	;GET THE IDENTITY AND SEE IF IT IS A FORK
	CHI$	"F"		;YES, THEN TYPE PRECEEDING LETTER
	CAMN	T1,[1B0]	;IS IT A PRIVATE PAGE?
	JRST	[CHI$	"P"	;YES, SAY IT IS PRIVATE
		 JRST	IDTYPL]	;CONTINUE LOOPING
	MOVM	T1,T1		;MAKE IT POSITIVE
	CALL	OCTOUT		;THEN OUTPUT EITHER FORK OR OFN NUMBER
	JRST	IDTYPL		;AND LOOP
	SUBTTL	ROUTINE TO SHOW JFN STATUS



;THIS ROUTINE IS CALLED WITH A JOB NUMBER IN AC J, TO FIND
;THE JFNS WHICH ARE IN USE BY THE JOB.  THIS ROUTINE REQUIRES THAT
;THE MONRD% JSYS BE WORKING.



DOJFN:	TXNN	F,FR.JSY	;DOES THE JSYS EXIST?
	RET			;NO, RETURN
	MOVEI	T1,TP.FIL	;THIS IS FILE TYPE OUTPUT
	CALL	HDRSET		;SO SET UP THE HEADER AND TAB STOPS
	SETZM	JFN		;INITIALIZE JFN NUMBER
	MOVE	T1,['MAXJFN']	;GET READY
	CALL	GETJS0		;READ HIGHEST JFN TO LOOK AT
	 RET			;CAN'T
	MOVEM	T1,MAXJFN	;SAVE IT
	MOVE	T1,SKPJFN	;GET NUMBER OF JFNS TO SKIP
	MOVEM	T1,EATNUM	;AND SAVE IT


JFNLOP:	AOS	T2,JFN		;ADVANCE TO NEXT JFN
	CAMG	T2,MAXJFN	;DONE WITH ALL JFNS YET?
	CALL	FULL		;OR IS SCREEN FULL?
	 RET			;YES, RETURN
	MOVE	T1,['FILSTS']	;GET READY TO READ STATUS OF JFN
	IMUL	T2,MLJFN	;MULTIPLY JFN BY LENGTH OF JFN BLOCK
	MOVEM	T2,JFNOFF	;SAVE OFFSET FOR LATER USE
	CALL	GETJSB		;READ JFN STATUS
	 JRST	JFNLOP		;FAILED, LOOK AT NEXT ONE
	TXNE	T1,GS%NAM!GS%ASG	;IS THIS JFN VALID?
	SOSL	EATNUM		;AND ARE WE DONE EATING LINES?
	JRST	JFNLOP		;NO, LOOK AT NEXT ONE
	MOVEM	T1,FILSTS	;YES, SAVE STATUS FOR LATER USE
	CALL	DOCOLS		;TYPE OUT LINE ABOUT JFN
	JRST	JFNLOP		;AND LOOP FOR NEXT ONE
;ROUTINES TO TYPE VARIOUS THINGS ABOUT FILES:



XXJFN:	MOVE	T1,JFN		;GET JFN
	JRST	OCTSP2		;OUTPUT IT AND RETURN


XXOFN:	MOVE	T1,FILSTS	;GET FILE STATUS BITS
	TXNN	T1,GS%OPN	;IS THE FILE OPEN?
	JRST	OFNDSH		;NO, TYPE DASHES
	MOVE	T1,['FILDEV']	;GET READY
	MOVE	T2,JFNOFF	;GET OFFSET TOO
	CALL	GETJSB		;READ DISPATCH ADDRESS FOR JFN
	 RET			;FAILED
	HRRZ	T1,T1		;KEEP ONLY THE ADDRESS
	CAME	T1,DSKDTB	;IS THIS A DISK?
	JRST	OFNDSH		;NO, GO TYPE DASHES
	MOVE	T1,['FILOFN']	;GET READY
	MOVE	T2,JFNOFF	;GET OFFSET
	CALL	GETJSB		;READ OFNS OF FILE
	 RET			;FAILED
	HRRZ	T4,T1		;REMEMBER THE SUPER INDEX BLOCK OFN
	HLRZ	T1,T1		;KEEP THE LOCAL OFN
	JUMPE	T1,OFNDSH	;IF ZERO, TYPE DASHES
	CALL	OCTSP3		;OUTPUT THE OFN
	JUMPE	T4,CPOPJ	;DONE IF WASN'T A LONG FILE
	CHI$	"/"		;SEPARATE THE OFNS
	MOVE	T1,T4		;GET OTHER OFN
	JRST	OCTOUT		;OUTPUT THE SUPER INDEX BLOCK'S OFN

OFNDSH:	STR$	[ASCIZ/ --/]	;SAY NO VALID OFN EXISTS
	RET			;DONE


XXINIF:	MOVE	T1,['FILVER']	;GET READY
	MOVE	T2,JFNOFF	;GET OFFSET
	CALL	GETJSB		;READ CREATOR OF JFN
	 RET			;FAILED
	HLRZ	T2,T1		;GET FORK WHICH STARTED JFN
	CALL	FNDFRK		;CONVERT TO SYSTEM FORK NUMBER
	STR$	[ASCIZ/--/]	;IF FORK NOT THERE, INDICATE THAT
	CAIE	T1,-1		;WAS THERE A FORK?
	JRST	OCTOUT		;YES, OUTPUT IT
	RET			;OTHERWISE DONE
XXBYTE:	MOVE	T1,['FILBYN']	;GET READY
	MOVE	T2,JFNOFF	;GET OFFSET
	CALL	GETJSB		;READ BYTE NUMBER
	 RET			;FAILED
	CALL	DECOUT		;OUTPUT THE NUMBER
	MOVE	T1,['FILBYT']	;GET READY
	MOVE	T2,JFNOFF	;SAME OFFSET
	CALL	GETJSB		;READ BYTE POINTER
	 RET			;FAILED
	CHI$	"("		;OUTPUT STARTING PARENTHESIS
	LDB	T1,[POINT 6,T1,11]	;GET SIZE OF BYTES
	CALL	DECOUT		;OUTPUT IT
	CHI$	")"		;THEN GIVE CLOSING PARENTHESIS
	RET			;DONE


XXFSTA:	MOVE	T1,FILSTS	;GET BACK STATUS BITS
	JRST	TYPSTS		;THEN OUTPUT THEM


XXFILE:	JRST	TYPFIL		;OUTPUT THE FILE SPEC
	SUBTTL	SUBROUTINE TO TYPE OUT A FILE SPEC FOR A JFN





;ROUTINE TO TRACE THE DATA IN A JSB DOWN FOR A PARTICULAR JFN, AND
;TO TYPE OUT THE FULL FILE SPEC ASSOCIATED WITH THE JFN.  CALLED WITH
;JFN OFFSET IN LOCATION JFNOFF.




TYPFIL:	MOVE	T1,['FILDDN']	;POINTER TO DEVICE STRING
	MOVE	T2,JFNOFF	;OFFSET FOR THIS JFN
	CALL	GETJSB		;READ THE POINTER
	 RET			;CAN'T
	HLRZ	T1,T1		;KEEP JUST THE POINTER
	JUMPE	T1,TYPFL1	;IF NO DEVICE, SKIP ON
	CALL	TYPPTR		;TYPE OUT DEVICE
	 RET			;FAILED
	CHI$	":"		;TYPE COLON FOR THE DEVICE


TYPFL1:	MOVE	T1,['FILDNM']	;GET READY TO READ DIRECTORY
	MOVE	T2,JFNOFF	;SAME OFFSET
	CALL	GETJSB		;READ POINTER
	 RET			;FAILED
	HLRZ	T1,T1		;GET POINTER IN RIGHT HALF
	JUMPE	T1,TYPFL2	;IF NO DIRECTORY, JUMP ON
	CHI$	"<"		;TYPE STARTING BRACKET
	CALL	TYPPTR		;TYPE OUT THE DIRECTORY NUMBER
	 RET			;FAILED
	CHI$	">"		;FINISH DIRECTORY
TYPFL2:	MOVE	T1,['FILNEN']	;GET READY
	MOVE	T2,JFNOFF	;AGAIN SAME OFFSET
	CALL	GETJSB		;READ THE POINTER WORD
	 RET			;FAILED
	MOVEM	T1,TXTTMP	;SAVE IT
	HLRZ	T1,T1		;GET POINTER TO FILE NAME
	CALL	TYPPTR		;TYPE FILE NAME STRING
	 RET			;FAILED
	MOVE	T1,['FILVER']	;GET READY
	MOVE	T2,JFNOFF	;SAME OFFSET
	CALL	GETJSB		;READ GENERATION NUMBER
	 RET			;FAILED
	HRLM	T1,TXTTMP	;SAVE GENERATION NUMBER
	SKIPN	T1,TXTTMP	;GET POINTER TO EXTENSION
	RET			;IF NO EXTENSION OR GENERATION, DONE
	CHI$	"."		;TYPE A DOT
	CALL	TYPPTR		;TYPE EXTENSION
	 RET			;FAILED
	CHI$	"."		;ONE MORE DOT
	HLRZ	T1,TXTTMP	;GET GENERATION NUMBER BACK
	CALL	DECOUT		;OUTPUT THE VERSION
	RETSKP			;GOOD RETURN
	SUBTTL	SUBROUTINE TO OUTPUT FILE STATUS INFORMATION




;CALLED WITH A JFN'S FILE STATUS BITS IN T1, TO OUTPUT INFORMATION
;ABOUT THE FILE.  THE STATUS BITS IN THE MONITOR'S STATUS WORD ARE
;THE SAME AS RETURNED BY THE GTSTS JSYS.




TYPSTS:	TXNN	T1,GS%OPN	;IS FILE OPENED?
	TXZ	T1,GS%RDF+GS%WRF+GS%XCF+GS%RND	;NO, CLEAR THESE BITS
	TXNE	T1,GS%RDF	;OPEN FOR READ?
	TXZ	T1,GS%XCF	;YES, CLEAR EXECUTE ACCESS
	TXNN	T1,GS%OPN+GS%AST	;CAN FILE BE OPENED BUT ISN'T?
	STR$	[ASCIZ/Nopen /]	;YES, SAY NOT OPENED
	TXNE	T1,GS%AST	;IS THE JFN PARSE ONLY?
	STR$	[ASCIZ/Parse /]	;YES, SAY SO
	TXNE	T1,GS%RDF	;OPEN FOR READ?
	STR$	[ASCIZ/Rd /]	;YES, SAY SO
	MOVEI	T2,[ASCIZ/Wrt /]	;GET STRING
	TXNN	T1,GS%RND	;APPEND ONLY?
	MOVEI	T2,[ASCIZ/App /]	;YES, GET OTHER TEXT
	TXNE	T1,GS%WRF	;OPEN FOR WRITE?
	STR$	(T2)		;SAY, SAY SO
	TXNE	T1,GS%XCF	;OPEN FOR EXECUTE?
	STR$	[ASCIZ/Xct /]	;YES, INDICATE THAT
	TXNE	T1,GS%FRK	;RESTRICTED JFN?
	STR$	[ASCIZ/Res /]	;YES, SAY SO
	TXNE	T1,GS%EOF	;AT END OF FILE?
	STR$	[ASCIZ/Eof /]	;SAY, INDICATE IT
	TXNE	T1,GS%ERR	;ANY ERRORS IN FILE?
	STR$	[ASCIZ/Err /]	;YES, SAY SO
	TXNN	T1,GS%NAM	;ANY FILE FOUND FOR JFN?
	STR$	[ASCIZ/Inv/]	;NO, SAY SPEC IS INVALID
	RET			;DONE
	SUBTTL	DISPLAY FOR QUEUES




;THIS DISPLAY ROUTINE LISTS THE QUEUES.  SET BY THE "Q" COMMAND.
;IPCF PACKETS ARE SENT TO QUASAR, AND THE RETURN MESSAGES ARE OUTPUT
;TO THE SCREEN.  THUS THE FORMAT OF THE OUTPUT IS TOTALLY UP TO
;QUASAR.



DPYQUE:	SETOM	HDRTYP		;CLEAR HEADER TYPE
	TAB$			;USE DEFAULT TAB STOPS
	TXNE	F,FR.CMP!FR.INF	;COMPRESSED OUTPUT OR SHOWING INFO LINES?
	JRST	QUENOC		;YES, SKIP THIS
	STR$	[ASCIZ/Queues as of /]	;TYPE SOME
	HRROI	T1,TEMP		;POINT TO TEMPORARY DATA
	SETOB	T2,T3		;CURRENT TIME, VERBOSE OUTPUT
	ODTIM			;COMPUTE AND STORE IT
	STR$	TEMP		;THEN OUTPUT IT
	STR$	[ASCIZ/

/]				;SPACE DOWN SOME

QUENOC:	CALL	GETPID		;GO OBTAIN PIDS FOR MYSELF AND QUASAR
	 JRST	LOSE		;FAILED, GO COMPLAIN
	CALL	SETEAT		;GO SET UP HOW MANY LINES TO EAT
	MOVEI	T1,MBLK-1	;POINT AT DATA BLOCK
	PUSH	T1,[0]			;NO FLAGS
	PUSH	T1,MYPID		;STORE SENDER
	PUSH	T1,QSRPID		;AND RECEIVER
	PUSH	T1,[XWD QSRLEN,QSRMSG]	;AND POINTER TO DATA
	MOVEI	T1,4		;SIZE OF PACKET DESCRIPTER BLOCK
	MOVEI	T2,MBLK		;ADDRESS OF BLOCK
	MSEND			;SEND THE PACKET TO QUASAR
	 ERJMP	[SETZM	QSRPID	;FAILED, CLEAR PID IN CASE NOT VALID
		JRST	LOSE]	;AND GO COMPLAIN
	TXZ	F,FR.TMP	;INITIALIZE FIRST TIME FLAG
;NOW READ THE REPLY FROM QUASAR AND TYPE IT:


RECLOP:	MOVEI	T1,MBLK-1	;POINT AT DATA BLOCK
	PUSH	T1,[IP%CFV]	;SET UP FLAGS
	PUSH	T1,QSRPID	;INTENDED SENDER (IGNORED)
	PUSH	T1,MYPID		;AND RECEIVER
	PUSH	T1,[1000,,DATLOC/1000]	;AND POINTER TO DATA
	MOVEI	T1,4		;LENGTH OF BLOCK
	MOVEI	T2,MBLK		;ADDRESS OF BLOCK
	MRECV			;BLOCK UNTIL A MESSAGE IS RETURNED
	 ERJMP	[SETZM	QSRPID	;FAILED, CLEAR PID IN CASE NO LONGER VALID
		JRST	LOSE]	;AND SAY WHAT HAPPENED
	MOVE	T1,MBLK+.IPCFS	;GET PID WHO SENT TO US
	CAME	T1,QSRPID	;FROM QUASAR?
	JRST	RECLOP		;NO, IGNORE THE PACKET
	MOVEI	T1,DATLOC+.OHDRS	;POINT AT FIRST BLOCK
	HLRZ	T2,(T1)		;GET SIZE OF THE BLOCK
	TXOE	F,FR.TMP	;FIRST PAGE OF DATA?
	JRST	QUETYP		;NO, JUST TYPE THE STRING
	ADDB	T1,T2		;MOVE TO BLOCK WE WANT
	MOVEI	T3,177		;YES, GET SET TO EAT LEADING CRLFS
	TLOA	T2,(POINT 7,0,34)	;MAKE A BYTE POINTER
RUBSTR:	DPB	T3,T2		;STORE A RUBOUT
	ILDB	T4,T2		;GET NEXT CHARACTER
	CAIE	T4,15		;CARRIAGE RETURN?
	CAIN	T4,12		;OR LINE FEED?
	JRST	RUBSTR		;YES, GO REPLACE WITH RUBOUT

QUETYP:	STR$	1(T1)		;OUTPUT THE TEXT
	MOVE	T1,DATLOC+.OFLAG	;GET FLAGS
	TXNE	T1,WT.MOR	;MORE MESSAGES COMING?
	JRST	RECLOP		;YES, LOOP
	RET			;NO, ALL DONE
	SUBTTL	ROUTINE TO OBTAIN ALL NECESSARY PIDS




;CALLED TO OBTAIN PIDS FOR SYSTEM INFO, QUASAR, AND MYSELF.
;SKIP RETURN IF SUCCESSFUL, NON-SKIP IF FAILED.




GETPID:	SKIPE	INFPID		;HAVE A PID FOR SYSTEM INFO?
	JRST	GETQSP		;YES, GO SEE ABOUT QUASAR
	MOVEI	T1,3		;SIZE OF BLOCK
	MOVEI	T2,MBLK		;ADDRESS OF IT TOO
	MOVEI	T3,.MURSP	;FUNCTION TO READ SYSTEM PIDS
	MOVEM	T3,MBLK		;SET IT UP
	MOVEI	T3,.SPINF	;WANT TO GET SYSTEM INFO
	MOVEM	T3,MBLK+1	;STORE IT
	MUTIL			;DO THE WORK
	 ERJMP	CPOPJ		;FAILED
	MOVE	T1,MBLK+2	;GET THE PID
	MOVEM	T1,INFPID	;SAVE FOR LATER

GETQSP:	SKIPE	QSRPID		;DO WE HAVE QUASAR'S PID?
	JRST	GETMYP		;YES, GO SEE ABOUT MY OWN PID
	MOVEI	T1,3		;SIZE OF ARGUMENT BLOCK
	MOVEI	T2,MBLK		;AND ADDRESS OF ARGUMENT BLOCK
	MOVEI	T3,.MURSP	;FUNCTION TO RETURN A PID
	MOVEM	T3,MBLK		;SET IT
	MOVEI	T3,.SPQSR	;CODE FOR QUASAR
	MOVEM	T3,MBLK+1	;SET IT
	MUTIL			;ASK MONITOR FOR THE PID
	 ERJMP	CPOPJ		;FAILED, ERROR RETURN
	MOVE	T1,MBLK+2	;GET THE PID
	MOVEM	T1,QSRPID	;AND REMEMBER IT FOR LATER


GETMYP:	SKIPE	MYPID		;SEE IF ALREADY HAVE OUR PID
	RETSKP			;YES, GOOD RETURN
	MOVEI	T1,3		;A FEW ARGUMENTS
	MOVEI	T2,MBLK		;NORMAL ARGUMENT BLOCK
	MOVEI	T3,.MUCRE	;FUNCTION TO CREATE A PID
	MOVEM	T3,MBLK		;SET IT UP
	MOVEI	T3,.FHSLF	;WANT A PID FOR MY PROCESS
	MOVEM	T3,MBLK+1	;STORE THE ARGUMENT
	MUTIL			;ASK TO HAVE A PID CREATED FOR US
	 ERJMP	CPOPJ		;FAILED
	MOVE	T1,MBLK+2	;GET THE PID THAT WAS OBTAINED
	MOVEM	T1,MYPID	;REMEMBER IT
	RETSKP			;GOOD RETURN
	SUBTTL	DISPLAY ROUTINE TO TYPE PIDS ON THE SYSTEM




;CALLED TO DISPLAY INFORMATION ABOUT IPCF DATA SYSTEM-WIDE.
;MOST THINGS CAN BE OBTAINED BY THE MUTIL JSYS, BUT SOME THINGS
;NEED THE MONRD% JSYS TO DO.



DPYIPC:	MOVEI	T1,TP.IPC	;THIS IS IPCF DATA
	CALL	HDRSET		;SO SET UP THE HEADER
	TXO	F,FR.EAT	;DO EATING OF LINES AFTER HEADER
	SETOM	PIDJOB		;CLEAR JOB NUMBER FOR LOOP
	SETOM	OLDJOB		;CLEAR OLD JOB NUMBER TOO


IPCLOP:	AOS	T2,PIDJOB	;MOVE TO NEXT JOB
	CAMG	T2,HGHJOB	;DID ALL JOBS?
	CALL	FULL		;OR IS SCREEN FULL?
	 RET			;YES, DONE
	MOVEM	T2,PIDTAB+1	;NO, SET JOB NUMBER IN BLOCK
	MOVEI	T1,PIDSIZ	;GET SIZE OF BLOCK
	MOVEI	T2,PIDTAB	;AND ADDRESS OF BLOCK
	MOVEI	T3,.MUFJP	;GET FUNCTION CODE
	MOVEM	T3,PIDTAB	;AND SET IT
	MUTIL			;ASK MONITOR TO READ INFO
	 ERJMP	IPCLOP		;FAILED, ASK ABOUT NEXT JOB
	MOVEI	J,PIDTAB	;POINT AT START OF PID LIST


PIDLOP:	ADDI	J,2		;MOVE TO NEXT PID PAIR
	SKIPN	(J)		;ANOTHER PID TO SHOW?
	JRST	IPCLOP		;NO, GO DO NEXT JOB
	CALL	DOCOLS		;YES, SHOW INFO ON THIS PID
	JRST	PIDLOP		;THEN GO DO ANOTHER ONE
;HERE TO OUTPUT THE VARIOUS THINGS ABOUT EACH PID FOUND.




XXPIDJ:	MOVE	T1,PIDJOB	;GET JOB NUMBER THIS PID IS FROM
	CAMN	T1,OLDJOB	;SAME AS LAST TIME?
	RET			;YES, RETURN
	MOVEM	T1,OLDJOB	;NO, SET IT
	JRST	DECSP2		;AND OUTPUT IT


XXPID:	HLRZ	T1,0(J)		;GET LEFT HALF OF PID
	CALL	OCTSP6		;OUTPUT IN FIELD OF 6
	STR$	[ASCIZ/,,/]	;THEN COMMAS
	HRRZ	T1,0(J)		;GET RIGHT HALF OF PID
	JRST	OCTOUT		;OUTPUT IT AND RETURN


XXPIDF:	MOVE	T1,1(J)		;GET WORD OF FLAGS
	TXNE	T1,IP%JWP	;IS THIS A JOB-WIDE PID?
	STR$	[ASCIZ/Job /]	;YES, SAY SO
	TXNE	T1,IP%NOA	;ACCESSIBLE BY OTHER PROCESSES?
	STR$	[ASCIZ/Res /]	;NO, SAY SO
	MOVE	T1,[PD.FLG]	;GET BYTE POINTER
	CALL	PIDMON		;ASK MONITOR FOR DATA
	 RET			;FAILED
	TXNE	T1,PD%DIS	;IS THE PID DISABLED?
	STR$	[ASCIZ/Dis/]	;YES, SAY SO
	RET			;DONE


XXPQTA:	MOVEI	T1,3		;THREE WORDS
	MOVEI	T2,MBLK		;POINT TO ARGUMENT BLOCK
	MOVEI	T3,.MUFSQ	;GET FUNCTION CODE
	MOVEM	T3,MBLK		;SET IT
	MOVE	T3,0(J)		;GET THE PID TO ASK ABOUT
	MOVEM	T3,MBLK+1	;STORE AS ARGUMENT
	MUTIL			;ASK MONITOR ABOUT THE PID
	 ERJMP	CPOPJ		;FAILED
	LDB	T1,[POINT 9,MBLK+2,26]	;GET SEND QUOTA
	CALL	DECSP4		;OUTPUT IT
	CHI$	"/"		;TYPE A SLASH
	LDB	T1,[POINT 9,MBLK+2,35]	;GET RECEIVE QUOTA
	JRST	DECOUT		;OUTPUT IT AND RETURN
XXSYSP:	CALL	SYSPID		;READ ALL OF THE SYSTEM PIDS
	MOVE	T1,0(J)		;GET THE PID
	MOVSI	T2,-PIDNUM	;AND A COUNTER FOR LOOPING
	CAME	T1,PIDSYS(T2)	;FOUND THE PID YET?
	AOBJN	T2,.-1		;NO, KEEP SEARCHING
	JUMPGE	T2,CPOPJ	;RETURN IF NOT A SYSTEM PID
	STR$	[ASCIZ/  /]	;SPACE OVER SOME
	STR$	@PIDNAM(T2)	;OUTPUT THE NAME OF THIS PID
	RET			;DONE
	

;TABLE OF SYSTEM PID NAMES:


PIDNAM:	EXP	[ASCIZ/IPCC/]	;(0) SYSTEM IPCC
	EXP	[ASCIZ/INFO/]	;(1) <SYSTEM>INFO
	EXP	[ASCIZ/QUASAR/]	;(2) QUEUEING SYSTEM CONTROLLER
	EXP	[ASCIZ/QSRMDA/]	;(3) MOUNTABLE DEVICE ALLOCATOR
	EXP	[ASCIZ/ORION/]	;(4) OPERATOR SERVICE PROGRAM
	EXP	[ASCIZ/NETCON/]	;(5) DECNET CONTROLLER

	PIDNUM==.-PIDNAM	;NUMBER OF ENTRIES




XXPPRG:	HRLZ	T1,PIDJOB	;GET JOB NUMBER
	HRRI	T1,.JOBPN	;INDEX FOR PROGRAM NAME
	GETAB			;GET IT
	 ERJMP	CPOPJ		;FAILED
	JRST	SIXOUT		;OUTPUT IN SIXBIT
XXRECC:	MOVE	T1,[PD.CNT]	;GET POINTER TO OUTSTANDING PACKETS
	CALL	PIDMON		;ASK MONITOR FOR DATA
	 RET			;FAILED
	JRST	OCTSP4		;OUTPUT AND RETURN



XXPOWN:	MOVE	T1,[PD.FKO]	;GET OWNER FORK POINTER
	CALL	PIDMON		;ASK MONITOR FOR DATA
	 RET			;FAILED
	JRST	OCTSP3		;OUTPUT IT



XXPDWT:	MOVE	T1,[PD.FKW]	;GET FORK WAIT FIELD
	CALL	PIDMON		;ASK MONITOR FOR DATA
	 RET			;FAILED
	CAIN	T1,-1		;NO FORK IN A WAIT?
	STR$	[ASCIZ/--/]	;YES, SAY SO
	CAIE	T1,-1		;WELL?
	JRST	OCTOUT		;YES, GO OUTPUT IT
	RET			;DONE




;LOCAL SUBROUTINE TO READ DATA ABOUT A PID BY USE OF MONRD% JSYS.
;BYTE POINTER TO DATA IS IN T1.  RETURNS VALUE IN T1 IF SUCCESSFUL.
;NON-SKIP IF FAIL.


PIDMON:	HRRZ	T3,T1		;PUT OFFSET IN RIGHT PLACE
	HLLZ	T4,T1		;SAVE BYTE POINTER
	MOVEI	T1,.RDPID	;FUNCTION CODE
	MOVE	T2,0(J)		;GET PID TO READ DATA OF
	MONRD%			;DO THE WORK
	 ERJMP	CPOPJ		;FAILED
	JUMPL	T1,CPOPJ	;ALSO FAILED
	HRRI	T4,T2		;MAKE BYTE POINTER POINT TO DATA
	LDB	T1,T4		;GET THE DATA
	RETSKP			;GOOD RETURN
XXPNAM:	CALL	GETPID		;OBTAIN A PID FOR MYSELF
	 RET			;FAILED, CAN'T FIND NAME
	MOVEI	T1,MBLK-1	;POINT AT ARGUMENT BLOCK
	PUSH	T1,[0]		;NO FLAGS
	PUSH	T1,MYPID	;SET MY PID AS THE SENDER
	PUSH	T1,[0]		;RECEIVER IS SYSTEM INFO
	PUSH	T1,[3,,INFMSG]	;POINT AT DATA TO SEND
	MOVE	T1,0(J)		;GET THE PID TO ASK ABOUT
	MOVEM	T1,INFDAT	;SET AS DATA FOR SYSTEM INFO
	MOVEI	T1,4		;LENGTH OF ARGUMENT BLOCK
	MOVEI	T2,MBLK		;ADDRESS
	MSEND			;SEND THE PACKET
	 ERJMP	LOSE		;FAILED


INFREC:	MOVE	T1,[TEMP,,TEMP+1]	;GET SET
	SETZM	TEMP			;TO CLEAR SOME WORDS
	BLT	T1,TEMP+TMPSIZ-1	;DO IT
	MOVEI	T1,MBLK-1	;POINT AT DATA BLOCK
	PUSH	T1,[0]		;NO FLAGS
	PUSH	T1,[0]		;SENDER IS IGNORED
	PUSH	T1,MYPID	;MY PID IS THE RECEIVER
	PUSH	T1,[TMPSIZ,,TEMP]	;PLACE TO STORE ANSWER
	MOVEI	T1,4		;GET LENGTH
	MOVEI	T2,MBLK		;AND ADDRESS OF BLOCK
	MRECV			;RECEIVE THE ANSWER
	 ERJMP	LOSE		;FAILED
	MOVE	T1,MBLK+.IPCFS	;GET SENDER
	CAME	T1,INFPID	;IS IT FROM SYSTEM INFO?
	JRST	INFREC		;NO, IGNORE IT
	TXNE	F,FR.MOR	;ANY MORE COLUMNS COMING?
	SETZM	TEMP+5		;YES, THEN RESTRICT THE NAME
	STR$	TEMP+1		;OUTPUT THE NAME
	RET			;DONE
	SUBTTL	SUBROUTINE TO READ ALL SYSTEM PIDS



;CALLED TO OBTAIN THE SYSTEM PIDS AND STORE THEM IN A TABLE FOR
;LATER USE.  ANY PID WHICH DOES NOT EXIST WILL BE ZERO.



SYSPID:	MOVEI	T1,.MURSP	;FUNCTION TO READ SYSTEM PID TABLE
	MOVEM	T1,MBLK		;SET IT
	SETOM	MBLK+1		;AND INITIALIZE OFFSET


SYSPIL:	AOS	T1,MBLK+1	;ADVANCE TO THE NEXT OFFSET
	CAIL	T1,PIDNUM	;DID ALL KNOWN SYSTEM PIDS?
	RET			;YES, DONE
	SETZM	PIDSYS(T1)	;CLEAR WORD IN CASE MUTIL FAILS
	MOVEI	T1,3		;SIZE OF ARGUMENT BLOCK
	MOVEI	T2,MBLK		;ADDRESS OF THE BLOCK
	MUTIL			;READ THE PID VALUE
	 ERJMP	SYSPIL		;FAILED, TRY NEXT ONE
	DMOVE	T1,MBLK+1	;GET THE OFFSET AND THE PID
	MOVEM	T2,PIDSYS(T1)	;REMEMBER THE PID
	JRST	SYSPIL		;LOOP
	SUBTTL	DISPLAY FOR DISK STATUS




;THIS DISPLAY TYPES OUT THE STATUS OF ALL THE DISK DRIVES ON THE
;SYSTEM.  UNFORTUNATELY, THIS CURRENTLY REQUIRES WHEEL PRIVILEGES
;TO WORK.  ONLY USES THE MSTR JSYS.




DPYDSK:	CALL	DOSTR		;GO TYPE THE STATUS OF ALL STRUCTURES
	MOVEI	T1,TP.DSK	;THIS IS THE DISK OUTPUT DISPLAY
	CALL	HDRSET		;SO SET UP HEADERS AND TAB STOPS
	TXO	F,FR.EAT	;REMEMBER TO SET UP EATING LATER
	SETOM	SBLK+.MSRCH	;INITIALIZE CHANNEL NUMBER
	SETOM	SBLK+.MSRCT	;CONTROLLER NUMBER
	SETOM	SBLK+.MSRUN	;AND UNIT NUMBER



DSKLOP:	HRROI	T1,STRUC	;GET POINTER TO STRUCTURE NAME
	MOVEM	T1,SBLK+.MSRSN	;SET IN ARGUMENT BLOCK
	HRROI	T1,ALIAS	;GET POINTER TO ALIAS NAME
	MOVEM	T1,SBLK+.MSRSA	;PUT IN ARGUMENT BLOCK
	SETZM	STRUC		;CLEAR NAMES IN CASE NOT FILLED IN
	SETZM	ALIAS		;SO WON'T BE CONFUSED
	MOVE	T1,[.MSRBT+1,,.MSRNU]	;GET LENGTH AND FUNCTION
	MOVEI	T2,SBLK		;AND ADDRESS OF ARGUMENT BLOCK
	MSTR			;DO THE WORK
	 ERJMP	DSKDON		;FAILED, GO SEE WHY
	MOVE	T1,SBLK+.MSRCH	;GET CHANNEL
	MOVE	T2,SBLK+.MSRCT	;AND CONTROLLER NUMBER
	MOVE	T3,SBLK+.MSRUN	;AND UNIT NUMBER
	CALL	GETUDB		;GO READ IN THE UDB FOR THIS DISK
	TXZA	F,FR.UDB	;UDB IS INVALID
	TXO	F,FR.UDB	;UDB IS OK
	CALL	DOCOLS		;SHOW DATA ABOUT THIS UNIT
	JRST	DSKLOP		;DO NEXT UNIT


DSKDON:	MOVEI	T1,.FHSLF	;GET READY
	GETER			;READ LAST ERROR IN MY JOB
	ANDI	T2,-1		;REMOVE THE FORK HANDLE
	CAIE	T2,MSTX18	;NO MORE UNITS?
	JRST	LOSE		;NO, SOME OTHER ERROR
	RET			;YES, DONE
;ROUTINES CALLED TO OUTPUT THE COLUMNS ABOUT THE DISK UNITS:



XXCHAN:	MOVE	T1,SBLK+.MSRCH	;GET CHANNEL NUMBER
	JRST	OCTSP2		;OUTPUT IT AND RETURN



XXUNIT:	MOVE	T1,SBLK+.MSRUN	;GET UNIT NUMBER
	JRST	OCTSP3		;OUTPUT IT AND RETURN



XXCTRL:	SKIPL	T1,SBLK+.MSRCT	;GET CONTROLLER NUMBER
	JRST	OCTSP2		;IF ONE, TYPE IT
	STR$	[ASCIZ/ -/]	;OTHERWISE SAY THERE IS NONE
	RET			;DONE


XXSTR:	STR$	STRUC		;OUTPUT THE STRUCTURE NAME
	RET			;DONE



XXALIS:	STR$	ALIAS		;OUTPUT THE ALIAS NAME
	RET			;DONE



XXLUNT:	MOVE	T1,SBLK+.MSRST	;GET STATUS
	TXNE	T1,MS%OFL	;IS DISK OFF LINE?
	RET			;YES, CAN'T KNOW THIS THEN
	HLRZ	T1,SBLK+.MSRNS	;GET LOGICAL UNIT NUMBER
	ADDI	T1,1		;INCREMENT BY 1
	CALL	OCTOUT		;OUTPUT IT
	CHI$	"/"		;THEN A SLASH
	HRRZ	T1,SBLK+.MSRNS	;GET TOTAL UNITS IN STRUCTURE
	JRST	OCTOUT		;OUTPUT IT



XXSWAP:	MOVE	T1,SBLK+.MSRST	;GET STATUS BITS
	TXNE	T1,MS%OFL	;OFF LINE?
	RET			;YES, THEN NO INFORMATION AVAILABLE
	MOVE	T1,SBLK+.MSRSW	;GET NUMBER OF SWAPPING SECTORS
	IDIV	T1,SBLK+.MSRSP	;CONVERT FROM SECTORS TO PAGES
	JRST	DECSP6		;OUTPUT IT AND RETURN
XXUSTS:	MOVE	T1,SBLK+.MSRST	;GET STATUS BITS
	TXNE	T1,MS%MNT	;MOUNTED?
	STR$	[ASCIZ/Mount /]	;YES, SAY SO
	TXNE	T1,MS%DIA	;DOING DIAGNOSTICS?
	STR$	[ASCIZ/Diag /]	;YES, SAY SO
	TXNE	T1,MS%OFL	;IS IT OFF-LINE?
	STR$	[ASCIZ/Offline /]	;YES, SAY SO
	TXNN	T1,MS%MNT!MS%DIA!MS%OFL	;READY BUT NOT IN USE?
	STR$	[ASCIZ/Free /]	;YES, SAY ITS FREE
	TXNE	T1,MS%ERR	;ERROR DURING READING?
	STR$	[ASCIZ/Err /]	;YES, SAY SO
	TXNE	T1,MS%BBB	;BAD BAT BLOCKS?
	STR$	[ASCIZ/BadBAT /]	;YES, SAY SO
	TXNE	T1,MS%HBB	;BAD HOME BLOCK?
	STR$	[ASCIZ/BadHOM /]	;YES, SAY SO
	TXNE	T1,MS%WLK	;WRITE LOCKED?
	STR$	[ASCIZ/Wrtlck/]	;YES, SAY SO
	RET			;DONE




XXTYPE:	LDB	T1,[POINT 9,SBLK+.MSRST,17]	;GET TYPE FIELD
	MOVSI	T2,-TYPNUM	;GET SET FOR SEARCH
	HLRZ	T3,TYPTAB(T2)	;GET NEXT POSSIBLE MATCH
	CAME	T1,T3		;FOUND IT?
	AOBJN	T2,.-2		;NO, KEEP SEARCHING
	JUMPGE	T2,OCTSP3	;IF NOT FOUND, TYPE IN OCTAL
	HRRZ	T1,TYPTAB(T2)	;GET ADDRESS OF STRING
	STR$	(T1)		;TYPE IT
	RET			;DONE


TYPTAB:	XWD	.MSRP4,[ASCIZ/RP04/]	;RP04 DISK
	XWD	.MSRP5,[ASCIZ/RP05/]	;RP05 DISK
	XWD	.MSRP6,[ASCIZ/RP06/]	;RP06 DISK
	XWD	.MSRP7,[ASCIZ/RP07/]	;RP07 DISK
	XWD	.MSRM3,[ASCIZ/RM03/]	;RM03 DISK
	XWD	.MSR20,[ASCIZ/RP20/]	;RP20 DISK

	TYPNUM==.-TYPTAB	;NUMBER OF ENTRIES
XXSEEK:	TXNN	F,FR.UDB	;IS THE UDB VALID?
	RET			;NO, TYPE NOTHING
	MOVE	T1,UDBSEK	;GET OFFSET
	MOVE	T1,UDB(T1)	;GET THE DATA TO TYPE
	JRST	DECSP6		;GO OUTPUT IT



XXREAD:	SKIPA	T1,UDBRED	;GET OFFSET FOR READS
XXWRIT:	MOVE	T1,UDBWRT	;OR OFFSET FOR WRITES
	TXNN	F,FR.UDB	;IS THE UDB VALID?
	RET			;NO, QUIT
	MOVE	T1,UDB(T1)	;GET THE NUMBER OF READS OR WRITES
	IDIV	T1,SBLK+.MSRSP	;DIVIDE TO GET PAGES
	JRST	DECSP6		;GO OUTPUT IT



XXRDER:	MOVE	T1,UDBSRE	;SOFT READ ERRORS
	MOVE	T4,UDBHRE	;AND HARD READ ERROS

TYPERR:	TXNN	F,FR.UDB	;IS THE UDB VALID?
	RET			;NO
	MOVE	T1,UDB(T1)	;GET NUMBER OF SOFT ERRORS
	MOVE	T4,UDB(T4)	;AND NUMBER OF HARD ERRORS
	JUMPN	T1,TYPERY	;GO ON IF HAVE ANY ERRORS
	JUMPN	T4,TYPERY	;OF EITHER TYPE
	STR$	[ASCIZ/  --   --/]	;NONE, SAY SO
	RET			;DONE

TYPERY:	CALL	DECSP3		;OUTPUT NUMBER OF SOFT ERRORS
	STR$	[ASCIZ/S /]	;MARK THEM AS SOFT AND SPACE OVER
	MOVE	T1,T4		;GET ERROR COUNT
	CALL	DECSP3		;OUTPUT NUMBER OF HARD ERRORS
	CHI$	"H"		;MARK THEM AS HARD
	RET			;DONE



XXWTER:	MOVE	T1,UDBSWE	;SOFT WRITE ERROR
	MOVE	T4,UDBHWE	;AND HARD WRITE ERROR
	JRST	TYPERR		;GO OUTPUT THEM



XXPSER:	MOVE	T1,UDBSPE	;SOFT POSITIONING ERROR
	MOVE	T4,UDBHPE	;HARD POSITIONING ERROR
	JRST	TYPERR		;GO OUTPUT THEM
	SUBTTL	SUBROUTINE TO READ THE UDB OF A DISK OR MAGTAPE UNIT




;CALLED WITH CHANNEL NUMBER IN T1, CONTROLLER ON THAT CHANNEL IN T2, AND
;UNIT ON THE CONTROLLER IN T3, TO RETURN STARTING IN LOCATION UDB THE
;UNIT DATA BLOCK FOR THAT DEVICE.  THIS ROUTINE REQUIRES PRIVILEGES AS
;PEEKS ARE USED TO OBTAIN THE INFORMATION.  SKIP RETURN IF SUCCESSFUL.



GETUDB:	SKIPL	T1		;RANGE CHECK CHANNEL NUMBER
	CAILE	T1,7		;WHICH CAN ONLY BE FROM 0 TO 7
	RET			;BAD, GIVE ERROR
	CAML	T2,[-1]		;RANGE CHECK THE CONTROLLER NUMBER
	CAILE	T2,7		;WHICH CAN ONLY BE FROM -1 TO 7
	RET			;BAD, GIVE ERROR
	JUMPL	T3,CPOPJ	;NEGATIVE UNIT NUMBER IS ILLEGAL
	SKIPGE	T2		;ANY CONTROLLER?
	CAIG	T3,7		;NO, THEN UNIT HAS TO BE FROM 0 TO 7
	CAILE	T3,377		;YES, THEN UNIT CAN BE FROM 0 TO 377
	RET			;NOPE, FAIL
	MOVEM	T1,CHAN		;SAVE CHANNEL
	MOVEM	T2,CTRL		;CONTROLLER
	MOVEM	T3,UNIT		;AND UNIT TOO
	CALL	UDBSYM		;GO OBTAIN ALL UDB SYMBOLS NEEDED
	 RET			;FAILED
	MOVE	T1,CHAN		;GET BACK CHANNEL NUMBER
	ADD	T1,CHNTAB	;CREATE ADDRESS OF CHANNEL POINTER
	CALL	DOPEEK		;OBTAIN THE CDB ADDRESS
	 RET			;FAILED
	JUMPE	T1,CPOPJ	;IF ZERO, NO SUCH CHANNEL
	ADD	T1,CDBUDB	;ADD IN ADDRESS OF THE UDB/KDB POINTERS
	SKIPGE	T2,CTRL		;ANY CONTROLLER?
	MOVE	T2,UNIT		;NO, THEN GET UNIT INSTEAD
	ADD	T1,T2		;ADD IN CONTROLLER/UNIT NUMBER
	CALL	DOPEEK		;OBTAIN THE UDB/KDB ADDRESS
	 RET			;FAILED
	JUMPE	T1,CPOPJ	;IF ZERO, NO SUCH UNIT
	SKIPGE	CTRL		;ANY CONTROLLER?
	JRST	HAVUDB		;NO, THEN WE HAVE THE UDB ADDRESS NOW
	ADD	T1,KDBIUN	;ADD OFFSET OF UDB POINTERS
	CALL	DOPEEK		;READ AOBJN WORD TO UNITS OF CONTROLLER
	 RET			;FAILED
	JUMPGE	T1,CPOPJ	;IF NO UNITS, FAIL
	MOVE	T4,T1		;MOVE TO SAFE AC
UDBSRC:	HRRZ	T1,T4		;GET ADDRESS OF NEXT UDB POINTER
	CALL	DOPEEK		;READ THE POINTER
	 RET			;FAILED
	JUMPE	T1,UDBSRN	;IF NONE, TRY NEXT UNIT
	MOVEM	T1,TEMP		;REMEMBER UDB ADDRESS FOR LATER
	ADD	T1,UDBSLV	;ADD IN OFFSET TO GET SLAVE NUMBER
	CALL	DOPEEK		;READ THE SLAVE NUMBER
	 RET			;FAILED
	ANDI	T1,-1		;KEEP ONLY THE RIGHT HALF
	CAME	T1,UNIT		;IS THIS THE REQUIRED UNIT?
UDBSRN:	AOBJN	T4,UDBSRC	;NO, SEARCH SOME MORE
	JUMPGE	T4,CPOPJ	;FAIL IF NOT FOUND
	MOVE	T1,TEMP		;RESTORE THE UDB ADDRESS

HAVUDB:	MOVE	T2,UDBDDD	;GET SIZE OF UDB
	CAIL	T2,UDBSIZ	;MAKE SURE BLOCK IS LARGE ENOUGH
	RET			;NO, THEN FAIL
	HRL	T1,T2		;PUT SIZE IN LEFT HALF
	MOVEI	T2,UDB		;SET UP ADDRESS WHERE DATA GOES


DOPEEK:	TLNN	T1,-1		;WANT A SINGLE WORD OF DATA?
	MOVEI	T2,T3		;YES, POINT TO AC TO RECEIVE ANSWER
	TLNN	T1,-1		;WELL?
	HRLI	T1,1		;YES, WANT ONLY ONE WORD
	PEEK			;ASK MONITOR FOR DATA
	 ERJMP	CPOPJ		;FAILED
	MOVE	T1,T3		;PUT ANSWER IN RIGHT AC
	RETSKP			;GOOD RETURN
	SUBTTL	SUBROUTINE TO OBTAIN UDB SYMBOLS BY SNOOPING




;HERE TO FILL IN THE TABLE OF OFFSETS AND SUCH SO WE CAN DO PEEKS
;WITH THE DATA.  


UDBSYM:	TXNE	F,FR.UDS	;DO WE ALREADY HAVE THE SYMBOLS?
	RETSKP			;YES, GOOD RETURN
	MOVSI	T4,-NUMUDB	;GET READY FOR LOOP

UDBSYL:	MOVEI	T1,.SNPSY	;GET FUNCTION CODE
	MOVE	T2,TBSUDB(T4)	;GET WORD OF DATA
	MOVE	T3,TBMUDB(T4)	;AND PROGRAM NAME
	SNOOP			;GET THE VALUE
	 ERJMP	CPOPJ		;FAILED
	MOVEM	T2,TBVUDB(T4)	;SAVE THE VALUE
	AOBJN	T4,UDBSYL	;LOOP OVER ALL WORDS
	TXO	F,FR.UDS	;SYMBOLS ARE NOW GOTTEN
	RETSKP			;GOOD RETURN




;TABLE OF SYMBOLS WE WANT TO SNOOP.  THIS MACRO IS EXPANDED LATER ON
;IN THE PROGRAM.


DEFINE	USYMS,<			;SYMBOLS WE WANT TO KNOW ABOUT

	XX	CHNTAB,STG	;;TABLE OF CHANNEL ADDRESSES
	XX	CDBUDB		;;OFFSET IN CDB TO START OF UDBS
	XX	KDBIUN,PHYSIO	;;POINTER TO UDB ADDRESSES
	XX	UDBDDD,PHYP4	;;FIRST WORD OF DEVICE DEPENDENT PART
	XX	UDBSEK		;;NUMBER OF SEEKS
	XX	UDBRED		;;READS
	XX	UDBWRT		;;WRITES
	XX	UDBSRE		;;SOFT READ ERRORS
	XX	UDBSWE		;;SOFT WRITE ERRORS
	XX	UDBHRE		;;HARD READ ERRORS
	XX	UDBHWE		;;HARD WRITE ERRORS
	XX	UDBSPE,PHYP4	;;SOFT POSITIONING ERROR
	XX	UDBHPE,PHYP4	;;HARD POSITIONING ERROR
	XX	UDBSLV,PHYSIO	;;UNIT NUMBER ON CONTROLLER
>
	SUBTTL	SUBROUTINE TO TYPE STRUCTURE STATUS




;CALLED TO OUTPUT THE STATUS OF EACH MOUNTED STRUCTURE ON THE SYSTEM,
;SUCH AS THE AMOUNT OF SPACE USED ON EACH ONE, AND THE MOUNT COUNTS.
;NO PRIVILEGES REQUIRED FOR THIS OUTPUT.



DOSTR:	MOVEI	T1,TP.STR	;THIS IS THE STRUCTURE DISPLAY
	CALL	HDRSET		;SO SET IT UP
	TXO	F,FR.EAT	;REMEMBER TO EAT LINES AFTERWARD
	SETO	J,		;GET READY FOR LOOP


STRSTL:	ADDI	J,1		;MOVE TO NEXT POSSIBLE DEVICE
	MOVSI	T1,(J)		;GET READY
	IORI	T1,.DEVCH	;TO GET DATA ON THIS DEVICE
	GETAB			;GET IT
	 ERJMP	CPOPJ		;FAILED, ASSUME NO MORE
	LDB	T1,[POINTR T1,DV%TYP]	;GET DEVICE TYPE
	CAIE	T1,.DVDSK	;IS THIS A DISK?
	JRST	STRSTL		;NO, TRY NEXT DEVICE
	MOVSI	T1,(J)		;GET READY
	IORI	T1,.DEVNA	;TO OBTAIN THE DEVICE NAME
	GETAB			;GET IT
	 ERJMP	CPOPJ		;FAILED
	CAMN	T1,['DSK   ']	;IS THIS THE GENERIC DISK?
	JRST	STRSTL		;YES, DON'T USE IT
	CALL	SIXASC		;CONVERT FROM SIXBIT TO ASCIZ
	DMOVE	T1,TEMP		;GET THE NAME
	DMOVEM	T1,DEVNAM	;SAVE IT AWAY
	HRROI	T1,DEVNAM	;GET A POINTER
	MOVEM	T1,MBLK+.MSGSN	;AND SET IN ARGUMENT BLOCK
	MOVE	T1,[.MSGFC+1,,.MSGSS]	;GET READY
	MOVEI	T2,MBLK		;POINT TO DATA AREA
	MSTR			;ASK ABOUT THIS STRUCTURE
	 ERJMP	STRSTL		;FAILED, LOOP
	SETZM	HAVALC		;CLEAR FLAG SAYING HAVE ALLOCATION INFO
	CALL	DOCOLS		;NOW SHOW THE DATA
	JRST	STRSTL		;LOOP
;ROUTINES TO OUTPUT DATA ABOUT EACH STRUCTURE:




XXSTNM:	SPACE			;SPACE OVER FIRST
	STR$	DEVNAM		;OUTPUT THE NAME OF THE STRUCTURE
	RET			;DONE



XXSTST:	MOVE	T1,MBLK+.MSGST	;GET THE STATUS BITS
	TXNE	T1,MS%PS	;IS THIS PUBLIC?
	STR$	[ASCIZ/Public /]	;YES, SAY SO
	TXNE	T1,MS%DIS	;IS IT BEING DISMOUNTED?
	STR$	[ASCIZ/Dismount /]	;YES, SAY SO
	TXNE	T1,MS%DOM	;IS IT DOMESTIC?
	STR$	[ASCIZ/Domestic /]	;YES
	TXNN	T1,MS%DOM	;IS IT FOREIGN?
	STR$	[ASCIZ/Foreign /]	;YES, SAY SO
	TXNE	T1,MS%LIM	;IS STRUCTURE LIMITED?
	STR$	[ASCIZ/Limit /]	;YES, SAY SO
	TXNN	T1,MS%NRS	;IS STRUCTURE REGULATED?
	STR$	[ASCIZ/Regulated /]	;YES, SAY SO
	TXNE	T1,MS%INI	;IS IT BEING INITIALIZED?
	STR$	[ASCIZ/Init/]	;YES, SAY SO
	RET			;DONE



XXSTMC:	MOVE	T1,MBLK+.MSGMC	;GET THE MOUNT COUNT
	JRST	DECSP3		;OUTPUT IT



XXSTOF:	MOVE	T1,MBLK+.MSGFC	;GET OPEN FILE COUNT
	JRST	DECSP3		;OUTPUT IT



XXSTPG:	CALL	GETALC		;OBTAIN ALLOCATION DATA FOR STRUCTURE
	 RET			;FAILED
	MOVE	T1,T2		;GET FREE PAGES
	JRST	DECSP5		;OUTPUT IT



XXSTSZ:	CALL	GETALC		;GET ALLOCATION INFORMATION
	 RET			;FAILED
	ADD	T1,T2		;ADD TOGETHER TO GET SIZE
	JRST	DECSP6		;OUTPUT IT
	SUBTTL	ROUTINE TO GET ALLOCATION INFO




;CALLED TO GET THE ALLOCATION DATA FOR A STRUCTURE WHOSE NAME IS
;IN LOCATION STRNAM.  SKIP RETURN IF SUCCESSFUL.  TO SAVE TIME,
;WE DON'T RECOMPUTE THE DATA IF THE FLAG HAVALC IS SET.



GETALC:	DMOVE	T1,STRALC	;GET ALLOCATION INFORMATION
	SKIPE	HAVALC		;IS IT CORRECT?
	RETSKP			;YES, GOOD RETURN
	HRROI	T1,DEVNAM	;GET READY
	STDEV			;CONVERT NAME TO DESIGNATOR
	 ERJMP	CPOPJ		;FAILED, CAN'T DO THIS
	MOVE	T1,T2		;MOVE TO RIGHT AC
	GDSKC			;READ DISK ALLOCATION INFO
	 ERJMP	CPOPJ		;FAILED
	DMOVEM	T1,STRALC	;SAVE FOR LATER
	SETOM	HAVALC		;SAY HAVE THE DATA
	RETSKP			;GOOD RETURN
	SUBTTL	DISPLAY FOR ENQ/DEQ STATUS




;THIS DISPLAY TYPES ALL OF THE ENQ LOCKS AND THE QUEUES FOR THOSE
;LOCKS.  WHEEL PRIVILEGES ARE REQUIRED FOR THIS DISPLAY, SINCE WE
;USE THE ENQC JSYS TO COLLECT THE DATA.




DPYENQ:	MOVEI	T1,.ENQCD	;FUNCTION TO DUMP THE QUEUES
	MOVEI	T2,DATLOC	;ADDRESS OF WHERE TO DUMP THEM
	MOVEI	T3,DATSIZ	;GET SIZE OF AREA
	MOVEM	T3,DATLOC	;SET FOR MONITOR
	ENQC			;READ ALL OF THE DATA
	 ERJMP	LOSE		;FAILED, GO EXPLAIN TO USER
	MOVEI	T1,TP.EQL	;TYPE OF HEADER IS ENQ-LOCKS
	CALL	HDRSET		;SET UP TAB STOPS AND TITLE
	TXO	F,FR.EAT	;EAT LINES AFTER THE TITLE
	SETZM	LOKNUM		;CLEAR NUMBER OF LOCKS FOUND
	MOVEI	J,DATLOC+1	;SET UP POINTER



LOKLUP:	CALL	FULL		;IS SCREEN FULL?
	 RET			;YES, RETURN NOW
	CAIL	J,DATLOC+DATSIZ-ENQSAF	;RAN OFF OF END?
	JRST	ENQOVF		;YES, GO SAY WE OVERFLOWED
	MOVE	T1,.ENQDF(J)	;GET FLAG WORD
	CAMN	T1,[-1]		;REACHED END?
	JRST	ENQQUE		;YES, GO DO QUEUES NOW
	TXNN	T1,EN%QCL	;IS THIS A LOCK BLOCK?
	JRST	ISQUE		;NO, IS A QUEUE BLOCK
	AOS	T1,LOKNUM	;COUNT ANOTHER LOCK BLOCK
	CAIL	T1,LCKMAX	;OVERFLOWED TABLE OF LOCKS?
	JRST	ENQOVF		;YES, SAY WE OVERFLOWED
	HRLZM	J,LOKTAB(T1)	;REMEMBER WHERE THE LOCK BLOCK IS
	CALL	DOCOLS		;DO ALL COLUMNS ABOUT THE LOCK
	MOVE	T1,.ENQDF(J)	;GET FLAGS AGAIN
	ADDI	J,.ENQDC	;MOVE TO LAST WORD OF BLOCK, MAYBE
	TXNN	T1,EN%QCT	;IS LAST WORD A USER CODE?
	AOJA	J,LOKLUP	;YES, MOVE TO NEXT BLOCK AND CONTINUE
	HRLI	J,(POINT 7,)	;NO, IS A STRING, SET UP
	ILDB	T1,J		;GET NEXT BYTE
	JUMPN	T1,.-1		;KEEP GOING UNTIL FIND A NULL
	MOVEI	J,1(J)		;THEN MOVE TO NEXT WORD
	JRST	LOKLUP		;PROCEED WITH NEXT BLOCK (HOPEFULLY!)
ISQUE:	MOVE	T1,LOKNUM	;GET THE NUMBER OF THE LOCK
	MOVEI	T2,-1		;GET A MASK TOO
	TDNN	T2,LOKTAB(T1)	;FIRST QUEUE BLOCK FOR THIS LOCK?
	HRRM	J,LOKTAB(T1)	;YES, REMEMBER WHERE IT IS
	ADDI	J,2		;MOVE BEYOND THE BLOCK
	JRST	LOKLUP		;AND GO BACK TO LOOP





;NOW LOOP OVER THE QUEUE BLOCKS. TYPING DATA ON THEM.  THE ADDRESSES
;OF THE FIRST QUEUE BLOCK FOR EACH LOCK WAS REMEMBERED IN THE FIRST
;PASS IN THE TABLE LOKTAB.



ENQOVF:	STR$	[ASCIZ/    [Table overflow, further entries not reported]
/]				;SAY WE OVERFLOWED

ENQQUE:	MOVEI	T1,TP.EQQ	;TYPE OF DISPLAY IS THE ENQ QUEUES
	CALL	HDRSET		;SET UP TAB STOPS AND TITLE LINE
	SETZM	ENQNUM		;CLEAR COUNTER
	SETOM	LSTNUM		;CLEAR LAST NUMBER


ENQQLP:	AOS	T2,ENQNUM	;GET NEXT NUMBER TO LOOK FOR
	CAMG	T2,LOKNUM	;DONE WITH ALL LOCKS?
	CALL	FULL		;OR IS SCREEN FULL?
	 RET			;YES, RETURN
	HRRZ	J,LOKTAB(T2)	;GET FIRST QUEUE BLOCK FOR THIS LOCK IF ANY
	JUMPE	J,ENQQLP	;NONE, GO TO NEXT BLOCK


DMPQUE:	MOVE	T1,.ENQDF(J)	;GET FLAG WORD
	CAIGE	J,DATLOC+DATSIZ-ENQSAF	;OVERFLOWED?
	TXNE	T1,EN%QCL	;OR REACHED A LOCK BLOCK?
	JRST	ENQQLP		;YES, GO LOOK AT NEXT ONE
	CALL	DOCOLS		;SHOW DATA ON THIS QUEUE BLOCK
	ADDI	J,2		;MOVE OUT OF BLOCK
	JRST	DMPQUE		;AND DO NEXT QUEUE BLOCK TOO
;FOLLOWING ARE THE ROUTINES FOR TYPING THE FIELDS OF THE LOCK BLOCKS
;AND OF THE QUEUE BLOCKS.




XXLLCK:	MOVE	T1,LOKNUM	;GET THE NUMBER OF THIS LOCK
	JRST	DECSP2		;OUTPUT IT



XXLLVL:	LDB	T1,[POINT 9,.ENQDF(J),17]	;GET LEVEL NUMBER
	JRST	DECSP3		;OUTPUT IT



XXLTYP:	HRRZ	T1,.ENQDF(J)	;GET THE TYPE OF THIS ENTRY
	CAIN	T1,-2		;RANDOM ENQ PRIVILEGES NEEDED?
	STR$	[ASCIZ/ENQ jobs/]	;YES, SAY THAT
	CAIN	T1,-3		;WHEEL PRIVILEGES NEEDED?
	STR$	[ASCIZ/WHEEL jobs/]	;YES, SAY THAT
	CAIE	T1,-2		;ONE OF THE ABOVE?
	CAIN	T1,-3		;WELL?
	RET			;YES, DONE
	CAIL	T1,400000	;A JOB NUMBER OR AN OFN
	JRST	XXLTYJ		;JOB
	STR$	[ASCIZ/OFN /]	;TYPE SOME
	JRST	OCTOUT		;OUTPUT THE OFN

XXLTYJ:	STR$	[ASCIZ/Job /]	;TYPE TEXT
	SUBI	T1,400000	;REMOVE OFFSET
	JRST	DECOUT		;OUTPUT IT



XXLRES:	MOVE	T1,.ENQDR(J)	;GET RESOURCE WORD
	TLZN	T1,-1		;IS THIS A GROUP?
	JRST	XXLREG		;YES
	CALL	DECOUT		;OUTPUT REMAINING RESOURCES
	CHI$	"/"		;THEN A SLASH
	HLRZ	T1,.ENQDR(J)	;GET TOTAL RESOURCES IN POOL
	JRST	DECOUT		;OUTPUT IT AND RETURN

XXLREG:	SKIPE	.ENQDT(J)	;IS THE ONE LOCK FREE?
	TDZA	T1,T1		;NO, GET ZERO
	MOVEI	T1,1		;OTHERWISE ONE
	CHI$	"0"(T1)		;SAY IF IT IS FREE OR NOT
	CHI$	"/"		;THEN TYPE A SLASH
	SKIPN	T1,.ENQDR(J)	;GROUP NUMBER OF ZERO?
	AOJA	T1,DECOUT	;YES, OUTPUT AVAILABILITY OF 1
	STR$	[ASCIZ/Group /]	;OTHERWISE SAY WHAT GROUP THIS IS
	JRST	DECOUT		;AND OUTPUT GROUP NUMBER
XXLTIM:	SKIPN	T4,.ENQDT(J)	;GET TIME STAMP IF ANY
	STR$	[ASCIZ/   --/]	;NONE, SAY SO
	JUMPE	T4,CPOPJ	;RETURN IF NO DATE
	SKIPGE	T4		;WAS TIME SET BACK THEN?
	MOVE	T4,BEGTIM	;NO, USE SYSTEM STARTUP TIME THEN
	HRROI	T1,TEMP		;POINT TO BUFFER
	MOVE	T2,T4		;GET TIME
	MOVX	T3,OT%NDA	;DON'T OUTPUT THE DATE
	ODTIM			;OUTPUT TO CORE
	STR$	TEMP		;THEN GIVE TO DPY
	MOVE	T1,NTIME	;GET NOW'S TIME
	SUB	T1,T4		;GET DIFFERENCE BETWEEN NOW AND THEN
	HLRZ	T1,T1		;KEEP JUST DAYS OF DIFFERENCE
	JUMPE	T1,CPOPJ	;LESS THAN A DAY, NO OUTPUT
	STR$	[ASCIZ/ -/]	;START OUTPUT
	CALL	DECOUT		;OUTPUT NUMBER OF DAYS
	CHI$	"D"		;SAY IT IS DAYS
	RET			;DONE




XXLCOD:	MOVE	T1,.ENQDC(J)	;GET CODE OR USER STRING
	MOVE	T2,.ENQDF(J)	;AND GET FLAGS
	TXNN	T2,EN%QCT	;IS THIS A TEXT STRING?
	JRST	XXLCOO		;NO, IS OCTAL NUMBER
	MOVEI	T1,.ENQDC(J)	;GET ADDRESS OF THE STRING
	HRLI	T1,(POINT 7,)	;MAKE BYTE POINTER TO IT
	MOVE	T2,[POINT 7,TEMP]	;POINT TO TEMP AREA TOO
	MOVEI	T3,TMPSIZ*5-1	;GET A COUNT TOO

XXLCLP:	ILDB	T4,T1		;GET NEXT CHAR
	JUMPE	T4,XXLCTP	;DONE WHEN GET A NULL
	CAIL	T4," "		;SEE IF A NORMAL CHAR
	CAILE	T4,176		;WELL?
	MOVEI	T4,"?"		;NO, TURN TO SOMETHING VISIBLE
	IDPB	T4,T2		;STORE THE CHAR
	SOJG	T3,XXLCLP	;LOOP UNLESS TOO MANY CHARS
	SETZ	T4,		;MAKE A NULL

XXLCTP:	IDPB	T4,T2		;MAKE STRING ASCIZ
	SPACE			;SPACE OVER FIRST
	TXNE	F,FR.MOR	;MORE OUTPUT COMING?
	SETZM	TEMP+3		;YES, CUT OFF THE NAME
	STR$	TEMP		;OUTPUT IT
	RET			;DONE


XXLCOO:	CHI$	"#"		;SAY THIS IS A NUMBER
	TLZ	T1,700000	;CLEAR OUT THE 5B2
	JRST	OCTOUT		;GO OUTPUT IT
XXQLCK:	MOVE	T1,ENQNUM	;GET NUMBER OF LOCK THIS IS FOR
	CAMN	T1,LSTNUM	;SAME AS LAST TIME?
	RET			;YES, RETURN
	MOVEM	T1,LSTNUM	;NO, SAVE NEW NUMBER
	JRST	DECSP2		;OUTPUT IT



XXQJOB:	HRRZ	T1,.ENQDF(J)	;GET JOB NUMBER OF ORIGINATOR
	JRST	DECSP2		;OUTPUT IT



XXQPRG:	HRLZ	T1,.ENQDF(J)	;GET JOB NUMBER
	HRRI	T1,.JOBPN	;AND INDEX
	GETAB			;READ PROGRAM NAME
	 ERJMP	CPOPJ		;FAILED
	JRST	SIXOUT		;OUTPUT IT


XXQREQ:	HLRZ	T1,.ENQDI(J)	;GET REQUEST DATA
	MOVE	T2,ENQNUM	;GET INDEX INTO LOKTAB
	HLRZ	T2,LOKTAB(T2)	;THEN ADDRESS OF LOCK BLOCK
	MOVE	T2,.ENQDR(T2)	;FINALLY GET RESOURCES WORD
	TLNN	T2,-1		;GROUP NUMBER?
	STR$	[ASCIZ/Group /]	;YES, SAY SO
	JRST	DECOUT		;OUTPUT GROUP OR REQUESTS WANTED



XXQID:	HRRZ	T1,.ENQDI(J)	;GET REQUEST ID
	JRST	OCTSP6		;OUTPUT IT



XXQFLG:	MOVE	T1,.ENQDF(J)	;GET FLAGS
	TXNE	T1,EN%QCO	;DOES THIS GUY OWN THE LOCK?
	STR$	[ASCIZ/Owner /]	;YES, SAY SO
	TXNE	T1,EN%QCB	;BLOCKED WAITING FOR EXCLUSIVE ACCESS?
	STR$	[ASCIZ/Blocked/]	;YES, SAY SO
	RET			;DONE
	SUBTTL	DISPLAY FOR TERMINAL INFORMATION




;THIS MODE OF OUTPUT TELLS THINGS ABOUT THE ACTIVE TERMINALS ON
;THE SYSTEM.  THIS IS SET BY THE "TT" COMMAND.




DPYTTY:	MOVEI	T1,TP.TTY	;THIS IS TERMINAL DISPLAY
	CALL	HDRSET		;SO SET UP HEADERS FOR IT
	TXO	F,FR.EAT	;REMEMBER TO EAT AFTER HEADER IS TYPED
	SETO	J,		;INITIALIZE FOR LOOP


TTYLOP:	ADDI	J,1		;MOVE TO NEXT TERMINAL
	CAMG	J,HGHTTY	;DID ALL TERMINALS?
	CALL	FULL		;OR IS SCREEN FULL?
	 RET			;YES, DONE
	MOVE	T1,['TTFLG1']	;WANT THE STATUS WORD
	CALL	GETTT0		;READ THE DATA
	 JRST	TTYLOP		;TERMINAL NOT IN USE, GO LOOP
	MOVEM	T1,TTYSTS	;SAVE FOR LATER
	CALL	TTYACT		;SEE IF TERMINAL IS ACTIVE ENOUGH
	 JRST	TTYLOP		;NO, DON'T SHOW IT
	SETOM	TTJBVL		;SAY WE NEED NEW JOB FROM TTY DATA
	CALL	DOCOLS		;TYPE DATA ABOUT THIS TERMINAL
	JRST	TTYLOP		;AND LOOP
;FOLLOWING ARE THE ROUTINES TO TYPE THINGS ABOUT EACH TERMINAL.



XXTNUM:	MOVE	T1,J		;GET TERMINAL NUMBER
	JRST	OCTSP3		;OUTPUT AND RETURN



XXTTYP:	MOVEI	T1,.TTDES(J)	;GET DEVICE DESIGNATOR
	GTTYP			;ASK MONITOR TO GET TERMINAL TYPE
	 ERJMP	CPOPJ		;CAN'T GET IT, RETURN
	MOVE	T1,T2		;MOVE TO RIGHT AC
	MOVSI	T2,-TTTNUM	;GET READY FOR SEARCH
	HLRZ	T3,TTTTAB(T2)	;GET NEXT POSSIBLE TERMINAL
	CAME	T1,T3		;FOUND IT?
	AOBJN	T2,.-2		;NO, KEEP SEARCHING
	JUMPGE	T2,OCTTEL	;CAN'T FIND IT, GIVE IN OCTAL
	HRRZ	T1,TTTTAB(T2)	;GET THE STRING ADDRESS
	STR$	(T1)		;OUTPUT TYPE
	RET			;DONE


	DEFINE	NT(CODE,TEXT),<
	XWD	CODE,[ASCIZ/TEXT/]	;;TERMINAL TYPES
>

TTTTAB:	NT	.TT33,<Model 33>
	NT	.TT35,<Model 35>
	NT	.TT37,<Model 37>
	NT	.TTEXE,Execuport
	NT	.TTDEF,Default
	NT	.TTIDL,Ideal
	NT	.TTV05,VT05
	NT	.TTV50,VT50
	NT	.TTL30,LA30
	NT	.TTG40,GT40
	NT	.TTL36,LA36
	NT	.TTV52,VT52
	NT	.TT100,VT100
	NT	.TTL38,LA38
	NT	.TT120,LA120

	TTTNUM==.-TTTTAB	;NUMBER OF TERMINALS IN TABLE
XXTINC:	SKIPA	T1,['TTICT ']	;GET WORD
XXTOUC:	MOVE	T1,['TTOCT ']	;OR GET OTHER WORD
	SKIPL	TTYSTS		;FAIL IF THIS IS A SHORT BLOCK
	CALL	GETTT0		;NORMAL BLOCK, READ WORD
	 RET			;CAN'T GET IT
	JRST	DECSP3		;OUTPUT IT




XXTSPD:	MOVEI	T1,.TTDES(J)	;GET TERMINAL DESIGNATOR
	MOVEI	T2,.MORSP	;FUNCTION TO READ LINE SPEEDS
	MTOPR			;READ IT
	 ERJMP	CPOPJ		;FAILED
	SKIPGE	T4,T3		;SAVE SPEED AND SEE IF UNKNOWN
	JRST	NOSPED		;ISN'T VALID
	HLRZ	T1,T4		;GET INPUT SPEED
	CALL	DECSP5		;OUTPUT IT
	HRRZ	T1,T4		;GET OUTPUT SPEED
	JRST	DECSP6		;OUTPUT IT AND RETURN

NOSPED:	STR$	[ASCIZ/   --    --/]	;SAY SPEED IS IRREVELANT
	RET			;DONE




XXTJOB:	CALL	TTYJOB		;GET JOB DATA FOR THIS TERMINAL
	 RET			;FAILED
	HLRZ	T1,T1		;KEEP ONLY THE JOB NUMBER
	CAIN	T1,-1		;NOT ASSIGNED?
	JRST	TTYNTA		;YES, GO SAY THAT
	CAIE	T1,-2		;BECOMING ASSIGNED?
	JRST	DECSP2		;NO, TELL JOB NUMBER
	STR$	[ASCIZ/Ass/]	;SAY BECOMING ASSIGNED
	RET			;DONE

TTYNTA:	STR$	[ASCIZ/--/]	;SAY UNASSIGNED
	RET			;DONE
XXTLNK:	MOVE	T1,['TTLINK']	;GET WORD
	CALL	GETTT0		;READ THE DATA
	 RET			;FAILED

TELLNK:	MOVEM	T2,TEMP		;SAVE AWAY THE LINK DATA
	MOVE	T4,[POINT 9,TEMP]	;GET BYTE POINTER
	TXZ	F,FR.TMP	;INITIALIZE FLAG

LNKLOP:	TXNN	T4,77B5		;DID ALL FOUR BYTES?
	RET			;YES, DONE
	ILDB	T1,T4		;GET NEXT BYTE
	CAIN	T1,777		;REAL TERMINAL LINKED HERE?
	JRST	LNKLOP		;NO, TRY NEXT BYTE
	TXOE	F,FR.TMP	;ANY PREVIOUS OUTPUT?
	SPACE			;YES, SPACE OVER
	CALL	OCTSP3		;OUTPUT THE TERMINAL NUMBER
	JRST	LNKLOP		;LOOP



XXTUSR:	CALL	TTYJOB		;FIND THE JOB INFO FOR THIS TERMINAL
	 RET			;CAN'T GET IT
	HLRZ	T1,T1		;KEEP ONLY THE JOB NUMBER
	CAIGE	T1,-2		;IS TERMINAL ASSIGNED TO A JOB?
	JRST	JOBUSR		;YES, GO SAY WHO IT IS
	STR$	[ASCIZ/None/]	;NO, SAY NOBODY IS THERE
	RET			;DONE
	TT%SAL==1B0		;SEND-ALL BEING DONE
	TT%SHT==1B1		;THIS IS A SHORT BLOCK
	TT%MES==1B2		;THIS IS A SYSTEM MESSAGE BLOCK
	TT%OTP==1B3		;OUTPUT ON ROUTE
	TT%SFG==1B5		;CONTROL-S WAS TYPED
	TT%PRM==1B8		;DON'T DEALLOCATE BLOCK

	TT%FEM==1B0		;LINE IS REMOTE
	TT%CON==1B3		;CARRIER IS ON
	TT%AUT==1B7		;LINE IS AUTO-SPEED


XXTFLG:	MOVE	T1,TTYSTS	;GET THE STATUS WORD
	TXNE	T1,TT%PRM	;IS THIS A PERMANENT BLOCK?
	STR$	[ASCIZ/Prm /]	;YES, SAY SO
	TXNE	T1,TT%SHT	;IS THIS A SHORT BLOCK?
	STR$	[ASCIZ/Sht /]	;YES, SAY SO
	TXNE	T1,TT%MES	;IS THIS A SYSTEM MESSAGE BLOCK?
	STR$	[ASCIZ/Msg /]	;YES, SAY SO
	TXNE	T1,TT%SAL	;SEND-ALL BEING DONE?
	STR$	[ASCIZ/Sndal /]	;YES, SAY SO
	TXNE	T1,TT%SFG	;CONTROL-S TYPED?
	STR$	[ASCIZ/Pag /]	;YES, SAY SO
	TXNE	T1,TT%OTP	;OUTPUT ON ROUTE?
	STR$	[ASCIZ/Out /]	;YES, SAY SO
	CALL	TTYJOB		;GET JOB DATA FOR THIS TTY
	 MOVEI	T1,-1		;FAILED, DEFAULT IT
	ANDI	T1,-1		;KEEP ONLY THE FORK NUMBER
	CAIE	T1,-1		;ANY FORK IN INPUT WAIT?
	STR$	[ASCIZ/In /]	;YES, SAY SO
	MOVEI	T1,.RDTTS	;GET FUNCTION
	MOVE	T2,J		;AND TERMINAL NUMBER
	MONRD%			;GET THE TTSTAT WORD
	 ERJMP	CPOPJ		;FAILED
	JUMPL	T1,CPOPJ	;ALSO FAILED
	TXNE	T2,TT%FEM	;IS THIS A REMOTE LINE?
	STR$	[ASCIZ/Rmt /]	;YES, SAY SO
	TXNE	T2,TT%CON	;IS CARRIER ON?
	STR$	[ASCIZ/Car /]	;YES, SAY SO
	TXNE	T2,TT%AUT	;IS LINE AUTO-BAUD?
	STR$	[ASCIZ/Auto /]	;YES, SAY SO
	CAMN	J,CTYNUM	;IS THIS THE CTY?
	STR$	[ASCIZ/Cty /]	;YES, SAY SO
	CAMLE	J,CTYNUM	;IS THIS A PTY?
	STR$	[ASCIZ/Pty /]	;YES, SAY SO
	RET			;DONE
	SUBTTL	SUBROUTINE TO CHECK FOR AN ACTIVE TERMINAL




;CALLED FOR EACH TERMINAL TO SEE IF THAT TERMINAL IS ACTIVE.  TERMINAL
;NUMBER IS SPECIFIED IN AC J.  SKIP RETURN IF TERMINAL SHOULD BE SHOWN
;BECAUSE OF SOMETHING INTERESTING.  ACTIVE TERMINALS STAY THAT WAY FOR
;ABOUT A MINUTE BEFORE THEY WILL DISAPPEAR FROM THE DISPLAY.



TTYACT:	CAILE	J,MAXTTY	;SEE IF NUMBER LARGER THAN OUR TABLE
	RETSKP			;YES, ACT LIKE ACTIVE THEN
	MOVE	T1,TTYSTS	;GET THE STATUS
	TXNE	T1,TT%SHT+TT%MES+TT%OTP	;ANYTHING HAPPENING?
	JRST	NEWACT		;YES, NOW ACTIVE
	MOVE	T1,['TTOCT ']	;GET READY
	CALL	GETTT0		;READ NUMBER OF OUTPUT CHARS
	SETZ	T1,		;FAILED, ASSUME NONE
	JUMPN	T1,NEWACT	;IF ANY, IS ACTIVE
	MOVE	T1,['TTICT ']	;GET READY
	CALL	GETTT0		;READ NUMBER IF INPUT CHARACTERS
	SETZ	T1,		;FAILED
	JUMPN	T1,NEWACT	;IF ANY THERE, IT'S ACTIVE
	SKIPE	T1,ACTTAB(J)	;SEE IF TERMINAL HAS BEEN ACTIVE
	CAMGE	T1,NTIME	;AND SEE IF RECENT ENOUGH TO WANT IT
	TXNN	F,FR.TAC	;OR SEE IF WANT ALL TERMINALS ANYWAY
	RETSKP			;YES, SHOW IT
	RET			;NO, FORGET IT



NEWACT:	MOVX	T1,<<ACTTIM,,0>/^D<60*24>>	;GET TIME INTERVAL
	ADD	T1,NTIME	;ADD CURRENT TIME
	MOVEM	T1,ACTTAB(J)	;REMEMBER WHEN WILL NO LONGER BE ACTIVE
	RETSKP			;GOOD RETURN
	SUBTTL	SUBROUTINES USED FOR TERMINAL DISPLAY




;CALLED TO USE THE MONRD% JSYS TO RETURN A WORD FROM THE TTACTL BLOCK
;OF A TERMINAL.  CALL WITH SIXBIT NAME IN T1, AND OFFSET FROM THAT NAME
;IN T2, AND TERMINAL NUMBER IN AC J.  SKIP RETURN WITH DATA IN T1 IF
;SUCCESSFUL.  CALL AT GETTT0 IF OFFSET IS ZERO.




GETTT0:	SETZ	T2,		;MAKE OFFSET ZERO
GETTTY:	MOVE	T3,T2		;MOVE OFFSET TO RIGHT AC
	MOVE	T2,T1		;MOVE SYMBOL TO RIGHT AC
	MOVEI	T1,.RDTTY	;SET UP FUNCTION CODE
	MOVE	T4,J		;GET TERMINAL NUMBER
	JRST	DOMONR		;GO DO THE JSYS





;SUBROUTINE TO READ THE GETAB ENTRY WHICH CONVERTS TERMINAL NUMBER TO
;JOB NUMBER.  TO SAVE TIME, LOCATION TTJBVL IS NONNEGATIVE IF WE ALREADY
;HAVE COLLECTED THE INFORMATION.  SKIP RETURN IF SUCCESSFUL WITH WORD
;IN T1.  TERMINAL NUMBER GIVEN IN AC J.



TTYJOB:	SKIPL	T1,TTJBVL	;GET DATA IF ALREADY KNOWN
	RETSKP			;YES, GOOD RETURN
	MOVSI	T1,(J)		;SET UP INDEX
	IORI	T1,.TTYJO	;AND TABLE NUMBER
	GETAB			;READ THE WORDD
	 ERJMP	CPOPJ		;FAILED
	MOVEM	T1,TTJBVL	;REMEMBER FOR NEXT TIME
	RETSKP			;GOOD RETURN
	SUBTTL	ROUTINE TO GIVE MONITOR STATISTICS





;THIS MODE OF OUTPUT IS USED TO OUTPUT MONITOR DATA, ON THE SYSTEM
;PERFORMANCE AS A WHOLE.  THIS MODE IS SET BY THE "M" COMMAND.





DPYMON:	SETOM	HDRTYP		;NO HEADERS ARE VALID ANYMORE
	TAB$			;SET UP DEFAULT TABS
	SETZB	T2,T3		;INITIALIZE FOR LOOP

VERLOP:	MOVSI	T1,(T3)		;GET READY
	IORI	T1,.SYSVE	;TO READ MONITOR VERSION
	GETAB			;READ A WORD OF IT
	 JRST	VERDON		;IF FAILED, ALL DONE
	JUMPE	T1,VERDON	;PROCEED IF DONE
	STR$	T1		;OUTPUT PART OF NAME
	AOJA	T3,VERLOP	;LOOP OVER ALL PARTS

VERDON:	CRLF			;TYPE A CRLF
	HRROI	T1,TEMP		;POINT TO TEMPORY AREA
	SETO	T2,		;WANT CURRENT TIME
	MOVX	T3,OT%DAY+OT%FDY+OT%FMN+OT%4YR+OT%DAM+OT%SPA+OT%SCL+OT%TMZ
	ODTIM			;STORE TIME WITH TIME ZONE
	STR$	TEMP		;THEN OUTPUT IT
	STR$	[ASCIZ/     Uptime: /]	;TYPE MORE
	TIME			;READ TIME
	IDIVI	T1,^D1000	;TURN MILLISECONDS TO SECONDS
	CALL	TIMOUT		;OUTPUT IT
	CRLF			;THEN A CRLF
	CALL	SETEAT		;SET UP HOW MANY LINES TO BE EATEN
	CALL	DOSTAT		;GO TYPE OUT THE STATUS INFORMATION
	CALL	DOCLAS		;TYPE OUT CLASS INFORMATION
	CALL	DOLOAD		;TYPE OUT THE LOAD AVERAGES
	PJRST	DOACT		;FINISH WITH ACTIVE JOB INFO
	SUBTTL	ROUTINE TO TYPE OUT "WATCH" INTO




;THE FOLLOWING CODE TYPES OUT MONITOR STATISTICS IN A MANNER SIMILAR
;TO WHAT WATCH TYPES.  THE COLUMNS ARE ARRANGED FOUR TO A LINE.




DOSTAT:	CALL	RDSTAT		;GO READ NEW VALUES
	TAB$	[$TABS<14,29,41,51,62,63,64,65,66,67>]	;SET UP NICE TAB STOPS
	STR$	[ASCIZ/
Statistics for an interval of /]	;TYPE SOME HEADER
	MOVE	T1,STADIF	;GET INTERVAL
	IDIVI	T1,^D100	;CONVERT TO TENTHS OF A SECOND
	CAIL	T2,^D50		;SHOULD WE ROUND UP?
	ADDI	T1,1		;YES
	MOVEI	T4,DECOUT	;SET UP ROUTINE TO CALL
	CALL	FIXOUT		;OUTPUT AS FIXED POINT NUMBER
	STR$	[ASCIZ/ seconds:
/]				;FINISH HEADER
	MOVSI	J,-STATNM	;GET NUMBER OF ENTRIES TO TYPE


STATLP:	TRNE	J,3		;TIME FOR A TAB?
	TAB			;YES, TYPE ONE
	TRNN	J,3		;TIME FOR A CRLF INSTEAD?
	CRLF			;YES, GIVE ONE
	HRRZ	T1,STATTB(J)	;GET THE NAME OF THE ENTRY
	STR$	(T1)		;OUTPUT IT
	STR$	[ASCIZ/: /]	;FOLLOW WITH COLON AND SPACE
	CALL	@STATCD(J)	;GO TYPE OUT THE VALUE
	AOBJN	J,STATLP	;LOOP OVER ALL ENTRIES
	CRLF			;END WITH A CRLF


STATCP:	MOVE	T1,[NEWSTA,,OLDSTA]	;GET READY
	BLT	T1,OLDTIM	;COPY NEW STATISTICS AS OLD ONES
	RET			;ALL DONE
;FOLLOWING ARE THE ROUTINES CALLED TO OUTPUT THE VARIOUS VALUES.
;THE DATA FOR EACH ROUTINE IS IN THE TABLES NEWSTA AND OLDSTA.


;ROUTINE TO OUTPUT THE DIFFERENCE BETWEEN NEW AND OLD VALUES, AND
;ALSO TYPE THE TOTAL VALUE:



DODIF:	MOVE	T1,NEWSTA(J)	;GET NEW VALUE
	SUB	T1,OLDSTA(J)	;SUBTRACT OLD VALUE
	CALL	DECOUT		;OUTPUT IT
	TAB			;TAB OVER
				;THEN OUTPUT TOTAL VALUE



;ROUTINE TO OUTPUT THE NEW VALUE ITSELF:


DONUM:	MOVE	T1,NEWSTA(J)	;GET THE NEW VALUE
	PJRST	DECOUT		;OUTPUT IT AND RETURN




;ROUTINE TO COMPUTE AN AVERAGE OVER THE TIME INTERVAL:


DOAVG:	MOVE	T1,NEWSTA(J)	;GET THE NEW TIME
	SUB	T1,OLDSTA(J)	;SUBTRACT THE OLD TIME
	IMULI	T1,^D10		;SINCE HAVE ONE PLACE AFTER DECIMAL POINT
	MOVEI	T4,DECSP3	;GET READY
	JRST	DOPCT1		;JOIN OTHER CODE




;ROUTINE TO OUTPUT THE PERCENTAGE OF TIME TAKEN IN THE LAST INTERVAL:


DOPCT:	MOVE	T1,NEWSTA(J)	;GET THE NEW TIME
	SUB	T1,OLDSTA(J)	;SUBTRACT THE OLD TIME
	IMULI	T1,^D1000	;GET READY TO GET TENTHS OF PERCENT
	MOVEI	T4,DECSP2	;GET READY
DOPCT1:	IDIV	T1,STADIF	;DIVIDE BY TIME INTERVAL
	LSH	T2,1		;DOUBLE REMAINDER
	CAML	T2,STADIF	;SHOULD WE ROUND UP?
	ADDI	T1,1		;YES, DO IT
	PJRST	FIXOUT		;OUTPUT AS FIXED POINT NUMBER
	SUBTTL	ROUTINE TO COLLECT DATA FOR WATCH TYPE OUTPUT




;CALLED TO FILL IN THE TABLE NEWSTA WITH THE RESULTS OF GETABS ON
;THE ENTRIES GIVEN IN THE STATTB TABLE.  LATER ON THE DATA IS OUTPUT
;TO THE USER.




RDSTAT:	TIME			;READ TIME SINCE SYSTEM STARTED
	MOVEM	T1,NEWTIM	;SAVE IT
	SUB	T1,OLDTIM	;GET DIFFERENCE FROM OLD TIME
	MOVEM	T1,STADIF	;SAVE IT
	MOVSI	J,-STATNM	;GET READY FOR A LOOP


RDSTAL:	MOVE	T1,STATTB(J)	;GET THE TABLE INDEX
	HRRI	T1,.SYSTA	;AND THE TABLE NUMBER
	GETAB			;READ THE INFORMATION
	 SETZ	T1,		;FAILED, MAKE IT ZERO
	MOVEM	T1,NEWSTA(J)	;SAVE THE VALUE
	AOBJN	J,RDSTAL	;LOOP OVER ALL ENTRIES
	RET			;DONE
	SUBTTL	SUBROUTINE TO OUTPUT LOAD AVERAGES




;THIS IS CALLED TO TYPE THE LOAD AVERAGES OUT.  THE LOAD AVERAGES
;KEPT AS FLOATING POINT NUMBERS.




DOLOAD:	STR$	[ASCIZ/
Load averages:/]		;START OUT TYPEOUT
	MOVSI	T1,14		;GET INDEX OF 1 MINUTE AVERAGE
	MOVX	T3,1B1!1B4!1B6!37B17!4B23!2B29	;GET BITS
	CALL	LOADTP		;TYPE IT OUT
	MOVSI	T1,15		;GET INDEX OF 5 MINUTE AVERAGE
	CALL	LOADTP		;TYPE IT OUT
	MOVSI	T1,16		;GET INDEX OF 15 MINUTE AVERAGE
	CALL	LOADTP		;TYPE IT
	JRST	DOCRLF		;FINISH WITH A CRLF



LOADTP:	HRRI	T1,.SYSTA	;DATA IS IN THE SYSTAT TABLE
	GETAB			;READ IT
	 SETZ	T1,		;FAILED, MAKE ZERO
	MOVE	T2,T1		;PUT INTO RIGHT AC
	HRROI	T1,TEMP		;POINT TO STORAGE AREA
	FLOUT			;OUTPUT THE NUMBER
	 JFCL			;SHOULD NOT FAIL
	STR$	TEMP		;NOW OUTPUT THE NUMBER
	RET			;DONE
	SUBTTL	SUBROUTINE TO OUTPUT NUMBER OF JOBS ON SYSTEM




;CALLED TO OUTPUT THE NUMBER OF JOBS ON THE SYSTEM, AND HOW MANY OF
;THEM ARE ACTIVE.  (THEIR IDLE TIME IS 1 MINUTE OR LESS).




DOACT:	STR$	[ASCIZ/Jobs: /]	;TYPE SOME
	SETZB	T1,T4		;CLEAR COUNTERS
	MOVE	J,HGHJOB	;GET HIGHEST JOB

DOACTL:	SKIPN	CURRUN(J)	;DOES THIS JOB HAVE RUNTIME?
	JRST	DOACTN		;NO, LOOK AT NEXT ONE
	ADDI	T1,1		;YES, COUNT IT
	SKIPN	IDLE(J)		;IS THE JOB ACTIVE?
	ADDI	T4,1		;YES, COUNT IT
DOACTN:	SOJGE	J,DOACTL	;LOOP OVER ALL JOBS

	CALL	DECOUT		;OUTPUT TOTAL NUMBER
	CHI$	"/"		;THEN A SLASH
	MOVE	T1,HGHJOB	;GET HIGHEST JOB NUMBER
	ADDI	T1,1		;ADD SINCE WE COUNT JOB 0
	CALL	DECOUT		;OUTPUT TOTAL JOBS POSSIBLE
	STR$	[ASCIZ/     Active: /]	;GET READY
	MOVE	T1,T4		;GET NUMBER OF ACTIVE JOBS
	CALL	DECOUT		;OUTPUT THEM
	JRST	DOCRLF		;END IN CRLF
	SUBTTL	SUBROUTINE TO TYPE OUT SCHEDULAR CLASSES



;CALLED AS PART OF THE MONITOR STATISTICS, TO OUTPUT THE SCHEDULER CLASSES
;CURRENTLY IN USE.  USES THE SKED% JSYS TO COLLECT THE DATA.



DOCLAS:	MOVEI	T1,.SKRBC	;FUNCTION TO READ BIAS KNOB
	MOVEI	T2,T3		;ADDRESS OF BLOCK
	MOVEI	T3,2		;TWO ARGUMENTS
	SKED%			;READ THE KNOB
	 ERJMP	CPOPJ		;FAILED, ASSUME NO JSYS EXISTS
	MOVE	T1,T4		;GET VALUE OF KNOB
	STR$	[ASCIZ/
Bias knob: /]			;START OUTPUT
	CALL	DECOUT		;OUTPUT THE VALUE
	MOVEI	T1,.SKRCV	;FUNCTION
	MOVEI	T2,T3		;LOCATION FOR BLOCK
	MOVEI	T3,2		;TWO ARGUMENTS AGAIN
	SKED%			;READ THE CLASS PARAMETERS
	 ERJMP	DOCRLF		;FAILED
	STR$	[ASCIZ/    Class scheduler is /]	;TYPE SOME
	TXNE	T4,SK%STP	;IS IT ON?
	STR$	[ASCIZ/off/]	;NO, SAY SO
	TXNN	T4,SK%STP	;WELL?
	STR$	[ASCIZ/on/]	;YES
	CRLF			;THEN A CRLF
	CALL	GETCLS		;READ CLASSES FOR ALL JOBS
	TAB$	[$TABS<6,12,18,25,32,40>]	;SET NEW TAB STOPS
	TXZ	F,FR.HDR	;CLEAR HEADER FLAG
	SETO	J,		;INITIALIZE CLASS FOR LOOP
CLSLOP:	MOVEI	T1,.SA15L+1	;NUMBER OF ARGUMENTS
	AOS	T2,J		;GET NEXT CLASS
	DMOVEM	T1,KBLK		;STORE AWAY
	MOVEI	T1,.SKRCS	;FUNCTION CODE
	MOVEI	T2,KBLK		;ADDRESS OF ARGUMENT BLOCK
	SKED%			;READ THE INFORMATION
	 ERJMP	CPOPJ		;FAILED, RETURN
	SKIPN	KBLK+.SASHR	;ANY SHARE?
	SKIPE	KBLK+.SAUSE	;OR UTILIZATION?
	JRST	SHWCLS		;YES, THEN SHOW THIS CLASS
	CAIG	J,MAXCLS	;GREATER THAN OUR HIGHEST CLASS?
	SKIPN	CLSNUM(J)	;OR NO JOBS IN THE CLASS?
	JRST	CLSLOP		;YES, DON'T SHOW IT

SHWCLS:	TXON	F,FR.HDR	;ALREADY OUTPUT THE HEADER?
	STR$	[ASCIZ/Class	Share	 Use	1-Load	5-Load	15-Load	Jobs in class

/]				;NO, THEN OUTPUT IT
	MOVE	T1,J		;GET CLASS
	CALL	DECSP3		;OUTPUT IT
	TAB			;THEN TAB OVER
	MOVE	T1,KBLK+.SASHR	;GET THE SHARE
	CALL	FLTOUT		;OUTPUT A FLOATING POINT NUMBER
	TAB			;THEN TAB AGAIN
	MOVE	T1,KBLK+.SAUSE	;GET THE UTILIZATION
	CALL	FLTOUT		;OUTPUT IT AS FLOATING POINT TOO
	TAB			;THEN TAB AGAIN
	MOVE	T1,KBLK+.SA1ML	;GET ONE MINUTE LOAD AVERAGE
	CALL	FLTOUT		;OUTPUT IT
	TAB			;THEN TAB
	MOVE	T1,KBLK+.SA5ML	;GET FIVE MINUTE LOAD AVERAGE
	CALL	FLTOUT		;OUTPUT IT
	TAB			;THEN TAB
	MOVE	T1,KBLK+.SA15L	;GET FIFTEEN MINUTE LOAD AVERAGE
	CALL	FLTOUT		;OUTPUT IT
	TAB			;ANOTHER TAB
	CALL	TYPCLS		;AND LIST ALL JOBS IN THAT CLASS
	CRLF			;THEN DO A CRLF
	JRST	CLSLOP		;LOOP
	SUBTTL	SUBROUTINES TO COLLECT AND LIST JOBS IN A CLASS




;HERE TO CREATE A TABLE OF CLASSES FOR ALL THE JOBS.  USED LATER
;TO LIST THOSE JOBS IN EACH SCHEDULER CLASS.



GETCLS:	MOVE	T1,[CLSTAB,,CLSTAB+1]	;GET READY
	SETOM	CLSTAB			;TO CLEAR INFO IN TABLE
	BLT	T1,CLSTAB+MAXJOB-1	;DO IT
	MOVE	T1,[CLSNUM,,CLSNUM+1]	;GET READY
	SETZM	CLSNUM			;CLEAR NUMBER OF JOBS IN CLASSES
	BLT	T1,CLSNUM+MAXCLS	;DO IT
	SETO	J,		;GET READY FOR LOOP


GETCLL:	ADDI	J,1		;MOVE TO NEXT JOB
	CAMLE	J,HGHJOB	;DID THEM ALL?
	RET			;YES, RETURN
	MOVEM	J,KBLK+.SAJOB	;SET IN ARGUMENT BLOCK
	MOVEI	T1,3		;GET NUMBER OF WORDS
	MOVEM	T1,KBLK		;PUT IN ARGUMENT BLOCK TOO
	MOVEI	T1,.SKRJP	;GET FUNCTION CODE
	MOVEI	T2,KBLK		;POINT TO FUNCTION BLOCK
	SKED%			;READ THE INFO
	 ERJMP	GETCLL		;FAILED, DO NEXT JOB
	MOVE	T1,KBLK+.SAJCL	;GET THE SCHEDULER CLASS
	MOVEM	T1,CLSTAB(J)	;REMEMBER FOR LATER
	SKIPL	T1		;SEE IF IN RANGE OF OUR TABLE
	CAILE	T1,MAXCLS	;WELL?
	JRST	GETCLL		;NO, IGNORE INCREMENTING COUNT
	AOS	CLSNUM(T1)	;YES, INCREMENT COUNT
	JRST	GETCLL		;LOOP
;HERE TO TYPE ALL OF THE JOBS WHICH BELONG TO A PARTICULAR SCHEDULER
;CLASS.  THE DATA HAD PREVIOUSLY BEEN COLLECTED BY THE GETCLS ROUTINE.
;SCHEDULER CLASS TO BE LISTED IN IN AC J.




TYPCLS:	SKIPN	CLSNUM(J)	;ANY JOBS IN THIS CLASS?
	STR$	[ASCIZ/None/]	;NO, SAY SO
	SKIPN	CLSNUM(J)	;WELL?
	RET			;NO, SO QUIT NOW
	SETOB	T4,TEMP		;GET READY FOR THE LOOP


TYPCLL:	AOS	T4		;ADVANCE TO NEXT JOB
	CAMG	T4,HGHJOB	;DONE WITH ALL JOBS?
	CAME	J,CLSTAB(T4)	;OR DONE WITH A RANGE?
	JRST	TYPCLR		;YES, GO TYPE IT
	SKIPGE	TEMP		;SEE IF HAVE TO INITIALIZE THE RANGE
	MOVEM	T4,TEMP		;YES, SAVE JOB NUMBER
	JRST	TYPCLL		;GO BACK TO THE LOOP


TYPCLR:	SKIPGE	TEMP		;HAVE A RANGE TO TYPE?
	JRST	TYPCLE		;NO, GO SEE IF DONE
	CALL	LEFT		;GET AMOUNT OF SPACE LEFT ON LINE
	CAIGE	T1,^D6		;ENOUGH FOR ANOTHER RANGE?
	STR$	[BYTE(7)12,11,11,11,11,11,11]	;NO, MOVE TO NEXT LINE
	MOVE	T1,TEMP		;GET FIRST JOB NUMBER
	CALL	DECOUT		;OUTPUT IT
	MOVEI	T1,-1(T4)	;GET LAST JOB OF RANGE
	CAME	T1,TEMP		;SAME AS FIRST JOB?
	CHI$	"-"		;NO, SEPARATE WITH DASH
	CAME	T1,TEMP		;WELL?
	CALL	DECOUT		;NO, TYPE LAST JOB OF RANGE
	SPACE			;THEN TYPE A SPACE
	SETOM	TEMP		;REINITIALIZE FIRST JOB OF RANGE

TYPCLE:	CAMGE	T4,HGHJOB	;LOOKED AT ALL JOBS?
	JRST	TYPCLL		;NO, TRY NEXT ONE
	RET			;YES, DONE
	SUBTTL	DISPLAY TO SHOW STATUS OF SYSTEM RESOURCES




;THIS DISPLAY SHOWS THE AMOUNT OF RESOURCES USED, SUCH AS SPT SLOTS,
;FREE CORE, SWAPPING SPACE, ETC.  A BAR GRAPH IS SHOWN AS PART OF THE
;DISPLAY TO MAKE THESE NUMBERS OBVIOUS.



DPYRES:	TAB$	[$TABS	<0,16,28>]	;SET NICE TAB STOPS
	SETOM	HDRTYP		;NO SPECIAL HEADERS FOR THIS DISPLAY
	TXNN	F,FR.CMP	;SKIP HEADER IF COMPRESSING
	STR$	[ASCIZ"Resource	Used/Total	                  Percentage used

"]
	SETZM	RESDAT		;INITIALIZE TOTAL IN CASE FAIL TOTALLY
	SETO	J,		;GET READY FOR LOOP


RESLOP:	MOVEI	T1,.RDRES	;GET FUNCTION CODE
	TLNN	J,-1		;NOT A RESIDENT SUBFIELD?
	CAML	J,RESQTL	;OR NO MORE SUBFIELDS?
	IORI	J,-1		;YES, SET TO DO NEXT FIELD
	AOS	T2,J		;ADVANCE TO NEXT ENTRY
	MONRD%			;READ THE DATA
	 ERJMP	RESDON		;FAILED
	JUMPL	T1,RESDON	;ALSO
	CALL	RESTYP		;TYPE DATA ON THIS POOL
	JRST	RESLOP		;LOOP


RESDON:	STR$	[ASCIZ/		0%       20%       40%       60%       80%       100%
/]				;TYPE OUT PERCENTAGE LINE
	RET			;RETURN
;HERE TO TYPE A LINE ABOUT EACH FREE POOL:



RESTYP:	HLRZ	T4,J		;GET TYPE OF FIELD THIS IS
	TRNE	J,-1		;ACTUALLY A SUBFIELD OF RESIDENT SPACE?
	MOVEI	T4,RESPOL-RESFLD-1(J)	;YES, FIX UP TO POINT TO OTHER TABLE
	CAIN	T4,RESPOL-RESFLD;SUB FIELD 0?
	RET			;YES, FORGET IT
	STR$	@RESFLD(T4)	;OUTPUT PROPER TEXT
	TAB			;THEN TAB
	MOVE	T1,T2		;COPY TOTAL
	SKIPGE	RESFLD(T4)	;WANTS THE VALUE ITSELF?
	SKIPA	T1,T3		;YES, GET IT
	SUB	T1,T3		;NO, THEN GET DIFFERENCE
	DMOVEM	T1,TEMP		;SAVE VALUES
	CALL	DECSP5		;OUTPUT CURRENT VALUE
	SPACE			;THEN SPACE ONE
	MOVE	T1,TEMP+1	;GET ORIGINAL VALUE
	CALL	DECOUT		;OUTPUT IT TOO
	TAB			;TAB OVER MORE
	DMOVE	T1,TEMP		;GET BACK VALUES
	CALL	DOHIST		;OUTPUT HISTOGRAM
	JRST	DOCRLF		;END IN A CRLF


;EACH INDIVIDUAL RESOURCE:

RESFLD:	EXP	[ASCIZ/Res free core/]	;(0) TOTAL FREE RESIDENT BLOCKS
	EXP	[ASCIZ/Swap free core/]	;(1) SWAPPABLE STORAGE
	EXP	[ASCIZ/  ENQ blocks/]	;(2) ENQ USAGE
	EXP	1B0+[ASCIZ/  DECnet core/]	;(3) SWAPPABLE NETWORK
	EXP	1B0+[ASCIZ/Open files/]	;(4) NUMBER OF OFNS
	EXP	1B0+[ASCIZ/SPT slots/]	;(5) SPT SLOTS
	EXP	[ASCIZ/Swapping pages/]	;(6) PAGES OF SWAPPING
	EXP	[ASCIZ/User core/]	;(7) PAGES OF USER CORE USED
	EXP	1B0+[ASCIZ/Forks/]	;(10) NUMBER OF FORKS USED

	MAXRES==.-RESFLD-1	;HIGHEST RESOURCE


;SUBFIELDS OF THE RESIDENT STORAGE FIELD:

RESPOL:	EXP	[ASCIZ/  Unused pool/]	;(0) CATCH22 POOL
	EXP	[ASCIZ/  General pool/]	;(1) GENERAL
	EXP	[ASCIZ/  Terminals/]	;(2) TERMINAL DATA
	EXP	[ASCIZ/  DECnet core/]	;(3) NETWORK
	EXP	[ASCIZ/  Timer blocks/]	;(4) TIMER BLOCKS

	MAXPOL==.-RESPOL	;HIGHEST KNOWN TYPE
	SUBTTL	SUBROUTINE TO TYPE OUT HISTOGRAM DATA



;CALLED WITH A FRACTION GIVEN BY THE NUMBERS IN ACS T1 AND T2, TO
;OUTPUT A BAR GRAPH WHICH GIVES THE PERCENTAGE OF THE FRACTION.
;ILLEGAL VALUES ARE TAMED BEFORE TRYING TO USE THEM.  THE PATTERN
;IS SEVERAL PERCENTAGE POINTS TO A COLUMN.




DOHIST:	SKIPL	T3,T1		;MOVE AND CHECK SIGN OF NUMBER
	SKIPG	T2		;AND OF DENOMINATOR
	SETZB	T2,T3		;BAD, CLEAR THEM
	CAMLE	T3,T2		;SEE IF HAVE AN IMPROPER FRACTION
	MOVE	T3,T2		;YES, REDUCE TO UNITY
	MULI	T3,^D100	;TURN INTO A PERCENTAGE
	DIV	T3,T2		;FROM THE FRACTION
	IDIVI	T3,PERCOL	;CONVERT PERCENTAGE
	IMULI	T3,PERCOL	;TO A MULTIPLE OF THE COMPRESSION
	SETZ	T1,		;START WITH ZERO
STARLP:	ADDI	T1,PERCOL	;ADVANCE TO NEXT PERCENTAGE
	CHI$	"*"		;TYPE A STAR
	CAMG	T1,T3		;DONE?
	JRST	STARLP		;NO


HSTLOP:	ADDI	T3,PERCOL	;INCREMENT TO NEXT NUMBER
	CAILE	T3,^D100	;REACHED THE END?
	RET			;YES, DONE
	MOVE	T1,T3		;COPY NUMBER
	IDIVI	T1,^D10		;SEE IF AT A MULTIPLE OF 10
	SKIPN	T2		;AT A MULTIPLE?
	CHI$	"!"		;YES, THEN TYPE MARKER
	SKIPE	T2		;WELL?
	SPACE			;NO, JUST SPACE OVER
	JRST	HSTLOP		;LOOP
	SUBTTL	DISPLAY WHICH SHOWS BUSY DEVICES




;THIS DISPLAY SHOWS WHO OWNS THE DEVICES ON THE SYSTEM.  ALL
;DEVICES WHICH ARE NOT DISKS AND CONTROLLING TERMINALS ARE DISPLAYED.



DPYDEV:	MOVEI	T1,TP.DEV	;THIS IS THE DEVICE DISPLAY
	CALL	HDRSET		;SO SET UP HEADERS FOR IT
	TXO	F,FR.EAT	;REMEMBER TO EAT LINES LATER
	SETO	J,		;SET UP FOR LOOP


DEVLOP:	ADDI	J,1		;MOVE TO NEXT INDEX
	MOVSI	T1,(J)		;SET UP INDEX
	IORI	T1,.DEVUN	;TABLE OF OWNERS AND UNITS
	GETAB			;READ IT
	 ERJMP	CPOPJ		;FAILED, ALL DONE
	HLRZ	T2,T1		;GET JOB NUMBER
	CAIE	T2,-1		;NOT ASSIGNED TO ANY JOB?
	CAIN	T2,-2		;OR ASSIGNED TO RESOURCE ALLOCATOR?
	JRST	DEVLOP		;YES, TRY NEXT ONE
	MOVEM	T1,DEVUNT	;SAVE WORD FOR LATER
	MOVSI	T1,(J)		;SET UP INDEX AGAIN
	IORI	T1,.DEVCH	;TABLE OF DEVICE CHARACTERISTICS
	GETAB			;READ IT
	 ERJMP	DEVLOP		;CAN'T, GO TO NEXT ONE
	LDB	T2,[POINT 9,T1,17]	;GET DEVICE TYPE
	CAIN	T2,.DVDSK	;IS IT A DISK?
	JRST	DEVLOP		;YES, DON'T SHOW IT
	CAIE	T2,.DVTTY	;IS IT A TTY?
	JRST	DEVSHW		;NO, GO SHOW IT
	HLLZ	T1,DEVUNT	;GET BACK JOB NUMBER
	IORI	T1,.JOBTT	;INDEX FOR JOB TO TERMINAL
	GETAB			;GET IT
	 ERJMP	DIE		;FAILED
	TSC	T1,DEVUNT	;GET DIFFERENCES WITH SAVED UNIT
	TLNN	T1,-1		;CONTROLLING TERMINAL?
	JRST	DEVLOP		;YES, DON'T SHOW IT

DEVSHW:	MOVSI	T1,(J)		;GET INDEX
	IORI	T1,.DEVNA	;WANT NAME
	GETAB			;READ IT
	 SETZ	T1,		;CAN'T, USE ZERO
	MOVEM	T1,DEVNAM	;SAVE FOR LATER
	CALL	DOCOLS		;DO THE COLUMNS
	JRST	DEVLOP		;THEN LOOP
;FOLLOWING ARE THE ROUTINES TO OUTPUT THINGS ABOUT DEVICES:



XXDEVN:	MOVE	T1,DEVNAM	;GET THE DEVICE NAME
	JRST	SIXOUT		;OUTPUT IT



XXDEVC:	MOVE	T1,DEVNAM	;GET DEVICE NAME
	CALL	SIXASC		;CONVERT IT TO ASCIZ
	HRROI	T1,TEMP		;POINT TO NAME
	STDEV			;CONVERT TO DESIGNATOR
	 ERJMP	CPOPJ		;FAILED
	MOVE	T1,T2		;MOVE TO RIGHT AC
	JRST	OCTFUL		;OUTPUT IT



XXDEVJ:	HLRZ	T1,DEVUNT	;GET THE JOB NUMBER
	JRST	DECSP3		;THEN OUTPUT IT



XXDEVU:	HLRZ	T1,DEVUNT	;GET THE JOB NUMBER AGAIN
	JRST	JOBUSR		;AND OUTPUT THE USER
	SUBTTL	DISPLAY FOR DECNET STATUS




;THIS MODE IS ENTERED BY THE "DN" COMMAND.  THE STATUS OF ALL NODES
;ON THE NETWORK IS GIVEN, AND THE STATUS OF ALL LOGICAL LINK
;BLOCKS IS ALSO GIVEN.



DPYDEC:	MOVEI	T1,.NDGLN	;FUNCTION TO READ LOCAL NODE NAME
	MOVEI	T2,T3		;ARGUMENT BLOCK ADDRESS
	HRROI	T3,LCLNOD	;POINT TO STORAGE
	NODE			;GET THE INFORMATION
	 ERJMP	LOSE		;FAILED
	TXNE	F,FR.CMP	;DON'T WANT TO SEE TITLES?
	JRST	DECNOH		;YEP, SKIP IT
	STR$	[ASCIZ/This is node /]	;TYPE SOME
	STR$	LCLNOD		;THEN GIVE THE NODE NAME
	MOVEI	T1,2		;WANT TWO VERSIONS RETURNED
	MOVEM	T1,TEMP		;STORE
	MOVEI	T1,DATLOC	;GET ADDRESS OF FIRST BLOCK
	MOVEM	T1,TEMP+1	;STORE
	MOVEI	T1,DATLOC+10	;GET ADDRESS OF SECOND BLOCK
	MOVEM	T1,TEMP+2	;STORE THAT TOO
	MOVEI	T1,.NDGVR	;FUNCTION CODE
	MOVEI	T2,TEMP		;POINT TO ARGUMENTS
	NODE			;READ THE DATA
	 ERJMP	LOSE		;FAILED
	STR$	[ASCIZ/    NSP version /]	;TYPE SOME MORE
	MOVEI	T1,DATLOC	;POINT TO VERSION STUFF
	CALL	VEROUT		;OUTPUT STRANGE VERSION STYLE
	STR$	[ASCIZ/    Routing version /]	;TYPE MORE
	MOVEI	T1,DATLOC+10	;POINT TO DATA
	CALL	VEROUT		;OUTPUT THAT TOO
	CRLF			;DO A CRLF

DECNOH:
	TXNN F,FR.CMP		;SUPPRESING TITLES?
	CALL	DONODE		;NO...SO SHOW THE AVAILABLE NODES
	CRLF			;THEN DO ANOTHER CRLF
	CALL	SETEAT		;SET UP TO EAT LINES NOW
	JRST	DOLLNK		;GO SHOW LOGICAL LINKS
	SUBTTL	ROUTINE TO TYPE OUT AVAILABLE NODES




;THIS ROUTINE OUTPUTS THE LIST OF AVAILABLE NODES.




DONODE:	MOVEI	T1,.NDGNT	;FUNCTION TO READ DECNET STRUCTURE
	MOVEI	T2,DATLOC	;POINT TO STORAGE AREA
	MOVEI	T3,DATSIZ	;GET SIZE OF AREA
	MOVEM	T3,DATLOC+.NDNND	;SET IN ARGUMENT BLOCK
	NODE			;READ THE DATA
	 ERJMP	LOSE		;FAILED, GO SAY WHY
	HLRZ	T4,DATLOC+.NDNND	;GET NUMBER OF NODES RETURNED
	MOVEI	T3,DATLOC+.NDBK1	;GET ADDRESS OF FIRST POINTER
	TXZ	F,FR.TMP	;CLEAR TEMP FLAG
	STR$	[ASCIZ/Available nodes: /]	;TYPE SOME


NODLOP:	SOJL	T4,DOCRLF	;IF NO MORE NODES, DO CRLF AND RETURN
	TXOE	F,FR.TMP	;TIME FOR A COMMA?
	STR$	[ASCIZ/, /]	;YES, SEPARATE THE NODES
	CALL	LEFT		;GET ROOM LEFT ON THIS LINE
	CAIGE	T1,^D8		;ENOUGH FOR ANOTHER NODE NAME?
	STR$	[ASCIZ/
                 /]		;NO, MOVE TO NEW LINE
	MOVE	T1,(T3)		;GET ADDRESS OF THIS BLOCK
	MOVE	T1,.NDNAM(T1)	;GET POINTER TO NODE NAME
	STR$	(T1)		;TYPE IT
	AOJA	T3,NODLOP	;DO NEXT ONE
	SUBTTL	SUBROUTINE TO DUMP INFORMATION ABOUT LOGICAL LINKS




;CALLED TO TYPE OUT ALL OF THE LOGICAL LINKS ON THIS NODE, AND THEIR
;STATUS, ETC.  THIS CURRENTLY REQUIRES THE MONRD% JSYS TO COLLECT THE
;DATA.



DOLLNK:	TXNN	F,FR.JSY	;IS THE MONRD% JSYS IN?
	RET			;NO, CAN'T GET THIS
	MOVEI	T1,TP.DLL	;TYPE OF DISPLAY
	CALL	HDRSET		;SET UP HEADERS
	MOVEI	T1,.RDDLL	;GET FUNCTION CODE
	MOVE	T2,[-DATSIZ,,DATLOC]	;POINT TO BUFFER AREA
	MONRD%			;READ THE DATA
	 ERJMP	CPOPJ		;FAILED, CAN'T GET IT
	JUMPL	T1,CPOPJ	;ALSO CAN'T GET IT
	HRRZM	T2,LNKNUM	;SAVE NUMBER OF LINKS WE GOT
	MOVEI	J,DATLOC	;POINT TO THE DATA


JBLNKL:	SOSL	LNKNUM		;ANY MORE LOGICAL LINKS TO SHOW?
	CALL	FULL		;OR IS SCREEN FULL?
	 RET			;YES, RETURN
	SETOM	KWNJOB		;CLEAR ANY KNOWN JOB FOR A FORK
	LDB	T1,[POINT 4,DL.2(J),5]	;GET STATE OF LINK
	CAIN	T1,1		;ACTIVE?
	TXNN	F,FR.ACT	;OR WANT ALL LINKS ANYWAY?
	CALL	DOCOLS		;YES, SHOW DATA ABOUT THIS LINK
	ADDI	J,DLLNUM	;ADVANCE TO NEXT LINK
	JRST	JBLNKL		;AND SHOW IT
;BITS AND FIELDS IN THE LOGICAL LINK BLOCKS.  REFER TO NSPPAR.MAC FOR
;THE ORIGINAL DEFINITIONS.


	LLSTA==POINT 4,DL.2(J),5	;STATE CODE
	LLFLG==POINT 12,DL.2(J),17	;FLAGS FOR THIS LL BLOCK
	  LLSDE==POINT 1,DL.2(J),7	;LL BLOCK IS DISASSOCIATED FROM FORK
	  LLFOB==POINT 1,DL.2(J),17	;THIS IS A SRV
	  LLINT==POINT 1,DL.2(J),6	;THIS IS AN INTERNAL LINK
	LLLNK==POINT 18,DL.2(J),35	;LINK ID
	LLFRK==POINT 18,DL.3(J),17	;FORK WHICH OWNS LL BLOCK
	LLFNM==POINT 8,DL.4(J),19	;REMOTE OBJECT NUMBER
	LLHLK==POINT 16,DL.4(J),35	;LINK ID ON REMOTE HOST
	LLBRP==POINT 1,DL.7(J),0	;TRANSBIT BACK-PRESSURE BIT
	LLBRL==POINT 1,DL.7(J),1	;RECEIVE BACK-PRESSURE BIT
	LLMFC==POINT 2,DL.7(J),3	;FLOW CONTROL CODE
	LLMSM==POINT 8,DL.7(J),27	;MAXIMUM MESSAGES ALLOWED
	LLDSN==POINT 12,DL.11(J),11	;TRANSMIT COUNTER
	LLIDN==POINT 12,DL.11(J),35	;RECEIVE COUNTER
	LLTSK==POINT 30,DL.13(J),35	;POINTER TO TASK NAME
	LLBPCT==POINT 36,DL.17(J),35	;CURRENT BYTE COUNT
	LLBSZ==POINT 6,DL.20(J),5	;BYTE SIZE FOR IO
	LLRSN==POINT 16,DL.20(J),35	;REASON CODE FOR ABORT
	LLHSN==POINT 18,DL.22(J),17	;REMOTE NODE NUMBER
	LLSOB==POINT 18,DL.33(J),17	;OBJECT CODE FOR A SRV


;THE FOLLOWING MACRO DEFINES WHICH WORDS WE WANT TO KNOW ABOUT,
;AND IS USED TO RETURN THEM IN THE MONRD% JSYS.


	DEFINE	LLNUMS,<
LLLIST	<2,3,4,7,10,11,13,17,20,22,33>
>
;ROUTINES TO TYPE OUT VARIOUS THINGS ABOUT THE LINKS.



XXLKFK:	LDB	T1,[LLSDE]	;GET FLAG FOR DISASSOCIATED LL BLOCK
	JUMPN	T1,LNKDIS	;JUMP IF IT IS DISASSOCIATED
	LDB	T1,[LLFRK]	;GET FORK WHICH OWNS THIS LINK
	JRST	OCTSP3		;OUTPUT IT

LNKDIS:	STR$	[ASCIZ/--/]	;SAY NO FORK
	RET			;DONE



XXLKJB:	LDB	T1,[LLSDE]	;SEE IF THIS BLOCK IS DISACCOCIATED
	JUMPN	T1,LNKDIS	;YES, GO TYPE DASHES
	LDB	T1,[LLFRK]	;GET THE FORK OWNINT IT
	CALL	FRKJOB		;FIND WHICH JOB HAS THAT FORK
	 RET			;FAILED
	JRST	DECSP2		;OK, GO OUTPUT JOB NUMBER




XXLPRG:	LDB	T1,[LLSDE]	;SEE IF THIS IS A DISASSOCIATED BLOCK
	JUMPN	T1,CPOPJ	;IF SO, TYPE NOTHING
	LDB	T1,[LLFRK]	;GET THE FORK WHICH OWNS IT
	CALL	FRKJOB		;FIND OUT THE JOB NUMBER
	 RET			;FAILED
	MOVSI	T1,(T1)		;PUT INTO LEFT HALF
	IORI	T1,.JOBPN	;INDEX
	GETAB			;READ PROGRAM NAME
	 ERJMP	CPOPJ		;FAILED
	JRST	SIXOUT		;GO OUTPUT IT
XXLBYC:	LDB	T1,[LLBPCT]	;GET THE CURRENT BYTE COUNT
	JRST	DECSP6		;OUTPUT IT


XXLKID:	LDB	T1,[LLLNK]	;GET THIS LINK ID
	JRST	OCTSP6		;OUTPUT IT AND RETURN


XXLKIR:	LDB	T1,[LLHLK]	;GET LINK ID ON REMOTE HOST
	JRST	OCTSP6		;OUTPUT IT AND RETURN


XXLSEG:	LDB	T1,[LLDSN]	;GET TRANSMIT COUNTER
	CALL	OCTSP4		;OUTPUT IT
	LDB	T1,[LLIDN]	;GET RECEIVE COUNTER
	JRST	OCTSP6		;OUTPUT AND RETURN



XXLOBJ:	LDB	T2,[LLFOB]	;GET FLAG DISTINGUSHING DCN FROM A SRV
	LDB	T1,[LLSOB]	;GET OBJECT CODE ASSUMING THIS IS A SRV
	SKIPN	T2		;IS THIS ACTUALLY A DCN?
	LDB	T1,[LLFNM]	;YES, GET REMOTE OBJECT
	MOVSI	T2,-OBJNUM	;GET READY FOR SEARCH
	HLRZ	T3,OBJTAB(T2)	;GET NEXT OBJECT NUMBER
	CAME	T1,T3		;FOUND IT?
	AOBJN	T2,.-2		;NO, CONTINUE LOOKING
	JUMPGE	T2,DECOUT	;IF NOT FOUND, OUTPUT IN DECIMAL
	MOVE	T1,OBJTAB(T2)	;GET POINTER TO NAME
	STR$	(T1)		;TYPE IT
	RET			;DONE
;TABLE OF OBJECT NAMES:


	DEFINE	NT(CODE,TEXT),<
	XWD	<CODE>,[ASCIZ/TEXT/]	;;CODE AND NAME
>

OBJTAB:	NT	0,TASK
	NT	1,FAL1
	NT	2,URDS
	NT	3,ATS
	NT	4,CTS
	NT	5,TCL1
	NT	6,OSI
	NT	7,NRM
	NT	10,3270
	NT	11,2780
	NT	12,3790
	NT	13,TPS
	NT	17,TCL
	NT	20,TLK
	NT	21,FAL
	NT	22,RTL
	NT	23,NCU
	NT	26,MAIL
	NT	27,NVT
	NT	30,TCON
	NT	31,LOOP
	NT	32,EVENT
	NT	34,FTS
	NT	^D47,POSI
	NT	^D63,DTR
	NT	^D65,TOPOL
	NT	^D123,PMR
	NT	^D201,MS


	OBJNUM==.-OBJTAB	;NUMBER OF ENTRIES
XXLKTP:	MOVE	T1,<PW(LLFLG)>(J)	;GET WORD CONTAINING FLAGS
	TXNE	T1,<PM(LLFOB)>	;IS THIS A SRV OR A DCN?
	TDZA	T2,T2		;A SRV, MAYBE
	MOVEI	T2,1		;A DCN, MAYBE
	TXNE	T1,<PM(LLINT)>	;IS THIS REALLY INTERNAL?
	MOVEI	T2,2		;YES, GET THAT OFFSET
	STR$	[ASCII/SRV /
		 ASCII/DCN /
		 ASCII/Int /](T2)	;OUTPUT PROPER NAME
	CHI$	"("		;TYPE OPENING PARENTHESIS
	LDB	T1,[LLBSZ]	;GET BYTE SIZE
	CALL	DECOUT		;OUTPUT BYTE SIZE
	CHI$	")"		;FINISH THE PARANTHESIS
	RET			;DONE





XXLHST:	LDB T3,[LLHSN]		;GET THE REMOTE NODE NUMBER
	JUMPE T3,NOREM		;IF NONE, LOCAL
	MOVEI T1,16		;MAGIC NODE JSYS FUNCTION
	MOVEI T2,T3		;ADDRESS OF ARG BLOCK
	HRROI T4,TEMP		;BP TO NODE NAME
	NODE
	 ERJMP CPOPJ
	SKIPE TEMP		;IF NONE, LOCAL
	JRST TELHST

NOREM:	STR$	LCLNOD		;OUTPUT OUR OWN NODE
	RET			;DONE
XXLUSR:	LDB	T1,[LLSDE]	;SEE IF LL BLOCK IS DISACCIATED
	JUMPN	T1,CPOPJ	;IF SO, TYPE NOTHING
	LDB	T1,[LLFRK]	;GET FORK OWNING THE LINK
	CALL	FRKJOB		;CONVERT TO JOB NUMBER
	 RET			;CAN'T DO IT



JOBUSR:	HRROI	T2,T4		;WANT ONE WORD RETURNED IN T4
	MOVEI	T3,.JIUNO	;JOB'S USER NUMBER
	GETJI			;READ IT
	 ERJMP	CPOPJ		;CAN'T
	MOVE	T1,T4		;MOVE TO RIGHT AC
	MOVEI	T2,3		;WANT THREE WORDS
	JRST	USROUT		;GO OUTPUT IT



XXLTSK:	LDB	T1,[LLTSK]	;GET POINTER TO TASK NAME
	JUMPE	T1,CPOPJ	;RETURN IF NULL
	TLNE	T1,-1		;BETTER NOT BE OUT OF SECTION 
	RET			;YES, CAN'T GET IT
	HRLI	T1,^D20		;ASK FOR SOME WORDS
	MOVEI	T2,TEMP		;POINT TO STORAGE
	PEEK			;READ TEXT
	 ERJMP	CPOPJ		;NO PRIVILEGES
TELHST:	SETZM	TEMP+^D20	;MAKE SURE TEXT ENDS
	MOVX	T1,177B13	;GET MASK FOR SECOND CHARACTER IN WORD
	TXNE	F,FR.MOR	;ANY MORE COLUMNS?
	ANDCAM	T1,TEMP+1	;YES, CUT OFF TEXT AFTER SIX CHARS
	STR$	TEMP		;OUTPUT NAME
	RET			;DONE
XXFLOW:	LDB	T1,[LLBRP]	;GET BACK PRESSURE BIT
	CHR$	[EXP " ","T"](T1)	;SAY IF TRANSMITS ARE BLOCKED
	LDB	T1,[LLBRL]	;GET OTHER BACK PRESSURE BIT
	CHR$	[EXP " ","R"](T1)	;SAY IF RECEIVES ARE BLOCKED
	SPACE			;SPACE OVER SOME
	LDB	T1,[LLMFC]	;GET TYPE OF FLOW CONTROL
	CAILE	T1,MAXFLW	;LEGAL VALUE?
	SETO	T1,		;NO, SAY UNKNOWN
	STR$	@FLOWTB(T1)	;OUTPUT THE TYPE
	JUMPE	T1,CPOPJ	;IF NONE, ALL DONE
	STR$	[ASCIZ/: /]	;TYPE MORE
	LDB	T1,[LLMSM]	;GET REMAINING MESSAGES TO SEND
	JRST	DECOUT		;OUTPUT AND RETURN


	[ASCIZ/???/]		;UNKNOWN CODE
FLOWTB:	[ASCIZ/None/]		;(0) NO FLOW CONTROL
	[ASCIZ/Seg/]		;(1) CONTROL IS BY SEGMENT
	[ASCIZ/Msg/]		;(2) CONTROL IS BY MESSAGES

	MAXFLW==.-FLOWTB-1	;HIGHEST KNOWN FLOW CONTROL CODE



XXLSTA:	LDB	T1,[LLSTA]	;GET STATE CODE
	CAILE	T1,LLSMAX	;GREATER THAN KNOWN STATE?
	JRST	OCTOUT		;YES, OUTPUT IN OCTAL
	STR$	@LLSTAB(T1)	;NO, OUTPUT THE STATE
	RET			;DONE


LLSTAB:	[ASCIZ/Transient/]	;(0) NON-EXISTANT
	[ASCIZ/CI wait/]	;(1) OBJECT IS LISTENING
	[ASCIZ/CI sent/]	;(2) CONNECT-INITIALIZE SENT
	[ASCIZ/CI read/]	;(3) CONNECT-INITIALIZE RECEIVED
	[ASCIZ/Active/]		;(4) LINK IS ACTIVE
	[ASCIZ/DI sent/]	;(5) DI SENT
	[ASCIZ/DI queued/]	;(6) DI QUEUED
	[ASCIZ/DI read/]	;(7) DI REVEIVED
	[ASCIZ/CC sent/]	;(10) CC SENT
ABTCOD:	[ASCIZ/Aborted/]	;(11) CONNECTION ABORTED


	LLSMAX==.-LLSTAB-1	;HIGHEST KNOWN STATE
XXLABT:	LDB	T1,[LLSTA]	;GET STATE CODE
	CAIE	T1,ABTCOD-LLSTAB	;IS IT CONNECTION BROKEN?
	RET			;NO, TYPE NOTHING
	LDB	T1,[LLRSN]	;YES, GET REASON
	MOVSI	T2,-DINUM	;GET READY FOR SEARCH
	HLRZ	T3,DITAB(T2)	;GET NEXT POSSIBILITY
	CAME	T1,T3		;IS THIS IT?
	AOBJN	T2,.-2		;NO, KEEP SEARCHING
	JUMPGE	T2,DECOUT	;CAN'T FIND, GO GIVE NUMBER
	HRLZ	T1,DITAB(T2)	;GET ADDRESS OF STRING
	HRRI	T1,TEMP		;POINT TO STORAGE
	BLT	T1,TEMP+^D20	;COPY THE STRING
	TXNE	F,FR.MOR	;MORE COLUMNS COMING?
	SETZM	TEMP+3		;YES, CUT OFF OUTPUT
	STR$	TEMP		;OUTPUT REASON
	RET			;DONE



;TABLE OF DISCONNECT REASONS:


	DEFINE	NT(CODE,TEXT),<
	XWD	<CODE>,[ASCIZ/TEXT/]	;;CODE AND TEXT FOR ERRORS
>


DITAB:	NT	.DCX0,No special error
	NT	.DCX1,Resource allocation failure
	NT	.DCX2,Unknown destination node
	NT	.DCX3,Node shutting down
	NT	.DCX4,Unknown destination process
	NT	.DCX5,Invalid name field
	NT	.DCX11,User abort
	NT	.DCX32,Too many node connections
	NT	.DCX33,Too many process connections
	NT	.DCX34,Access not permitted
	NT	.DCX35,Logical link mismatch
	NT	.DCX36,Invalid account
	NT	.DCX37,Segment size too small
	NT	.DCX38,Process aborted
	NT	.DCX39,No path to destination node
	NT	.DCX40,Aborted due to data loss
	NT	.DCX41,Unknown destination process
	NT	.DCX42,Disconnect confirmation
	NT	.DCX43,Image data field too long


	DINUM==.-DITAB		;SIZE OF TABLE
	SUBTTL	DISPLAY FOR ARPANET STATUS




;THIS DISPLAY MODE IS SET BY THE "ANH" COMMAND.  THE STATUS OF ALL
;ARPANET SITES IS GIVEN.  THIS DOES NOT NEED THE MONRD% JSYS.




DPYARH:	MOVX	T1,.GTHSZ	;WANT TO READ NUMBER OF HOSTS
	GTHST%			;READ IT
	 ERJMP	NOARPA		;FAILED, GO SEE WHY
	SKIPN	J,T3		;PUT NUMBER OF HOSTS IN RIGHT AC
	RET			;NO HOSTS, RETURN
	MOVEI	T1,TP.ANH	;THIS IS DISPLAY FOR HOST STATUS
	CALL	HDRSET		;SET UP HEADERS
	TXO	F,FR.EAT	;REMEMBER TO EAT OUTPUT LATER


APALOP:	CALL	FULL		;SEE IF SCREEN IS FULL YET
	 RET			;YES, DONE
	MOVX	T1,.GTHHI	;GET FUNCTION
	MOVEI	T3,(J)		;AND HOST INDEX
	GTHST%			;READ HOST NUMBER AND STATUS
	 ERJMP	APALPL		;FAILED
	TXNE	F,FR.AAH	;WANT TO ONLY SHOW ACTIVE (UP) HOSTS?
	TXNE	T4,HS%UP	;YES, CHECK IF HOST IS UP
	TXNN	T4,HS%VAL	;MAKE SURE STATUS IS VALID ALSO
	JRST	APALPL		;NOT UP OR NOT VALID, SKIP ON
	DMOVEM	T3,APANUM	;WANT TO SHOW IT, SAVE NUMBER AND STATUS
	CALL	DOCOLS		;SHOW THIS HOST
APALPL:	AOBJN	J,APALOP	;LOOP UNTIL LOOKED AT THEM ALL
	RET			;DONE



NOARPA:	MOVEI	T1,.FHSLF	;GET READY
	GETER			;READ ERROR REASON
	HRRZ	T1,T2		;GET ERROR CODE
	CAIE	T1,ILINS2	;IS THE JSYS UNDEFINED?
	JRST	LOSE		;NO, SOME OTHER ERROR
	STR$	[ASCIZ/
? No ARPANET code exists in this monitor
/]				;YES, SAY WHAT'S WRONG
	RET			;AND RETURN
;ROUTINES TO TYPE DATA ABOUT HOSTS:



XXAHST:	MOVE	T1,APANUM	;GET HOST NUMBER
	JRST	OCTOUT		;OUTPUT IT



XXANAM:	MOVEI	T1,.GTHNS	;WANT TO GET NAME
	HRROI	T2,TEMP		;POINT TO STORAGE
	MOVE	T3,APANUM	;GET HOST NUMBER
	GTHST%			;READ THE NAME STRING
	 ERJMP	CPOPJ		;NONE EXISTS
	TXNE	F,FR.MOR	;ANY MORE COLUMNS?
	SETZM	TEMP+3		;YES, THEN RESTRICT THE NAME
	STR$	TEMP		;OUTPUT THE NAME
	RET			;DONE




XXATYP:	LDB	T1,[POINTR APASTS,HS%STY]	;GET TYPE CODE
	CAILE	T1,APATPX	;HIGHER THAN WE KNOW?
	JRST	OCTTEL		;YES, GIVE THE NUMBER
	STR$	@APATPT(T1)	;NO, TYPE THE SYSTEM
	MOVE	T1,APASTS	;GET STATUS AGAIN
	TXNN	T1,HS%SRV	;IS THIS A USER?
	STR$	[ASCIZ/ (user)/]	;YES, SAY SO
	RET			;DONE


APATPT:	[ASCIZ	/other/]	;(0)
	[ASCIZ	/TENEX/]	;(1)
	[ASCIZ	/ITS/]		;(2)
	[ASCIZ	/TOPS-10/]	;(3) 
	[ASCIZ	/TIP/]		;(4)
	[ASCIZ	/MTIP/]		;(5)
	[ASCIZ	/ELF/]		;(6)
	[ASCIZ	/ANTS/]		;(7)
	[ASCIZ	/MULTICS/]	;(10)
	[ASCIZ	/TOPS-20/]	;(11)
	[ASCIZ	/UNIX/]		;(12)

	APATPX==.-APATPT-1	;HIGHEST KNOWN SYSTEM TYPE
XXASTS:	MOVE	T1,APASTS	;GET THE STATUS OF THIS HOST
	TXNE	T1,HS%UP	;IS HOST UP?
	STR$	[ASCIZ/Up/]	;YES, SAY SO
	TXNE	T1,HS%UP	;WELL?
	RET			;YES, DONE
	STR$	[ASCIZ/Down, /]	;SAY IT IS DOWN
	LDB	T1,[POINTR APASTS,HS%RSN]	;GET REASON FOR BEING DOWN
	STR$	@RSNTAB(T1)	;OUTPUT REASON
	LDB	T1,[POINTR APASTS,<HS%DAY!HS%HR!HS%MIN>]	;GET TIME
	JUMPE	T1,CPOPJ	;DONE IF UNKNOWN
	CAIE	T1,<.RTJST(-1,<HS%DAY!HS%HR!HS%MIN>)>	;"-1" FORM OF UNKNOWN?
	CAIN	T1,<.RTJST(-1,<HS%DAY!HS%HR!HS%MIN>)>-1	;OR "-2" FORM?
	RET			;YES, DONE
	STR$	[ASCIZ/, up /]	;HAVE REAL TIME, START OUTPUT
	LDB	T1,[POINTR APASTS,HS%DAY]	;GET DAY OF WEEK
	STR$	DAYTAB(T1)	;TYPE IT
	LDB	T1,[POINTR APASTS,HS%HR]	;GET HOUR
	CALL	DECOUT		;OUTPUT IT
	CHI$	":"		;THEN THE COLON
	LDB	T1,[POINTR APASTS,HS%MIN]	;GET MINUTE
	IMULI	T1,5		;FIVE MINUTE EXPANSION
	JRST	DECOUT		;OUTPUT AND RETURN


RSNTAB:	[ASCIZ/net err/]	;(0)	REASONS WHY HOST IS DOWN
	[ASCIZ/sys dwn/]	;(1)
	[ASCIZ/frn NCP/]	;(2)
	[ASCIZ/nosuch/]		;(3)
	[ASCIZ/NCP ini/]	;(4)
	[ASCIZ/PM/]		;(5)
	[ASCIZ/hdw wrk/]	;(6)
	[ASCIZ/sfw wrk/]	;(7)
	[ASCIZ/restart/]	;(8)
	[ASCIZ/power/]		;(9)
	[ASCIZ/bpt/]		;(10)
	[ASCIZ/hdw err/]	;(11)
	[ASCIZ/sched/]		;(12)
	[ASCIZ/#13/]		;(13)
	[ASCIZ/#14/]		;(14)
	[ASCIZ/unknown/]	;(15)



DAYTAB:	ASCII	/Mon /		;(0) MONDAY
	ASCII	/Tue /		;(1) TUESDAY
	ASCII	/Wed /		;(2) WEDNESDAY
	ASCII	/Thu /		;(3) THURSDAY
	ASCII	/Fri /		;(4) FRIDAY
	ASCII	/Sat /		;(5) SATURDAY
	ASCII	/Sun /		;(6) SUNDAY
	SUBTTL	DISPLAY ROUTINE TO SHOW ARPANET CONNECTIONS




;ROUTINE TO TYPE OUT ALL OF THE ARPANET CONNECTIONS IN USE ON THIS
;SYSTEM.  THIS IS THE "ANC" COMMAND.




DPYARC:	MOVEI	T1,TP.ANC	;GET CODE FOR ARPANET CONNECTION DISPLAY
	CALL	HDRSET		;AND SET UP HEADERS FOR IT
	TXO	F,FR.EAT	;REMEMBER TO DO EATING LATER
	MOVEI	T1,.GTNSZ	;GET FUNCTION
	GTNCP%			;READ NUMBER OF NETWORK CONNECTIONS
	 ERJMP	NOARPA		;FAILED, COMPLAIN
	SKIPN	J,T2		;COPY TO GOOD AC
	RET			;NONE, RETURN


ARPCLP:	CALL	FULL		;SEE IF SCREEN IS OVERFLOWED YET
	 RET			;YES, DONE
	MOVX	T1,.GTNIX	;GET FUNCTION TO RETURN DATA
	MOVEI	T2,(J)		;USES CONNECTION INDEX
	MOVEI	T3,ABLK		;POINT TO BLOCK
	MOVSI	T4,-<.NCSTS+1>	;GET NUMBER OF WORDS
	GTNCP%			;READ THE STATUS
	 ERJMP	ARPCLL		;FAILED
	MOVE	T1,ABLK+.NCFSM	;GET THE STATE OF THE CONNECTION
	CAIE	T1,DEADCD	;IS IT DEAD?
	CAIN	T1,FREECD	;OR FREE?
	JRST	ARPCLL		;YES, DON'T SHOW IT
	CALL	DOCOLS		;SHOW DATA ON THIS CONNECTION
ARPCLL:	AOBJN	J,ARPCLP	;LOOP OVER ALL OF THEM
	RET			;DONE
;ROUTINES TO TYPE VARIOUS DATA ABOUT ARPANET CONNECTIONS:



XXACFH:	MOVX	T1,.GTHNS	;WANT TO GET HOST STRING
	HRROI	T2,TEMP		;POINT TO STORAGE
	MOVE	T3,ABLK+.NCFHS	;GET HOST NUMBER
	GTHST%			;READ HOST NAME
	 ERJMP	ACFHNU		;FAILED, GO GIVE NUMBER
	TXNE	F,FR.MOR	;LAST COLUMN?
	SETZM	TEMP+3		;NO, THEN CUT OFF OUTPUT
	STR$	TEMP		;OUTPUT NAME
	RET			;DONE

ACFHNU:	MOVE	T1,ABLK+.NCFHS	;GET NUMBER
	JRST	OCTTEL		;OUTPUT NUMBER



XXACLS:	SKIPA	T1,ABLK+.NCLSK	;GET LOCAL SOCKET NUMBER
XXACFS:	MOVE	T1,ABLK+.NCFSK	;OR FOREIGN SOCKET NUMBER
	JRST	OCTOUT		;OUTPUT IT



XXACVT:	MOVE	T1,ABLK+.NCNVT	;GET VIRTUAL TERMINAL NUMBER
	CAME	T1,[-1]		;REALLY ONE HERE?
	JRST	OCTSP3		;YES, SAY WHICH ONE IT IS
	STR$	[ASCIZ/---/]	;NO, TYPE DASHES
	RET			;DONE



XXACBT:	MOVE	T1,ABLK+.NCBTC	;GET NUMBER OF BITS TRANSMITTED OR RECEIVED
	JRST	DECOUT		;TYPE AND RETURN
XXABTA:	SKIPA	T1,ABLK+.NCBAL	;GET BIT ALLOCATION
XXAMSA:	MOVE	T1,ABLK+.NCMSG	;OR MESSAGE ALLOCATION
	JRST	DECOUT		;OUTPUT IT



XXAPRS:	MOVE	T4,[POINT 4,ABLK+.NCSTS,19]	;POINT TO PREVIOUS STATES
APRSLP:	ILDB	T1,T4		;GET NEXT STATE
	CALL	APASTE		;OUTPUT IT
	TLNN	T4,770000	;FINISHED OFF WORD YET?
	RET			;YES, RETURN
	STR$	[ASCIZ/, /]	;NO, SPACE OVER SOME
	JRST	APRSLP		;AND CONTINUE



XXASTE:	MOVE	T1,ABLK+.NCFSM	;GET THE STATE OF THE CONNECTION
APASTE:	SKIPL	T1		;MAKE SURE IT IS REASONABLE
	CAILE	T1,APASTM	;SO WE CAN OUTPUT IT
	JRST	OCTOUT		;NO, THEN GIVE IN OCTAL
	STR$	APASTT(T1)	;TYPE THE STATE CODE
	RET			;DONE



;TABLE OF CONNECTIONS STATES:


	DEADCD==0		;STATE OF A DEAD CONNECTION
	FREECD==16		;STATE OF A FREE CONNECTION

APASTT:	ASCII	/DEAD/		;(0) DEAD
	ASCII	/CLZD/		;(1) CLOSED
	ASCII	/PNDG/		;(2) PENDING
	ASCII	/LSNG/		;(3) LISTENING
	ASCII	/RFCR/		;(4) RFC RECEIVED
	ASCII	/CLW1/		;(5) CLOSE WAIT SUB1
	ASCII	/RFCS/		;(6) RFC SENT
	ASCII	/OPND/		;(7) OPENED
	ASCII	/CLSW/		;(10) CLOSE WAIT
	ASCII	/DATW/		;(11) FINAL DATA WAIT
	ASCII	/RFN1/		;(12) RFN1 FINAL WAIT
	ASCII	/CLZW/		;(13) PROGRAM CLOSE WAIT
	ASCII	/RFN2/		;(14) RFN2 SUB2 WAIT
	ASCII	/NUSE/		;(15) NOT IN USE
	ASCII	/FREE/		;(16) FREE
	
	APASTM==.-APASTT-1	;HIGHEST LEGAL STATE
	SUBTTL	ROUTINE TO GIVE HELP MESSAGE



;THIS MODE IS ENTERED BY THE "H" COMMAND.  THERE ARE SEVERAL
;SUB-DISPLAYS, SUCH AS HELP FILE TYPEOUT, COLUMN TYPEOUT.  THE NORMAL
;HELP DISPLAY SIMPLY TYPES OUT THE HELP FILE FOR SYSDPY.




DPYHLP:	SETOM	HDRTYP		;CLEAR ANY HEADER STUFF
	TAB$			;SET DEFAULT TABS
	SKIPE	T1,HLPDSP	;ANY SPECIAL HELP DISPLAY?
	JRST	(T1)		;YES, GO DO IT
	CALL	SETEAT		;GO SET UP HOW MANY LINES TO EAT
	SKIPE	T1,HLPJFN	;HAVE HELP FILE OPEN YET?
	JRST	HLPTYP		;YES, GO TYPE IT OUT
	MOVX	T1,GJ%SHT+GJ%OLD	;GET READY
	HRROI	T2,[ASCIZ/HLP:SYSDPY.HLP/]	;GET STRING
	GTJFN			;OPEN THE HELP FILE
	 ERJMP	LOSE		;FAILED, GO EXPLAIN THINGS
	HRRZM	T1,HLPJFN	;REMEMBER THE JFN
	MOVX	T2,OF%RD+7B5	;GET SET TO OPEN THE FILE
	OPENF			;OPEN IT
	 ERJMP	[MOVE T1,HLPJFN	;FAILED, GET JFN
		 SETZM HLPJFN	;CLEAR IT
		 RLJFN		;RELEASE IT
		 ERJMP LOSE	;FAILED
		 JRST LOSE]	;SUCCEEDED, GO COMPLAIN

HLPTYP:	SETZ	T2,		;WANT TO BE AT FRONT OF FILE
	SFPTR			;SET US THERE
	 ERJMP	LOSE		;FAILED
HLPSCN:	BIN			;READ NEXT CHARACTER
	 ERJMP	HLPDON		;FAILED, GO SEE WHY
	CAIE	T2,15		;CARRIAGE RETURN?
	CAIN	T2,12		;OR LINE FEED?
	JRST	HLPSCN		;YES, IGNORE THEM
	BKJFN			;PUT BACK THE CHARACTER
	 ERJMP	LOSE		;FAILED
HLPLOP:	CALL	FULL		;OVERFLOWED THE SCREEN?
	 RET			;YES, RETURN NOW
	MOVE	T1,HLPJFN	;GET INPUT JFN
	MOVE	T2,[POINT 7,TEMP]	;GET POINTER TO BUFFER
	MOVNI	T3,TMPSIZ*5-5	;GET NUMBER OF BYTES TO READ
	SIN			;READ THEM
	 ERJMP	HLPDON		;FAILED, GO SEE WHY
	IDPB	T3,T2		;END STRING WITH A NULL
	STR$	TEMP		;OUTPUT THIS PART
	JRST	HLPLOP		;LOOP UNTIL END OF FILE REACHED

HLPDON:	SETZ	T1,		;GET A NULL
	IDPB	T1,T2		;STORE IT TO MAKE ASCIZ STRING
	STR$	TEMP		;OUTPUT REMAINING PART OF TEXT
	MOVEI	T1,.FHSLF	;GET READY
	GETER			;FIND OUT WHY WE STOPPED
	ANDI	T2,-1		;KEEP ONLY THE ERROR CODE
	CAIE	T2,IOX4		;END OF FILE?
	JRST	LOSE		;NO, GO COMPLAIN
	RET			;DONE
	SUBTTL	SUBROUTINE TO TYPE OUT COLUMN NAMES




;CALLED AS PART OF THE HELP COMMAND, TO CREATE A LIST OF THE COLUMN
;NAMES, TELLING WHICH ONES ARE BEING SHOWN.  THE OUTPUT IS ORDERED
;SO HE CAN TELL WHICH DISPLAYS THE COLUMNS ARE FOR.




HLPCOL:	TAB$	[$TABS	<15,40>]	;SET NICE TAB STOPS
	TXNN	F,FR.CMP	;SUPPRESS IF COMPRESSING
	STR$	[ASCIZ/Display	Displayed columns	Suppressed columns

/]				;TYPE SOME
	CALL	SETEAT		;SET UP TO EAT LINES
	SETOM	LSTTYP		;CLEAR LAST TYPE SEEN
	MOVE	J,COLHLC	;GET AOBJN POINTER TO DISPLAY TYPES


HLPCLL:	AOBJP	J,CPOPJ		;RETURN IF DID ALL DISPLAY TYPES
	HRRZM	J,COLTYP	;REMEMBER THIS COLUMN TYPE
	TXOE	F,FR.NDC	;ANY PREVIOUS TYPES OUTPUT?
	CRLF			;YES, SEPARATE FROM THEM
	SETZM	COLDIS		;INITIALIZE INDEX INTO DISPLAYED COLUMNS
	SETZM	COLSUP		;AND INDEX INTO SUPPRESSED COLUMNS

TYPCNX:	SETZ	T4,		;CLEAR RESULT AC
	CALL	FNDDIS		;FIND THE NEXT DISPLAYED COLUMN
	 MOVE	T4,T1		;REMEMBER THE TEXT ADDRESS
	CALL	FNDSUP		;THEN FIND THE NEXT SUPPRESSED COLUMN
	 HRL	T4,T1		;SAVE THAT ADDRESS TOO
	JUMPE	T4,HLPCLL	;IF NO MORE COLUMNS, DO NEXT TYPE
	SKIPLE	@DPYTAB+$DPEAT	;STILL HAVE LINES TO EAT?
	JRST	TYPCNC		;YES, JUST DO A CRLF
	MOVE	T2,COLTYP	;GET CURRENT COLUMN TYPE
	HLRZ	T3,DISTAB(T2)	;GET NAME OF DISPLAY
	CAME	T2,LSTTYP	;SAME AS PREVIOUS ONE?
	STR$	(T3)		;NO, SAY WHICH DISPLAY THIS IS
	MOVEM	T2,LSTTYP	;AND REMEMBER THE NEW TYPE
	TAB			;SPACE OVER
	TRNE	T4,-1		;ANY DISPLAYED COLUMN?
	STR$	(T4)		;YES, OUTPUT IT
	TAB			;THEN TAB AGAIN
	TLNE	T4,-1		;ANY SUPPRESSED COLUMN?
	STR$	(T1)		;YES, OUTPUT IT
TYPCNC:	CRLF			;END IN A CRLF
	JRST	TYPCNX		;LOOP OVER SOME MORE COLUMNS
;SUBROUTINES TO SEARCH FOR ANOTHER DISPLAYED COLUMN OR SUPPRESSED
;COLUMN.  SKIP RETURNS IF NOT FOUND, NON-SKIP WITH TEXT OF COLUMN IN
;T1 IF FOUND.



FNDDIS:	MOVE	T1,COLDIS	;GET NEXT POSSIBLE COLUMN
	SKIPN	T2,COLDSP(T1)	;ANY MORE DISPLAYED COLUMNS?
	RETSKP			;NOT FOUND, SKIP RETURN
	AOS	COLDIS		;INCREMENT COUNTER
	MOVE	T3,CL.TYP(T2)	;GET THE TYPE OF COLUMN
	CAME	T3,COLTYP	;THE ONE CURRENTLY LOOKING FOR?
	JRST	FNDDIS		;NO, LOOP FOR ANOTHER ONE
	MOVSI	T1,-COLNUM	;GET READY FOR SEARCH

FNDDIL:	HRRZ	T3,COLTAB+1(T1)	;FIND ADDRESS FOR NEXT POSSIBLE COLUMN
	CAME	T2,T3		;FOUND THIS ONE?
	AOBJN	T1,FNDDIL	;NO, KEEP GOING
	JUMPGE	T1,FNDDIS	;SHOULD NEVER FAIL, BUT ...

HAVSUP:	HLRZ	T1,COLTAB+1(T1)	;GET THE STRING FOR THIS COLUMN
	RET			;RETURN IT




FNDSUP:	MOVE	T1,COLSUP	;GET NEXT POSSIBLE INDEX
	CAIL	T1,COLNUM	;ALL DONE?
	RETSKP			;YES, SKIP RETURN
	AOS	COLSUP		;INCREMENT COUNTER
	HRRZ	T2,COLTAB+1(T1)	;GET ADDRESS OF DATA FOR COLUMN
	MOVE	T3,CL.TYP(T2)	;THEN GET TYPE OF COLUMN
	CAME	T3,COLTYP	;THE ONE WE ARE INTERESTED IN?
	JRST	FNDSUP		;NO, KEEP LOOKING
	SETZ	T3,		;GET READY FOR A LOOP

FNDSUL:	SKIPN	COLDSP(T3)	;RAN OUT OF COLUMNS?
	JRST	HAVSUP		;YES, THIS IS A SUPPRESSED COLUMN
	CAME	T2,COLDSP(T3)	;FOUND THE COLUMN?
	AOJA	T3,FNDSUL	;NO, KEEP SEARCHING
	JRST	FNDSUP		;YES, LOOK AT NEXT COLUMN
	SUBTTL	INFORMATION LINE ROUTINE




;IF SELECTED BY THE "IN" COMMAND, THIS ROUTINE TYPES AS THE LAST LINE
;OF THE DISPLAY A SIMPLE STATUS LINE  CONTAINING USEFUL INFORMATION.



INFO:	MOVE	T1,@DPYTAB+$DPLEN	;GET TERMINAL LENGTH
	HRLOI	T1,-1(T1)	;SET UP FOR TWO LINES AT BOTTOM
	MOVEI	T2,-1		;WANT ALL COLUMNS
	SIZ$	T1		;TELL DPY WHERE WINDOW IS
	CRLF			;START WITH A CRLF
	HRROI	T1,TEMP		;POINT TO TEMPORARY DATA
	SETO	T2,		;WANT CURRENT TIME
	MOVX	T3,OT%SCL!OT%NSC!2B29	;GET FLAGS
	ODTIM			;STORE THE TIME TEXT
	STR$	TEMP		;THEN OUTPUT IT
	MOVEI	T1,.DWNTI	;WANT TO READ DOWNTIME
	GETAB			;READ IT
	 SETZ	T1,		;FAILED, ASSUME NONE
	JUMPLE	T1,DWNNON	;PROCEED IF NO DOWNTIME
	SUB	T1,NTIME	;COMPUTE TIME UNTIL SYSTEM DOWN
	JUMPLE	T1,DWNTEL	;SKIP ON IF DOWNTIME ALREADY PASSED
	ADDI	T1,<1B17/^D<60*24>>-1	;ROUND UP TO NEXT HIGHER MINUTE
	MULI	T1,^D<60*24>	;CONVERT FROM UNIVERSAL TIME
	ASHC	T1,^D17		;TO MINUTES UNTIL SYSTEM DOWN
	CAILE	T1,DWNTIM	;TIME TO WARN USER ABOUT SYSTEM GOING DOWN?
	JRST	DWNNON		;NOPE, SKIP OUTPUT
				;YES, PROCEED TO TYPE TIME
DWNTEL:	SKIPG	T1		;SYSTEM ALREADY DOWN?
	STR$	[ASCIZ/,  System down/]	;YES, SAY SO
	JUMPLE	T1,DWNNON	;SKIP ON IF NO TIME TO OUTPUT
	STR$	[ASCIZ/,  Down in /]	;MORE TIME LEFT, TYPE THIS
	CALL	DECOUT		;THEN MINUTES LEFT
	STR$	[ASCIZ/ min/]	;FINISH TEXT

DWNNON:	STR$	[ASCIZ/,  Load av /]	;START LOAD AVERAGE
	MOVE	T1,[14,,.SYSTA]	;GET SYSTAT TABLE ENTRY
	GETAB			;READ IT
	 SETZ	T1,		;FAILED, MAKE ZERO
	FMPRI	T1,(10.0)	;CONVERT TO MULTIPLE OF TEN
	FIXR	T1,T1		;THEN CONVERT TO INTEGER
	MOVEI	T4,DECOUT	;NORMAL DECIMAL OUTPUT ROUTINE
	CALL	FIXOUT		;OUTPUT IT
	STR$	[ASCIZ/,  Sleep /]	;SPACE OVER
	CALL	GETSLP		;FIND OUT THE SLEEP TIME
	ADDI	T1,^D500	;ROUND UP
	IDIVI	T1,^D1000	;TURN INTO SECONDS
	CALL	DECOUT		;TYPE IT
	STR$	[ASCIZ/ sec,  Page /]	;MORE STUFF
	MOVE	T1,PAGE		;GET PAGE NUMBER
	AOJA	T1,DECOUT	;ADD ONE AND GO TYPE IT
	SUBTTL	FORK TERMINATION INTERRUPT HANDLING




;HERE WHEN WE ARE WAITING FOR AN INFERIOR TO TERMINATE, TO BREAK
;OUT OF THE SLEEP WE WERE DOING FOR IT.



FRKINT:	PUSH	P,T1		;SAVE AN AC
	MOVEI	T1,PSHINT	;GET PC TO GO TO
	SKIPN	FRKFLG		;IN THE SLEEP?
	MOVEM	T1,CHNPC1	;YES, CHANGE THE PC
	MOVEI	T1,1		;GET POSITIVE NUMBER
	MOVEM	T1,FRKFLG	;STOP THE NEXT SLEEP
	POP	P,T1		;RESTORE THE AC
	DEBRK			;RETURN WHERE INTERRUPTED
	SUBTTL	CHARACTER INTERRUPT HANDLING



;HERE TO HANDLE AN INTERRUPT DUE TO CHARACTER TYPE IN.  THE
;CHARACTER IS STORED IN ONE OF SEVERAL BUFFERS, AND WHEN A LINE FEED
;IS SEEN THE BUFFER IS MADE AVAILABLE TO THE COMMAND PROCESSOR.



TTYINT:	PUSH	P,T1		;SAVE AN AC
	PUSH	P,T2		;AND ANOTHER


CHRCHK:	MOVEI	T1,.PRIIN	;GET READY
	SIBE			;IS INPUT BUFFER NONEMPTY?
	 JRST	CHRGET		;YES, GO HANDLE A CHAR
	POP	P,T2		;NO, RESTORE ACS
	POP	P,T1		;BOTH
	DEBRK			;AND DISMISS THE INTERRUPT


CHRGET:	PUSH	P,[CHRCHK]	;SET TO CHECK ANOTHER CHAR WHEN DONE
	PBIN			;GET THE CHARACTER
	SKIPL	@INTBUF		;SEE IF HAVE NOPLACE TO PUT THE CHAR
	CAIN	T1,33		;OR SEE IF IT IS AN ALTMODE
	JRST	CHRALT		;YES, RING BELL
	CAIN	T1,"U"-100	;CONTROL-U?
	JRST	CHRINI		;YES, GO REINITIALIZE
	CAIN	T1,177		;RUBOUT?
	JRST	CHRRUB		;YES, GO UNDO A CHAR
	CAIN	T1,12		;LINE FEED?
	JRST	CHRLIN		;YES, HAVE A LINE
	AOS	T2,INTCNT	;ADD 1 TO INPUT CHARS
	CAILE	T2,BUFLEN*5-1	;ROOM FOR NEW CHAR?
	JRST	CHRFUL		;NO, COMPLAIN
	IDPB	T1,INTPTR	;PUT IT IN THE BUFFER
	CAIN	T2,1		;FIRST CHARACTER ON THIS LINE?
	CAIE	T1," "		;AND IT IS A SPACE?
	RET			;NO, JUST RETURN
	MOVEI	T1,"S"		;YES, GET SCROLL COMMAND LETTER
	DPB	T1,INTPTR	;REPLACE SPACE WITH IT
	MOVEI	T1,12		;GET A LINE FEED
	JRST	CHRLIN		;AND PRETEND IT WAS TYPED IN
;HERE ON AN ALTMODE. WE DON'T DO ANY RECOGNITION, SO WARN THE
;USER BY BEEPING AT HIM.


CHRALT:	MOVEI	T1,7		;GET A BELL CHAR
	PBOUT			;OUTPUT IT
	RET			;RETURN



;HERE ON A RUBOUT.  WE REMOVE THE LATEST CHARACTER FROM THE
;INPUT BUFFER.  WE BEEP AT HIM IF THERE ARE NO MORE CHARS.


CHRRUB:	SKIPG	INTCNT		;ANY CHARS STORED?
	JRST	CHRALT		;NO, GO BEEP AT HIM
	SOS	INTCNT		;YES, DECREMENT COUNT
	SETO	T1,		;SET COUNT OF -1
	ADJBP	T1,INTPTR	;BACK UP BYTE POINTER BY A CHAR
	MOVEM	T1,INTPTR	;AND STORE BACK
	RET			;RETURN



;HERE ON A CONTROL-U.  WE DELETE ALL INPUT WE HAVE ACCUMULATED
;SO FAR.  THIS ROUTINE IS ALSO CALLED TO INITIALIZE THE INPUT BUFFER.


CHRINI:	MOVE	T1,@INTBUF	;GET BUFFER WE ARE USING
	HRLI	T1,(POINT 7,)	;MAKE A POINTER TO IT
	MOVEM	T1,INTPTR	;SAVE POINTER
	SETZM	INTCNT		;CLEAR COUNT OF SAVED CHARS
	RET			;RETURN



;HERE WHEN HE HAS TYPED TOO MANY CHARACTERS, AND OUR BUFFER HAS
;FILLED UP.  WE WIPE OUT THE BUFFER AND BEEP AT HIM.


CHRFUL:	MOVEI	T1,7		;GET A BELL
	PBOUT			;OUTPUT IT
	JRST	CHRINI		;GO INITIALIZE AGAIN
;HERE WHEN A LINE FEED HAS BEEN TYPED.  WE MAKE THIS BUFFER AVAILABLE
;TO THE PROGRAM, ADVANCE TO THE NEXT BUFFER, AND GET THE MAIN CODE OUT
;OF THE DISMS IF IT WAS IN IT.



CHRLIN:	IDPB	T1,INTPTR	;FIRST STORE THE LINE FEED
	MOVSI	T1,(1B0)	;GET SIGN BIT
	IORM	T1,@INTBUF	;MAKE BUFFER AVAILABLE TO MAIN CODE
	AOS	T1,INTBUF	;ADVANCE TO NEXT BUFFER
	CAILE	T1,BUFFS+BUFNUM-1	;WENT OFF OF END?
	MOVEI	T1,BUFFS	;YES, RESET TO FIRST ONE
	MOVEM	T1,INTBUF	;SAVE POINTER
	CALL	CHRINI		;INITIALIZE POINTER AND COUNTER
	MOVEI	T1,SLPINT	;GET PC TO GO TO
	SKIPN	TTYFLG		;IN THE SLEEP?
	MOVEM	T1,CHNPC1	;YES, STOP IT
	MOVEI	T1,1		;GET POSITIVE
	MOVEM	T1,TTYFLG	;STOP THE NEXT SLEEP
	RET			;RETURN
	SUBTTL	ROUTINE TO INITIALIZE TTY BUFFERS





;CALLED AT START OF PROGRAM TO BUILD ALL THE BUFFERS.  THEY ARE
;INITIALLY SET SO THEY ARE AVAILBLE TO THE INTERRUPT CODE, AND NOT
;TO THE MAIN CODE.  THE POINTERS TO THE CURRENT BUFFERS ARE
;ALSO INITIALIZED.




BUFINI:	MOVEI	T1,BUFFS	;GET ADDRESS OF FIRST BUFFER HEADER
	MOVEM	T1,INTBUF	;SET AS INTERRUPT CODE'S CURRENT BUFFER
	MOVEM	T1,RUNBUF	;AND AS COMMAND CODE'S CURRENT BUFFER
	MOVEI	T1,BUFNUM-1	;GET NUMBER OF BUFFERS TO INITIALIZE
	MOVEI	T2,BUFFER	;AND ADDRESS OF WHERE BUFFERS POINT

	MOVEM	T2,BUFFS(T1)	;POINT NEXT BUFFER AT ITS LOCATION
	ADDI	T2,BUFLEN	;MOVE TO NEXT ONE
	SOJGE	T1,.-2		;LOOP OVER ALL BUFFER HEADERS
	PJRST	CHRINI		;THEN GO INITIALIZE INTERRUPT DATA
	SUBTTL	ROUTINE TO DO SPECIAL ACTIONS AT STARTUP



;CALLED RIGHT AFTER PROGRAM IS STARTED, TO SEE IF ANY SPECIAL ACTIONS
;ARE TO BE PERFORMED.  IF SO, WE SET UP TO DO THEM.  ARGUMENTS ARE
;OBTAINED FROM THE PRARG BLOCK OF THIS PROCESS.



GETARG:	SETO	T1,		;GET READY
	HRROI	T2,T4		;TO READ OUR CONTROLLING JOB
	MOVEI	T3,.JICPJ	;GET OFFSET
	GETJI			;READ IT
	 ERJMP	DIE		;FAILED
	JUMPE	T4,ARGINS	;IF CONTROLLED BY JOB ZERO, GO INSERT JSYS
	MOVE	T1,[.PRARD,,.FHSLF]	;GET FUNCTION
	MOVEI	T2,TEMP		;POINT TO STORAGE
	MOVEI	T3,1		;WANT ONLY ONE WORD
	PRARG			;READ PRARG BLOCK
	 ERJMP	DIE		;FAILED, COMPLAIN
	JUMPLE	T3,CPOPJ	;RETURN OK IF NO WORDS READ
	SKIPN	TEMP		;ANY SPECIAL ACTIONS DESIRED?
	RET			;NO, RETURN
	MOVE	T1,[.PRAST,,.FHSLF]	;GET FUNCTION
	MOVEI	T2,T4		;POINT TO AC
	MOVEI	T3,1		;ONE ARGUMENT
	SETZ	T4,		;WANT TO CLEAR THE BLOCK
	PRARG			;CLEAR IT
	 ERJMP	DIE		;FAILED
	SKIPL	T1,TEMP		;GET THE FUNCTION CODE
	CAILE	T1,ARGMAX	;AND VERIFY ITS VALIDITY
	JRST	ARGBAD		;IT'S BAD, GO COMPLAIN
	PJRST	@ARGTAB-1(T1)	;DISPATCH TO ROUTINE


ARGTAB:	EXP	ARGINS		;(1) JUST INSERT THE MONRD% JSYS

	ARGMAX==.-ARGTAB	;HIGHEST LEGAL FUNCTION




ARGINS:	TXO	F,FR.INS	;SET FLAG SAYING INSERT JSYS ONLY
	CALL	JSYTST		;GO INSERT THE JSYS IF NECESSARY
	HALTF			;QUIT
	JRST	.-1		;AND STAY THAT WAY



ARGBAD:	HRROI	T1,[ASCIZ/
? Illegal function code given in PRARG block
/]				;GET STRING
	PSOUT			;TYPE IT
	HALTF			;STOP
	JRST	.-1		;FOREVER
	SUBTTL	SUBROUTINE TO SET UP TO READ INITIAL INDIRECT FILE




;HERE TO FIND THE SYSDPY.INI FILE IF IT EXISTS, AND SET IT UP
;SO THAT COMMANDS WILL BE READ FIRST FROM THAT FILE.



TAKINI:	HRROI	T1,TEMP		;POINT AT BUFFER
	HRROI	T2,[ASCIZ/PS:</]	;GET READY
	SETZ	T3,		;TO START STRING
	SOUT			;STORE IT
	MOVE	T2,MYUSER	;GET MY USER NUMBER
	DIRST			;CONVERT IT TO STRING
	 ERJMP	DIE		;SHOULDN'T FAIL
	HRROI	T2,[ASCIZ/>SYSDPY.INI/]	;GET REST OF STRING
	SOUT			;BUILD REST OF FILE SPEC
	MOVX	T1,GJ%SHT+GJ%OLD+GJ%ACC	;SET UP
	HRROI	T2,TEMP		;POINT AT FILE SPEC
	GTJFN			;TRY TO FIND THE FILE
	 ERJMP	NOINIG		;FAILED, GO SEE WHY
	MOVX	T2,7B5+OF%RD	;WANT TO READ THE FILE
	OPENF			;DO THE OPEN
	 ERJMP	DIE		;FAILED, GO COMPLAIN
	HRRZM	T1,TAKJFN	;SAVE THE JFN AWAY
	SETZ	T1,		;USE DEFAULT LABEL
	CALL	TAKFIL		;GO SET UP TO READ COMMANDS FROM IT
	 JFCL			;DON'T CARE IF IT FAILS
	RET			;RETURN
;HERE IF FAILED TO FIND THE FILE:


NOINIG:	MOVSI	T2,-NOFNUM	;GET READY FOR SEARCH
	CAME	T1,NOFTAB(T2)	;FOUND THE ERROR?
	AOBJN	T2,.-1		;NO, KEEP SEARCHING
	JUMPGE	T2,DIE		;IF NOT FOUND, GIVE ERROR
	RET			;OTHERWISE ITS OK



NOFTAB:	EXP	GJFX16,GJFX17,GJFX18,GJFX19
	EXP	GJFX20,GJFX24,GJFX32

	NOFNUM==.-NOFTAB	;NUMBER OF ERRORS IN TABLE
;HERE TO PUSH A LEVEL OF INDIRECT COMMANDS.  WE SAVE THE CURRENT
;FILE POINTER, SAVED CHARACTER AND RESCAN FLAG, AND SET UP TO READ
;THE COMMAND FILE AGAIN.  SKIP RETURN IF SUCCESSFUL.



TAKPSH:	MOVE	T4,TAKLVL	;GET THE CURRENT LEVEL
	CAIL	T4,TAKMAX	;CAN WE GO ANOTHER LEVEL DEEPER?
	RET			;NO, ERROR RETURN
	MOVE	T1,TAKJFN	;GET INDIRECT FILE JFN
	SKIPE	T2,T4		;AT TTY INPUT LEVEL?
	RFPTR			;NO, READ THE CURRENT FILE POSITION
	 ERJMP	CPOPJ		;FAILED, ERROR RETURN
	MOVEM	T2,TAKPTR(T4)	;SAVE THE OLD FILE POSITION
	SETZ	T2,		;GET SET
	SFPTR			;SET INPUT TO BEGINNING OF FILE
	 ERJMP	CPOPJ		;FAILED
	HRRZ	T1,SAVCHR	;GET THE SAVED CHARACTER
	TXNE	F,FR.RSN	;IS THE RESCAN FLAG SET?
	TLO	T1,-1		;YES, REMEMBER THAT
	MOVEM	T1,TAKSVC(T4)	;SAVE THEM
	TXZ	F,FR.RSN	;CLEAR THE RESCAN FLAG
	AOS	TAKLVL		;INCREMENT DEPTH COUNTER
	RETSKP			;GOOD RETURN




;HERE TO POP UP A LEVEL OF INDIRECT COMMANDS.  WE HAVE TO RESTORE THE
;CURRENT FILE POSITION, THE SAVED CHARACTER, AND THE RESCAN FLAG.



TAKPOP:	SOS	T4,TAKLVL	;DECREMENT THE DEPTH COUNTER
	MOVE	T1,TAKJFN	;GET THE JFN OF THE TAKE FILE
	MOVE	T2,TAKPTR(T4)	;AND THE OLD FILE POINTER
	SKIPE	T4		;RETURNING TO TTY COMMANDS?
	SFPTR			;NO, THEN SET THE FILE POINTER
	 ERJMP	DIE		;FAILED, GO LOSE
	SKIPL	T1,TAKSVC(T4)	;GET SAVED CHAR AND SEE IF WE SHOULD RESCAN
	TXZA	F,FR.RSN	;NO, CLEAR FLAG
	TXO	F,FR.RSN	;YES, SET IT
	HRRZM	T1,SAVCHR	;RESTORE THE CHARACTER
	RET			;DONE
	SUBTTL	COMMAND PROCESSOR



;HERE WHEN A LINE OF INPUT HAS BEEN READ IN, TO HANDLE THE COMMANDS.
;COMMANDS ARE SINGLE LETTERS, FOLLOWED BY ARGUMENTS WHICH MAY BE
;OMITTED.



RUNCMD:	TXZ	F,FR.RSN	;NO CHARACTERS TO BE REREAD
	SKIPL	T1,@RUNBUF	;SEE IF A BUFFER IS READY TO READ
	TDZA	T1,T1		;NO, CLEAR AC
	HRLI	T1,(POINT 7,)	;YES, MAKE A BYTE POINTER TO IT
	MOVEM	T1,RUNPTR	;SAVE THE BYTE POINTER
	SKIPN	TAKLVL		;DO COMMANDS IF READING FROM FILE
	JUMPE	T1,CPOPJ	;OR IF TTY LINE IS READY



NXTCMD:	TXZ	F,FR.NEG	;RESET NEGATE FLAG FOR NEW COMMAND
NXTCNG:	CALL	EATSPS		;EAT ANY LEADING SPACES
	GETCHR			;THEN READ NEXT CHARACTER
	CAIN	C,12		;IS THIS THE LINE FEED?
	JRST	RUNFIN		;YES, COMMAND LINE IS DONE
	MOVSI	T1,-CMDNUM	;NO, GET READY FOR LOOP

CMDSRC:	HLRZ	T2,CMDTAB(T1)	;GET NEXT COMMAND
	CAME	T2,C		;MATCH OUR LETTER?
	AOBJN	T1,CMDSRC	;NO, KEEP SEARCHING
	JUMPL	T1,CMDHAV	;GO IF FOUND IT
	RESCAN			;PUT BACK THE CHARACTER
	CALL	JOBIN		;LOOK FOR A JOB NUMBER
	JUMPGE	T2,RUNBAD	;IF NOT THERE, THEN BAD COMMAND
	SKIPA	T2,[CMDJOB]	;SET UP ROUTINE TO CALL

CMDHAV:	HRRZ	T2,CMDTAB(T1)	;GET ADDRESS
	CALL	(T2)		;CALL ROUTINE FOR COMMAND
	 JRST	RUNBAD		;IF BAD, GO TYPE BELL
	 JRST	NXTCMD		;LOOK FOR NEXT COMMAND
	JRST	NXTCNG		;FOR "N" COMMAND, GO BACK DIFFERENTLY
;HERE WHEN DONE WITH A COMMAND.  IF WE WERE READING FROM AN
;INDIRECT COMMAND, WE POP UP TO THE NEXT HIGHER COMMAND LEVEL.  IF
;WE WERE READING FROM THE TTY, WE HAVE TO ADVANCE THE BUFFER.




RUNBAD:	CALL	CHRALT		;BAD INPUT, RING THE BELL
RUNFIN:	MOVE	T1,NTIME	;GET CURRENT TIME
	MOVEM	T1,SLWTIM	;RESET SLOWDOWN TIMER
	SKIPE	TAKLVL		;WERE WE READING FROM A COMMAND FILE?
	JRST	TAKCDN		;YES, GO POP UP A LEVEL
	HRRZS	@RUNBUF		;MAKE BUFFER AVAILABLE TO INTERRUPT CODE
	AOS	T1,RUNBUF	;ADVANCE TO NEXT BUFFER
	CAILE	T1,BUFFS+BUFNUM-1	;WENT OFF OF END?
	MOVEI	T1,BUFFS	;YES, RESET TO TOP
	MOVEM	T1,RUNBUF	;SAVE NEW POINTER
	JRST	RUNCMD		;SEE IF ANOTHER COMMAND IS READY



TAKCDN:	CALL	TAKPOP		;POP BACK TO OLD LEVEL
	SKIPE	RUNPTR		;WERE WE READING TTY COMMANDS?
	JRST	NXTCMD		;YES, GO CONTINUE DOING THAT
	JRST	RUNCMD		;NO, THEN SEE IF HAVE ANY NOW
;COMMAND TABLE.  CHARACTERS ARE IN LEFT HALF, ADDRESSES OF ROUTINES
;ARE IN RIGHT HALF.


CMDTAB:	XWD	",",CPOPJ1	;COMMA, GOOD RETURN
	XWD	"T",CMDT	;SHOW TITLES OR DO TTY DISPLAY
	XWD	"G",CMDGET	;GET COMMANDS FROM SPECIFIED OPTION
	XWD	"C",CMDCOL	;COLUMN FORMAT COMMAND
	XWD	"A",CMDA	;ADVANCE, ACTIVE, ARPANET COMMANDS
	XWD	"K",CMDK	;KILL OFF A JOB OR THE EXEC
	XWD	"B",CMDBLK	;SET NUMBER OF BLANKS BETWEEN COLUMNS
	XWD	"U",CMDUSR	;SHOW JOBS OF GIVEN USER
	XWD	"R",CMDREF	;REFRESH COMMAND
	XWD	"W",CMDSLP	;WAIT TIME COMMAND
	XWD	"L",CMDLIN	;SET NUMBER OF LINES OF OVERLAP
	XWD	"E",CMDE	;EXIT OR DO ENQ/DEQ STATUS
	XWD	"I",CMDI	;SET IDLE TIME OR SHOW IPCF DATA
	XWD	"N",CMDNEG	;NEGATE NEXT COMMAND
	XWD	"O",CMDOPR	;OPERATOR JOBS
	XWD	"D",CMDD	;DO DEFAULTS OR DECNET STATUS
	XWD	"H",CMDHLP	;HELP COMMAND
	XWD	"M",CMDMON	;DO MONITOR STATUS DISPLAY
	XWD	"J",CMDONE	;DO ALL JOBS DISPLAY
	XWD	"P",CMDP	;PUSH OR SHOW PARTICULAR PROGRAM
	XWD	"S",CMDS	;SKIP NUMBER OF JFNS OR FORKS
	XWD	"Q",CMDQUE	;SHOW THE QUEUES


	CMDNUM==.-CMDTAB	;NUMBER OF COMMANDS
;ROUTINES TO HANDLE EACH COMMAND:




CMDT:	GETCHR			;READ NEXT CHARACTER
	CAIN	C,"T"		;WANTS TTY DISPLAY?
	JRST	SETTTY		;YES, GO SET IT UP
	RESCAN			;NO, RESTORE THE CHAR
	TXNN	F,FR.NEG	;WANT TO SHOW TITLE LINES?
	TXZA	F,FR.CMP	;NO, CLEAR FLAG
	TXO	F,FR.CMP	;YES, SET FLAG
	SETOM	HDRTYP		;CLEAR ANY KNOWN HEADER
	RETSKP			;GOOD RETURN




CMDI:	GETCHR			;GET NEXT CHARACTER
	CAIN	C,"N"		;IS IT AN I?
	JRST	SHWINF		;YES, GO DO INFORMATION COMMAND
	CAIE	C,"P"		;IS IT A P?
	JRST	SHWIDL		;NO, GO DO IDLE COMMAND
	MOVEI	R,DPYIPC	;SET UP TO SHOW IPCF STUFF

NEWDPY:	SETZM	PAGE		;RESET TO FIRST PAGE
	TXZ	F,FR.END	;ACT LIKE MORE PAGES TO GO
	CALL	PAGSET		;RESET SCROLLING TIMER
	SKIPN	T1,HLPJFN	;ANY HELP FILE OPEN?
	RETSKP			;NO, ALL DONE
	CLOSF			;YES, CLOSE THE FILE
	 ERJMP	.+1		;IGNORE ERROR
	SETZM	HLPJFN		;CLEAR THE JFN
	RETSKP			;DONE

SHWIDL:	RESCAN			;REREAD THE CHARACTER
	TXNN	F,FR.NEG	;WANT OPPOSITE ACTION?
	TDZA	T1,T1		;NO, CLEAR FOR DEFAULT CHECK
	MOVEI	T1,1		;YES, SET FOR OTHER CHECK
	MOVEM	T1,MAXIDF	;SAVE THE FLAG
	CALL	DECINZ		;READ NUMBER OF MINUTES
	SKIPL	T2		;NO ARGUMENT GIVEN?
	MOVX	T1,DFTIDL	;YES, THEN GET DEFAULT
	MOVEM	T1,MAXIDL	;SET VALUE
	RETSKP			;GOOD RETURN



SHWINF:	TXNN	F,FR.NEG	;WANTS TO SHUT OFF INFORMATION LINE?
	TXOA	F,FR.INF	;NO, SAY TO DO IT
	TXZ	F,FR.INF	;YES, SHUT IT OFF
	RETSKP			;GOOD RETURN
CMDSLP:
IFE DECSW,<
	TXZ	F,FR.NOS	;ALLOW SLOWING DOWN UNTIL KNOW OTHERWISE
>
	CALL	DECINZ		;READ NUMBER OF SECONDS TO WAIT
	IMULI	T1,^D1000	;CONVERT TO MILLISECONDS
	SKIPN	T2		;WAS ANY NUMBER TYPED AT ALL?
	MOVEI	T1,DFTSLP	;NO, THEN SUPPLY THE DEFAULT
IFN DECSW,<
	CAIG	T1,^D1000	;LESS THAN 1 SECONDS?
	MOVEI	T1,^D1000	;YES, SLEEP FOR 1 INSTEAD
>
	MOVEM	T1,SLPTIM	;SAVE NEW SLEEP TIME
	CAIE	C,"!"		;WANT THE RATE TO BE CONSTANT?
	RETSKP			;NO, ALL DONE
	GETCHR			;YES, EAT THE EXCLAIMATION MARK
IFE DECSW,<
	SKIPN	TAKLVL		;DON'T ACCEPT FEATURE FROM TAKE FILES
	TXO	F,FR.NOS	;REMEMBER TO NOT SLOW DOWN
>
	RETSKP			;RETURN



CMDLIN:	CALL	DECIN		;READ FOLLOWING NUMBER
	SKIPL	T2		;ANY NUMBER TYPED?
	MOVX	T1,DFTLAP	;NO, SET UP DEFAULT OVERLAP
	MOVEM	T1,OVRLAP	;SET THE NEW OVERLAP
	RETSKP			;GOOD RETURN




CMDE:	GETCHR			;READ NEXT CHARACTER
	CAIN	C,"Q"		;WANT ENQ/DEQ STATUS?
	JRST	SETENQ		;YES, GO SET UP FOR THAT
	CAIN	C,"N"		;WANT TO ENABLE PRIVILEGES?
	JRST	ENABLE		;YES, GO DO IT
	RESCAN			;REREAD THE CHARACTER
	TTY$	$TTCLR		;CLEAR SCREEN AND HOME UP
	HALTF			;EXIT NICELY
	TXO	F,FR.REF!FR.RFC	;SET TO REFRESH SCREEN
	RETSKP			;AND SKIP RETURN


ENABLE:	GETCHR			;READ NEXT CHARACTER
	CAIE	C,"!"		;BETTER BE EXCLAIMATION MARK
	RET			;NO, ERROR
	MOVEI	T1,.FHSLF	;GET READY
	RPCAP			;READ MY PRIVILEGES
	TRNN	T2,SC%WHL!SC%OPR	;CAN I DO PRIVILEGED STUFF?
	RET			;NO, ERROR
	MOVE	T3,T2		;YES, COPY THE PRIVILEGES OVER
	EPCAP			;TURN ON ALL OUR PRIVILEGES
	 ERJMP	CPOPJ		;FAILED SOMEHOW
	TXNE	F,FR.JSY	;COULD WE DO THE JSYS BEFORE?
	RETSKP			;YES, GOOD RETURN
	TTY$	$TTCLR		;ERASE THE SCREEN SO ERRORS CAN BE SEEN
	CALL	JSYTST		;TRY TO INSERT THE JSYS NOW
	TXO	F,FR.REF!FR.RFC	;REMEMBER TO REFRESH THE SCREEN
	RETSKP			;GOOD RETURN
SETARP:	GETCHR			;GET NEXT CHARACTER
	SETZ	T1,		;CLEAR IN CASE NO MATCH
	CAIN	C,"H"		;WANT HOSTS?
	MOVEI	T1,DPYARH	;YES
	CAIN	C,"C"		;WANTS CONNECTIONS?
	MOVEI	T1,DPYARC	;YES
	JUMPE	T1,CPOPJ	;FAIL IF NOT EITHER OF THEM
	MOVE	R,T1		;SET UP DISPATCH
	JRST	NEWDPY		;GO FINISH


SETDEC:	MOVEI	R,DPYDEC	;SET TO DO DECNET DISPLAY
	TXZA	F,FR.ACT	;ALL LINKS TOO
SETENQ:	MOVEI	R,DPYENQ	;DO ENQ/DEQ DISPLAY
	JRST	NEWDPY		;GO FINISH



SETTTY:	MOVEI	R,DPYTTY	;DO THE TTY DISPLAY
	TXZA	F,FR.TAC	;SHOW ALL TERMINALS
SETSTR:	MOVEI	R,DPYDSK	;OR STRUCTURE DISPLAY
	JRST	NEWDPY		;GO SET IT UP



SETRES:	SKIPA	R,[DPYRES]	;DO RESOURCES DISPLAY
SETDEV:	MOVEI	R,DPYDEV		;DO DEVICE DISPLAY
	JRST	NEWDPY		;FINISH



CMDNEG:	TXO	F,FR.NEG	;SET THE NEGATE FLAG FOR NEXT COMMAND
	AOS	(P)		;DOUBLE SKIP RETURN
	RETSKP			;DONE



CMDOPR:	TXNE	F,FR.NEG	;WANT OPERATOR JOBS SHOWN?
	TXZA	F,FR.OPR	;NO, CLEAR BIT
	TXO	F,FR.OPR	;YES, SET BIT
	JRST	NEWDPY		;RESET SCREEN
;COMMAND TO GET COMMANDS FROM THE INDIRECT FILE.  COMMANDS ARE
;GOTTEN FROM THE STATEMENTS FOLLOWING THE SPECIFIED LABEL.



CMDGET:	SKIPN	TAKJFN		;SEE IF OUR COMMAND FILE IS OPEN
	RET			;NO, THEN GIVE AN ERROR
	CALL	SIXIN		;GET WHAT LABEL TO LOOK FOR

TAKFIL:	SKIPN	T1		;WAS THERE ONE?
	MOVX	T1,DFTLBL	;NO, USE THE DEFAULT
	MOVEM	T1,TAKLBL	;SAVE THE LABEL
	CALL	TAKPSH		;NEST TO NEXT LEVEL OF INDIRECTION
	 RET			;FAILED

LBLSRC:	TXO	F,FR.NOC	;DON'T CONVERT THE LABEL CHAR TO LF
	GETCHR			;READ NEXT CHARACTER
	CAIN	C,12		;END OF THE FILE?
	JRST	[TXZ	F,FR.NOC	;YES, CLEAR SPECIAL FLAG
		 JRST	TAKPOP]	;RETURN TO PREVIOUS LEVEL WITH ERROR
	CAIE	C,LBLCHR	;FOUND THE LABEL CHARACTER?
	JRST	LBLSRC		;NO, KEEP SEARCHING
	CALL	SIXIN		;READ THE LABEL NAME
	CAME	T1,TAKLBL	;THE ONE WE ARE LOOKING FOR?
	JRST	LBLSRC		;NO, LOOK FOR ANOTHER LABEL
	TXZ	F,FR.NOC	;CLEAR SPECIAL FLAG
	RETSKP			;YES, RETURN TO GET COMMANDS FROM IT
;COMMAND TO KILL THE EXEC WE HAD PUSHED INTO, OR SOME JOB NUMBER.  IF
;KILLING A JOB, THE COMMAND MUST END IN A "!" TO PREVENT ACCIDENTS.



CMDK:	GETCHR			;READ NEXT CHARACTER
	CAIE	C,"E"		;WANTS THE EXEC TO DISAPPEAR?
	 JRST	KILJOB		;NO, GO SEE ABOUT A JOB
	SKIPN	T1,HANDLE	;GET FORK HANDLE IF ANY
	RETSKP			;NONE, SUCCEED
	KFORK			;TRASH THE POOR EXEC
	 ERJMP	CPOPJ		;FAILED
	SETZM	HANDLE		;OK, IT IS NO LONGER HERE
	RETSKP			;GOOD RETURN



KILJOB:	RESCAN			;RESTORE CHARACTER
	CALL	JOBIN		;READ JOB NUMBER IF ANY
	MOVE	T4,C		;REMEMBER IF TYPED "." OR NOT
	GETCHR			;THEN GET TERMINATING CHAR
	CAIE	C,"!"		;COMMAND PROPERLY TYPED?
	RET			;NO, ERROR
	CAIN	T4,"."		;WANT TO KILL MYSELF?
	JRST	KILSLF		;YES, DO DO IT
	JUMPL	T2,KILHVJ	;JUMP ON IF SUPPLIED A JOB NUMBER
	CAIE	R,DPYONE	;WANTS DEFAULT, LOOKING AT A JOB?
	RET			;NO, THEN FAIL
	MOVE	T1,THEJOB	;YES, GET THE JOB NUMBER

KILHVJ:	JUMPLE	T1,CPOPJ	;CAN'T LOG OUT JOB 0
	CAME	T1,MYJOB	;MY OWN JOB?
	CAMLE	T1,HGHJOB	;OR ILLEGAL JOB?
	RET			;YES, ERROR
	LGOUT			;TRY TO LOG JOB OUT
	 ERJMP	CPOPJ		;FAILED
	RETSKP			;GOOD RETURN


KILSLF:	TTY$	$TTCLR		;FIRST CLEAR THE SCREEN
	SETO	T1,		;WANT TO KILL THIS JOB
	LGOUT			;GO AWAY
	 ERJMP	.+1		;FAILED
	TXO	F,FR.REF!FR.RFC	;SCREEN NEEDS REFRESHING NOW
	RET			;AND ERROR RETURN
;HERE TO SELECT WHAT PART OF THE QUEUES ARE TO BE SHOWN.


CMDQUE:	SETZB	T3,T4		;INITIALIZE FLAGS
CMDQLP:	GETCHR			;READ NEXT CHARACTER
	MOVSI	T1,-QUENUM	;GET READY FOR SEARCH
	HLRZ	T2,QUETAB(T1)	;GET NEXT LETTER
	CAME	T2,C		;MATCH?
	AOBJN	T1,.-2		;NO, KEEP SEARCHING
	JUMPGE	T1,CMDQDN	;JUMP IF NO MATCH
	HRRZ	T1,QUETAB(T1)	;GET ADDRESS OF INSTRUCTION
	XCT	(T1)		;SET SOME BITS
	JRST	CMDQLP		;LOOP FOR NEXT LETTER


CMDQDN:	CAIL	C,"A"		;SEE IF TERMINATED ON A LETTER
	CAILE	C,"Z"		;WELL?
	SKIPA			;NO
	RET			;YES, ERROR RETURN
	RESCAN			;PUT BACK THE CHARACTER
	SKIPN	T4		;SPECIFIED ANY QUEUES?
	TXO	T4,LIQALL	;NO, THEN DO ALL AS DEFAULT
	MOVEM	T4,QSRFL1	;SET THE FLAG BITS
	MOVEM	T3,QSRFL2	;IN BOTH LOCATIONS
	MOVEI	R,DPYQUE	;SET UP TO SHOW THE QUEUES
	JRST	NEWDPY		;GO FINISH



QUETAB:	XWD	"A",[TXO T4,LIQALL]	;ALL QUEUES
	XWD	"O",[TXO T4,LIQOUT]	;OUTPUT QUEUES
	XWD	"B",[TXO T4,LIQBAT]	;BATCH QUEUE
	XWD	"L",[TXO T4,LIQLPT]	;LINE PRINTER QUEUE
	XWD	"M",[TXO T4,LIQMNT]	;MOUNT REQUESTS
	XWD	"R",[TXO T4,LIQRET]	;RETRIEVAL REQUESTS
	XWD	"F",[TXO T3,LS.FST]	;WANTS FAST LISTING
	XWD	"D",[TXO T3,LS.ALL]	;WANTS DETAILED LISTING

	QUENUM==.-QUETAB	;NUMBER OF COMMANDS
CMDREF:	GETCHR			;READ FOLLOWING CHAR
	CAIN	C,"E"		;WANTS TO SEE AVAILABLE RESOURCES?
	JRST	SETRES		;YES
	CAIN	C,"P"		;WANTS TO SET RUN TIME SUPRESS LIMIT?
	JRST	SETRTS		;YES
	RESCAN			;NO, PUT BACK THE CHAR
	CALL	DECINZ		;INPUT A NUMBER
	SKIPN	T1		;NONZERO VALUE GIVEN?
	MOVX	T1,DFTREF	;NO, THEN GET DEFAULT
	SKIPL	T2		;WAS ONE INPUT?
	TXOA	F,FR.REF	;NO, THEN SET UP REFRESH
	MOVEM	T1,REFTIM	;YES, SAVE THE NUMBER
CPOPJ1:	AOS	(P)		;SET FOR SKIP RETURN
	RET			;RETURN

SETRTS:	TXNN	F,FR.NEG	;INVERSE SENCE?
	TDZA	T1,T1		;NO, CLEAR FOR DEFAULT CHECK
	MOVEI	T1,1		;YES, SET FOR OTHER CHECK
	MOVEM	T1,MAXRPF	;SAVE THE FLAG
	CALL	DECINZ		;GET THE NUMBER OF '100THs OF PERCENTS TO
	SKIPL	T2		; SUPPRESS, AND SEE IF TO TAKE DEFAULT
	MOVX	T1,DFTRPL	;GET THE DEFAULT
	MOVEM	T1,MAXRPT	;SET THE TIME
	RETSKP			;RETURN


CMDJOB:	CAMLE	T1,HGHJOB	;IS IT TOO LARGE?
	RET			;NO, ERROR
	MOVE	T4,T1		;SAVE A COPY
	CAIE	C,"-"		;FOLLOWED BY A DASH?
	JRST	CMDRAN		;NO, GO DO ONE JOB
	MOVE	T4,T1		;YES, SAVE THIS ONE
	GETCHR			;GOBBLE THE DASH
	CALL	JOBIN		;INPUT ANOTHER JOB NUMBER
	JUMPGE	T2,CPOPJ	;ERROR IF NONE THERE
	CAMLE	T1,HGHJOB	;SEE IF LEGAL AGAIN
	RET			;NO, ERROR

CMDRAN:	CAMGE	T1,T4		;SEE IF ORDER IS RIGHT
	EXCH	T1,T4		;NO, SWITCH THEM THEN
	SUB	T1,T4		;GET NUMBER OF JOBS DIFFERENCE
	SUBI	T4,1		;BACK OFF A JOB
	ADJBP	T4,[POINT 1,BITS,0]	;GET A BYTE POINTER
	TXNN	F,FR.NEG	;ADDING JOBS?
	TDZA	T2,T2		;YES, CLEAR AC
	MOVEI	T2,1		;NO, SET AC NONZERO
	IDPB	T2,T4		;DEPOSIT THE BIT
	SOJGE	T1,.-1		;LOOP OVER REQUIRED NUMBER OF JOBS
	RETSKP			;GOOD RETURN



CMDD:	GETCHR			;GET THE NEXT CHARACTER
	CAIN	C,"N"		;WANTS TO SHOW DECNET STATUS?
	JRST	SETDEC		;YES, GO DO IT
	CAIN	C,"V"		;WANTS TO SHOW DEVICES
	JRST	SETDEV		;YES, GO DO IT
	RESCAN			;NO, RESTORE THE CHAR
	CALL	DEFALT		;CALL ROUTINE TO DEFAULT EVERYTHING
	RETSKP			;GOOD RETURN
;COMMAND TO SHOW OR REMOVE HELP DISPLAY.  WE TRY TO PRESERVE THE STATE
;OF THE PREVIOUS DISPLAY, SO THAT GETTING HELP DOESN'T RIP YOU OFF.


CMDHLP:	TXNE	F,FR.NEG	;WANT TO SEE HELP TEXT?
	JRST	HLPNO		;NO, GO REMOVE IT
	GETCHR			;READ NEXT CHAR
	CAIE	C,"C"		;WANTS HELP ON COLUMN COMMANDS?
	JRST	HLPNRM		;NO, GO DO NORMAL HELP
	CALL	DISNAM		;READ IN THE NAME OF THE DISPLAY
	 RET			;BAD INPUT
	SUB	T4,[1,,DISTAB+1]	;MAKE AOBJN POINTER OVER TYPES
	MOVEM	T4,COLHLC	;AND SAVE IT
	MOVEI	T1,HLPCOL	;GET SPECIAL HELP ROUTINE
	MOVEM	T1,HLPDSP	;REMEMBER IT
	JRST	HLPNRD		;AND FINISH UP

HLPNRM:	RESCAN			;PUT BACK THE NEXT CHARACTER
	SETZM	HLPDSP		;SET NO SPECIAL HELP ROUTINE
HLPNRD:	TXZ	F,FR.END	;ACT LIKE MORE PAGES COMING
	SETZ	T1,		;GET A ZERO
	EXCH	T1,PAGE		;GET OLD PAGE COUNTER AND CLEAR IT
	TLNE	R,-1		;ALREADY SET UP FOR HELP?
	RETSKP			;YES, GOOD RETURN
	MOVSI	R,(R)		;NO, SAVE CURRENT ROUTINE
	HRRI	R,DPYHLP	;SET UP HELP MODE
	MOVEM	T1,OLDPAG	;SAVE IT FOR LATER RESTORATION
	RETSKP			;AND SKIP RETURN

HLPNO:	TLNN	R,-1		;WERE WE IN THE HELP DISPLAY?
	RET			;NO, ERROR
	HLRZ	R,R		;YES, RESTORE OLD DISPLAY
	MOVE	T1,OLDPAG	;GET OLD PAGE VALUE
	MOVEM	T1,PAGE		;AND RESTORE IT
	RETSKP			;GOOD RETURN
;COMMAND TO SET THE NUMBER OF BLANK SPACES BETWEEN COLUMNS IN A DISPLAY.


CMDBLK:	CALL	DISNAM		;READ IN A DISPLAY NAME
	 RET			;ERROR
	GETCHR			;READ NEXT CHAR
	CAIE	C,"/"		;SECOND ARGUMENT FOLLOWING?
	JRST	DEFBLK		;NO, WANTS DEFAULT SEPARATION USED
	CALL	DECIN		;READ SEPARATION
	CAIG	T1,MAXSEP	;MAKE SURE NOT TOO LARGE
	JUMPG	T1,DEFBLL	;AND MAKE SURE POSITIVE
	RET			;NO, ERROR

DEFBLK:	RESCAN			;REREAD THE CHAR
	SETZ	T1,		;INDICATE TO USE DEFAULTS


DEFBLL:	SKIPN	T2,T1		;GET SPECIFIED SEPARATION
	HRRZ	T2,(T4)		;WANTS DEFAULT, GET IT
	MOVEM	T2,COLSEP-DISTAB(T4)	;STORE NEW SEPARATION
	AOBJN	T4,DEFBLL	;LOOP FOR NECESSARY DISPLAYS
	SETOM	HDRTYP		;INVALIDATE ANY OLD HEADER
	RETSKP			;GOOD RETURN



;USEFUL SUBROUTINE TO READ IN A DISPLAY NAME, AND RETURN AN AOBJN
;POINTER IN T4 WHICH POINTS TO THE SELECTED COLUMNS.  SKIP RETURN
;IF SUCCESSFUL.


DISNAM:	CALL	CPYTXT		;COPY THE NAME OF THE DISPLAY
	 JUMPN	T1,CPOPJ	;ERROR IF BUFFER OVERFLOWED
	MOVE	T4,[-DISNUM,,DISTAB+1]	;ASSUME WANT ALL COLUMNS SET
	JUMPE	T1,CPOPJ1	;RETURN IF CORRECT
	MOVEI	T1,DISTAB	;GET ADDRESS OF THE TABLE
	HRROI	T2,TXTBUF	;AND POINTER TO USER'S STRING
	TBLUK			;SEARCH FOR DISPLAY NAME
	TXNN	T2,TL%ABR+TL%EXM	;FIND A MATCH?
	RET			;NO, FAIL
	HRRO	T4,T1		;MAKE AOBJN POINTER TO PARTICULAR COLUMN
	RETSKP			;AND GIVE GOOD RETURN
CMDONE:	GETCHR			;GET FOLLOWING CHAR
	CAIN	C,"T"		;WANTS TO SPECIFY A TERMINAL?
	JRST	ONETTY		;YES, GO DO THAT
	RESCAN			;NO, REREAD THE CHAR
	CALL	JOBINZ		;READ JOB NUMBER IF THERE
	JUMPGE	T2,CMDALL	;IF NONE, DO ALL JOBS
	CAMLE	T1,HGHJOB	;SEE IF LEGAL JOB NUMBER
	RET			;NO, ERROR RETURN
	MOVEM	T1,THEJOB	;YES, SAVE NUMBER
	SETZM	THETTY		;AND CLEAR TERMINAL TO SHOW
	MOVEI	R,DPYONE	;GET ROUTINE TO DO
	JRST	NEWDPY		;GO FINISH


ONETTY:	CALL	OCTIN		;READ THE TTY NUMBER
	JUMPGE	T2,CPOPJ	;MUST HAVE ONE SPECIFIED
	CAMLE	T1,HGHTTY	;MAKE SURE IT IS LEGAL
	RET			;NO, ERROR
	ADDI	T1,.TTDES	;TURN INTO TERMINAL DESIGNATOR
	MOVEM	T1,THETTY	;THEN SAVE IT
	MOVEI	R,DPYONE	;GET ROUTINE TO DO
	JRST	NEWDPY		;AND FINISH




CMDMON:	SKIPA	R,[DPYMON]	;SET UP ROUTINE
CMDALL:	MOVEI	R,DPYALL	;OR OTHER ROUTINE
	JRST	NEWDPY		;GO FINISH
CMDS:	GETCHR			;READ FOLLOWING CHAR
	MOVSI	T1,-SDPNUM	;GET READY FOR SEARCH
	HLRZ	T2,CMDSDP(T1)	;GRAB NEXT COMMAND LETTER
	CAME	C,T2		;FOUND MATCH?
	AOBJN	T1,.-2		;NO, KEEP LOOKING
	HRRZ	T1,CMDSDP(T1)	;GET DISPATCH ADDRESS
	JRST	(T1)		;GO TO IT


CMDSDP:	XWD	"T",SETSTR	;SET UP STRUCTURE DISPLAY
	XWD	"J",CMDSKJ	;SKIP SOME JFNS
	XWD	"F",CMDSKF	;SKIP SOME FORKS
	XWD	"B",SETBIA	;SET BIAS CONTROL KNOB
	XWD	"+",SCRREL	;SCROLL AHEAD SOME PAGES
	XWD	"-",SCRREL	;SCROLL BACKWARDS SOME PAGES
	XWD	"I",SCRINT	;SET SCROLLING INTERVAL
	XWD	-1,SCRPHY	;IF NO MATCH, SCROLL TO PARTICULAR PAGE

	SDPNUM==.-CMDSDP-1	;NUMBER OF REAL COMMANDS




CMDSKF:	CALL	DECINZ		;READ ARGUMENT
	MOVEM	T1,SKPFRK	;SAVE NUMBER OF FORKS TO SKIP
	RETSKP			;SKIP RETURN



CMDSKJ:	CALL	DECINZ		;READ ARGUMENT
	MOVEM	T1,SKPJFN	;SAVE NUMBER OF JFNS TO SKIP
	RETSKP			;SKIP RETURN



SETBIA:	CALL	DECIN		;READ THE FOLLOWING NUMBER
	JUMPGE	T2,CPOPJ	;IF TYPED NONE, ERROR
	GETCHR			;GET THE NEXT CHARACTER
	CAIE	C,"!"		;MUST BE EXCLAIMATION POINT
	RET			;NO, ERROR
	MOVE	T4,T1		;MOVE VALUE TO RIGHT AC
	MOVEI	T1,.SKSBC	;FUNCTION TO SET BIAS KNOB
	MOVEI	T2,T3		;ADDRESS OF BLOCK
	MOVEI	T3,2		;TWO ARGUMENTS
	SKED%			;SET IT
	 ERJMP	CPOPJ		;FAILED, GIVE ERROR
	RETSKP			;GOOD RETURN
;HERE FOR THOSE VARIATIONS OF THE "S" COMMAND WHICH AFFECT SCROLLING.
;THE CURRENT SCREEN PAGE NUMBER CAN BE SET TO A PARTICULAR VALUE,
;OR CHANGED RELATIVE TO THE CURRENT PAGE.



SCRPHY:	RESCAN			;REREAD LAST CHAR
	CALL	DECIN		;THEN GET PAGE NUMBER
	SUBI	T1,1		;COMPENSATE FOR PAGE NUMBERING
	JUMPL	T2,SCRSAV	;IF ONE GIVEN, SET TO THAT PAGE
	CALL	PAGDO		;OTHERWISE JUST ADVANCE TO NEXT SCREEN
	RETSKP			;GOOD RETURN



SCRREL:	MOVE	T4,C		;SAVE WHICH COMMAND THIS IS
	CALL	DECIN		;READ FOLLOWING NUMBER
	SKIPL	T2		;WAS ONE TYPED?
	MOVEI	T1,1		;NO, THEN DEFAULT TO ONE
	CAIN	T4,"-"		;WANTS TO BACK UP?
	MOVN	T1,T1		;YES, NEGATE THE NUMBER
	ADD	T1,PAGE		;ADD CURRENT PAGE NUMBER IN
SCRSAV:	SKIPGE	T1		;TRYING TO GO NEGATIVE?
	SETZ	T1,		;YES, TAME IT
	MOVEM	T1,PAGE		;SET NEW PAGE NUMBER
	TXZ	F,FR.END	;ACT LIKE MORE PAGES TO GO
	CALL	PAGSET		;RESET SCROLLING INTERVAL
	RETSKP			;GOOD RETURN




SCRINT:	CALL	DECIN		;GET INTERVAL FOR SCROLLING
	MOVEM	T1,PAGINT	;SAVE IT
	CALL	PAGSET		;RESET PAGING TIMER
	RETSKP			;GOOD RETURN
;COMMAND TO ADVANCE THE SINGLE-JOB DISPLAY TO THE NEXT SUITABLE
;JOB NUMBER.  THESE ARE THE JOBS SHOWN ON THE NORMAL DISPLAY.
;ALSO USED TO DETERMINE WHETHER OR NOT TO SHOW ACTIVE LOGICAL
;LINK NODES.



CMDA:	GETCHR			;READ NEXT CHARACTER
	CAIN	C,"N"		;WANTS TO SEE ARPANET STATUS?
	JRST	SETARP		;YES, GO DO THAT
	RESCAN			;NO, PUT BACK CHARACTER
	CAIE	R,DPYONE	;CURRENTLY DOING ONE-JOB DISPLAY?
	JRST	CMDACT		;NO, GO CHECK FOR OTHER DISPLAYS
	MOVE	J,THEJOB	;GET THE JOB WE WERE SHOWING


ADVSRC:	ADDI	J,1		;MOVE TO NEXT JOB
	CAMLE	J,HGHJOB	;OFF OF END?
	SETZ	J,		;YES, START OVER
	CAMN	J,THEJOB	;WENT ALL THE WAY AROUND?
	JRST	NEWDPY		;YES, STAY WITH THIS JOB
	CALL	GETDAT		;READ INFORMATION ON THIS JOB
	 JRST	ADVSRC		;NO SUCH JOB, CONTINUE LOOKING
	CALL	SUPPRS		;WANT TO SEE THIS JOB?
	 JRST	ADVSRC		;NO, LOOK AT NEXT ONE
	MOVEM	J,THEJOB	;YES, SET NEW JOB TO WATCH
	JRST	NEWDPY		;RESET PAGING AND RETURN


CMDACT:	SETZ	T1,		;CLEAR
	CAIN	R,DPYDEC	;DECNET DISPLAY?
	MOVX	T1,FR.ACT	;YES, GET FLAG
	CAIN	R,DPYTTY	;TERMINAL DISPLAY?
	MOVX	T1,FR.TAC	;YES, GET DIFFERENT FLAG
	CAIN	R,DPYARH	;ARPANET HOST DISPLAY?
	MOVX	T1,FR.AAH	;YES, OTHER FLAG
	JUMPE	T1,CPOPJ	;FAIL IF NOT THEM
	TXNN	F,FR.NEG	;WANT TO SEE ACTIVE STUFF ONLY?
	TDOA	F,T1		;YES, SET THE FLAG
	TDZ	F,T1		;NO, CLEAR THE FLAG
	RETSKP			;GOOD RETURN
;COMMAND TO SPECIFY USER NAMES WHICH ARE TO BE SHOWN.



CMDUSR:	CALL	CPYTXT		;COPY POSSIBLE USER NAME
	 JUMPN	T1,CPOPJ	;IF OVERFLOWED, GIVE ERROR
	JUMPN	T1,CMDUSL	;PROCEED IF SUPPLIED A NAME
	TXNN	F,FR.NEG	;NEGATING USERS?
	CAIN	C,"/"		;OR EXPLICITLY SPECIFYING NULL NAMES?
	JRST	CMDUSL		;YES, PROCEED
	SETZM	USRLST		;NO ARGUMENTS AT ALL, CLEAR LIST
	RETSKP			;AND SKIP RETURN

CMDUSL:	MOVEI	T1,USERS	;GET STORAGE ADDRESS READY
	SKIPN	USRLST		;ALREADY HAVE SOME NAMES STORED?
	MOVEM	T1,USRFRE	;NO, THEN INITIALIZE FIRST FREE LOCATION
	SUBI	T2,TXTBUF-1	;COMPUTE WORDS USED FOR NEW STRING
	ADD	T2,USRFRE	;THEN COMPUTE NEW FIRST FREE ADDRESS
	CAIL	T2,USERS+USRSIZ	;ABOUT TO OVERFLOW STORAGE AREA?
	RET			;YES, FAIL RETURN
	MOVE	T1,USRFRE	;GET ADDRESS TO COPY INTO
	HRLI	T1,TXTBUF-1	;AND LOCATION TO COPY FROM (MINUS ONE)
	BLT	T1,(T2)		;COPY STRING INTO STORAGE AREA
	EXCH	T2,USRFRE	;SET NEW FIRST FREE LOCATION AND GET OLD ONE
	EXCH	T2,USRLST	;POINT HEADER AT NEW ENTRY AND GET OLD ONE
	TXNE	F,FR.NEG	;WANT TO NOT SEE THIS NAME?
	TLO	T2,-1		;YES, FLAG IT AS UNDESIRED
	MOVEM	T2,@USRLST	;STORE FLAG AND POINTER INTO STORAGE
	CAIE	C,"/"		;MORE NAMES COMING?
	JRST	NEWDPY		;NO, RESET PAGING AND RETURN
	GETCHR			;YES, EAT THE SLASH
	CALL	CPYTXT		;READ THE NEXT NAME
	 JUMPN	T1,CPOPJ	;FAIL IF OVERFLOWED
	JRST	CMDUSL		;GO PROCESS IT
;HERE TO EITHER REMOVE A COLUMN OF OUTPUT, OR TO ADD A COLUMN OF
;OUTPUT TO THE END OF THE DISPLAY.


CMDCOL:	CALL	CPYTXT		;COPY THE COLUMN NAME
	 RET			;HAS TO BE ONE
	MOVEI	T1,COLTAB	;GET ADDRESS OF COLUMN NAME TABLE
	HRROI	T2,TXTBUF	;AND POINTER TO USER'S STRING
	TBLUK			;SEARCH FOR THE NAME
	TXNN	T2,TL%ABR+TL%EXM	;FIND A MATCH?
	RET			;NO, ERROR
	HRRZ	T1,(T1)		;GET ADDRESS OF COLUMN DATA
	AOS	(P)		;GOOD RETURN NOW
	TXNE	F,FR.NEG	;WANT TO ADD THIS ENTRY?
	JRST	COLREM		;NO, GO REMOVE IT
	MOVE	T3,T1		;SAVE COLUMN
	MOVEI	T1,-1		;GET A LARGE NUMBER
	GETCHR			;GET THE NEXT CHARACTER
	CAIE	C,"/"		;SECOND ARGUMENT COMING?
	RESCAN			;NO, PUT BACK THE CHAR
	CAIN	C,"/"		;WELL?
	CALL	DECIN		;YES, READ THE ARGUMENT
	MOVE	T2,T1		;PUT NUMBER IN RIGHT AC
	MOVE	T1,T3		;AND COLUMN ADDRESS IN RIGHT AC
	JRST	COLADD		;GO ADD AT DESIRED COLUMN NUMBER
;HERE TO REMOVE A COLUMN FROM THE DISPLAY.  ENTRY TO REMOVE IS IN
;AC T1, WHICH IS NOT CHANGED.


COLREM:	SETOM	HDRTYP		;HEADER ISN'T VALID ANYMORE
	SETZ	T2,		;SET UP FOR LOOP
COLREL:	SKIPN	T3,COLDSP(T2)	;RAN OUT OF COLUMNS?
	RET			;YES, IT WAN'T THERE TO REMOVE
	CAME	T1,T3		;IS THIS THE ONE TO REMOVE?
	AOJA	T2,COLREL	;NO, KEEP SEARCHING

COLRLL:	MOVE	T3,COLDSP+1(T2)	;GET NEXT WORD
	MOVEM	T3,COLDSP(T2)	;MOVE IT UP OVER OLD ONE
	JUMPE	T3,CPOPJ	;DONE WHEN MOVED THE NULL WORD
	AOJA	T2,COLRLL	;LOOP UNTIL DONE




;HERE TO ADD A COLUMN TO THE DISPLAY.  ENTRY TO BE ADDED IS IN T1,
;AND COLUMN NUMBER TO INSERT IT AT IS IN T2.


COLADD:	MOVEM	T2,TEMP		;SAVE AWAY THE COLUMN NUMBER
	CALL	COLREM		;FIRST REMOVE THE ENTRY
	MOVE	T2,CL.TYP(T1)	;GET THE TYPE OF COLUMN THIS IS
	SETZ	T3,		;INITIALIZE INDEX

COLADS:	SKIPN	T4,COLDSP(T3)	;GET NEXT COLUMN
	JRST	COLADF		;NO MORE, INSERT AT END THEN
	CAMN	T2,CL.TYP(T4)	;WRONG COLUMN TYPE?
	SOSLE	TEMP		;OR NOT TO SPECIFIED COLUMN NUMBER?
	AOJA	T3,COLADS	;YES, KEEP SEARCHING

COLADF:	EXCH	T1,COLDSP(T3)	;PUT NEW ENTRY HERE AND GET OLD ENTRY
	SKIPE	T1		;REACHED THE END?
	AOJA	T3,COLADF	;NO, KEEP SWITCHING THEM
	SETZM	COLDSP+1(T3)	;MAKE SURE NEXT ENTRY IS ZERO
	RET			;DONE
CMDP:	GETCHR			;READ THE NEXT CHARACTER
	CAIE	C,"R"		;COMMAND TO SHOW A PROGRAM?
	JRST	DOPUSH		;NO, GO PUSH TO ANOTHER EXEC
	MOVEI	T1,TXTBUF	;POINT TO STANDARD STORAGE AREA
	MOVEI	T2,^D13		;GET COUNT FOR WORST CASE WILDCARDING
	CALL	CPYTX1		;READ IN PROGRAM NAME
	 JUMPN	T1,CPOPJ	;FAILED IF OVERFLOWED
	JUMPN	T1,PRGHAV	;SKIP ONWARD IF HAVE A NAME
	TXNN	F,FR.NEG	;NEGATING PROGRAMS?
	CAIN	C,"/"		;OR EXPLICITLY SPECIFYING BLANK NAME?
	JRST	PRGHAV		;YES, PROCEED
	SETZM	PRGNUM		;NOPE, CLEAR LIST OF PROGRAM NAMES
	JRST	NEWDPY		;AND RESET SCREEN

PRGHAV:	MOVE	T1,PRGNUM	;GET NUMBER OF PROGRAM NAMES STORED
	CAILE	T1,PRGMAX	;OVERFLOWED?
	RET			;YES, ERROR RETURN
	AOS	T1,PRGNUM	;INCREMENT NUMBER OF PROGRAM NAMES
	IMULI	T1,3		;GET OFFSET AGAIN
	DMOVE	T2,TXTBUF	;GET FIRST TWO WORDS FROM BUFFER
	MOVE	T4,TXTBUF+2	;AND THIRD WORD
	TXNE	F,FR.NEG	;WANTS TO SUPPRESS THE PROGRAM NAME?
	IORI	T2,1		;YES, FLAG LOW ORDER BIT IN FIRST WORD
	DMOVEM	T2,PRGWLD-3(T1)	;STORE FIRST TWO WORDS INTO TABLE
	MOVEM	T4,PRGWLD-1(T1)	;AND THIRD WORD ALSO
	CAIE	C,"/"		;ANOTHER PROGRAM NAME COMING?
	JRST	NEWDPY		;NO, GO RESET SCREEN AND RETURN
	GETCHR			;YES, EAT THE SLASH
	MOVEI	T1,TXTBUF	;POINT TO STANDARD STORAGE AREA
	MOVEI	T2,^D13		;GET COUNT FOR WORST CASE WILDCARDING
	CALL	CPYTX1		;READ IN ANOTHER PROGRAM NAME
	 JUMPN	T1,CPOPJ	;FAILED IF OVERFLOWED
	JRST	PRGHAV		;AND GO BACK TO LOOP
;COMMAND TO DO A PUSH TO A NEW EXEC.  WHILE THE EXEC IS RUNNING,
;WE STILL COMPUTE THE CPU PERCENTAGES AND IDLE TIME.  WHEN THE EXEC
;TERMINATES, WE REFRESH THE SCREEN AND RETURN.  IF AN EXEC HAD
;PREVIOUSLY BEEN USED, WE JUST CONTINUE IT.




DOPUSH:	RESCAN			;RESTORE UNWANTED CHARACTER
	MOVEI	T1,.FHSLF	;GET READY
	MOVX	T2,1B<TTYCHN>	;TO DISABLE TERMINAL INTERRUPT
	DIC			;DO IT
	CALL	ECHOON		;TURN ON ECHOING NOW
	SKIPE	T1,HANDLE	;ALREADY HAVE AN EXEC AROUND?
	JRST	PSHCON		;YES, JUST CONTINUE IT
	SETZ	T4,		;REMEMBER NO JFN AND NO FORK YET
	MOVX	T1,CR%CAP	;GET READY TO CREATE ONE
	CFORK			;MAKE AN INFERIOR FORK
	 ERJMP	PSHFAI		;FAILED
	HRLZ	T4,T1		;REMEMBER THE FORK HANDLE
	MOVX	T1,GJ%OLD+GJ%SHT	;GET FLAGS
	HRROI	T2,[ASCIZ/SYSTEM:EXEC.EXE/]	;AND FILE SPEC
	GTJFN			;GET A JFN ON THE FILE
	 ERJMP	PSHFAI		;FAILED
	IORB	T1,T4		;COMBINE JFN AND HANDLE
	GET			;READ EXEC INTO FORK
	 ERJMP	PSHFAI		;FAILED
	TRZ	T4,-1		;THE JFN NOW BELONGS TO THE INFERIOR
	TTY$	$TTCLR		;CLEAR SCREEN AND HOME UP
	TXO	F,FR.REF!FR.RFC	;REMEMBER TO REFRESH SCREEN LATER
	HLRZ	T1,T4		;GET HANDLE BACK
	SETZ	T2,		;NORMAL START ADDRESS
	SFRKV			;START THE FORK
	 ERJMP	PSHFAI		;FAILED
	HLRZM	T4,HANDLE	;OK, REMEMBER HANDLE FOR NEXT PUSH
	JRST	PSHCHK		;JOIN MAIN LOOP



PSHCON:	TTY$	$TTCLR		;CLEAR SCREEN AND HOME UP
	TXO	F,FR.REF!FR.RFC	;REMEMBER TO REFRESH SCREEN LATER
	TXO	T1,SF%CON	;SET FLAG TO SAY CONTINUE FORK
	SFORK			;CONTINUE IT
	 ERJMP	PSHFIN		;FAILED, GIVE ERROR
	JRST	PSHCHK		;OK, GO TO MAIN LOOP
;NOW WAIT FOR THE EXEC TO FINISH UP:


PSHCHK:	SETOM	FRKFLG		;SAY NOT YET IN SLEEP
	MOVEI	T1,.FHSLF	;GET HANDLE
	MOVX	T2,1B<.ICIFT>	;THEN CHANNEL
	AIC			;ACTIVATE FORK TERMINATION CHANNEL

PSHLOP:	MOVEI	T1,PSHSLP	;GET SLEEP TIME
	AOSN	FRKFLG		;SET FLAG AND CHECK IT
	DISMS			;WAIT A LITTLE BIT IF NECESSARY
PSHINT:	SETOM	FRKFLG		;NO LONGER SLEEPING
	GTAD			;READ TIME AND DATE
	MOVEM	T1,NTIME	;SAVE IT
	CALL	CPUCMP		;COMPUTE NEW CPU DATA
	CALL	CHKDRM		;AND COMPUTE NEW DORMANCY DATA
	MOVE	T1,HANDLE	;GET HANDLE
	RFSTS			;GET STATUS
	LDB	T1,[POINT 17,T1,17]	;GET STATUS CODE
	CAIN	T1,.RFHLT	;DID IT HALT?
	JRST	PSHFIS		;YES, DONE
	CAIE	T1,.RFFPT	;FORCED HALT?
	JRST	PSHLOP		;NO, BACK TO LOOP
	HRROI	T1,[ASCIZ/
? EXEC terminated abnormally at PC /]	;GET STRING
	PSOUT			;TYPE IT
	MOVEI	T1,.PRIOU	;TO TERMINAL
	ANDI	T2,-1		;TRASH BITS
	MOVEI	T3,^D8		;OCTAL
	NOUT			;SAY WHAT THE PC IS
	 JFCL			;IGNORE ERROR
	HRROI	T2,[ASCIZ/ - /]	;GET STRING
	SETZ	T3,		;TERMINATE ON NULL
	SOUT			;TYPE SEPARATOR
	HRLO	T2,HANDLE	;GET HANDLE, LAST ERROR
	ERSTR			;SAY WHY THE EXEC DIED
	 JFCL			;CAN'T KNOW
	 JFCL			;EITHER ERROR
	HRROI	T2,[ASCIZ/
/]				;GET FINAL CRLF
	SOUT			;TYPE IT
	DOBE			;WAIT UNTIL DONE
	MOVEI	T1,^D5000	;GET TIME
	DISMS			;WAIT UNTIL HE CAN SEE IT
	JRST	PSHFIS		;AND RETURN
;HERE TO TERMINATE THE PUSH IF WE COULD NOT START IT UP:



PSHFAI:	HRRZ	T1,T4		;GET POSSIBLE JFN WE CREATED
	SKIPE	T1		;WAS THERE ONE?
	RLJFN			;YES, RELEASE IT
	 ERJMP	.+1		;IGNORE ERROR
	HLRZ	T1,T4		;GET POSSIBLE FORK HANDLE
	SKIPE	T1		;WAS THERE ONE?
	KFORK			;YES, RELEASE IT
	 ERJMP	.+1		;IGNORE FAILURE
	JRST	PSHFIN		;GO FINISH UP NOW




;HERE TO FINISH A PUSH WHEN THE EXEC HAS TERMINATED:


PSHFIS:	AOS	(P)		;SKIP RETURN
PSHFIN:	MOVEI	T1,.FHSLF	;MY FORK
	MOVX	T2,1B<.ICIFT>	;CHANNEL FOR TERMINATION
	DIC			;DISABLE INTERRUPT
	MOVE	T1,MYNAME	;GET MY NAME
	SETNM			;CHANGE BACK TO IT
	CALL	ECHOOF		;TURN ECHOING OFF AGAIN
	MOVEI	T1,.FHSLF	;GET READY
	MOVX	T2,1B<TTYCHN>	;TO REACTIVATE TERMINAL INTERRUPT
	AIC			;DO IT
	IIC			;CAUSE ONE IN CASE OF TYPE-AHEAD
	RET			;RETURN
	SUBTTL	SIMPLE INPUT ROUTINES



;OCTAL AND DECIMAL NUMBER INPUT ROUTINES.  AC T2 IS NEGATIVE IF A
;NUMBER WAS FOUND, NONNEGATIVE OTHERWISE.  AC T1 WILL BE ZERO IF
;NO NUMBER WAS FOUND.  AC T3 IS UNCHANGED.


DECINZ:	CALL	EATSPS		;READ SPACES FIRST
DECIN:	SETZB	T1,T2		;CLEAR AC'S
NUMINL:	GETCHR			;READ NEXT CHARACTER
	CAIL	C,"0"		;VALID DIGIT?
	CAILE	C,"9"		;WELL?
	JRST	NUMHAV		;NO, GO FINISH UP
	TLOE	T2,400000	;YES, SET FLAG TO SAY FOUND A NUMBER
	IMULI	T1,^D10		;MAKE ROOM FOR NEXT DIGIT
	ADDI	T1,-"0"(C)	;ADD NEW DIGIT IN
	JRST	NUMINL		;LOOP OVER WHOLE NUMBER

NUMHAV:	SKIPGE	T1		;SEE IF OVERFLOWED?
	MOVX	T1,.INFIN	;YES, THEN GET POSITIVE INFINITY
	JRST	REREAD		;GO REREAD LAST CHAR



OCTIN:	SETZB	T1,T2		;CLEAR AC'S
OCTINL:	GETCHR			;READ NEXT CHAR
	CAIL	C,"0"		;OCTAL DIGIT?
	CAILE	C,"7"		;WELL?
	JRST	NUMHAV		;NO, GO FINISH UP
	TLOE	T2,400000	;SET FLAG SAYING HAVE NUMBER
	LSH	T1,3		;SHIFT OVER A DIGIT
	IORI	T1,-"0"(C)	;ADD IN NEW ONE
	JRST	OCTINL		;LOOP




;ROUTINE TO INPUT A JOB NUMBER, WHICH COULD BE MY OWN DUE TO A PERIOD.
;RETURNS SAME AS DECINZ OR DECIN.


JOBINZ:	CALL	EATSPS		;EAT LEADING SPACES
JOBIN:	CALL	DECIN		;LOOK FOR A NUMBER
	JUMPL	T2,CPOPJ	;RETURN IF GOT ONE
	CAIE	C,"."		;NO, THEN SEE IF A PERIOD IS THERE
	RET			;NO, RETURN
	GETCHR			;YES, EAT THE PERIOD
	MOVE	T1,MYJOB	;GET MY JOB NUMBER
	SETO	T2,		;SAY WE HAVE A NUMBER
	RET			;RETURN
;SIXBIT INPUT ROUTINE.  ALPHANUMERICS ARE ALLOWED ONLY.  RETURNS
;QUANTITY IN AC T1.



SIXIN:	SETZ	T1,		;CLEAR RESULT
	MOVE	T2,[POINT 6,T1]	;AND SET UP BYTE POINTER

SIXINL:	GETCHR			;READ NEXT CHARACTER
	CAIL	C,"0"		;POSSIBLY ALPHANUMERIC?
	CAILE	C,"Z"		;WELL?
	JRST	REREAD		;NO, RESCAN THE CHAR AND RETURN
	CAILE	C,"9"		;WELL?
	CAIL	C,"A"		;IS IT?
	SKIPA			;YES
	JRST	REREAD		;NO, RESCAN IT AND RETURN
	TRNE	T1,77		;ROOM FOR ANOTHER CHARACTER?
	JRST	SIXINL		;NO, IGNORE THIS ONE
	SUBI	C," "		;CONVERT FROM ASCII TO SIXBIT
	IDPB	C,T2		;STORE THE CHARACTER
	JRST	SIXINL		;AND LOOP




;ROUTINE TO SKIP OVER SPACES AND TABS:


EATSPS:	GETCHR			;GET NEXT CHARACTER
	CAIE	C," "		;A SPACE?
	CAIN	C,"	"	;OR TAB?
	JRST	EATSPS		;YES, KEEP EATING
REREAD:	RESCAN			;NO, SET TO RESCAN THIS CHAR
	RET			;AND RETURN
	SUBTTL	SUBROUTINE TO READ COMMAND CHARACTERS




;CHARACTER INPUT ROUTINE.  CHARACTERS ARE READ EITHER FROM AN
;INDIRECT FILE, OR FROM THE INPUT BUFFERS.  THIS ROUTINE PROVIDES
;FOR THE RESCANNING OF A SINGLE CHARACTER.  CHAR READ IS RETURNED
;IN AC C.


RUNCHR:	MOVE	C,SAVCHR	;GET OLD CHARACTER
	TXZE	F,FR.RSN	;WANT A NEW CHARACTER INSTEAD?
	RET			;NO, RETURN THIS ONE
	SKIPE	TAKLVL		;READING FROM AN INDIRECT FILE?
	JRST	TAKCHR		;YES, HANDLE SPECIAL
	ILDB	C,RUNPTR	;NO, GET NEW CHAR FROM OUR BUFFER


CHRHAV:	CAIN	C,15		;CARRIAGE RETURN?
	JRST	RUNCHR		;YES, IGNORE IT
	JUMPE	C,RUNCHR	;ALSO EAT NULLS
	CAIL	C,"A"+40	;IS THIS A LOWER CASE CHAR?
	CAILE	C,"Z"+40	;WELL?
	SKIPA			;NO
	SUBI	C,40		;YES, CONVERT TO UPPER CASE
	MOVEM	C,SAVCHR	;REMEMBER IN CASE HAVE TO REREAD IT
	CAIN	C,12		;HAVE A LINE FEED?
	RESCAN			;YES, MAKE SURE IT STAYS AROUND
	RET			;RETURN
TAKCHR:	PUSH	P,T1		;SAVE SOME AC'S
	PUSH	P,T2		;THAT WE NEED
	MOVE	T1,TAKJFN	;GET JFN
	BIN			;READ THE NEXT CHARACTER
	 ERJMP	TAKERR		;FAILED, GO ANALYSE
	CAIN	T2,12		;FOUND A LINE FEED IN FILE?
	MOVEI	T2," "		;YES, MAKE IT A SPACE
	TXNN	F,FR.NOC	;SEE IF WE SHOULD CONVERT THE CHAR
	CAIE	T2,LBLCHR	;IS THIS THE START OF A LABEL?
	SKIPA	C,T2		;NO, MOVE CHAR TO RIGHT AC
TAKDON:	MOVEI	C,12		;GET A LINEFEED TO SAY WE'RE DONE
	POP	P,T2		;RESTORE AC'S
	POP	P,T1		;THAT WERE USED
	JRST	CHRHAV		;GO FINISH CHARACTER HANDLING


TAKERR:	MOVEI	T1,.FHSLF	;GET SET
	GETER			;FIND OUT WHY WE LOST
	ANDI	T2,-1		;KEEP ONLY THE ERROR REASON
	CAIN	T2,IOX4		;END OF FILE?
	JRST	TAKDON		;YES, GO RETURN A LINE FEED
	JRST	DIE		;NO, THEN LOSE
	SUBTTL	ROUTINE TO SET UP ALL DEFAULT PARAMETERS




;THIS ROUTINE IS CALLED AT SYSTEM STARTUP, OR BY THE "D" COMMAND.
;ALL THE PARAMETERS ARE SET TO THEIR INITIAL VALUE.



DEFALT:	TXZ	F,FR.TAC!FR.OPR!FR.CMP!FR.ACT!FR.AAH!FR.INF
IFE DECSW,<
	TXZ	F,FR.NOS
>
	SETZM	SKPFRK		;CLEAR NUMBER OF FORKS TO SKIP
	SETZM	SKPJFN		;AND NUMBER OF JFNS TO SKIP
	SETZM	USRLST		;CLEAR LIST OF USERS TO SHOW
	MOVE	T1,NTIME	;GET CURRENT TIME
	MOVEM	T1,SLWTIM	;AND RESET THE SLOWDOWN TIMER
	MOVX	T1,LIQALL	;GET FLAGS FOR ALL QUEUES
	MOVEM	T1,QSRFL1	;SET THEM
	SETZM	QSRFL2		;CLEAR OTHER QUEUE FLAGS
	MOVX	T1,DFTPAG	;GET DEFAULT PAGE INTERVAL
	MOVEM	T1,PAGINT	;SET IT
	CALL	PAGSET		;AND RECOMPUTE SCROLLING TIME
	MOVX	T1,DFTLAP	;GET DEFAULT LINES TO OVERLAP
	MOVEM	T1,OVRLAP	;SET IT
	MOVX	T1,DFTSLP	;GET DEFAULT SLEEP TIME
	MOVEM	T1,SLPTIM	;SET IT
	MOVX	T1,DFTREF	;GET DEFAULT TIME BETWEEN REFRESHES
	MOVEM	T1,REFTIM	;SET IT
	MOVX	T1,DFTIDL	;GET DEFAULT IDLE TIME
	MOVEM	T1,MAXIDL	;AND SET IT
	MOVX	T1,DFTRPL	;GET DEFAULT RUNTIME PERCENT CUTOFF
	MOVEM	T1,MAXRPT	;SET IT
	SETZM	MAXIDF		;SET FLAG TO NORMAL CHECK
	SETZM	PRGNUM		;CLEAR ANY PROGRAM NAMES STORED
	MOVE	T1,[BITS,,BITS+1]	;GET READY
	SETZM	BITS		;CLEAR FIRST WORD OF BITS
	BLT	T1,BITS+<MAXJOB/^D36>	;THEN THE REST
	JRST	COLINI		;THEN GO INITIALIZE THE COLUMNS
	SUBTTL	SUBROUTINE TO SET UP HEADER AND TAB STOPS




;CALLED WITH THE HEADER TYPE IN T1, TO BUILD THE HEADER STRING AND
;SET THE PROPER TAB STOPS FOR FOLLOWING OUTPUT.  STRING IS STORED
;IN LOCATION HDRTXT.  IF FR.NDC IS SET, WE MAKE THE TITLE HAVE A CRLF
;FIRST, TO SEPARATE US FROM THE PREVIOUS OUTPUT.



HDRSET:	TXZ	F,FR.HDR	;CLEAR THE HEADER FLAG
	CAMN	T1,HDRTYP	;SEE IF ALREADY SET PROPER HEADER AND TABS
	RET			;YES, JUST RETURN
	MOVEM	T1,HDRTYP	;NO, REMEMBER WHAT WE ARE BUILDING
	MOVE	T2,[COLTBS,,COLTBS+1]	;GET READY
	SETZM	COLTBS		;TO CLEAR TAB STOP WORDS
	BLT	T2,COLTBS+3	;DO IT
	MOVE	T2,[POINT 7,HDRTXT]	;GET POINTER TO HEADER STORAGE
	MOVEM	T2,HDRPTR	;SAVE IT
	MOVEI	T2,12		;GET CRLF READY
	TXNE	F,FR.NDC	;WANT A PRELIMINARY CRLF?
	IDPB	T2,HDRPTR	;YES, START STRING WITH ONE THEN
	SETO	T2,		;INITIALIZE COLUMN COUNTER
	SETZM	HDRPOS		;INITIALIZE COLUMN POSITION


HDRLOP:	ADDI	T2,1		;MOVE TO NEXT HEADER
	SKIPN	T3,COLDSP(T2)	;ANY MORE COLUMNS TO LOOK AT?
	JRST	HDRDON		;NO, GO FINISH UP
	HRRZ	T4,CL.TYP(T3)	;GET TYPE
	CAME	T1,T4		;THE TYPE WE WANT?
	JRST	HDRLOP		;NO, LOOK SOME MORE
	MOVE	T4,CL.SIZ(T3)	;GET WIDTH OF THIS COLUMN
	ADD	T4,COLSEP(T1)	;ADD IN SEPARATION BETWEEN COLUMNS
	ADDB	T4,HDRPOS	;ADD INTO TOTAL WIDTH SO FAR
	CAIL	T4,^D36*4-1	;CHECK TO SEE IF TOO LARGE
	SETZ	T4,		;YES, MAKE NICER
	ADJBP	T4,[POINT 1,COLTBS,0]	;MAKE PROPER BYTE POINTER
	MOVEM	T4,TEMP		;SAVE AWAY
	MOVEI	T4,1		;GET A BIT
	DPB	T4,TEMP		;SET THE TAB STOP
	TXNE	F,FR.CMP	;COMPRESSING HEADERS?
	JRST	HDRLOP		;YES, JUST GO TO NEXT COLUMN
	MOVEI	T4,11		;GET A TAB
	TXOE	F,FR.HDR	;FIRST COLUMN?
	IDPB	T4,HDRPTR	;NO, THEN SEPARATE THE COLUMNS
	ADDI	T3,CL.TXT	;POINT TO THE TEXT STRING
	CALL	HDRSTR		;STORE IT AWAY
	JRST	HDRLOP		;AND LOOP
;HERE WHEN DONE PROCESSING ALL COLUMNS, TO FINISH UP.


HDRDON:	MOVEI	T3,[BYTE (7)12,12]	;GET A COUPLE OF END OF LINES
	TXNN	F,FR.CMP	;COMPRESSING OUTPUT?
	CALL	HDRSTR		;NO, STORE THESE
	SETZ	T1,		;GET A NULL
	IDPB	T1,HDRPTR	;MAKE STORED STRING ASCIZ
	TAB$	COLTBS		;SET THE PROPER TAB STOPS
	TXZ	F,FR.HDR	;CLEAR THE HEADER BIT AGAIN
	RET			;DONE




;LOCAL SUBROUTINE TO STORE AN ASCIZ STRING AWAY AS PART OF THE HEADER.
;ADDRESS OF STRING IS IN T3.


HDRSTR:	HRLI	T3,(POINT 7,)	;MAKE A BYTE POINTER
HDRSTL:	ILDB	T4,T3		;GET NEXT CHARACTER
	JUMPE	T4,CPOPJ	;DONE WHEN GET A NULL
	IDPB	T4,HDRPTR	;STORE THIS CHAR
	JRST	HDRSTL		;LOOP FOR NEXT CHAR
	SUBTTL	SUBROUTINE TO OUTPUT ALL COLUMNS OF A LINE




;CALLED TO LOOP OVER ALL COLUMNS FOR THE CURRENT OUTPUT, CALLING
;THE VARIOUS SUBROUTINES TO OUTPUT THINGS.  IT IS ASSUMED THAT
;THE HDRSET ROUTINE WAS PREVIOUSLY CALLED.  RETURNS WHEN ALL
;COLUMNS HAVE BEEN PRINTED.  CRLF IS TYPED WHEN THE LINE IS DONE.



DOCOLS:	CALL	HEADER		;TYPE HEADER IF NECESSARY
	TXZE	F,FR.EAT	;EATING NEEDED?
	CALL	SETEAT		;YES, GO SET IT UP
	SKIPLE	@DPYTAB+$DPEAT	;STILL EATING LINES?
	JRST	DOCRLF		;YES, DON'T DO ANY WORK YET THEN
	SETOM	NXTCOL		;INITIALIZE NEXT COLUMN FOR LOOP


DOCOLL:	MOVE	T1,NXTCOL	;GET THE OLD NEXT COLUMN
	MOVEM	T1,CURCOL	;SET AS THE CURRENT COLUMN
DOCOLF:	AOS	T1,NXTCOL	;GET NEXT COLUMN
	SKIPN	T1,COLDSP(T1)	;OUT OF COLUMNS?
	JRST	COLNOM		;YES, GO CLEAR FLAG
	HRRZ	T2,CL.TYP(T1)	;GET THE TYPE OF COLUMN
	CAME	T2,HDRTYP	;SAME TYPE AS THE HEADER IS SET UP FOR?
	JRST	DOCOLF		;NO, KEEP SEARCHING
	TXOA	F,FR.MOR	;THERE ARE MORE COLUMNS
COLNOM:	TXZ	F,FR.MOR	;NO MORE COLUMNS COMING
	SKIPGE	T1,CURCOL	;GET CURRENT COLUMN TO SHOW
	JRST	CHKMOR		;ISN'T ONE, GO LOOK SOME MORE
	MOVE	T1,COLDSP(T1)	;GET ADDRESS OF DATA BLOCK
	CALL	@CL.DSP(T1)	;PRINT DATA FOR THIS COLUMN
	TAB			;APPEND A TAB AFTER THE COLUMN
CHKMOR:	TXNN	F,FR.MOR	;ANY MORE COLUMNS COMING?
	JRST	DOCRLF		;NO, END LINE WITH A CRLF
	JRST	DOCOLL		;YES, GO DO NEXT COLUMN
	SUBTTL	SUBROUTINES TO CONTROL SCREEN HANDLING




;CALLED AFTER A SCREEN HAS BEEN OUTPUT, TO SEE IF THE NEXT SCREEN
;SHOULD BE SCROLLED OR NOT, AND TO DO IT IF NECESSARY.  CALL AT
;PAGSET TO JUST SET UP THE NEXT SCROLLING TIME.



PAGCHK:	MOVE	T1,NTIME	;GET CURRENT TIME
	CAMGE	T1,PAGTIM	;TIME TO SCROLL?
	RET			;NO
	TLNE	R,-1		;IN HELP DISPLAY?
	JRST	PAGSET		;YES, DELAY SCROLLING

PAGDO:	TXZN	F,FR.END	;DID PREVIOUS SCREEN END THE DISPLAY?
	AOSA	PAGE		;NO, MOVE TO NEXT PAGE
	SETZM	PAGE		;YES, RESET TO FIRST PAGE

PAGSET:	MOVE	T1,PAGINT	;GET INTERVAL BETWEEN SCROLLS
	MUL	T1,[1,,0]	;CONVERT FROM SECONDS
	DIVI	T1,^D<60*60*24>	;TO UNIVERSAL TIME
	ADD	T1,NTIME	;COMPUTE TIME FROM NOW
	SKIPN	PAGINT		;ANY INTERVAL AT ALL?
	MOVX	T1,.INFIN	;NOPE, SET SO WILL NEVER SCROLL
	MOVEM	T1,PAGTIM	;REMEMBER TIME OF NEXT SCROLLING
	RET			;DONE





;SUBROUTINE TO SET UP THE WINDOW FOR THE MAIN OUTPUT DISPLAY.  IF
;NO INFORMATION LINE IS TYPED, THE WINDOW IS THE WHOLE DISPLAY.
;IF A LINE IS TO BE TYPED, THE DISPLAY IS TWO LINES LESS.



WINSET:	TLNN	R,-1		;SHOWING HELP DISPLAY?
	TXNE	F,FR.INF	;OR WANTS INFORMATION LINE?
	JRST	WINSEY		;YES, DO GO SPECIAL WINDOW
	SIZ$			;NO, RESET BACK TO WHOLE SCREEN
	RET			;DONE

WINSEY:	MOVE	T1,@DPYTAB+$DPLEN	;GET TERMINAL LENGTH
	SUBI	T1,2		;WANT ALL LINES EXCEPT LAST TWO
	MOVEI	T2,-1		;WANT ALL COLUMNS
	SIZ$	T1		;SET WINDOW
	RET			;DONE
	SUBTTL	SUBROUTINE TO RETURN SLEEP TIME




;CALLED TO COMPUTE THE SLEEP INTERVAL, TAKING INTO ACCOUNT THE
;SLOWING DOWN OF THE INTERVAL DUE TO INACTIVITY.  RETURNS SLEEP
;TIME IN MILLISECONDS IN T1.




GETSLP:
IFE DECSW,<
	TXNE	F,FR.NOS	;ALLOWED TO SLOW DOWN DISPLAY?
	JRST	NRMSLP		;NOPE, THEN USE SPECIFIED SLEEP TIME
>
	MOVE	T1,NTIME	;GET CURRENT TIME
	SUB	T1,SLWTIM	;FIND INTERVAL SINCE LAST COMMAND
	MUL	T1,[^D<60*60*24*1000>]	;CONVERT FROM UNIVERSAL TIME
	ASHC	T1,^D17		;INTO MILLISECONDS
	SUBI	T1,SLWGRC	;SUBTRACT GRACE TIME
	JUMPLE	T1,NRMSLP	;IF NOT YET TIME TO SLOW, USE SPECIFIED SLEEP
	IDIVI	T1,SLWFAC	;CONVERT FROM ELAPSED TIME TO SLOWING TIME
	CAILE	T1,MAXSLP	;LARGER THAN MAXIMUM SLOWING?
	MOVEI	T1,MAXSLP	;YES, REDUCE TO MAXIMUM
	CAMGE	T1,SLPTIM	;LARGER THAN HIS SPECIFIED TIME?
NRMSLP:	MOVE	T1,SLPTIM	;NO, USE SPECIFIED TIME
	RET			;DONE
	SUBTTL	SUBROUTINE TO SET UP INITIAL COLUMNS



;HERE TO BUILD THE LIST OF DEFAULT COLUMNS FOR OUTPUT.  THE
;ORDER OF COLUMNS DEPENDS ON THE VALUE DEFINED FOR THAT COLUMN
;IN THE COLS MACRO.  LOWER NUMBERED COLUMNS WILL APPEAR BEFORE
;HIGHER NUMBERED COLUMNS.  COLUMNS WITH A ZERO NUMBER WILL NOT
;BE INSERTED AT ALL.



COLINI:	SETOM	HDRTYP		;HEADER IS UNKNOWN AFTER THIS
	MOVEI	T1,DISNUM	;GET READY FOR LOOP
	HRRZ	T2,DISTAB(T1)	;GET DEFAULT SEPARATION BETWEEN COLUMNS
	MOVEM	T2,COLSEP(T1)	;INITIALIZE VALUE FOR THIS DISPLAY
	SOJG	T1,.-2		;LOOP OVER ALL DISPLAYS
	SETZM	COLDSP		;CLEAR OUR CURRENT COLUMNS
	SETZM	ORDVAL		;INITIALIZE LOOP


COLINL:	AOS	T1,ORDVAL	;MOVE TO NEXT VALUE
	MOVEM	T1,ORDMIN	;SET AS THE MINIMUM ALLOWABLE VALUE
	HRLOI	T1,377777	;GET INFINITY
	MOVEM	T1,ORDVAL	;SET AS INITIAL VALUE
	SETZM	ORDHAV		;CLEAR COLUMN WHICH IS PICKED
	MOVEI	T1,COLNUM+2	;GET HIGHEST COLUMN+1
	MOVEM	T1,ORDIDX	;INITIALIZE INDEX

COLINS:	SOSG	T1,ORDIDX	;GET NEXT POSSIBLE COLUMN
	JRST	COLINH		;NO MORE, GO PROCESS SELECTED COLUMN
	HRRZ	T1,COLTAB(T1)	;GET ADDRESS OF THIS COLUMN
	MOVE	T2,CL.VAL(T1)	;THEN GET THE VALUE FOR THIS COLUMN
	CAML	T2,ORDMIN	;AT LEAST AS LARGE AS OUR MINIMUM?
	CAML	T2,ORDVAL	;AND LESS THAN PREVIOUS SMALLEST?
	JRST	COLINS		;NO, KEEP LOOKING
	MOVEM	T2,ORDVAL	;YES, SAVE THIS VALUE
	MOVEM	T1,ORDHAV	;AND THE ADDRESS
	JRST	COLINS		;LOOK FOR A BETTER COLUMN


COLINH:	SKIPN	T1,ORDHAV	;SEE IF FOUND A COLUMN
	RET			;NO, ALL COLUMNS ARE DONE
	MOVEI	T2,-1		;INDICATE COLUMN GOES AT END
	CALL	COLADD		;ADD THIS COLUMN TO ONES BEING SHOWN
	JRST	COLINL		;LOOP AGAIN
	SUBTTL	SUBROUTINE TO INITIALIZE RUNTIME TABLES



;HERE AT START OF PROGRAM, TO SET THE INITIAL RUNTIME VARIABLES
;FOR ALL THE JOBS.



TBLINI:	MOVEI	I,CPUAVG-1	;SET INITIAL VALUE
	GTAD			;READ TIME OF DAY
	MOVEM	T1,OTIME	;SET OLD TIME OF DAY
	MOVEM	T1,NTIME	;AND NEW TIME OF DAY
	MOVEI	T2,CPUAVG-1	;GET READY FOR LOOP
	MOVEM	T1,TIMES(T2)	;SAVE TIMES THAT TABLES WERE MADE
	SOJGE	T2,.-1		;LOOP OVER ALL TABLES
	MOVNM	T1,TIMRUN	;SAVE NEGATIVE TIME IN TIME TABLE
	MOVE	T1,[TIMRUN,,TIMRUN+1]	;GET SET
	BLT	T1,TIMRUN+MAXJOB-1	;STORE TIMES IN ALL WORDS
	MOVE	T1,[BITS,,BITS+1]	;GET READY
	SETZM	BITS		;CLEAR FIRST WORD OF BITS
	BLT	T1,BITS+<MAXJOB/^D36>	;AND THE REST ALSO
	MOVE	J,HGHJOB	;START WITH HIGHEST JOB

TBLINL:	MOVSI	T1,(J)		;GET READY
	IORI	T1,.JOBRT	;TO READ JOB'S RUN TIME
	GETAB			;READ IT
	 ERJMP	DIE		;FAILED
	SKIPGE	T1		;JOB EXIST?
	SETZ	T1,		;NO, THEN SET RUNTIME TO ZERO
	MOVEM	T1,CURRUN(J)	;SAVE AS CURRENT RUNTIME
	MOVEI	T2,CPUAVG-1	;GET READY
	MOVEM	T1,@OLDRUN(T2)	;SAVE IN OTHER TABLES ALSO
	SOJGE	T2,.-1		;LOOP OVER THEM ALL
	SOJGE	J,TBLINL	;LOOP OVER ALL JOBS
	RET			;RETURN
	SUBTTL	SUBROUTINE TO RECALCULATE PERCENTAGES OF CPU TIME




;HERE TO TAKE THE TABLES OF RUNTIM AND ORUNTM, AND TO COMPUTE THE
;PERCENTAGE OF ALL JOB'S CPU TIME, AND STORE THEM BACK INTO THE
;TABLE RUNDIF.  CALLED OCCASSIONALLY.




CPUCMP:	MOVE	T1,NTIME	;GET CURRENT TIME
	SUB	T1,OTIME	;SEE HOW LONG SINCE LAST CALCULATION
	CAIGE	T1,<<CPUINT_^D18>/^D<24*60*60>>	;TIME TO GET NEW DATA?
	RET			;NO, JUST RETURN
	SOJGE	I,CPUCMI	;DECREMENT TO NEXT TABLE
	MOVEI	I,CPUAVG-1	;TIME TO RESET TO TOP
	TXO	F,FR.CPR	;SET THAT THE DATA IS READY

CPUCMI:	MOVE	J,HGHJOB	;GET HIGHEST POSSIBLE JOB

CPUCML:	MOVE	T1,CURRUN(J)	;GET LATEST RUNTIME OF JOB
	SUB	T1,@OLDRUN(I)	;SUBTRACT RUNTIME FROM BEFORE
	SKIPGE	T1		;IS IT REASONABLE?
	SETZ	T1,		;NO, CLEAR IT
	MOVEM	T1,RUNDIF(J)	;SAVE FOR OUTPUT LATER
	SOJGE	J,CPUCML	;LOOP OVER ALL JOBS

	HRRZ	T1,OLDRUN(I)	;GET ADDRESS OF PROPER TABLE
	HRLI	T1,CURRUN	;AND ADDRESS OF CURRENT RUNTIMES
	MOVE	T2,T1		;COPY ADDRESS
	BLT	T1,MAXJOB-1(T2)	;SET NEW RUNTIMES FOR TABLE
	MOVE	T1,NTIME	;GET CURRENT TIME AGAIN
	MOVEM	T1,OTIME	;SAVE AS OLD TIME
	MOVE	T2,TIMES(I)	;GET TIME THAT CURRENT DATA WAS MADE
	MOVEM	T1,TIMES(I)	;SET CURRENT TIME FOR NEW DATA
	SUB	T1,T2		;GET DIFFERENCE IN TIMES
	MUL	T1,[^D<1000*60*60*24>]	;CONVERT TO MILLISECONDS
	ASHC	T1,^D17		;FROM UNIVERSAL FORMAT
	MOVEM	T1,TIMDIF	;SAVE DIFFERENCE
	RET			;RETURN
	SUBTTL	ROUTINE TO UPDATE IDLE TIMES FOR ALL JOBS



;ROUTINE TO UPDATE THE IDLE TIMES FOR ALL JOBS.
;CALL AT UPDORM IF UPDATING A SINGLE JOB.



CHKDRM:	MOVE	J,HGHJOB	;GET HIGHEST JOB
CHKDRL:	MOVSI	T1,(J)		;GET INDEX READY
	IORI	T1,.JOBRT	;AND RUNTIME TABLE
	GETAB			;READ VALUE
	 ERJMP	DIE		;FAILED
	CALL	UPDORM		;UPDATE DORMANCY FOR JOB
	MOVEM	T1,IDLE(J)	;SAVE THE RESULT
	SOJGE	J,CHKDRL	;LOOP OVER ALL JOBS
	RET			;DONE



;HERE TO CHECK THE IDLE TIME OF A SINGLE JOB:


UPDORM:	JUMPL	T1,NOTJOB	;IF NOT A JOB, CLEAR STUFF
	CAMN	T1,CURRUN(J)	;SAME RUNTIME AS LAST TIME?
	JRST	GETIDL		;YES, SKIP ONWARD
	MOVEM	T1,CURRUN(J)	;NO, SAVE NEW RUNTIME
	MOVE	T1,NTIME	;GET CURRENT TIME
	MOVEM	T1,TIMRUN(J)	;AND SAVE AS TIME RUNTIME CHANGED
	SETZ	T1,		;IDLE TIME IS NOW ZERO
	RET			;RETURN


GETIDL:	MOVE	T1,NTIME	;GET CURRENT TIME
	MOVM	T2,TIMRUN(J)	;AND ABSOLUTE VALUE OF TIME JOB LAST RAN
	SUB	T1,T2		;GET THE DIFFERENCE
	SKIPGE	T1		;SEE IF NEGATIVE
	SETZ	T1,		;YES??? THEN SET TO ZERO
	MULI	T1,^D<60*24>	;CONVERT UNIVERSAL TIME TO MINUTES
	ASHC	T1,^D17		;BY MULTIPLYING BY CORRECT CONSTANT
	RET			;AND RETURN
;HERE WHEN THE JOB IS NONEXISTANT, TO CLEAR THE TABLES FOR IT.




NOTJOB:	SETZM	CURRUN(J)	;CLEAR CURRENT RUNTIME
	MOVEI	T1,CPUAVG-1	;GET SET FOR LOOP
	SETZM	@OLDRUN(T1)	;CLEAR ALL RUNTIME TABLES
	SOJGE	T1,.-1		;KEEP LOOPING UNTIL DONE
	MOVE	T1,NTIME	;GET CURRENT TIME
	MOVEM	T1,TIMRUN(J)	;AND SET IN TIME TABLE
	SETZ	T1,		;GET A ZERO
	MOVE	T2,J		;GET COPY OF JOB
	ADJBP	T2,[POINT 1,BITS,0]	;GET BYTE POINTER TO RIGHT BIT
	DPB	T1,T2		;LET JOB BE SEEN LATER
	RET			;THEN RETURN
	SUBTTL	ROUTINE TO RETURN STATE OF A JOB



;CALLED WITH JOB NUMBER IN J, AND TERMINAL NUMBER IN T1, TO RETURN
;THE STATE OF A JOB AS AN ASCII STRING IN T1.




STATE:	JUMPL	T1,STATRN	;IF NOT ON A TERMINAL, ASSUME RUNNING
	MOVSI	T1,(T1)		;TERMINAL NUMBER IS INDEX
	IORI	T1,.TTYJO	;TABLE OF TERMINALS
	GETAB			;READ DATA
	 ERJMP	DIE		;FAILED
	ANDI	T1,-1		;KEEP ONLY THE RIGHT HALF
	CAIN	T1,-1		;IS ANY FORK IN JOB WAITING FOR TTY?
STATRN:	SKIPA	T1,[ASCIZ/ RUN/]	;NO, THEN STATE IS RUNNING
	MOVE	T1,[ASCIZ/ TI/]	;YES, THEN STATE IS TI
	RET			;RETURN
	SUBTTL	ROUTINE TO TYPE STATUS OF A FORK





;CALLED WITH THE FORK STATUS WORD IN T1, TO TYPE OUT THE PROPER
;STATUS OF THE FORK.





FRKSTS:	HLRZ	T2,T1		;GET CODE
	ANDI	T2,(RF%STS)	;KEEP ONLY THE CODE
	CAILE	T2,STSMAX	;LEGAL CODE?
	IORI	T2,-1		;NO, SET TO UNKNOWN
	TXNE	T1,RF%FRZ	;WAS PROCESS FROZEN?
	SKIPL	STSTAB(T2)	;AND IN A STATE WHERE IT MAKES SENSE?
	SKIPA			;NO
	MOVEI	T2,-2		;YES, SAY WAS FROZEN
	STR$	@STSTAB(T2)	;OUTPUT THE STATUS NOW
	RET			;AND RETURN



	STS	1,frozen
	STS	1,unknown
STSTAB:	STS	1,running
	STS	1,IO wait
	STS	0,halt
	STS	0,error halt
	STS	1,fork wait
	STS	1,sleep
	STS	0,JSYS trap
	STS	0,addr break


	STSMAX==.-STSTAB-1	;HIGHEST KNOWN CODE
	SUBTTL	SUBROUTINE TO TYPE OUT THE RSCAN BUFFER




;CALLED TO TYPE THE RSCAN BUFFER FOR A JOB.  THIS IS USUALLY THE
;LAST COMMAND PROCESSED WHICH RAN A PROGRAM.



TYPRSC:	TXNN	F,FR.JSY	;CAN WE DO THE MONRD% JSYS?
	RET			;NO, TYPE NOTHING
	STR$	[ASCIZ/RSCAN buffer: /]	;START THE OUTPUT
	MOVE	T1,['RSCNBP']	;GET THE SYMBOL
	CALL	GETJS0		;READ THE POINTER
	 JRST	DOCRLF		;FAILED, JUST TYPE A CRLF
	JUMPE	T1,RSCNON	;NULL POINTER, SAY SO
	MOVEI	T2,^D20		;ALLOW A LONG STRING
	CALL	TYPPTM		;TYPE IT OUT
	 JFCL			;DON'T CARE IT IT FAILS
	JRST	DOCRLF		;THEN FINISH WITH A CRLF


RSCNON:	STR$	[ASCIZ/(none)
/]				;SAY THERE IS NONE
	RET			;RETURN
	SUBTTL	SUBROUTINE TO TYPE OUT ASCIZ STRING FROM A JSB





;CALLED WITH AN ADDRESS INTO A JSB IN AC T1, TO READ AND OUTPUT THE
;ASCIZ STRING THAT THE POINTER IS POINTING TO.  USED FOR OUTPUT OF
;FILE NAMES.  SKIP RETURN IF SUCCESSFUL.  CALL AT TYPPTM WITH LENGTH
;IN T2 IF STRING CAN BE LONGER THAN A NORMAL FILE SPEC.




TYPPTR:	MOVEI	T2,^D8		;SET UP NORMAL SIZE LIMIT
TYPPTM:	ANDI	T1,-1		;KEEP ONLY RIGHT HALF
	JUMPE	T1,CPOPJ1	;IF NO POINTER, GOOD RETURN
	SUB	T1,JSVAR	;REMOVE JSB OFFSET
	MOVEM	T1,TXTPTR	;SAVE THE OFFSET
	SETZM	TXTCTR		;CLEAR COUNTER ALSO
	SETZM	TEMP(T2)	;CLEAR THE WORD AFTER THE MAXIMUM
	MOVEM	T2,TXTMAX	;SAVE THE MAXIMUM OFFSET


TYPPTL:	MOVE	T1,['JSVAR ']	;BASE ADDRESS OF WORD
	AOS	T2,TXTPTR	;INCREMENT TO NEXT WORD
	CALL	GETJSB		;READ THE WORD
	 RET			;FAILED
	AOS	T2,TXTCTR	;INCREMENT WORD COUNTER TOO
	MOVEM	T1,TEMP-1(T2)	;SAVE THIS WORD
	CAML	T2,TXTMAX	;MORE WORDS TO BE READ MAYBE?
	JRST	TYPPTT		;NO, GO TYPE RESULT
	TXNE	T1,177B34	;SEE IF THIS WORD ENDS IN A NULL
	TXNN	T1,177B27	;SOMPLACE IN THE WORD
	JRST	TYPPTT		;YES, TYPE RESULT
	TXNE	T1,177B20	;KEEP LOOKING FOR A NULL
	TXNN	T1,177B13	;WELL?
	JRST	TYPPTT		;FOUND IT, ALL DONE
	TXNE	T1,177B6	;LAST CHECK
	JRST	TYPPTL		;WORD IS FULL, GET NEXT ONE
;NOW SEARCH THE STRING AND REPLACE ALL BAD CHARACTERS WITH NICE
;ONES SO THAT THE OUTPUT ISN'T MESSED UP BY STRANGE FILENAMES.


TYPPTT:	MOVE	T1,[POINT 7,TEMP]	;GET A BYTE POINTER
TYPPFL:	ILDB	T2,T1		;GET NEXT CHARACTER
	JUMPE	T2,TYPPFO	;DONE WHEN HAVE A NULL
	CAIL	T2," "		;IS IT A CONTROL CHARACTER?
	JRST	TYPPFL		;NO, LEAVE IT ALONE
	CAIE	T2,15		;CARRIAGE RETURN?
	CAIN	T2,12		;OR LINE FEED?
	SKIPA	T2,[" "]	;YES, TURN THEM INTO HARMLESS SPACES
	MOVEI	T2,"?"		;OTHER CONTROL CHARS BECOME THIS
	DPB	T2,T1		;STORE THE NEW CHARACTER
	JRST	TYPPFL		;LOOP UNTIL DONE


TYPPFO:	STR$	TEMP		;OUTPUT THE STRING WE COLLECTED
	RETSKP			;GOOD RETURN
	SUBTTL	ROUTINE TO OUTPUT AN ERROR STRING



;CALLED WITH AN ERROR CODE IN T1, TO CONVERT IT TO A STRING AND
;OUTPUT IT TO THE SCREEN.  TO BE FAST, WE KEEP A TABLE OF THE MOST
;RECENT ERRORS WE KNOW ABOUT.



ERROUT:	CAIN	T1,LSTRX1	;NO ERRORS ENCOUNTERED YET?
	RET			;YES, TYPE NOTHING
	TXNE	F,FR.MOR	;ANY MORE COLUMNS?
	JRST	ERRJUS		;YES, JUST TYPE THE STRING
	MOVEM	T1,TEMP		;SAVE THE ERROR CODE
	MOVEI	T2,OCTSP6	;ASSUME WANT OCTAL OUTPUT AT FIRST
	CAIL	T1,.ERBAS	;IN RANGE OF OUR TABLE?
	CAILE	T1,.ERBAS+MAXERR	;WELL?
	JRST	ERROCT		;NO, WE GUESSED RIGHT
	SKIPN	T1,ERRS-.ERBAS(T1)	;IS THERE A MNEMONIC THERE?
	SKIPA	T1,TEMP		;NO, RESTORE NUMBER
	MOVEI	T2,SIXRHT	;YES, GET ROUTINE FOR SIXBIT OUTPUT
ERROCT:	CALL	(T2)		;OUTPUT EITHER SIXBIT OR OCTAL
	STR$	[ASCIZ/ - /]	;SPACE OVER SOME
	MOVE	T1,TEMP		;RESTORE CODE

ERRJUS:	HRLZ	T4,ERRCNT	;GET NUMBER OF ERRORS ALREADY STORED
	JUMPE	T4,NEWERR	;IF NONE, HAVE A NEW ERROR
	MOVN	T4,T4		;TURN INTO AOBJN POINTER
	MOVX	T2,.INFIN	;INITIALIZE AGE FOR LOOP


ERRSRC:	CAMN	T1,ERRCOD(T4)	;IS THIS THE ERROR CODE WE WANT?
	JRST	HAVERR		;YES, JUST GO TYPE IT
	CAMGE	T2,ERRAGE(T4)	;IS THIS ERROR OLDER THAN PREVIOUS ONES?
	JRST	ERRSRN		;NO, GO TRY NEXT ERROR
	MOVE	T2,ERRAGE(T4)	;YES, GET ITS AGE
	HRRZ	T3,T4		;AND REMEMBER WHICH ERROR THIS WAS
ERRSRN:	AOBJN	T4,ERRSRC	;LOOK AT ALL KNOWN ERRORS
	CAIL	T4,ERRNUM	;IS THE TABLE FULL?
	SKIPA	T4,T3		;YES, THEN USE THE OLDEST SLOT
NEWERR:	AOS	ERRCNT		;INCREMENT NUMBER OF STORED ERRORS
	MOVEM	T1,ERRCOD(T4)	;REMEMBER THIS ERROR CODE FOR LATER
	HRRZ	T1,T4		;GET READY
	IMULI	T1,ERRSIZ	;MAKE OFFSET INTO ERROR STRINGS
	ADD	T1,[POINT 7,ERRTAB]	;MAKE BYTE POINTER TO STORAGE
	MOVE	T2,ERRCOD(T4)	;GET ERROR CODE
	HRLI	T2,.FHSLF	;AND A VALID PROCESS HANDLE
	MOVEI	T3,ERRSIZ*5-1	;SET UP MAXIMUM SIZE OF STRING
	ERSTR			;CONVERT CODE TO STRING
	JFCL			;FAILED
	SKIPA	T1,T4		;FAILED, GET WHICH ENTRY WE FAILED ON
	JRST	HAVERR		;SUCCESSFUL, GO ON
	IMULI	T1,ERRSIZ	;MAKE OFFSET
	SETZM	ERRTAB(T1)	;ZERO THE STRING SINCE DON'T KNOW ERROR



;HERE WHEN WE HAVE FOUND THE ERROR CODE, TO TYPE THE STORED STRING:



HAVERR:	AOS	T1,ERRTOT	;INCREMENT AGE COUNTER
	MOVEM	T1,ERRAGE(T4)	;AND SET THIS ERROR AS BEING NEWEST
	MOVE	T1,T4		;GET WHICH ENTRY THIS IS
	IMULI	T1,ERRSIZ	;MAKE OFFSET INTO THE BUFFER
	SKIPN	ERRTAB(T1)	;IS THIS AN UNKNOWN ERROR?
	JRST	UNKERR		;YES, GO SAY SO
	PUSH	P,ERRTAB+5(T1)	;SAVE A WORD OF THE STRING
	TXNE	F,FR.MOR	;ARE THERE MORE COLUMNS AFTER THIS ONE?
	SETZM	ERRTAB+5(T1)	;YES, RESTRICT SIZE OF MESSAGE
	STR$	ERRTAB(T1)	;OUTPUT THE ERROR TEXT
	POP	P,ERRTAB+5(T1)	;RESTORE THE WORD OF THE TEXT
	RET			;DONE


UNKERR:	STR$	[ASCIZ/Unknown error /]	;SAY WE DON'T KNOW WHAT IT IS
	TXNN	F,FR.MOR	;MORE COLUMNS?
	RET			;NO, THEN WE ALREADY GAVE THE NUMBER
	MOVE	T1,ERRCOD(T4)	;GET THE NUMBER
	JRST	OCTOUT		;OUTPUT IT
	SUBTTL	SUBROUTINE TO TYPE OUT A JSYS VALUE



;CALLED WITH AN MUUO IN AC T1, TO OUTPUT IT NICELY.  IF IT IS A KNOWN
;JSYS, THE NAME WILL BE OUTPUT, OTHERWISE JUST JSYS NNN.  IF IT
;IS A UUO, THE OPCODE WILL BE TYPED.



UUOOUT:	HLRZ	T2,T1		;GET OPCODE AND STUFF
	JUMPE	T2,CPOPJ	;DONE IF NO INSTRUCTION
	CAIE	T2,(JSYS)	;IS THIS A JSYS?
	JRST	TYPUUO		;NO, TYPE OUT A UUO
	CAMN	T1,[MONRD%]	;IS IT OUR JSYS?
	JRST	OURJSY		;YES, TYPE SPECIAL
	HRRZ	T2,T1		;GET THE JSYS NUMBER
	CAIG	T2,JSYSMX	;IS THIS A KNOWN JSYS?
	SKIPN	T1,JSTABL(T2)	;AND DOES IT HAVE A NAME?
	SKIPA	T1,T2		;NO, HAVE TO OUTPUT AS JSYS NNN
	JRST	SIXOUT		;YES, GO OUTPUT IT
	STR$	[ASCIZ/JSYS /]	;BEGIN OUTPUT
	PJRST	OCTOUT		;OUTPUT NUMBER


OURJSY:	STR$	[ASCIZ/MONRD/]	;OUTPUT SPECIAL NAME
	RET			;DONE
;HERE TO TYPE OUT A UUO.  THIS IS NECESSARY FOR THOSE PROGRAMS WHICH
;RUN UNDER THE COMPATABILITY PACKAGE.



TYPUUO:	LDB	T2,[POINT 9,T1,8]	;GET OPCODE
	CAIN	T2,047		;IS THIS A CALLI?
	JRST	TYPCAL		;YES, HANDLE SPECIAL
	CAIN	T2,051		;IS THIS A TTCALL?
	JRST	TYPTTC		;YES, HANDLE SPECIAL
	CAILE	T2,100		;A NORMAL UUO?
	JRST	TYPOPC		;NO, TYPE OUT THE OPCODE
	MOVE	T1,UUOTAB-40(T2)	;YES, GET NAME
	PJRST	SIXOUT		;OUTPUT AND RETURN


TYPCAL:	STR$	[ASCIZ/CALLI /]	;TYPE START OF TEXT
	TRNE	T1,400000	;IS THIS A NEGATIVE CALLI?
	TDOA	T1,[-1,,200000]	;YES, EXTEND IT AND CLEAR PHYSICAL BIT
	TDZA	T1,[-1,,200000]	;NO, CLEAR LEFT HALF AND PHYSICAL BIT
	CHI$	"-"		;IF NEGATIVE CALLI, TYPE MINUS SIGN
	MOVM	T1,T1		;GET POSITIVE NUMBER
	PJRST	OCTOUT		;THEN OUTPUT THE NUMBER


TYPTTC:	LDB	T2,[POINT 4,T1,12]	;GET TTCALL TYPE
	MOVE	T1,TTCTAB(T2)	;GET NAME
	PJRST	SIXOUT		;OUTPUT IT


TYPOPC:	STR$	[ASCIZ/OPCODE /]	;TYPE OPCODE TEXT
	MOVE	T1,T2		;GET OPCODE
	PJRST	OCTOUT		;OUTPUT IT
	SUBTTL	SIMPLE DATA OUTPUT ROUTINES



;HERE WITH A TERMINAL NUMBER IN AC T1, TO OUTPUT THE PROPER THING,
;ONE OF NUMBER, OR "DET", OR NUMBER FOLLOWED BY CONTROLLING JOB.
;ASSUMES JOB INFORMATION IS READ INTO AREA AT BLK.



TTYOUT:	JUMPL	T1,TTYDET	;JUMP IF HE IS DETACHED
	MOVEI	T2," "		;GET A SPACE
	CAMN	T1,CTYNUM	;IS THIS THE CTY?
	MOVEI	T2,"*"		;YES, GET AN ASTERISK INSTEAD
	CHI$	(T2)		;OUTPUT SPACE OR STAR
	CALL	OCTOUT		;OUTPUT NUMBER
	SKIPGE	T1,BLK+.JICPJ	;CONTROLLED ON A PTY?
	RET			;NO, ALL DONE
	CHI$	"J"		;YES, OUTPUT LETTER TO INDICATE IT
	JRST	DECOUT		;THEN PRINT THE JOB NUMBER

TTYDET:	STR$	[ASCIZ/ Det/]	;GET DETACHED STRING
	RET			;AND RETURN




;HERE WITH A USER NUMBER IN T1, TO OUTPUT THE USER NAME.  IF ZERO,
;THE USER IS NOT LOGGED IN.  AC T2 HAS THE NUMBER OF WORDS TO
;RESTRICT THE OUTPUT TO IF MORE COLUMNS FOLLOW.



USROUT:	MOVE	T3,T2		;SAVE CUTOFF AMOUNT
	SKIPN	T2,T1		;MOVE NUMBER INTO RIGHT AC
	JRST	USRNLI		;SKIP ON IF NOT LOGGED IN
	CAMN	T1,OPRUSR	;IS THIS THE OPERATOR'S NUMBER?
	JRST	USRIOP		;YES, SKIP THE JSYS THEN
	HRROI	T1,TEMP		;POINT TO TEMPORARY STORAGE
	DIRST			;CONVERT NUMBER TO STRING
	 RET			;IF ERROR, RETURN NOW
	JUMPLE	T3,USRFUL	;OUTPUT WHOLE THING IF GIVEN ZERO
	CAIL	T3,TMPSIZ	;MAKE SURE NOT GIVEN JUNK
	JRST	USRFUL		;YES, ALLOW ALL OUTPUT THEN
	TXNE	F,FR.MOR	;MORE COLUMNS TO COME?
	SETZM	TEMP(T3)	;YES, RESTRICT LENGTH OF OUTPUT
USRFUL:	STR$	TEMP		;OUTPUT THE STRING
	RET			;AND RETURN

USRNLI:	STR$	[ASCIZ/Not logged in/]	;OUTPUT THIS STRING
	RET			;THEN RETURN

USRIOP:	STR$	[ASCIZ/OPERATOR/]	;GIVE OPERATOR
	RET			;AND RETURN
;HERE TO OUTPUT A PERCENTAGE IN THE FORM NN.MM, WHERE T1 HAS NN,
; AND T2 HAS MM


CENOUT:	MOVE	T4,T2		;SAVE FRACTIONAL PART
	SKIPN	T1		;IS THERE A NUMBER THERE?
	STR$	[ASCIZ/  /]	;NO, THEN TYPE SPACES
	SKIPE	T1		;WELL?
	CALL	DECSP2		;YES, OUTPUT IN A FIELD OF 3
	CHI$	"."		;THEN OUTPUT A DOT
	MOVE	T1,T4		;GET BACK FRACTIONAL PART
	IDIVI	T1,^D10		;SPLIT INTO SEPARATE DIGITS
	CHI$	"0"(T1)		;OUTPUT FIRST ONE
	CHI$	"0"(T2)		;AND SECOND ONE
	RET			;DONE





;HERE TO OUTPUT A HEADER LINE IF NECESSARY.  THE TEXT HAD PREVIOUSLY BEEN
;STORED IN HDRTXT.  THE HEADER HAS BEEN SET UP BY A PREVIOUS CALL TO
;THE HDRSET ROUTINE.



HEADER:	TXON	F,FR.HDR	;HAVE WE TYPED THE HEADER YET?
	STR$	HDRTXT		;NO, DO SO NOW
	TXO	F,FR.NDC	;CRLF WILL BE NEEDED IN NEXT DISPLAY
	RET			;DONE
	SUBTTL	SIMPLE OUTPUT SUBROUTINES



;THE FOLLOWING ROUTINES TAKE THEIR ARGUMENTS IN AC T1.  THEY GIVE
;ALL THEIR OUTPUT TO THE DPY ROUTINES.  THESE ROUTINES DO NOT USE
;JSYSES SO THAT THE PROGRAM CAN RUN AS FAST AS POSSIBLE.



TMHSPC:	CAIGE	T1,^D60		;AY LEAST ONE HOUR?
	STR$	[ASCIZ/   /]	;NO, SPACE OVER
TMHSPS:	CAIGE	T1,^D60		;ONLY MINUTES TO OUTPUT?
	JRST	DECSP2		;YES, GO DO IT
	MOVEI	T4,TIMTST	;GET READY
	JRST	TMHOUT		;JOIN OTHER CODE


TIMSPC:	CAIGE	T1,^D<60*60>	;AT LEAST ONE HOUR?
	STR$	[ASCIZ/   /]	;NO, SPACE OVER
	CAIGE	T1,^D60		;AT LEAST ONE MINUTE?
	STR$	[ASCIZ/   /]	;NO, SPACE OVER MORE
				;THEN FALL INTO TIME OUTPUT


TIMOUT:	CAIGE	T1,^D60		;LESS THAN ONE MINUTE?
	JRST	DECSP2		;YES, OUTPUT SIMPLY
	MOVEI	T4,TIMTST	;GET OUTPUT ROUTINE READY
	IDIVI	T1,^D<60*60>	;GET HOURS INTO T1 AND MINUTES IN T2
	HRLI	T4,(T2)		;SAVE MINUTES
	CALL	(T4)		;OUTPUT HOURS
	HLRZ	T1,T4		;GET BACK MINUTES
TMHOUT:	IDIVI	T1,^D60		;GET MINUTES IN T1 AND SECONDS IN T2
	HRLI	T4,(T2)		;SAVE SECONDS
	CALL	(T4)		;OUTPUT MINUTES
	HLRZ	T1,T4		;GET BACK SECONDS
				;AND FALL INTO OUTPUT ROUTINE


TIMYES:	CHI$	":"		;FIRST OUTPUT A COLON
	IDIVI	T1,^D10		;SPLIT INTO TWO DIGITS
	CHI$	"0"(T1)		;OUTPUT FIRST ONE
	CHI$	"0"(T2)		;THEN SECOND ONE
	RET			;AND RETURN


TIMTST:	JUMPE	T1,CPOPJ	;IF NOTHING THERE, RETURN
	HRRI	T4,TIMYES	;SOMETHING, SET UP OTHER ROUTINE
	JRST	DECSP2		;AND GO INTO TWO DIGIT OUTPUT
DECSP6:	CAIGE	T1,^D100000	;IS THIS A FIVE OR LESS DIGIT NUMBER?
	SPACE			;YES, SPACE OVER
DECSP5:	CAIGE	T1,^D10000	;IS THIS A FOUR OR LESS DIGIT NUMBER?
	SPACE			;YES, SPACE OVER
DECSP4:	CAIGE	T1,^D1000	;IS THIS A THREE OR LESS DIGIT NUMBER?
	SPACE			;YES, TYPE A SPACE
DECSP3:	CAIGE	T1,^D100	;IS THIS A TWO OR LESS DIGIT NUMBER?
	SPACE			;YES, TYPE A SPACE
DECSP2:	CAIGE	T1,^D10		;IS THIS ONE DIGIT NUMBER?
	SPACE			;YES
	JRST	DECOUT		;JOIN DECOUT ROUTINE


OCTSP6:	CAIGE	T1,100000	;FIVE OR LESS DIGITS?
	SPACE			;YES, TYPE SPACE
OCTSP5:	CAIGE	T1,10000	;FOUR OR LESS DIGITS?
	SPACE			;YES, DO A SPACE
OCTSP4:	CAIGE	T1,1000		;IS THIS A THREE OR LESS DIGIT NUMBER?
	SPACE			;YES, TYPE A SPACE
OCTSP3:	CAIGE	T1,100		;IS THIS TWO OR LESS DIGITS?
	SPACE			;YES
OCTSP2:	CAIGE	T1,10		;ONE DIGIT NUMBER?
	SPACE			;YES
	JRST	OCTOUT		;JOIN OCTAL OUTPUT CODE


FIXOUT:	IDIVI	T1,^D10		;SPLIT OFF TENTHS
	EXCH	T2,T4		;GET ROUTINE TO CALL AND SAVE DIGIT
	CALL	(T2)		;OUTPUT THE INTEGRAL PART
	CHI$	"."		;PRINT A DOT
	CHI$	"0"(T4)		;THEN PRINT THE FRACTIONAL PART
	RET			;DONE
INFOUT:	TLC	T1,377777	;INVERT
	TLCE	T1,377777	;ALL BITS LIT
	JRST	DECOUT		;NO, TYPE THE NUMBER
	STR$	[ASCIZ/+Inf/]	;YES, SAY SO
	RET			;DONE



OCTTEL:	CHI$	"#"		;SAY THIS IS AN OCTAL NUMBER
OCTOUT:	SKIPA	T3,[^D8]	;SET UP FOR OCTAL
DECOUT:	MOVEI	T3,^D10		;SET UP FOR DECIMAL
	JUMPGE	T1,NUMOUT	;OUTPUT IF NONNEGATIVE
	CHI$	"-"		;TYPE MINUS SIGN
	MOVM	T1,T1		;MAKE POSITIVE

NUMOUT:	IDIVI	T1,(T3)		;GET A DIGIT
	JUMPE	T1,NUMFIN	;IF ZERO, FINISH UP
	HRLM	T2,(P)		;SAVE THIS DIGIT
	CALL	NUMOUT		;LOOP
	HLRZ	T2,(P)		;DONE, GET BACK DIGIT
NUMFIN:	CHI$	"0"(T2)		;OUTPUT IT
CPOPJ:	RET			;AND RETURN
OCTFUL:	MOVEI	T3,^D12		;GET A COUNT
OCTFLL:	SETZ	T2,		;ZERO AC
	ROTC	T1,3		;GET NEXT CHAR
	CHI$	"0"(T2)		;OUTPUT IT
	SOJG	T3,OCTFLL	;LOOP UNTIL DONE
	RET			;DONE



;SUBROUTINE TO OUTPUT A VALUE AS A SYMBOL PLUS OFFSET.


SYMOUT:	CALL	CVTSYM		;CONVERT TO SYMBOL AND OFFSETS
	MOVEM	T2,TEMP		;SAVE OFFSET FOR AWHILE
	JUMPE	T1,SYMOUN	;IF NO SYMBOL, JUST OUTPUT OCTAL
	CALL	R50OUT		;OUTPUT RADIX50 NAME
	SKIPN	TEMP		;ANY OFFSET?
	RET			;NO, DONE
	CHI$	"+"		;YES, TYPE PLUS SIGN

SYMOUN:	MOVE	T1,TEMP		;GET BACK OCTAL
	PJRST	OCTOUT		;OUTPUT IT AND RETURN


R50OTT:	SKIPA	T3,[PBOUT]	;SET UP INSTRUCTION
R50OUT:	MOVE	T3,[CHI$ (T1)]	;OR OTHER ONE
	TLZ	T1,740000	;CLEAR JUNK IN HIGH ORDER BITS
R50OUL:	IDIVI	T1,50		;GET A DIGIT
	JUMPE	T1,R50FIN	;IF ZERO, HAVE ALL DIGITS
	HRLM	T2,(P)		;MORE, SAVE THIS ONE
	CALL	R50OUL		;LOOP
	HLRZ	T2,(P)		;GET BACK A DIGIT

R50FIN:	SETZ	T1,		;START WITH A NULL
	CAIL	T2,1		;IN RANGE OF A DIGIT?
	CAILE	T2,12		;WELL?
	SKIPA			;NO
	MOVEI	T1,"0"-1(T2)	;YES, GET ASCII CHAR
	CAIL	T2,13		;IN RANGE OF A LETTER?
	CAILE	T2,44		;WELL?
	SKIPA			;NO
	MOVEI	T1,"A"-13(T2)	;YES, GET ASCII CHAR
	CAIN	T2,45		;PERIOD?
	MOVEI	T1,"."		;YES
	CAIN	T2,46		;DOLLAR SIGN?
	MOVEI	T1,"$"		;YES
	CAIN	T2,47		;PERCENT SIGN?
	MOVEI	T1,"%"		;YES
	XCT	T3		;OUTPUT THE CHAR
	RET			;DONE
FLTOUT:	MOVE	T2,T1		;MOVE TO RIGHT AC
	HRROI	T1,TEMP		;POINT TO STORAGE
	MOVX	T3,FL%ONE+FL%PNT+FL%OVL+2B23+2B29	;GET BITS
	FLOUT			;OUTPUT NUMBER
	 ERJMP	CPOPJ		;FAILED
	STR$	TEMP		;TYPE IT
	RET			;DONE



VEROUT:	MOVE	T4,T1		;SAVE ADDRESS OF VERSION
	MOVE	T1,.NDVER(T4)	;GET VERSION
	CALL	OCTOUT		;OUTPUT IT
	CHI$	"."		;TYPE A DOT
	MOVE	T1,.NDECO(T4)	;GET ECO NUMBER
	CALL	OCTOUT		;OUTPUT IT TOO
	CHI$	"."		;ANOTHER DOT
	MOVE	T1,.NDCST(T4)	;GET CUSTOMER LEVEL
	JRST	OCTOUT		;FINISH WITH IT



PCOUT:	MOVE	T4,T1		;SAVE RIGHT HALF OF PC
	HLRZ	T1,T1		;AND GET LEFT HALF
	ANDI	T1,7777		;KEEP ONLY SECTION NUMBER
	SKIPN	T1		;NONZERO SECTION?
	STR$	[ASCIZ/    /]	;NO, SPACE OVER SOME
	SKIPE	T1		;WELL?
	CALL	OCTSP4		;YES, OUTPUT IT
	MOVS	T1,T4		;GET RIGHT HALF PC READY
				;FALL INTO OUTPUT CODE


OCTSIX:	MOVEI	T3,6		;GET A COUNT
OCTSIL:	SETZ	T2,		;CLEAR NEXT AC
	ROTC	T1,3		;SHIFT NEXT DIGIT IN
	CHI$	"0"(T2)		;OUTPUT IT
	SOJG	T3,OCTSIL	;LOOP OVER ALL DIGITS
	RET			;DONE
SIXRHT:	TRNE	T1,77		;RIGHT JUSTIFIED YET?
	JRST	SIXOUT		;YES, OUTPUT IT
	LSH	T1,-6		;NO, SHIFT OVER
	JUMPN	T1,SIXRHT	;LOOP UNTIL DONE



SIXOUT:	SKIPA	T4,[CHI$ (T1)]	;GET INSTRUCTION TO TYPE TO DPY
SIXOTT:	MOVE	T4,[PBOUT]	;OR INSTRUCTION TO TYPE TO TTY
	MOVE	T2,T1		;MOVE WORD TO BETTER AC
SIXOUL:	JUMPE	T2,CPOPJ	;DONE IF GET A NULL
	SETZ	T3,		;CLEAR NEXT AC
	ROTC	T2,6		;SHIFT IN NEXT CHARACTER
	MOVEI	T1," "(T3)	;CONVERT IT TO ASCII
	XCT	T4		;OUTPUT IT
	JRST	SIXOUL		;LOOP UNTIL DONE



DOCRLF:	CRLF			;TYPE THE CRLF
	RET			;RETURN
	SUBTTL	ROUTINES TO NOECHO AND ECHO THE TERMINAL




;ROUTINES TO TURN OFF OR ON ECHOING FOR THE TERMINAL.



ECHOON:	SKIPA	T3,[TXO	T2,TT%ECO]	;GET INSTRUCTION
ECHOOF:	MOVE	T3,[TXZ	T2,TT%ECO]	;OR OTHER ONE
	MOVEI	T1,.PRIIN	;PRIMARY INPUT
	RFMOD			;READ STATUS OF TERMINAL
	XCT	T3		;TURN ON OR OFF ECHO BIT
	SFMOD			;SET TERMINAL TO NEW STATUS
	RET			;RETURN
	SUBTTL	SUBROUTINE TO DO RESCANNING OF COMMAND LINE




;CALLED AT START OF PROGRAM, TO RESCAN THE INPUT BUFFER AND SEE
;IF WE WERE PROPERLY STARTED.  IF SO, THE REST OF THE BUFFER IS
;LEFT AS THE FIRST INPUT TO BE READ BY THE PROGRAM.




CMDINI:	MOVEI	T1,.RSINI	;GET FUNCTION
	RSCAN			;MAKE THE RESCAN BUFFER AVAILABLE
	 ERJMP	DIE		;FAILED
	MOVEM	T1,TEMP		;SAVE NUMBER OF CHARS AVAILABLE
	MOVE	T2,[POINT 6,MYNAME]	;GET A POINTER READY
	MOVEI	T3,6		;WANT TO READ SIX CHARACTERS


NAMCHK:	SOJL	T3,CPOPJ	;IF FINISHED WITH NAME, ALL DONE
	ILDB	T4,T2		;READ NEXT CHARACTER OF NAME
	JUMPE	T4,CPOPJ	;DONE IF NO MORE TO NAME
	SOSGE	TEMP		;DECREMENT COUNT OF CHARS LEFT
	RET			;NO MORE, THEN NO COMMANDS TO RESCAN
	PBIN			;READ NEXT CHARACTER
	CAIL	T1,"A"+40	;LOWER CASE?
	CAILE	T1,"Z"+40	;WELL?
	SKIPA			;NO
	SUBI	T1,40		;YES, MAKE UPPER CASE
	CAIN	T1," "(T4)	;MATCH HIS TYPEIN?
	JRST	NAMCHK		;YES, CONTINUE LOOKING

LINEAT:	SOSGE	TEMP		;BAD COMMAND, DECREMENT COUNT
	RET			;ALL OF LINE DONE, RETURN
	PBIN			;READ NEXT CHAR
	JRST	LINEAT		;LOOP UNTIL DONE
	SUBTTL	SUBROUTINES TO HANDLE EATING OF LINES




;THIS ROUTINE IS CALLED AFTER THE MAIN HEADER OF A DISPLAY IS TYPED
;OUT, TO TELL DPY HOW MANY LINES OF FOLLOWING OUTPUT ARE TO BE
;THROWN AWAY.  THIS IS DONE TO IMPLEMENT SCROLLING OF THE SCREEN VERY
;EASILY.  NUMBER OF SCREENFULLS TO EAT IS IN LOCATION PAGE.


SETEAT:	LOC$	T1		;READ CURRENT OUTPUT POSITION
	JUMPL	T1,CPOPJ	;IF ALREADY OVERFLOWED, IGNORE IT
	HLRZ	T1,T1		;GET LINE NUMBER FOR NEXT OUTPUT
	MOVE	T2,@DPYTAB+$DPLEN	;GET SIZE OF TERMINAL
	TLNN	R,-1		;IN A HELP DISPLAY, OR ARE WE
	TXNE	F,FR.INF	;SHOWING INFORMATION LINE?
	SUBI	T2,2		;YES, TWO LESS LINES LEFT IN DISPLAY
	SUB	T2,T1		;COMPUTE LINES REMAINING
	AOS	T1,T2		;ADJUST FOR ONE OFF EFFECT
	SUB	T1,OVRLAP	;DIDDLE BY AMOUNT OF DESIRED OVERLAP
	IMUL	T1,PAGE		;MULTIPLY BY PAGE NUMBER
	SKIPGE	T1		;NEGATIVE?
	SETZ	T1,		;YES, RAISE TO ZERO
	TLNE	T1,-1		;OVERFLOWED?
	MOVEI	T1,-1		;YES, MAKE LARGEST VALUE
	HRLI	T1,$SEEAT	;SET UP FUNCTION CODE
	SET$	T1		;TELL DPY HOW MUCH TO IGNORE
	RET			;DONE
	


;ROUTINE TO SEE IF THE SCREEN IS FULL.  USED TO TERMINATE LISTING OF
;DATA WHEN IT WOULD NEVER SHOW TO THE SCREEN.  SKIP RETURN IF SCREEN
;IS NOT YET FULL.  USES AC T1.


FULL:	LOC$	T1		;READ CURRENT POSITION
	JUMPGE	T1,CPOPJ1	;SKIP RETURN IF STILL MORE LINES LEFT
	RET			;ALL FULL, ERROR RETURN



;ROUTINE TO SEE HOW MUCH ROOM IS LEFT ON THE CURRENT LINE.  USED TO
;DETERMINE WHEN A CRLF IS NEEDED BEFORE FURTHER OUTPUT.  COLUMNS LEFT
;IS RETURNED IN AC T1.


LEFT:	LOC$	T1		;READ CURRENT POSITION
	ANDI	T1,-1		;ONLY KEEP THE COLUMN NUMBER
	SUB	T1,@DPYTAB+$DPWID	;SUBTRACT FROM SIZE OF LINE
	MOVN	T1,T1		;GET POSITIVE NUMBER
	RET			;DONE
	SUBTTL	ROUTINE WHICH CHECKS A PROGRAM NAME AGAINST A WILDCARD




;ROUTINE TO CHECK A JOB'S PROGRAM NAME AGAINST ONES SPECIFIED BY THE
;USER TO DECIDE IF THIS USER SHOULD BE SHOWN.  CALLED WITH THE USER'S
;SIXBIT PROGRAM NAME IN T1.  SKIP RETURN IF JOB IS SELECTED.




PRGCMP:	SKIPN	T4,PRGNUM	;ANY PROGRAM NAMES STORED?
	RETSKP			;NO, THEN SHOW EVERYTHING
	IMULI	T4,3		;THERE ARE THREE WORDS FOR EACH NAME
	CALL	SIXASC		;CONVERT THE SIXBIT NAME TO ASCIZ
	HRROI	T3,TEMP		;SET UP POINTER TO TEST NAME

PRCMPL:	SUBI	T4,3		;BACK DOWN BY A PROGRAM NAME
	JUMPL	T4,PRGNOM	;IF NEGATIVE, NO MORE TO CHECK
	MOVS	T1,PRGWLD(T4)	;GET FIRST WORD OF NAME
	CAIN	T1,(ASCII/*/)	;SEE IF IT IS THE TOTAL MATCH WILDCARD
	JRST	PRGMAT		;YES, AUTOMATIC MATCH THEN
	MOVEI	T1,.WLSTR	;GET FUNCTION FOR JSYS
	HRROI	T2,PRGWLD(T4)	;POINT AT WILD STRING
	WILD%			;COMPARE THE STRINGS
	 ERJMP	CPOPJ1		;FAILED, SHOW THE JOB
	TXNE	T1,WL%NOM	;FOUND A MATCH?
	JRST	PRCMPL		;NO, KEEP CHECKING

PRGMAT:	SKIPA	T1,PRGWLD(T4)	;GET CURRENT ENTRY WITH FLAG
PRGNOM:	SETCM	T1,PRGWLD	;OR ORIGINAL ENTRY
	TXNN	T1,1		;WANTED TO SEE THIS PROGRAM?
	AOS	(P)		;YES, SKIP RETURN
	RET			;NOPE
	SUBTTL	ROUTINE WHICH CHECKS USER NAME AGAINST LIST




;ROUTINE TO CHECK A USER NAME AGAINST A LIST OF WILDCARD USER NAMES,
;AND DECIDE WHETHER OR NOT THIS USER IS DESIRED.  CALLED WITH THE
;USER NUMBER IN T1.  SKIP RETURN IF THIS USER IS SELECTED.



USRCMP:	SKIPN	USRLST		;IS ANY LIST SET UP?
	RETSKP			;NO, THEN SHOW ALL JOBS
	MOVEI	T4,USRLST	;SET UP POINTER TO TEST STRINGS
	SKIPN	T2,T1		;MOVE USER NAME TO RIGHT AC
	JRST	NLICHK		;IF NOT LOGGED IN, GO TO SPECIAL ROUTINE
	HRROI	T1,TEMP		;POINT TO TEMPORARY STORAGE
	DIRST			;CONVERT NUMBER INTO USER NAME STRING
	 ERJMP	CPOPJ1		;FAILED, THEN SHOW THE JOB
	HRROI	T3,TEMP		;POINT TO NAME STRING

USRCML:	HRRZ	T4,(T4)		;FOLLOW LINK TO NEXT NAME STRING
	JUMPE	T4,USRNOM	;IF NO MORE, GO RETURN RESULT
	MOVS	T1,1(T4)	;GET FIRST WORD OF NAME STRING
	JUMPE	T1,USRCML	;IF NO STRING, GO TO NEXT ONE
	CAIN	T1,(ASCII/*/)	;SEE IF THIS IS THE TOTAL WILDCARD
	JRST	USRMAT		;YES, AUTOMATIC MATCH THEN
	MOVEI	T1,.WLSTR	;MUST DO JSYS, GET FUNCTION CODE
	HRROI	T2,1(T4)	;GET POINTER TO THIS WILDCARD STRING
	WILD%			;SEE IF THEY MATCH
	 ERJMP	DIE		;FAILED
	TXNE	T1,WL%NOM	;IS NAME MATCHED BY THIS STRING?
	JRST	USRCML		;NO, KEEP SEARCHING

USRMAT:	SKIPA	T1,(T4)		;GET FLAG FROM MATCHING STRING
USRNOM:	SETCM	T1,USERS	;OR GET COMPLIMENT OF FIRST STRING
	JUMPGE	T1,CPOPJ1	;SHOW JOB IF FLAG NOT SET
	RET			;AND DON'T IF SET


;HERE IF USER BEING CHECKED IS NOT LOGGED IN:


NLICHK:	HRRZ	T4,(T4)		;FOLLOW LINK TO NEXT NAME STRING
	JUMPE	T4,USRNOM	;IF NO MORE, RETURN RESULT
	SKIPN	1(T4)		;IS THE TEST STRING NULL?
	JRST	USRMAT		;YES, THEN HAVE A MATCH
	JRST	NLICHK		;NO, KEEP SEARCHING
	SUBTTL	SUBROUTINE TO COPY TEXT INTO SEPARATE BUFFER




;ROUTINE TO COPY TEXT FROM THE COMMAND BUFFER TO THE TXTBUF BUFFER.
;BUFFER MUST BE AT LEAST TXTLEN WORDS IN LENGTH.  ALL TEXT IS COPIED
;UNTIL THE FIRST SPACE, TAB, SLASH, COMMA, OR LINE FEED.  CALL IS:
;
;	CALL	CPYTXT		;COPY STRING
;	 (ERROR RETURN)	;FAILED
;	(GOOD RETURN)		;SUCCEEDED
;
;ON ERROR RETURN, T1 = 0 IF NO TEXT WAS GIVEN, OR NONZERO IF THE
;TEXT BUFFER WAS OVERFLOWED.  ON GOOD RETURN, T1 CONTAINS THE
;FIRST WORD OF THE BUFFER, AND T2 CONTAINS FIRST FREE WORD.
;CALL AT CPYTX1 IF SIZE AND ADDRESS IS NOT THE NORMAL ONE.




CPYTXT:	MOVEI	T2,TXTLEN*5-1	;SET UP SIZE OF AREA
	MOVEI	T1,TXTBUF	;POINT TO NORMAL TEXT BUFFER
CPYTX1:	HRLI	T1,(POINT 7,)	;MAKE A BYTE POINTER
	HRRZ	T3,T1		;REMEMBER ADDRESS OF BUFFER
	SETZM	(T3)		;AND CLEAR FIRST WORD

CPYTXL:	GETCHR			;READ NEXT CHARACTER
	CAIN	C,"V"-100	;QUOTING CHARACTER?
	JRST [	GETCHR		;YES, GET FOLLOWING CHARACTER
		JRST CPYTXY]	;AND USE IT AS IS
	CAIN	C,12		;END OF LINE?
	JRST	CPYTXD		;YES, DONE
	CAIE	C," "		;SPACE?
	CAIN	C,"	"	;OR TAB?
	JRST	CPYTXD		;YES, DONE
	CAIE	C,"/"		;SLASH?
	CAIN	C,","		;OR COMMA?
	JRST	CPYTXD		;YES, DONE
CPYTXY:	IDPB	C,T1		;STORE THIS CHAR
	SOJGE	T2,CPYTXL	;IF MORE ROOM, GET ANOTHER CHAR
	RET			;OTHERWISE RETURN ERROR


CPYTXD:	RESCAN			;REREAD TERMINATING CHARACTER
	SETZ	T2,		;GET A NULL
	IDPB	T2,T1		;MAKE THE STRING ASCIZ
	MOVEI	T2,1(T1)	;REMEMBER FIRST FREE WORD
	SKIPE	T1,(T3)		;ANY TEXT STORED?
	AOS	(P)		;YES, GOOD RETURN
	RET			;DONE
	SUBTTL	SUBROUTINE TO CONVERT SIXBIT WORD INTO ASCIZ





;CALLED WITH A SIXBIT QUANTITY IN AC1, TO STORE IN LOCATION TEMP AND
;TEMP+1 THE ASCIZ TEXT FOR THAT WORD.  USES ALL TEMP AC'S.
;ON RETURN, AC T1 IS READY TO APPEND MORE CHARACTERS TO THE STRING.



SIXASC:	SETZM	TEMP		;CLEAR WORDS FIRST
	SETZM	TEMP+1		;TO GUARANTEE A NULL EXISTS
	MOVE	T2,T1		;MOVE WORD TO BETTER AC
	MOVE	T1,[POINT 7,TEMP]	;GET READY

SIXASL:	JUMPE	T2,CPOPJ	;DONE IF WORD IS ZERO
	SETZ	T3,		;CLEAR NEXT AC
	ROTC	T2,6		;GET NEXT CHARACTER
	ADDI	T3," "		;CONVERT TO ASCII
	IDPB	T3,T1		;STORE AWAY
	JRST	SIXASL		;LOOP UNTIL DONE
	SUBTTL	SUBROUTINE TO CONVERT OCTAL VALUE TO SYMBOLS




;CALLED WITH AN OCTAL VALUE IN AC T1, TO OBTAIN THE RADIX50 SYMBOL
;AND OFFSET FOR THE VALUE.  THIS REQUIRES PRIVILEGES TO WORK.
;TO SAVE TIME, WE FIRST TRY TO FIND THE SYMBOL IN OUR OWN LOCAL
;SYMBOL TABLE.  RETURNS SYMBOL IN T1 AND OFFSET IN T2.



CVTSYM:	HRLZ	T4,MONSYC	;GET CURRENT COUNT OF SYMBOLS
	JUMPE	T4,SYMSNP	;IF NONE, GO SNOOP
	MOVN	T4,T4		;GET READY FOR A SEARCH
	CAME	T1,MONSYV(T4)	;FOUND THE VALUE IN TABLE?
	AOBJN	T4,.-1		;NO, KEEP LOOKING
	JUMPGE	T4,SYMSNP	;NOT IN TABLE, GO SNOOP IT
	MOVE	T1,MONSYS(T4)	;FOUND IT, GET THE SYMBOL NAME
	MOVE	T2,MONSYO(T4)	;AND THE OFFSET
	RET			;DONE


SYMSNP:	MOVEM	T1,TEMP		;SAVE FOR AWHILE
	CAIL	T4,MAXSYM	;IS THE SYMBOL TABLE FULL?
	JRST	SYMLOS		;YES, JUST RETURN OCTAL
	MOVEI	T1,.SNPAD	;FUNCTION TO FIND A SYMBOL
	MOVE	T2,TEMP		;VALUE TO FIND
	SETZ	T3,		;GLOBAL SEARCH
	SNOOP			;LOOK FOR IT
	 ERJMP	SYMLOS		;FAILED, RETURN OCTAL
	MOVE	T1,T2		;MOVE SYMBOL TO RIGHT AC
	MOVE	T2,T3		;AND OFFSET
	MOVEM	T1,MONSYS(T4)	;STORE THE SYMBOL NAME
	MOVEM	T2,MONSYO(T4)	;AND THE OFFSET
	MOVE	T3,TEMP		;GET VALUE WE FOUND
	MOVEM	T3,MONSYV(T4)	;SAVE IT
	AOS	MONSYC		;INCREMENT NUMBER OF SYMBOLS IN TABLE
	RET			;DONE


SYMLOS:	SETZ	T1,		;SAY NO SYMBOL KNOWN
	MOVE	T2,TEMP		;GET ORIGINAL VALUE
	RET			;DONE
	SUBTTL	ERROR TYPEOUT



;HERE TO TYPE ERRORS.  THE DIE ROUTINE STOPS PERMANENTLY.
;THE LOSE ROUTINE OUTPUTS THE ERROR MESSAGE TO DPY, AND DOESN'T
;STOP THE PROGRAM.



TOOMNY:	HRROI	T1,[ASCIZ/
? Tables too small for jobs on system, reassemble with larger MAXJOB
/]				;GET STRING
	PSOUT			;OUTPUT IT
	HALTF			;QUIT
	JRST	.-1		;STAY THAT WAY



DIE:	MOVEI	T1,.PRIOU	;OUTPUT STRAIGHT TO TERMINAL
	CALL	GIVERR		;TYPE THE LAST ERROR
	HALTF			;QUIT
	JRST	.-1		;STAY THAT WAY


LOSE:	HRROI	T1,TEMP		;POINT TO BUFFER
	CALL	GIVERR		;STORE THE ERROR MESSAGE
	STR$	TEMP		;OUTPUT IT
	RET			;DONE



GIVERR:	HRROI	T2,[ASCIZ/
? /]				;GET START OF ERROR
	SETZ	T3,		;CLEAR
	SOUT			;START STRING
	HRLOI	T2,.FHSLF	;LAST ERROR IN MY PROCESS
	MOVEI	T3,TMPSIZ*5-12	;GET MAXIMUM NUMBER OF CHARS
	ERSTR			;TYPE ERROR
	 JFCL			;IGNORE ERRORS
	 JFCL
	HRROI	T2,[ASCIZ/
/]				;GET A FINAL CRLF
	SETZ	T3,		;WHOLE STRING
	SOUT			;OUTPUT IT
	RET			;DONE
	SUBTTL	SUBROUTINE TO SEE IF MONRD% JSYS EXISTS



;THIS SUBROUTINE IS CALLED TO TRY OUT THE MONRD% JSYS TO SEE IF IT
;WORKS.  IF IT DOES NOT, WE TRY TO PUT IT INTO THE RUNNING MONITOR.
;THEN WE TRY IT AGAIN.  FLAG FR.JSY IS SET IF IT WORKS CORRECTLY.
;ALWAYS RETURNS RIGHT AFTER CALL.




JSYTST:	MOVEI	T1,.RDTST	;GET TEST FUNCTION
	SETZ	T2,		;CLEAR AC
	MONRD%			;TRY THE JSYS OUT
	 ERJMP	JSYINI		;FAILED, GO TRY TO PUT IT IN
	CAIN	T2,.TSTNY	;ABLE TO USE THE JSYS?
	JRST	SYMRED		;YES, GO COLLECT SYMBOLS
	CAIN	T2,.TSTNN	;TOLD WE AREN'T GOOD ENOUGH?
	RET			;YES, RETURN GRACEFULLY
	IERR	Wrong value returned from test function of "MONRD%" JSYS



;HERE WHEN THE MONRD% JSYS FAILS, TRY TO INSERT IT:


JSYINI:	CALL	MKJSYS		;TRY TO IMPLEMENT THE JSYS NOW
	 RET			;FAILED, ERROR MESSAGE ALREADY GIVEN
	MOVEI	T1,.RDTST	;GET TEST FUNCTION AGAIN
	SETZ	T2,		;CLEAR OTHER AC
	MONRD%			;TRY IT AGAIN NOW
	 ERJMP	[IERR	"MONRD%" JSYS not inserted (not enough free core)]
	CAIE	T2,.TSTNY	;GET THE PROPER NUMBER?
	IERR	"MONRD%" JSYS inserted but test function returns wrong value


SYMRED:	MOVSI	T4,-SYMCNT	;GET NUMBER OF SYMBOLS TO FIND OUT
SYMRDL:	MOVEI	T1,.RDSYM	;FUNCTION TO READ A SYMBOL VALUE
	MOVE	T2,SYMTAB(T4)	;GET SYMBOL TO FIND OUT
	MONRD%			;GET THE VALUE
	 ERJMP	NOMONS		;FAILED, GO SAY WHY
	JUMPN	T1,NOMONS	;ALSO FAILED
	MOVEM	T2,SYMVAL(T4)	;SAVE THE VALUE FOR LATER
	AOBJN	T4,SYMRDL	;LOOP OVER ALL SYMBOLS
	TXO	F,FR.JSY	;CAN USE JSYS NOW
	RET			;RETURN
;HERE FOR ERRORS IN SNOOPING OR USING MONRD%.  THESE ROUTINES ARE
;CALLED BY THE IERR AND SERR MACROS.  AN ERROR MESSAGE IS TYPED, AND
;THEN WE SLEEP FOR A FEW SECONDS TO GIVE TIME FOR THE TEXT TO BE READ.




NOMONS:	HRROI	T1,[ASCIZ/
? "MONRD%" JSYS failed to find the value of /]
	PSOUT			;START OFF ERROR MESSAGE
	MOVE	T1,SYMTAB(T4)	;GET THE SYMBOL NAME IN SIXBIT
	CALL	SIXOTT		;OUTPUT IT TO THE TERMINAL
	HRROI	T1,[ASCIZ/
/]				;GET A FINAL CRLF
	JRST	IERRTP		;AND FINISH THE OUTPUT




SERRTP:	PSOUT			;OUTPUT STRING
	MOVEI	T1,.PRIOU	;PRIMARY OUTPUT
	HRLOI	T2,.FHSLF	;LAST ERROR IN MY FORK
	SETZ	T3,		;INFINITE OUTPUT
	ERSTR			;DO IT
	 JFCL			;IGNORE ERRORS
	 JFCL
	SKIPA			;SKIP
IERRTP:	PSOUT			;OUTPUT THE ERROR MESSAGE
	MOVEI	T1,^D5000	;GET A TIME
	TXNN	F,FR.INS	;JUST INSERTING JSYS?
	DISMS			;NO, SLEEP SOME SO HE CAN READ ERROR
	RET			;THEN RETURN
	SUBTTL	ROUTINE TO "IMPLEMENT" USEFUL JSYS FOR SYSDPY


;ROUTINE TO IMPLEMENT THE MONRD% JSYS BY SNOOPING.  IT IS ONLY
;NECESSARY TO HAVE A PRIVILEGED USER DO THIS ONCE, THEREAFTER ANYONE
;CAN USE THE JSYS TO READ INFORMATION.  SKIP RETURN IF SUCCESSFUL.


MKJSYS:	MOVEI	T1,.FHSLF	;GET READY
	RPCAP			;READ MY CAPABILITIES
	TXNN	T3,SC%WHL!SC%OPR	;SEE IF I CAN SNOOP
	RET			;NO, RETURN WITHOUT COMPLAINING
	AOS	T1,VIRGIN	;BUMP COUNT OF TIMES WE GOT HERE
	CAIE	T1,1		;BETTER BE FIRST TIME
	IERR	Initialization code is runnable only once
	HRROI	T1,[ASCIZ/
Attempting to insert "MONRD%" JSYS by snooping.../]
	TXNN	F,FR.INS	;SKIP MESSAGE IF SPECIAL ENTRY
	PSOUT			;SAY WE ARE DOING THE WORK
	MOVEI	T1,.SNPSY	;FUNCTION TO GET A SYMBOL
	MOVE	T2,[RADIX50 0,.SNOOP]	;GET SYMBOL WE WANT
	MOVE	T3,[RADIX50 0,JSYSA]	;PROGRAM NAME
	SNOOP			;FIND ITS VALUE
	 SERR	SNOOP failed to get .SNOOP value
	MOVEM	T2,SNPVAL	;SAVE THE VALUE
	CALL	GETSYM		;FIX UP ALL CODE WITH SYMBOLS
	 RET			;ERROR, MESSAGE ALREADY GIVEN
	MOVEI	T1,.SNPLC	;GET FUNCTION TO LOCK PAGES
	MOVEI	T2,1		;ONE PAGE
	MOVEI	T3,SNPLOC/1000	;PAGE NUMBER TO BE LOCKED
	SNOOP			;DO IT
	 SERR	SNOOP failed to lock page
	IMULI	T2,1000		;TURN MONITOR PAGE INTO ADDRESS
	MOVEM	T2,MONADR	;SAVE IT
	MOVEI	T1,.SNPDB	;GET READY TO DEFINE A BREAKPOINT
	MOVEI	T2,0		;BREAKPOINT NUMBER 0
	MOVE	T3,SNPVAL	;GET ADDRESS TO BE PATCHED
	MOVSI	T4,(<CALL>)	;GET INSTRUCTION TO CALL US BY
	HRR	T4,MONADR	;INSERT ADDRESS
	SNOOP			;DEFINE THE BREAKPOINT
	 JRST	[CALL	SNPFIN	;FAILED, UNDO SNOOP
		SERR	SNOOP failed to define breakpoint]
	MOVEI	T1,.SNPIB	;FUNCTION TO PUT IN BREAKPOINT
	SNOOP			;PUT IT IN
	 JRST	[CALL	SNPFIN	;FAILED, UNDO SNOOP
		SERR	SNOOP failed to insert breakpoint]
	AOS	(P)		;INSERTED PROPERLY, SET UP FOR SKIP


SNPFIN:	MOVEI	T1,.SNPUL	;FUNCTION TO UNDO EVERYTHING
	SNOOP			;UNDO SNOOPING (AND INSTALL JSYS!!)
	 JFCL			;OH WELL
	RET			;ALL DONE
	SUBTTL	SUBROUTINE TO FILL IN SYMBOL VALUES



;SUBROUTINE TO FILL IN THE VALUES OF ALL MONITOR SYMBOLS REFERENCED
;BY THE $$ MACRO.  THIS IS DONE BY SCANNING THE SYMS TABLE, WHICH HAS
;BLOCKS OF DATA IN THE FOLLOWING FORMAT:
;
;	WORD 0		THE ADDRESS WHERE THE SYMBOL VALUE IS NEEDED.
;	WORD 1		THE SYMBOL NAME IN RADIX50.
;	WORD 2		THE PROGRAM MODULE NAME IN RADIX50.
;	WORD 3		ADDRESS TO SET NONZERO IF SYMBOL ISN'T FOUND.
;
;SKIP RETURN IF SUCCESSFULLY FOUND ALL SYMBOLS.




GETSYM:	MOVSI	J,-SYMNUM	;SET UP AOBJN LOOP OVER SYMBOL TABLE

GETSYL:	SKIPN	T2,SYMS+1(J)	;IS THIS A NEW SYMBOL TO FIND?
	JRST	GETSYX		;NO, LOOK AT NEXT ONE
	MOVE	T3,SYMS+2(J)	;GET PROGRAM NAME
	MOVEI	T1,.SNPSY	;FUNCTION TO LOOKUP A SYMBOL
	SNOOP			;ASK MONITOR FOR VALUE
	 JRST	UNKSYM		;FAILED, GO HANDLE IT
	MOVE	T1,SYMS+1(J)	;GET SYMBOL NAME AGAIN
	MOVE	T3,J		;COPY AOBJN POINTER FOR SEARCH

GETSIL:	CAME	T1,SYMS+1(T3)	;IS THIS SYMBOL THE DESIRED ONE?
	JRST	GETSIX		;NO, KEEP SEARCHING
	MOVE	T4,@SYMS(T3)	;YES, GET INSTRUCTION THERE
	ADD	T4,T2		;ADD IN THE SYMBOL VALUE
	TLNN	T4,-1		;IS LEFT HALF ZERO?
	MOVEM	T4,@SYMS(T3)	;YES, REPLACE WHOLE VALUE
	TLNE	T4,-1		;IS IT NONZERO?
	HRRM	T4,@SYMS(T3)	;YES, ONLY REPLACE RIGHT HALF
	SETZM	SYMS+1(T3)	;DONE WITH THIS USE OF THIS SYMBOL
GETSIX:	ADDI	T3,3		;MOVE TO NEXT FOUR-WORD BLOCK
	AOBJN	T3,GETSIL	;SEARCH ALL OF REST OF TABLE

GETSYX:	ADDI	J,3		;MOVE TO NEXT SYMBOL BLOCK
	AOBJN	J,GETSYL	;CONTINUE SEARCH FOR MORE NEW SYMBOLS
	RETSKP			;HAVE THEM ALL
;HERE IF WE FAILED TO FIND A SYMBOL VALUE, TO TYPE OUT THE NAME
;OF THE SYMBOL SO THAT THE PROBLEM CAN EASILY BE FIXED.  IF THIS
;SYMBOL IS ALLOWED TO BE UNKNOWN, WE JUST REMEMBER THAT.




UNKSYM:	SKIPE	T1,SYMS+3(J)	;ARE WE ALLOWED TO NOT KNOW THIS SYMBOL?
	JRST	[SETOM	(T1)	;YES, SET FLAG SAYING WE FAILED
		 JRST	GETSYX]	;AND GO BACK TO THE LOOP
	HRROI	T1,[ASCIZ/
? SNOOP failed to find value of /]	;GET READY
	PSOUT			;TYPE THE INITIAL STRING
	MOVE	T1,SYMS+1(J)	;GET THE SYMBOL
	CALL	R50OTT		;OUTPUT TO TERMINAL
	SKIPN	SYMS+2(J)	;ANY PROGRAM NAME?
	JRST	UNKSYF		;NO, SKIP ON
	HRROI	T1,[ASCIZ/ in module /]	;YES, SAY SO
	PSOUT			;OUTPUT IT
	MOVE	T1,SYMS+2(J)	;GET PROGRAM NAME
	CALL	R50OTT		;OUTPUT THAT TOO

UNKSYF:	HRROI	T1,[ASCIZ/:
  /]				;GET THE REST OF THE STRING
	JRST	SERRTP		;GO OUTPUT IT AND THE ERROR REASON
	SUBTTL	SNOOP CODE



;THE FOLLOWING INSTRUCTIONS ARE EXECUTED BY THE MONITOR TO IMPLEMENT
;A JSYS WHICH WILL READ ANOTHER JOB'S JSB OR PSB.  THIS CODE IS
;SELF-RELOCATABLE.  THIS IS CALLED FROM THE BEGINNING OF A SNOOP JSYS.


	XLIST			;DUMP ANY LITERALS FIRST
	LIT
	LIST

SYMS:				;SYMBOLS GET DUMPED HERE
	LOC	SNPLOC		;ACTUAL CODE GOES IN HIGH CORE



SNOPCD:	MOVSI	P2,(<JRST (P1)>)	;PUT INSTRUCTION IN P2
	JSP	P1,P2		;JUMP TO IT AND PUT PC INTO P1
	SUBI	P1,.		;RELOCATE THE CODE
	JSP	CX,$$(SAVT,APRSRV)	;SAVE AC'S SNOOP WANTS TO USE
	NOINT			;DON'T ALLOW US TO BE STOPPED
	MOVEI	T1,$$(JSTAB,LDINIT)	;GET ADDRESS OF JSYS TABLE
	HRRZ	T1,JSYNUM(T1)	;GET INSTRUCTION FOR OUR JSYS
	CAIN	T1,$$(UJSYS,SCHED)	;ALREADY BEEN DIDDLED?
	AOSE	ONCE(P1)	;OR ALREADY ENTERED THIS CODE?
	JRST	INSDON(P1)	;YES, DO NOTHING
	CALL	$$(LGTAD,TIMER)	;GET CURRENT TIME
	MOVEM	T1,POKTIM(P1)	;SAVE IT
	MOVE	T1,$$(JOBNO,STG)	;GET MY JOB NUMBER
	<HRL	T1,(T1)>+$$(JOBDIR,STG)	;AND MY USER NUMBER
	MOVEM	T1,POKWHO(P1)	;SAVE IT
	MOVEI	T1,JSYLEN+1	;GET NUMBER OF WORDS WANTED
	CALL	$$(ASGSWP,FREE)	;ALLOCATE FREE CORE
	 JRST	INSDON(P1)	;CAN'T GET IT
	AOS	P2,T1		;OK,  SAVE ADDRESS OF WHERE JSYS BEGINS
	HRLI	T1,.MONRD(P1)	;GET ADDRESS OF CODE TO COPY
	MOVEI	T2,JSYLEN-1(T1)	;GET ADDRESS OF LAST LOC TO COPY TO
	BLT	T1,(T2)		;COPY CODE INTO FREE CORE
	CALL	$$(SWPMWE,PAGEM)	;WRITE ENABLE THE MONITOR
	MOVEI	T1,$$(JSTAB,LDINIT)	;GET ADDRESS OF START OF JSYS TABLE
	HRRM	P2,JSYNUM(T1)	;SETUP DISPATCH ADDRESS
	CALL	$$(SWPMWP,PAGEM)	;WRITE PROTECT MONITOR AGAIN

INSDON:	OKINT			;ALLOW INTERRUPTS AGAIN
	RET			;RETURN

ONCE:	EXP	-1		;ONCE-ONLY FLAG

	LIT			;DUMP LITERALS NOW
	SUBTTL	THE MONRD% JSYS




;THE FOLLOWING CODE IS THE JSYS INSTALLED INTO THE RUNNING MONITOR.
;ITS FUNCTION IS TO RETURN INFORMATION NEEDED BY THIS PROGRAM.
;THE CALL IS:
;
;	MOVEI	T1,FUNCTION	;GET FUNCTION CODE
;	(ARGUMENTS IN T2-T4)	;AND POSSIBLE ARGUMENTS
;	MONRD%			;DO THE JSYS
;	 ERJMP	LOSE		;FAIL IF NOT IMPLEMENTED
;	JUMPN	T1,ERROR	;AC IS NONZERO IF FUNCTION FAILED
;				;DONE, ANY VALUE RETURNED IN T2



;FUNCTIONS AND CONSTANTS:


	.RDTST==0		;TEST FUNCTION
	.RDSYM==1		;READ SYMBOL FUNCTION
	.RDJSB==2		;READ FROM JSB
	.RDPSB==3		;READ FROM PSB
	.RDSTS==4		;READ FORK STATUS
	.RDMAP==5		;READ WORDS FROM FORK PAGE MAP
	.RDFST==6		;READ FKSTAT WORD
	.RDPID==7		;READ WORD FROM IPCF HEADER
	.RDDLL==10		;READ DECNET LOGICAL LINK DATA
	.RDTTY==11		;READ WORD FROM TERMINAL DATABASE
	.RDTTS==12		;READ TTSTAT WORD FOR TERMINAL
	.RDWSP==13		;READ FKWSP WORD
	.RDRES==14		;READ STATUS OF SYSTEM RESOURCES

	.TSTNY==123456		;VALUE RETURNED FROM TEST FUNCTION
	.TSTNN==654321		;VALUE RETURNED IF NOT ALLOWED TO DO IT
;THE ACTUAL JSYS CODE:



.MONRD:	MOVSI	P2,(<JRST (P1)>)	;SETUP RETURN INSTRUCTION
	JSP	P1,P2		;PUT PC IN P1 AND RETURN
	SUBI	P1,.		;RELOCATE IT
	NOINT			;DISALLOW INTERRUPTS

IFN FTPRIV,<
	MOVE	P2,$$(CAPENB,STG)	;GET HIS CAPABILITIES
	TXNN	P2,SC%WHL!SC%OPR	;ALLOWED TO DO THIS JSYS?
	JUMPN	T1,ERROR(P1)	;NO, ERROR UNLESS FUNCTION 0
>
	SKIPL	T1		;SEE IF HAVE LEGAL FUNCTION
	CAILE	T1,.RDMAX	;WELL?
	JRST	ERROR(P1)	;NO, GO LOSE
	ADD	T1,P1		;RELOCATE THE ADDRESS
	CALL	@MONRDT(T1)	;CALL THE SUBROUTINE
	 JRST	ERROR(P1)	;FAILED

	XCTU	[MOVEM P2,2](P1)	;STORE RETURNED VALUE
	TDZA	T1,T1		;CLEAR AC
ERROR:	SETO	T1,		;OR SET AC NONZERO
	XCTU	[MOVEM T1,1](P1)	;STORE SUCCESS FLAG
	OKINT			;ALLOW INTERRUPTS AGAIN
	JRST	$$(MRETN,SCHED)	;RETURN FROM JSYS



MONRDT:	IFIW	TSTFNC(P1)	;TEST EXISTANCE OF JSYS
	IFIW	SYMFNC(P1)	;READ VALUE OF SYMBOL
	IFIW	JSBFNC(P1)	;READ WORD FROM JSB
	IFIW	PSBFNC(P1)	;READ WORD FROM PSB
	IFIW	STSFNC(P1)	;GET FORK STATUS
	IFIW	MAPFNC(P1)	;READ ACCESS OF CORE PAGE
	IFIW	FSTFNC(P1)	;RETURN FKSTAT WORD
	IFIW	IPCFNC(P1)	;RETURN WORD FROM PID HEADER
	IFIW	DLLFNC(P1)	;DUMP LL BLOCKS FOR DECNET
	IFIW	TTYFNC(P1)	;RETURN WORD FROM TERMINAL BLOCKS
	IFIW	TTSFNC(P1)	;RETURN THE TTSTAT WORD
	IFIW	WSPFNC(P1)	;RETURN FKWSP WORD
	IFIW	RESFNC(P1)	;RETURN RESOURCE INFORMATION

	.RDMAX==.-MONRDT-1	;HIGHEST LEGAL FUNCTION


POKTIM:	EXP	0		;TIME AT WHICH JSYS WAS INSTALLED
POKWHO:	EXP	0		;USER NUMBER AND JOB NUMBER WHICH DID IT
;TEST FUNCTION.  USED TO SEE IF JSYS IS IMPLEMENTED.  NO ARGUMENTS.
;RETURNS IN T2 THE NUMBER .TSTN?, IN T3 THE TIME THE JSYS WAS PUT IN,
;AND IN T4 THE USER NUMBER AND JOB NUMBER WHICH DID IT.




TSTFNC:	DMOVE	T1,POKTIM(P1)	;GET THE TIME AND WHO PUT IN JSYS
	XCTU	[DMOVEM T1,3](P1)	;STORE IN USER'S AC
	MOVEI	P2,.TSTNY	;GET TEST NUMBER TO BE RETURNED

IFN FTPRIV,<
	MOVE	T1,$$(CAPENB,STG)	;GET PRIVILEGES
	TXNN	T1,SC%WHL!SC%OPR	;ABLE TO DO THE OTHER FUNCTIONS?
	MOVEI	P2,.TSTNN	;NO, GET FAILURE CODE
>
SKP:	AOS	(P)		;SET UP FOR SKIP RETURN
RET:	RET			;DO IT






;LOOKUP SYMBOL VALUE FUNCTION.  T2 = SIXBIT OF SYMBOL TO LOOK UP.
;RETURNS VALUE IN T2.


SYMFNC:	CALL	SYMSR0(P1)	;LOOK FOR THE SYMBOL
	 RET			;FAILED
	JRST	SKP(P1)		;GOOD RETURN






;GET STATUS OF FORK FUNCTION.  T2 = SYSTEM FORK NUMBER.
;RETURNS STATUS WORD (SAME AS .RFSTS) IN T2.


STSFNC:	MOVE	T1,T2		;PUT FORK NUMBER IN RIGHT AC
	MOVE	FX,T2		;AND IN OTHER AC
	CALL	CHKFRK(P1)	;SEE IF THE FORK IS THERE
	 RET			;NO, ERROR RETURN
	CALL	$$(MRFSTS,FORK)	;OK, READ FORK STATUS
	OKSKED			;ALLOW SCHEDULING NOW
	MOVE	P2,T1		;COPY STATUS
	JRST	SKP(P1)		;GOOD RETURN
;GET FKSTAT OR FKWSP WORD FOR FORK.  T2 = SYSTEM FORK NUMBER.  RETURNS
;WORD IN T2.


WSPFNC:	SKIPA	P2,WSPLOC(P1)	;GET ADDRESS OF WORKING SET TABLE
FSTFNC:	MOVEI	P2,$$(FKSTAT,STG)	;OR ADDRESS OF SCHEDULER TEST TABLE
	SKIPL	T2		;VERIFY FORK NUMBER
	CAIL	T2,$$(NFKS,STG)	;SOME MORE
	RET			;BAD
	ADD	P2,T2		;ADD IN OFFSET INTO TABLE
	MOVE	P2,(P2)		;GET WORD
	JRST	SKP(P1)		;GOOD RETURN

WSPLOC:	EXP	$$(FKWSP,STG)	;ADDRESS OF WORKING SET TABLE




;GET WORD FROM TTACTL DATA FOR TERMINALS.  T2 = SYMBOL IN BLOCK,
;T3 = OFFSET FROM SYMBOL, T4 = TERMINAL NUMBER.  RETURNS WORD IN T2.


TTYFNC:	MOVEI	T1,$$(TTDDLN,TTYSRV)	;GET LENGTH OF TERMINAL BLOCKS
	SUBI	T1,1		;BACK OFF ONE
	CALL	SYMSRC(P1)	;LOOK FOR THE SYMBOL
	 RET			;UNKNOWN SYMBOL
	XCTU	[SKIPL T1,4](P1)	;GET TERMINAL NUMBER
	CAIL	T1,$$(NLINES,STG)	;AND RANGE CHECK IT
	RET			;OUT OF RANGE
	<SKIPG	T1,(T1)>+$$(TTACTL,STG)	;GET POINTER TO DATA BLOCK
	 RET			;NOT ASSIGNED
	ADD	P2,T1		;ADD ADDRESS INTO OFFSET
	MOVE	P2,(P2)		;GET THE REQUIRED WORD
	JRST	SKP(P1)		;DONE




;GET THE WORD FROM TTSTAT FOR A TTY LINE.  AC T2 HAS THE LINE NUMBER.
;RETURNS THE WORD IN T2.


TTSFNC:	SKIPL	T2		;RANGE CHECK THE DATA
	CAIL	T2,$$(NLINES,STG)	;SOME MORE
	RET			;ITS BAD
	<MOVE	P2,(T2)>+$$(TTSTAT,STG)	;GET THE WORD
	JRST	SKP(P1)		;GOOD RETURN
;GET WORD FROM JSB FUNCTION.  T2 = SYMBOL IN JSB, T3 = OFFSET FROM SYMBOL,
;T4 = JOB NUMBER.  RETURNS WORD FROM JSB IN AC T2.
;THE JSB AREA STARTS AT LOCATION JSB, AND EXTENDS UP TO THE PAGE PPMPG.



JSBFNC:	MOVEI	T1,$$(JSVARZ,POSTLD)	;GET LAST ADDRESS IN JSB
	HRLI	T1,$$(JSVAR,JOBDAT)	;AND PUT IN LOWEST JSB ADDRESS
	CALL	SYMSRC(P1)	;LOOK FOR THE SYMBOL
	 RET			;FAILED, RETURN
	XCTU	[SKIPL T1,4](P1)	;GET JOB AND SEE IF NONNEGATIVE
	CAIL	T1,$$(NJOBS,STG)	;AND SEE IF NOT TOO LARGE
	RET			;NO, ERROR RETURN
	NOSKED			;STOP SCHEDULING NOW
	<SKIPGE	0(T1)>+$$(JOBRT,STG)	;IS THIS JOB NUMBER ASSIGNED?
	JRST	SKDRET(P1)	;NO, GO ERROR RETURN
	<HRRZ 	T1,0(T1)>+$$(JOBPT,STG)	;GET TOP FORK OF THE JOB
	<HRLZ	T1,0(T1)>+$$(FKJOB,STG)	;THEN GET SPT INDEX OF JSB
	MOVE	T2,P2		;GET ADDRESS
	SUBI	T2,$$(JSVAR,JOBDAT)	;SUBTRACT BASE ADDRESS
	LSH	T2,-^D9		;GET PAGE NUMBER INTO JSB
	HRR	T1,T2		;PUT THAT INTO T1
	PUSH	P,T1		;SAVE PAGE IDENT FOR LATER
	CALL	$$(MRPACS,PAGEM)	;READ ACCESSIBILITY OF PAGE
	JUMPE	T1,JSBZER(P1)	;NO PAGE, GO RETURN ZERO
	POP	P,T1		;PAGE IS THERE, RESTORE IDENT
	MOVEI	T2,$$(FPG1A,STG)	;GET ADDRESS OF TEMPORARY PAGE
	CALL	$$(SETMPG,PAGEM)	;MAP THE PAGE OF THE JSB
	NOINT			;MATCH OKINT DONE BY CLRJSB
	ANDI	P2,777		;ONLY KEEP OFFSET INTO PAGE NOW
	<MOVE	P2,0(P2)>+$$(FPG1A,STG)	;GET THE WORD FROM THE JSB
OKSKP:	CALL	$$(CLRJSB,FORK)	;UNMAP THE TEMPORARY PAGE
	OKSKED			;CAN SCHEDULE AGAIN NOW
	JRST	SKP(P1)		;GOOD RETURN


JSBZER:	OKSKED			;ALLOW SCHEDULING
	POP	P,T1		;POP OFF AC
	SETZ	P2,		;MAKE A ZERO RESULT
	JRST	SKP(P1)		;GOOD RETURN
;READ WORD OF PSB FUNCTION.  T2 = SYMBOL NAME, T3 = OFFSET FROM SYMBOL,
;T4 = SYSTEM FORK NUMBER.  RETURNS WORD OF PSB IN T2.
;WE ONLY PROVIDE FOR THE READING OF THE TWO IMPORTANT PAGES.



PSBFNC:	MOVEI	T1,$$(PSBPGA,STG)	;GET LOWER BOUND ON SYMBOL
	HRLI	T1,1777(T1)	;CREATE UPPER BOUND
	MOVS	T1,T1		;AND REVERSE TO MAKE CORRECT
	CALL	SYMSRC(P1)	;LOOK FOR HIS SYMBOL
	 RET			;NOT FOUND
	XCTU	[MOVE T1,4](P1)	;GET THE FORK NUMBER
	CALL	CHKFRK(P1)	;SEE IF FORK IS OK TO LOOK AT
	 RET			;NO, ERROR
	CALL	$$(SETLF3,FORK)	;FORK IS THERE, MAP THE PSB
	OKSKED			;THEN ALLOW SCHEDULING
	ADD	P2,T1		;RELOCATE WORD TO BE READ
	MOVE	P2,(P2)		;GET THE WORD
	CALL	$$(CLRJSB,FORK)	;UNMAP THE JSB OR PSB NOW
	JRST	SKP(P1)		;GOOD RETURN





;READ A WORD FROM THE HEADER BLOCK OF A PID.  T2 = PID TO READ,
;T3 = OFFSET INTO HEADER.  RETURNS WORD IN T2.



IPCFNC:	SKIPL	P2,T3		;VALIDATE THE HEADER OFFSET
	CAIL	P2,$$(PIDHDS,STG)	;AND SAVE IN GOOD AC
	RET			;BAD OFFSET
	MOVE	T1,T2		;MOVE PID TO RIGHT AC
	CALL	$$(VALPID,IPCF)	;VALIDATE THE PID NUMBER
	 RET			;BAD, RETURN
	ADD	P2,T2		;ADD ADDRESS OF HEADER TO OFFSET
	MOVE	P2,(P2)		;GET THE WORD
	JRST	SKP(P1)		;GOOD RETURN
;READ ACCESS OF A USER CORE PAGE.  T2 = PAGE NUMBER TO BE EXAMINED,
;T3 = SYSTEM FORK NUMBER.  RETURNS PAGE POINTER IN T2, IN THE FOLLOWING
;FORMAT:
;
;	0		THIS PAGE AND ALL FURTHER PAGES ARE NONEXISTANT
;	0,,N		THIS PAGE NONEXISTANT, NEXT EXISTANT PAGE IS N
;	1XXXXX,,XXXXXX	PRIVATE PAGE
;	2XXXXX,,FORK	SHARED PAGE WITH GIVEN SYSTEM FORK INDEX
;	2XXXXX,,-OFN	SHARED PAGE WITH GIVEN FILE OFN
;	3XXXXX,,FORK	INDIRECT PAGE WITH GIVEN FORK INDEX
;	3XXXXX,,-OFN	INDIRECT PAGE WITH GIVEN FILE OFN



MAPFNC:	MOVE	P2,T2		;SAVE PAGE NUMBER IN SAFE PLACE
	MOVE	T1,T3		;GET SYSTEM FORK NUMBER IN RIGHT AC
	TDNN	P2,[-1,,777000](P1)	;VALIDATE PAGE NUMBER
	CALL	CHKFRK(P1)	;AND VALIDATE FORK NUMBER
	 RET			;BAD, ERROR RETURN
	<HLRZ	T1,(T1)>+$$(FKPGS,STG)	;GET SPT INDEX OF PAGE TABLE
	MOVEI	T2,$$(FPG1A,STG)	;AND ADDRESS OF TEMP PAGE
	CALL	$$(SETMPG,PAGEM)	;MAP IN THE PAGE TABLE
	NOINT			;MATCH OKINT DONE BY CLRJSB
	<SKIPN	T1,(P2)>+$$(FPG1A,STG)	;IS PAGE POINTER IN USE?
	AOJA	P2,MAPZER(P1)	;NO, GO HUNT FOR NEXT USED ONE
	MOVE	P2,T1		;PUT POINTER IN SAFE PLACE
	CALL	$$(CLRJSB,FORK)	;REMOVE THE MAPPING
	OKSKED			;ALLOW SCHEDULING NOW
	TLNN	P2,200000	;IS THIS A DIRECT POINTER?
	JRST	SKP(P1)		;YES, RETURN IT AS IS
	HRRZ	T1,P2		;GET SPT INDEX FROM POINTER
	CAIL	T1,$$(NOFN,STG)	;IS THIS AN OFN?
	<SKIPA	T1,(T1)>+$$(SPTH,STG)	;NO, GET PAGE'S ORIGIN
	HRLZ	T1,T1		;YES, SET UP
	HLRZ	T2,T1		;GET OFN IF ANY
	SKIPE	T2		;IS THIS OFN,,PAGE OR 0,,FORK?
	MOVN	T1,T2		;IS OFN, NEGATE IT
	HRR	P2,T1		;REPLACE RIGHT HALF WITH OFN OR FORK
	JRST	SKP(P1)		;GOOD RETURN


MAPZER:	TRZN	P2,777000	;WENT OFF END OF THE PAGE MAP?
	<SKIPE	(P2)>+$$(FPG1A,STG)	;OR FOUND A NONZERO ENTRY?
	JRST	OKSKP(P1)	;YES, DO UNMAP, OKSKED, AND SKIP RETURN
	AOJA	P2,MAPZER(P1)	;OTHERWISE KEEP SEARCHING
;FUNCTION TO DUMP OUT THE LL BLOCKS INTO CORE.  T2 = <-LEN,,ADDR>
;OF BLOCK TO STORE DATA.  RETURNS IN T2 SIZE OF EACH BLOCK IN LEFT
;HALF, AND NUMBER OF BLOCKS RETURNED IN RIGHT HALF.



OKDLL:	BLOCK	1		;NONZERO IF NOT ABLE TO DO THIS FUNCTION
	.FAIL.==OKDLL		;DEFINE LOC IN CASE SYMBOLS AREN'T FOUND



DLLFNC:	SKIPE	OKDLL(P1)	;SEE IF WE CAN DO THIS STUFF
	RET			;NO, RETURN
	MOVE	P3,T2		;SAVE IOWD POINTER
	SUB	P3,[1,,1](P1)	;FIX UP POINTER
	MOVSI	P2,DLLNUM	;GET SIZE OF EACH BLOCK AND CLEAR COUNTER
	CALL	$$(LOKLL,NSPSRV)	;LOCK UP THE NETWORK STRUCTURE
	MOVEI	T1,DLLSUB(P1)	;GET CO-ROUTINE ADDRESS
	SETO	T2,		;WE WANT ALL LOGICAL LINK BLOCKS
	CALL	$$(OBJSRC,NSPSRV)	;CALL CO-ROUTINE TO PROCESS THEM
	CALL	$$(ULOKLL,NSPSRV)	;UNLOCK THE DATA STRUCTURE
	JRST	SKP(P1)		;GOOD RETURN


;SUBROUTINE CALLED FOR EACH LOGICAL LINK BLOCK.  AC T1 HAS
;THE ADDRESS OF THE NEW LL BLOCK.


DLLSUB:	JSP	CX,$$(SAVT,APRSRV)	;HAVE TO SAVE ALL TEMPORARIES
	MOVSI	T2,-DLLNUM	;GET READY FOR A LOOP
	HRR	T2,P1		;RELOCATE AOBJN POINTER
	MOVSI	T3,(<MOVEM T4,>)	;SET UP AN INSTRUCTION

DLLSTL:	AOBJP	P3,RET(P1)	;RETURN IF NO MORE ROOM
	MOVE	T4,T1		;COPY ADDRESS OF LL BLOCK
	ADD	T4,DLLTAB(T2)	;ADD OFFSET DESIRED
	MOVE	T4,(T4)		;GET THE DATA
	HRR	T3,P3		;POINT TO NEXT WORD
	XCTU	T3		;STORE THE WORD
	 ERJMP	RET(P1)		;FAILED
	AOBJN	T2,DLLSTL(P1)	;STORE ALL DESIRED WORDS
	AOJA	P2,RET(P1)	;COUNT BLOCKS STORED AND RETURN
;TABLE OF WORDS TO BE RETURNED BACK TO USER.  THIS TABLE IS BUILT
;BY EXPANDING THE LLNUMS MACRO DEFINED EARLIER.




	DEFINE	LLLIST(ARGS),<
	IRP	ARGS,<		;;LOOP OVER ALL ARGS
	DL.'ARGS==.-DLLTAB	;;ASSIGN OFFSET
	EXP	ARGS		;;MAKE OFFSET TABLE
>
>



DLLTAB:	LLNUMS			;EXPAND THE MACRO


	DLLNUM==.-DLLTAB	;NUMBER OF WORDS

	.FAIL.==0		;NO MORE SYMBOL FAILURES ALLOWED NOW
;FUNCTION TO RETURN VARIOUS SYSTEM RESOURCE INFORMATION IN THE MONITOR.
;CALLED WITH TYPE OF RESOURCE IN T2.  RETURNS T2 =  CURRENT VALUE,
;AND T3 = INITIAL VALUE.



RESFNC:	TRNN	T2,-1		;WANTS A SUB FIELD OF RESIDENT SPACE?
	JRST	RESSUB(P1)	;NO, GO DO OTHER FIELDS
	SUBI	T2,1		;DECREMENT OFFSET
	TLNN	T2,-1		;SEE IF NONZERO LEFT HALF
	CAIL	T2,$$(RESQTL,STG)	;OR IF FUNCTION IS TOO BIG
	RET			;YES, BAD
	<MOVE	P2,(T2)>+$$(RESQTB,FREE)	;GET INITIAL COUNT
	<MOVE	T2,(T2)>+$$(RESUTB,STG)	;AND CURRENT FREE COUNT
	XCTU	[MOVEM T2,3](P1)	;GIVE TO USER
	JRST	SKP(P1)		;AND RETURN FINAL RESULT TOO


RESSUB:	HLRZ	T2,T2		;GET FIELD OFFSET
	CAILE	T2,MAXRES	;RANGE CHECK THE INDEX
	RET			;BAD
	ADD	T2,P1		;RELOCATE ADDRESS
	SKIPGE	P2,RESTB1(T2)	;GET VALUE OR POINTER
	MOVE	P2,(P2)		;WAS A POINTER, GET DATA
	CAMN T2,P1		;IS IT RESIDENT FREE SPACE?
	JRST RESFTL(P1)		;YES, GO DO SPECIAL CASE
	SKIPL	T2,RESTB2(T2)	;HAVE TO COMPUTE CURRENT VALUE?
	TLOA	T2,(IFIW)	;YES, SET BIT FIRST
	SKIPA	T2,@T2		;NO, JUST GET IT
	CALL	@T2		;YES, COMPUTE DATA
	XCTU	[MOVEM T2,3](P1)	;GIVE TO USER
	JRST	SKP(P1)		;DONE


;CALCULATE TOTAL OF POOLS FOR THE CUMULATIVE OUTPUT FOR RES. FREE SPACE

RESFTL:	MOVNI T2,$$(RESQTL,STG) ;GET THE NUMBER OF POOLS
	HRLZS T2		;MAKE AOBJN POINTER
	SETZ T3,		;INIT THE COUNT
RESFT1:	<MOVE T4,(T2)>+$$(RESQTB,STG)  ;GET INITIAL VALUE
	<SUB T4,(T2)>+$$(RESUTB,STG)  ;CALC AMOUNT USED
	ADD T3,T4		;ADD IT IN
	AOBJN T2,RESFT1(P1)	;MORE TO DO?
	MOVE T2,P2		;NO, GET THE INITIAL VALUE
	SUB T2,T3		;CALC WHAT'S LEFT
	XCTU [MOVEM T2,3](P1)	;RETURN IT
	JRST SKP(P1)		;DONE
RESTB1:	EXP	$$(NRESFB,STG)	;(0) NUMBER OF RESIDENT BLOCKS
	EXP	$$(SWFREL,STG)	;(1) AMOUNT OF SWAPABLE SPACE
	EXP	$$(ENQMXF,STG)	;(2) MAXIMUM ENQ USAGE
	EXP	$$(MAXBLK,STG)	;(3) MAXIMUM NETWORK STORAGE
	EXP	$$(NOFN,STG)	;(4) SIZE OF OFN TABLE
	EXP	$$(SSPT,STG)	;(5) SIZE OF SPT TABLE
	IFIW	$$(DRMTPG,STG)	;(6) NUMBER OF SWAPPING PAGES
	IFIW	$$(TOTRC,STG)	;(7) TOTAL USER CORE AVAILABLE
	EXP	$$(NFKS,STG)	;(10) NUMBER OF FORKS

	MAXRES==.-RESTB1	;HIGHEST  VALUE


RESTB2:	IFIW	$$(RESFRE,STG)	;FREE RESIDENT BLOCKS
	IFIW  2+$$(SWPFRE,STG)	;NONRESIDENT STORAGE
	IFIW	$$(ENQSPC,STG)	;ENQ SPACE LEFT
	IFIW	$$(BLKASG,STG)	;NETWORK SPACE ASSIGNED
	IFIW	$$(NOF,PAGEM)	;CURRENT OFNS ASSIGNED
	IFIW	$$(SPTC,PAGEM)	;CURRENT SPT SLOTS ASSIGNED
	IFIW	$$(DRMFRE,STG)	;FREE SWAPPING PAGES
	IFIW	$$(NRPLQ,STG)	;PAGES ON THE REPLACEABLE QUEUE
	Z	FRKCNT(P1)	;ROUTINE TO COUNT USED FORKS


;ROUTINE TO COMPUTE NUMBER OF USED FORKS ON THE SYSTEM.


FRKCNT:	SETZ	T2,		;START WITH ZERO
	MOVNI	T3,$$(NFKS,STG)	;GET NUMBER OF FORKS TOTAL
	MOVSI	T3,(T3)		;MAKE AOBJN POINTER
FRKCN1:	<SKIPL	(T3)>+$$(FKPT,STG)	;THIS FORK ASSIGNED?
	ADDI	T2,1		;YES, COUNT IT
	AOBJN	T3,FRKCN1(P1)	;LOOP UNTIL LOOKED AT THEM ALL
	RET			;DONE
;SUBROUTINE TO CHECK A SYSTEM WIDE FORK NUMBER, AND VERIFY THAT THE
;FORK IS LEGAL AND EXISTS.  CALL:
;
;	MOVE	T1,FORK		;GET SYSTEM FORK NUMBER
;	CALL	CHKFRK(P1)	;VERIFY THAT IT IS THERE
;	 (ERROR)		;ILLEGAL FORK, OR NOT EXISTANT
;	(GOOD RETURN)		;IS LEGAL, WE ARE NOSKED
;
;ON A SUCCESSFUL RETURN, WE ARE RUNNING NOSKED SO THE CALLER MUST
;DO AN OKSKED SOMETIME.   DOES NOT CHANGE T1.





CHKFRK:	SKIPL	T1		;SEE IF FORK NUMBER IS LEGAL
	CAIL	T1,$$(NFKS,STG)	;WELL?
	RET			;NO, ERROR
	NOSKED			;NO RACES NOW
	HRRZ	T2,.JBVER	;GET MONITOR VERSION
	CAIGE	T2,NWFKPT	;NEW STYLE SCHEDULAR CODE?
	JRST	CHKFRO(P1)	;NO, GO DO OLD WAY
	<SKIPL	0(T1)>+$$(FKPT,STG)	;IS FORK ASSIGNED?
	JRST	SKP(P1)		;YES, GOOD RETURN
	JRST	SKDRET(P1)	;NO, GIVE ERROR RETURN

CHKFRO:	<HLRZ	T2,0(T1)>+$$(FKPT,STG)	;GET QUEUE FORK IS ON
	CAIE	T2,$$(WTLST,STG)	;IS FORK IN A WAIT?
	CAIN	T2,$$(GOLST,STG)	;OR RUNNABLE?
	JRST	SKP(P1)		;YES, SUCCESSFUL RETURN
SKDRET:	OKSKED			;NO, THEN FORK IS NONEXISTANT
	RET			;SO ERROR RETURN
;SUBROUTINE TO SEARCH FOR A MONITOR SYMBOL IN OUR LITTLE TABLE, AND
;RANGE CHECK IT AGAINST THE LIMITS OF THE PSB OR JSB.  CALL:
;
;	MOVE	T1,[LOWADR,,HGHADR]	;GET BOUNDS ON THE ADDRESS
;	MOVE	T2,SYMBOL	;GET SIXBIT SYMBOL
;	CALL	SYMSRC(P1)	;LOOK FOR IT
;	 (ERROR)		;NOT FOUND, OR OUT OF LEGAL RANGE
;	(GOOD RETURN)		;VALUE IN AC P2
;
;A SYMBOL NAME OF ZERO IMPLIES A VALUE OF ZERO, SO THAT THE OFFSET
;GIVEN IS THE ACTUAL ADDRESS WANTED.  CALL AT SYMSR0 IF NO OFFSET
;IS TO BE USED, AND NO RANGE CHECKING IS WANTED.




SYMSR0:	SETZ	T1,		;NO BOUNDS CHECKING
SYMSRC:	SKIPN	P2,T2		;ANY SYMBOL NAME SPECIFIED?
	JRST	SYMSRV(P1)	;NO, WANTS THE PARTICULAR VALUE
	MOVSI	T3,-SYMCNT	;GET NUMBER OF SYMBOLS TO LOOK AT
	HRR	T3,P1		;RELOCATE THE ADDRESS

SYMLOP:	CAME	T2,SYMTAB(T3)	;FOUND THE SYMBOL YET?
	AOBJN	T3,SYMLOP(P1)	;NO, KEEP LOOKING
	JUMPGE	T3,RET(P1)	;NOT FOUND, ERROR
	MOVE	P2,SYMVAL(T3)	;OK, GET THE VALUE
SYMSRV:	JUMPE	T1,SKP(P1)	;IF NO BOUNDS CHECKING, ARE DONE
	XCTU	[ADD P2,3](P1)	;ADD IN OFFSET SPECIFIED BY USER
	HLRZ	T2,T1		;GET LOWER BOUND
	CAML	P2,T2		;ADDRESS LESS THAN LOWER BOUND?
	CAILE	P2,(T1)		;OR HIGHER THAN UPPER BOUND?
	RET			;YES, ERROR
	JRST	SKP(P1)		;NO, THEN SKIP RETURN
;TABLE OF KNOWN SYMBOLS WE CAN BE TOLD TO USE:


	DEFINE	SS,<		;;DEFINE SYMBOLS WE WILL KNOW ABOUT

	XX	JSVAR,JOBDAT	;BEGINNING OF JOB STORAGE BLOCK
	XX	JSVARZ,POSTLD	;END OF JOB STORAGE BLOCK
	XX	RSCNBP		;POINTER TO JOB'S RSCAN BUFFER
	XX	MAXJFN		;HIGHEST JFN IN USE
	XX	FILSTS		;STATUS BITS FOR JFN
	XX	FILBYT		;BYTE POINTER INTO WINDOW
	XX	FILBYN		;BYTE NUMBER INTO FILE
	XX	FILDDN		;POINTER TO DEVICE STRING IN JFN BLOCK
	XX	FILDNM		;POINTER TO DIRECTORY STRING
	XX	FILNEN		;POINTER TO NAME AND EXTENSION STRINGS
	XX	FILVER		;GENERATION NUMBER
	XX	FILOFN		;OFN FOR THIS FILE
	XX	FILDEV		;DEVICE DISPATCH
	XX	DSKDTB,DISC	;ADDRESS FOR DISKS
	XX	SYSFK		;JOB FORK TO SYSTEM FORK TABLE
	XX	FKPTRS		;STRUCTURE OF FORKS
	XX	NUFKS		;NUMBER OF USER FORKS
	XX	FKCNT		;NUMBER OF FORKS IN THE JOB
	XX	MLJFN		;LENGTH OF EACH JFN BLOCK

	XX	PSVAR,JOBDAT	;BEGINNING OF PROCESS STORAGE BLOCK
	XX	PSVARZ,POSTLD	;END OF PROCESS STORAGE BLOCK
	XX	JOBNO		;JOB NUMBER FORK BELONGS TO
	XX	UPDL		;BEGINNING OF JSYS STACK
	XX	FKRT		;FORK RUN TIME
	XX	PPC		;PROCESS PC
	XX	KIMUU1		;LAST USER UUO
	XX	CAPMSK		;POSSIBLE CAPABILITIES
	XX	CAPENB		;ENABLED CAPABILITIES
	XX	UTRPCT		;NUMBER OF PAGE TRAPS
	XX	LSTERR		;LAST ERROR IN FORK
	XX	INTDF		;NO INTERRUPTIONS COUNTER
	XX	TRAPPC		;THE PC OF THE LAST PAGE FAULT

	XX	TTFLG1,TTYSRV	;FLAGS
	XX	TTOCT,TTYSRV	;CHARACTERS IN OUTPUT BUFFER
	XX	TTICT,TTYSRV	;CHARACTERS IN INPUT BUFFER
	XX	TTLINK,TTYSRV	;LINES LINKED TO THIS TTY
	XX	TTFLGS,TTYSRV	;MORE FLAGS

	XX	RESQTL		;NUMBER OF RESIDENT FREE POOLS
>
	DEFINE	XX(SYMBOL,MODULE<STG>),<
	EXP	SIXBIT	/SYMBOL/	;SIXBIT NAME
>

	XALL			;ALLOW LISTING


SYMTAB:	SS


	SYMCNT==.-SYMTAB	;NUMBER OF SYMBOLS
	DEFINE	XX(SYMBOL,MODULE<STG>),<
SYMBOL:	Z	$$(SYMBOL,MODULE)	;VALUE OF NAME
>



SYMVAL:	SS
	SALL			;RETURN TO NORMAL LISTING
	LIT			;DUMP LITERALS

	JSYLEN==.-.MONRD	;NUMBER OF WORDS FOR JSYS


	IFG	<.-SNPLOC-1000>,<	;MAKE SURE STILL ON ONE PAGE
PRINTX	? SNOOP code is larger than a page.  Do not attempt to run program!
>

	RELOC			;RETURN TO NORMAL CODE

	SYMNUM==<.-SYMS>/4	;NUMBER OF SYMBOLS TO FILL IN
	SUBTTL	MACRO TO DEFINE THE DISPLAY TYPES




;THE FOLLOWING MACRO DEFINES THE TYPES OF DISPLAYS WHICH CAN
;BE OUTPUT, AND WHICH HAVE DEFINABLE COLUMNS.  (THUS THINGS LIKE
;THE QUEUE DISPLAY WON'T APPEAR HERE, SINCE NO COLUMNS CAN BE
;CHANGED).  THE ARGUMENTS ARE:
;
;	XX	SEPARATION, TYPE, TEXT
;
;WHERE SEPARATION IS THE DEFAULT NUMBER OF BLANKS BETWEEN COLUMNS,
;TYPE IS THE MNEMONIC FOR THIS DISPLAY USED IN THE COLUMN MACRO LATER,
;AND TEXT IS THE NAME OF THIS COLUMN FOR TBLUK PURPOSES.  THIS
;TABLE MUST BE IN ALPHABETICAL ORDER.



	DEFINE	TYPES,<		;;DEFINE THE TYPES


XX	3,ANH,ARPANET-HOSTS	;;HOSTS ON THE ARPANET
XX	3,ANC,ARPANET-LINKS	;;ARPANET CONNECTIONS
XX	2,DLL,DECNET-STATUS	;;DECNET DISPLAY
XX	4,DEV,DEVICES		;;SYSTEM DEVICES
XX	1,DSK,DISK-UNITS	;;UNITS IN THE SYSTEM
XX	3,EQL,ENQ-LOCKS		;;LOCKS FOR ENQ/DEQ
XX	3,EQQ,ENQ-QUEUES	;;QUEUES FOR THE LOCKS
XX	2,FIL,FILES		;;FILES OF A JOB
XX	2,FRK,FORKS		;;FORKS IN A JOB
XX	2,IPC,IPCF-STATUS	;;THE PIDS ON THE SYSTEM
XX	2,JOB,JOBS		;;ALL OF THE JOBS
XX	2,STR,STRUCTURES	;;DISK STRUCTURES
XX	2,TTY,TERMINALS		;;THE TERMINALS
>




	DEFINE	XX(SEP,TYPE,TEXT),<
	TP.'TYPE==.-DISTAB		;;DEFINE HEADER CODE
	XWD	[ASCIZ/TEXT/],SEP	;;DUMP NAME AND SEPARATION
>



DISTAB:	XWD	DISNUM,DISNUM	;NUMBER OF ENTRIES
	TYPES			;EXPAND THE TABLE

	DISNUM==.-DISTAB-1	;NUMBER OF ENTRIES
	SUBTTL	MACRO TO DEFINE THE COLUMNS




;THE FOLLOWING MACRO DEFINES THE COLUMNS WHICH CAN BE OUTPUT FOR
;A FORK.  THE ARGUMENTS ARE:
;
;	XX	ORDER, TYPE, SIZE, ROUTINE, NAME, HEADER
;
;ORDER GIVES THE DEFAULT ORDERING OF THE COLUMNS.
;TYPE IS THE TYPE OF COLUMN THIS IS, WITHOUT THE "TP."
;SIZE IS THE NUMBER OF SPACES THIS COLUMN NEEDS IN WORST CASE.
;ROUTINE IS THE DISPATCH ADDRESS FOR THIS COLUMN, WITHOUT THE "XX"
;NAME IS THE KEYWORD NAME FOR THIS COLUMN.
;HEADER IS THE TEXT OUTPUT AS THE HEADER FOR THIS COLUMN.




	DEFINE	COLS,<


XX	0,DLL,15,LABT,ABORT-REASON,<Abort reason>	;;ABORT REASON
XX	0,JOB,15,ACCT,ACCOUNT,<  Account>	;;ACCOUNT STRING
XX	30,DSK,6,ALIS,ALIAS,<Alias>		;;DISK ALIAS
XX	0,DLL,10,LBYC,BYTE-COUNT-IN-SEGMENT,<Byte count>	;;BYTES
XX	10,DSK,4,CHAN,CHANNEL,<Chan>		;;DISK CHANNEL
XX	60,EQL,15,LCOD,CODE-FOR-LOCK,<Lock code>	;;LOCK CODE
XX	0,JOB,7,CTIM,CONNECT-TIME,<Connect>	;;CONNECT TIME OF JOB
XX	15,DSK,4,CTRL,CONTROLLER,<Ctrl>		;;DISK CONTROLLER
XX	60,JOB,5,CPU,CPU-PERCENTAGE,< %CPU>	;;PERCENTAGE OF THE CPU
XX	10,DEV,6,DEVN,DEVICE,<Device>		;;DEVICE
XX	30,DEV,12,DEVC,DEVICE-DESIGNATOR,< Designator>	;;DESIGNATOR
XX	20,DEV,5,DEVJ,DEVICE-OWNER,<Owner>	;;OWNER OF DEVICE
XX	40,DEV,15,DEVU,DEVICE-USER,<  User>	;;USER OF DEVICE
XX	0,JOB,20,CDIR,DIRECTORY,<Connected directory>	;;DIRECTORY
XX	90,DSK,25,USTS,DISK-STATUS,<Disk status>	;;STATUS
XX	20,EQQ,3,QJOB,ENQ-BLOCK-CREATOR,<Job>	;;JOB WHICH MADE BLOCK
XX	25,EQQ,6,QPRG,ENQ-PROGRAM,< Prog>	;;PROGRAM NAME
XX	30,EQQ,7,QFLG,ENQ-STATUS,<Status>	;;QUEUE BLOCK STATUS
XX	60,FIL,140,FILE,FILE-NAME,<   File name>	;;FILE NAME OF JFN
XX	40,FIL,10,BYTE,FILE-POINTER,<Pointer>	;;CURRENT FILE POINTER
XX	50,FIL,14,FSTA,FILE-STATUS,<Status>	;;STATUS OF JFN
XX	30,IPC,10,PIDF,FLAGS-FOR-PID,<Flags>	;;FLAGS
XX	80,TTY,25,TFLG,FLAGS-FOR-TERMINAL,<Flags>	;;TERMINAL FLAGS
XX	0,DLL,11,FLOW,FLOW-STATUS,<Flow status>	;;FLOW CONTROL
XX	0,JOB,15,FHST,FOREIGN-HOST,<Foreign host>	;;ARPANET HOST
XX	15,ANC,11,ACFS,FOREIGN-SOCKET,<Foreign soc>	;;FOREIGN SOCKET
XX	10,FRK,3,FORK,FORK,<Frk>		;;THE FORK NUMBER
XX	0,FRK,5,FFLG,FORK-FLAGS,<Flags>		;;FORK FLAGS
XX	80,FRK,10,RUN,FORK-RUNTIME,<   Runtime>	;;RUNTIME OF FORK
XX	50,FRK,10,STAT,FORK-STATUS,<Status>	;;THE STATUS OF THE FORK
XX	0,JOB,5,FKS,FORKS-IN-JOB,<Forks>	;;NUMBER OF FORKS
XX	30,EQL,10,LRES,FREE-LOCKS,<Free locks>	;;FREE LOCKS LEFT
XX	40,STR,6,STPG,FREE-PAGES,< Free>	;;NUMBER OF FREE PAGES
XX	20,ANH,15,ANAM,HOST-NAME,<Host name>	;;NAME OF HOST
XX	10,ANH,11,AHST,HOST-NUMBER,<Host number>	;;HOST NUMBER
XX	50,ANH,30,ASTS,HOST-STATUS,<Status>	;;HOST STATUS
XX	40,ANH,14,ATYP,HOST-TYPE,<System type>	;;TYPE OF HOST
XX	70,JOB,6,IDLE,IDLE-TIME,< Idle>		;;IDLE TIME
XX	30,FIL,3,INIF,INITIALIZING-FORK,<Frk>	;;FORK WHICH STARTED JFN
XX	40,TTY,3,TINC,INPUT-CHARACTERS,< In>	;;CHARS IN INPUT
XX	0,FRK,5,INTD,INTERRUPT-DEFER-COUNT,<INTDF>	;;INTERRUPT DEFER
XX	10,FIL,3,JFN,JFN,<JFN>			;;JFN OF FILE
XX	10,JOB,3,JOB,JOB,<Job>			;;JOB NUMBER
XX	40,FRK,9,CALL,LAST-CALL,<Last call>	;;THE LAST JSYS DONE
XX	0,FRK,25,LERR,LAST-ERROR,<  Last error>	;;LAST ERROR IN FORK
XX	40,EQL,6,LLVL,LEVEL-OF-LOCK,<Level>	;;LOCK LEVEL
XX	0,DLL,4,LKFK,LINK-FORK-OWNER,<Fork>	;;FORK OWNER OF LINK
XX	0,DLL,7,LKID,LINK-ID,<Link ID>		;;LINK ID
XX	10,DLL,3,LKJB,LINK-JOB-OWNER,<Job>	;;OWNER OF LINK
XX	20,DLL,7,LPRG,LINK-PROGRAM,<Program>	;;PROGRAM NAME FOR LINK
XX	70,DLL,9,LSTA,LINK-STATE,<State>	;;STATE
XX	30,DLL,7,LKTP,LINK-TYPE,< Type>		;;TYPE OF I/O
XX	90,DLL,15,LUSR,LINK-USER,<  User>	;;USER
XX	0,JOB,15,LINK,LINKED-TERMINALS,<Links to TTY>	;;TERMINAL LINKS
XX	10,ANC,11,ACLS,LOCAL-SOCKET,<Local soc>	;;SOCKET NUMBER
XX	10,EQL,4,LLCK,LOCK-NUMBER,<Lock>	;;ENQ LOCK NUMBER
XX	0,FRK,24,CORE,MAPPED-PAGES,<Mapped pages>	;;PAGE MAP
XX	0,FRK,10,MPC,MONITOR-PC,<Monitor PC>	;;THE MONITOR PC
XX	20,STR,5,STMC,MOUNT-COUNT,<Mount>	;;NUMBER OF MOUNTS
XX	0,ANC,9,ABTA,NCP-BIT-ALLOCATION,<Bit alloc>	;;ALLOCATION OF BITS
XX	30,ANC,10,ACBT,NCP-BITS-TRANSFERED,<Bits trans>	;;BITS SENT
XX	40,ANC,15,ACFH,NCP-FOREIGN-HOST,<Foreign host>	;;HOST
XX	0,ANC,9,AMSA,NCP-MESSAGE-ALLOC,<Msg alloc>	;;ALLOCATION OF MSGS
XX	20,ANC,3,ACVT,NCP-NVT,<NVT>		;;NETWORK VIRTUAL TERMINAL
XX	50,ANC,5,ASTE,NCP-STATE,<State>		;;STATE OF NCP CONNECTION
XX	50,DSK,4,LUNT,NUMBER-OF-PACK,<Pack>	;;PACK NUMBER
XX	10,TTY,3,TNUM,NUMBER-OF-TERMINAL,<TTY>	;;TERMINAL
XX	40,DLL,6,LOBJ,OBJECT-NAME,<Object>	;;OBJECT NAME
XX	20,FIL,7,OFN,OFN,< OFN>			;;THE OFNS OF THE FILE
XX	0,ANC,22,APRS,OLD-NSP-STATES,<Previous states>	;;OLD STATES
XX	30,STR,5,STOF,OPEN-FILE-COUNT,<Files>	;;NUMBER OF FILES OPEN
XX	50,TTY,3,TOUC,OUTPUT-CHARACTERS,<Out>	;;CHARS IN OUTPUT
XX	10,IPC,3,PIDJ,OWNER-OF-PID,<Job>	;;JOB WHICH OWNS PID
XX	20,TTY,3,TJOB,OWNER-OF-TERMINAL,<Job>	;;JOB OWNING TTY
XX	10,EQQ,4,QLCK,OWNING-LOCK,<Lock>	;;LOCK WHICH OWNS QUEUE
XX	0,IPC,7,RECC,PACKETS-TO-READ,<Packets>	;;NUMBER OF PACKETS
XX	0,FRK,12,TRPC,PAGE-TRAP-PC,<Page trap PC>	;;PC OF PAGE TRAPS
XX	60,FRK,6,TRAP,PAGE-TRAPS,<Ptraps>	;;NUMBER OF PAGE TRAPS
XX	30,FRK,10,UPC,PC,<   User PC>		;;THE CURRENT USER PC
XX	20,IPC,13,PID,PID,<     PID>		;;THE PID
XX	15,IPC,4,POWN,PID-FORK,<Fork>		;;FORK WHICH CREATED PID
XX	50,IPC,20,PNAM,PID-NAME,<  Name>	;;NAME OF PID
XX	17,IPC,6,PPRG,PID-PROGRAM,< Prog>	;;PROGRAM RUNNING
XX	0,FRK,5,PRIV,PRIVILEGES,<Privs>		;;PRIVILEGES OF FORK
XX	30,JOB,7,PROG,PROGRAM,<Program>		;;PROGRAM NAME
XX	0,IPC,9,PQTA,QUOTAS,< Quotas>		;;SEND, RECEIVE QUOTAS
XX	0,DSK,12,RDER,READ-ERRORS,<Read errors>	;;NUMBER OF READ ERRORS
XX	70,DSK,8,READ,READS,<  Reads>		;;DISK READS
XX	60,DLL,6,LHST,REMOTE-HOST-NAME,<Host>	;;REMOTE HOST
XX	0,DLL,9,LKIR,REMOTE-ID,<Remote ID>	;;REMOTE ID
XX	50,EQQ,10,QID,REQUEST-ID,<Request ID>	;;REQUEST ID
XX	50,JOB,9,JRUN,RUNTIME,< Runtime>	;;RUNTIME OF JOB
XX	0,JOB,5,JCLS,SCHEDULER-CLASS,<Class>	;;SCHEDULER CLASS
XX	0,FRK,16,SCHD,SCHEDULER-TEST,<Scheduler test>	;;FKSTAT WORD
XX	0,DSK,12,PSER,SEEK-ERRORS,<Seek errors>	;;NUMBER OF SEEK ERRORS
XX	60,DSK,8,SEEK,SEEKS,<  Seeks>		;;DISK SEEKS
XX	45,STR,6,STSZ,SIZE-OF-STRUCTURE,< Size>	;;SIZE
XX	0,TTY,11,TSPD,SPEEDS,<Line speeds>	;;SPEED OF LINE
XX	40,JOB,5,JSTA,STATE,<State>		;;STATE JOB IS IN
XX	10,STR,9,STNM,STRUCTURE,<Structure>	;;STRUCTURE NAME
XX	50,STR,40,STST,STRUCTURE-STATUS,<Structure status>	;;STATUS
XX	20,FRK,3,SUP,SUPERIOR,<Sup>		;;THE SUPERIOR OF THE FORK
XX	0,DSK,8,SWAP,SWAPPING-SPACE,<Swapping>	;;SWAPPING SPACE
XX	40,IPC,10,SYSP,SYSTEM-PID,<System PID>	;;THE SYSTEM PID
XX	0,DLL,6,LTSK,TASK-NAME,<Task>		;;NAME OF TASK
XX	20,JOB,8,TERM,TERMINAL,<Terminal>	;;TERMINAL JOB IS ON
XX	50,EQL,13,LTIM,TIME-LOCK-OBTAINED,<Time locked>	;;TIME
XX	80,DLL,10,LSEG,TRANSMIT-RECEIVE-SEGMENT,<Trans Recv>	;COUNTERS
XX	70,TTY,15,TLNK,TTY-LINKS,<Links to TTY>	;;LINKS
XX	25,TTY,15,TUSR,TTY-USER,<   User>	;;USER ON A TERMINAL
XX	0,DSK,4,TYPE,TYPE-OF-DISK,<Type>	;;TYPE OF DISK
XX	20,EQL,11,LTYP,TYPE-OF-LOCK,<Restriction>	;;TYPE OF ENQ LOCK
XX	30,TTY,9,TTYP,TYPE-OF-TERMINAL,<Type>	;;TERMINAL TYPE
XX	20,DSK,4,UNIT,UNIT,<Unit>		;;DISK UNIT
XX	80,JOB,15,USER,USER-NAME,<   User>	;;USER NAME
XX	40,DSK,6,STR,VOLUME-ID,<Vol ID>		;;THE VOLUME NAME
XX	70,FRK,7,WSIZ,WORKING-SET-SIZE,<WS size>	;;WORKING SET SIZE
XX	0,DSK,12,WTER,WRITE-ERRORS,<Write errors>	;;WRITE ERRORS
XX	80,DSK,8,WRIT,WRITES,< Writes>		;;DISK WRITES
>
	DEFINE	XX(ORD,TYP,SIZE,DISP,NAME,HEAD),<
	XWD	[ASCIZ/NAME/],[	EXP	TP.'TYP		;TYPE OF COLUMN
		IFE <^D<ORD>>,<	EXP	0>		;ORDERING DATA
		IFN <^D<ORD>>,<	XWD	TP.'TYP,^D<ORD>>
				EXP	XX'DISP		;DISPATCH ADDRESS
				EXP	^D<SIZE>	;WIDTH OF COLUMN
				ASCIZ	"HEAD"]		;HEADER TEXT
>




COLTAB:	XWD	COLNUM,COLNUM	;NUMBER OF ENTRIES
	COLS			;EXPAND THE TABLE


	COLNUM==.-COLTAB-1	;NUMBER OF COLUMNS
	SUBTTL	DEFINITIONS OF THE STATISTICS



;TABLE OF ENTRIES TO BE TYPED.  THE IMBEDDED XX MACRO HAS THE FOLLOWING
;ARGUMENTS:
;
;	XX	NAME,ROUTINE,INDEX
;
;WHERE NAME IS THE NAME OF THIS DATA (4 OR LESS LETTERS TO LOOK GOOD),
;ROUTINE IS THE CODE TO TYPE OUT THE DATA, AND INDEX IS THE INDEX INTO
;THE GETAB TABLE CONTAINING THE DATA.




	DEFINE	STATS,<


XX	USED,DOPCT,32		;;USED TIME AS PERCENTAGE
XX	NRUN,DOAVG,13		;;AVERAGE NUMBER OF RUNNABLE FORKS
XX	DMRD,DODIF,4		;;NUMBER OF DRUM READS
XX	TTIN,DODIF,21		;;NUMBER OF TERMINAL INPUT CHARACTERS

XX	IDLE,DOPCT,0		;;IDLE TIME AS PERCENTAGE
XX	NBAL,DOAVG,12		;;AVERAGE NUMBER OF FORKS IN BALANCE SET
XX	DMWR,DODIF,5		;;NUMBER OF DRUM WRITES
XX	TTOU,DODIF,22		;;NUMBER OF TERMINAL OUTPUT CHARACTERS

XX	SWPW,DOPCT,1		;;SWAP-WAIT TIME AS PERCENTAGE
XX	BSWT,DOAVG,26		;;AVERAGE NUMBER OF FORKS WAITING
XX	DKRD,DODIF,6		;;NUMBER OF DISK READS
XX	WAKE,DODIF,10		;;NUMBER OF PROCESS WAKEUPS

XX	SKED,DOPCT,2		;;SCHEDULAT OVERHEAD TIME AS PERCENTAGE
XX	UPGS,DOAVG,37		;;AVERAGE NUMBER OF PAGES IN BALANCE SET
XX	DKWR,DODIF,7		;;NUMBER OF DISK WRITES
XX	TTCC,DODIF,11		;;NUMBER OF TERMINAL INTERRUPTS
>
;NOW EXPAND THE TABLE PROPERLY:




	DEFINE	XX(NAME,ROUTINE,INDEX),<
	XWD	INDEX,[ASCIZ/NAME/]
>

	XALL			;LET EXPANSION SHOW



STATTB:	STATS			;GENERATE THE TABLE



	STATNM==.-STATTB	;NUMBER OF ENTRIES
;NOW PRODUCE THE TABLE OF ROUTINES:




	DEFINE	XX(NAME,ROUTINE,INDEX),<
	EXP	ROUTINE		;CODE TO HANDLE NAME
>




STATCD:	STATS			;GENERATE THE TABLE



	SALL			;RETURN TO NORMAL LISTING
	SUBTTL	TABLE OF JSYSES AND UUOS




;THE FOLLOWING TABLE OF JSYSES IS PRODUCED BY EXPANDING THE
;MACRO DEFJS DEFINED IN UUOSYM.  UNUSED JSYSES JUST STAY ZERO.



JSTABL:				;TABLE OF JSYS NAMES


IF1,<	DEFINE	DEFJS(NAME,NUMBER,FLAGS,EXTRA1,EXTRA2),<
	JSYSMX==NUMBER		;;JUST FIND LAST DEFINED JSYS
	>


	JSLIST			;DO THE WORK
	BLOCK	JSYSMX+1	;ALLOCATE SPACE FOR THE TABLE
>




IF2,<	DEFINE	DEFJS(NAME,NUMBER,FLAGS,EXTRA1,EXTRA2),<

	XLIST			;;TURN OFF LISTING
	IFG	<NUMBER-JSYSMX>,<
		BLOCK	NUMBER-JSYSMX
		>		;;LEAVE ROOM FOR GAPS
	EXP	SIXBIT/NAME/	;;GENERATE THIS JSYS NAME
	JSYSMX==NUMBER+1	;;MOVE UP TO NEXT JSYS VALUE
	LIST			;;RESUME LISTING
	>


	JSYSMX==0		;INITIALIZE JSYS NUMBER
	JSLIST			;GENERATE THE TABLE
>
UUOTAB:					;TABLE OF UUO NAMES


	UU	<CALL,INIT,UUO42,UUO43,UUO44,UUO45,UUO46,CALLI >
	UU	<OPEN,TTCALL,UUO52,UUO53,UUO54,RENAME,IN,OUT>
	UU	<SETSTS,STATO,GETSTS,STATZ,INBUF,OUTBUF,INPUT,OUTPUT>
	UU	<CLOSE,RELEAS,MTAPE,UGETF,USETI,USETO,LOOKUP,ENTER>
	UU	<UJEN>



TTCTAB:	UU	<INCHRW,OUTCHR,INCHRS,OUTSTR,INCHWL,INCHSL,GETLCH,SETLCH>
	UU	<RESCAN,CLRBFI,CLRBFO,SKPINC,SKPINL,TTCALL,TTCALL>
	SUBTTL	SYMBOLS TO BE SNOOPED FOR DISK STATISTICS



	XALL			;LET EXPANSIONS SHOW


	DEFINE	XX(SYM,MOD<PHYSIO>),<
	RADIX50	0,SYM		;;DEFINE RADIX50 VALUE OF SYMBOL
>


TBSUDB:	USYMS			;TABLE OF SYMBOLS

	NUMUDB==.-TBSUDB	;NUMBER OF SYMBOLS




	DEFINE	XX(SYM,MOD<PHYSIO>),<
	RADIX50	0,MOD		;;PROGRAM NAME TO FIND SYMBOL IN
>

TBMUDB:	USYMS			;TABLE OF PROGRAM NAMES
	DEFINE	XX(SYM,MOD<PHYSIO>),<
SYM:	EXP	0		;;DEFINE LOCATION FOR VALUE TO GO
>

TBVUDB:	USYMS			;TABLE OF VALUES TO FILL IN


	SALL			;RETURN TO NORMAL
	SUBTTL	ERROR CODE MNEMONICS



;THE FOLLOWING TABLE IS GENERATED BY EXPANDING THE .ERCOD MACRO
;IN MONSYM.  IN PASS1, WE SIMPLY LOOK FOR THE HIGHEST ERROR CODE.
;IN PASS2, WE GENERATE THE TABLE.



IF1,<
	DEFINE	.ERR(NUMBER,NAME,TEXT),<
	IFG <NUMBER-MAXERR>,<MAXERR==NUMBER>
	>

	MAXERR==0		;START OFF HIGHEST ERROR NUMBER

	.ERCOD			;EXPAND ERROR MACRO

ERRS:	BLOCK	MAXERR+1	;LEAVE ROOM FOR THE ERRORS
>



IF2,<
	DEFINE	.ERR(NUMBER,NAME,TEXT),<
	XLIST
	RELOC	ERRS+NUMBER
	SIXBIT	/NAME/
	LIST
	>

ERRS:	.ERCOD			;GENERATE THE ERROR TABLE

	RELOC	ERRS+MAXERR+1	;THEN RELOCATE TO PROPER PLACE
>
	SUBTTL	DATA STORAGE




LEVTAB:	EXP	CHNPC1		;PLACE TO STORE PC
	BLOCK	2		;OTHER LEVELS UNUSED

CHTAB:	XWD	1,TTYINT	;LEVEL 1, INTERRUPT ROUTINE
	BLOCK	.ICIFT-1	;UNUSED CHANNELS
	XWD	1,FRKINT	;LEVEL 1, INTERRUPT ROUTINE
	BLOCK	^D36-.ICIFT	;OTHER CHANNELS UNUSED



;POINTERS TO THE RUNTIMES



	XX==0			;START OFF COUNTER AT ZERO

OLDRUN:	REPEAT	CPUAVG,<
	Z	RUNTIM+<XX*MAXJOB>(J)
	XX==XX+1
>
;MESSAGE TO BE SENT TO QUASAR FOR QUEUE LISTING:



QSRMSG:	XWD	QSRLEN,.QOLIS	;TYPE OF FUNCTION AND LENGTH
	XWD	0,'SYS'		;FLAGS AND 3 LETTER MNENOMIC
	EXP	0		;ACKNOWLEDGE WORD

QSRFL2:	EXP	0		;FLAGS FILLED IN LATER
	EXP	1		;ONE ARGUMENT BLOCK FOLLOWING

	XWD	2,.LSQUE	;QUEUE BLOCK
QSRFL1:	EXP	0		;WHICH QUEUES TO LIST, FILLED IN LATER

	QSRLEN==.-QSRMSG	;SIZE OF PACKET





;MESSAGE SENT TO SYSTEM INFO TO OBTAIN NAME OF A PID:



INFMSG:	EXP	.IPCIG		;FUNCTION TO RETURN NAME OF A PID
	EXP	0		;NO COPIES OF THE RESPONSE
INFDAT:	EXP	0		;FILLED IN LATER
PDL:	BLOCK	PDLSIZ		;STACK AREA
KWNJOB:	BLOCK	1		;JOB NUMBER A FORK BELONGS TO
LCLNOD:	BLOCK	5		;LOCAL NODE NAME
PCFLAG:	BLOCK	1		;THE PC FLAGS OF A FORK
PC:	BLOCK	1		;THE CURRENT PC OF A FORK
USERPC:	BLOCK	1		;THE USER MODE PC OF A FORK
HAVPC:	BLOCK	1		;SET IF PC STUFF IS AVAILABLE
HAVID:	BLOCK	1		;SET IF ID INFORMATION IS KNOWN
HAVALC:	BLOCK	1		;SET IF HAVE ALLOCATION INFO
STRALC:	BLOCK	2		;ALLOCATION INFORMATION
TTJBVL:	BLOCK	1		;TERMINAL TO JOB WORD IF NONNEGATIVE
JOBFRK:	BLOCK	1		;JOB FORK NUMBER WE ARE ON
FORK:	BLOCK	1		;SYSTEM FORK NUMBER WE ARE ON
THETTY:	BLOCK	1		;TERMINAL NUMBER DOING SINGLE DISPLAY ON
THEJOB:	BLOCK	1		;JOB NUMBER DOING SINGLE DISPLAY ON
TXTPTR:	BLOCK	1		;ADDRESS IN JSB OF ASCII TEXT
TXTMAX:	BLOCK	1		;MAXIMUM NUMBER OF WORDS IN STRING
TXTCTR:	BLOCK	1		;COUNTER INTO WHICH WORD OF TEXT WE ARE ON
JFNOFF:	BLOCK	1		;OFFSET INTO JSB OF A JFN BLOCK
JFN:	BLOCK	1		;JFN WE ARE TYPING OUT
TXTTMP:	BLOCK	1		;TEMPORARY WORD
SNPVAL:	BLOCK	1		;VALUE OF .SNOOP SYMBOL
MONADR:	BLOCK	1		;ADDRESS IN MONITOR OF SNOOP PAGE
TIMES:	BLOCK	CPUAVG		;TIMES DATA IN EACH TABLE WAS COMPUTED
RUNTIM:	BLOCK	MAXJOB*CPUAVG	;TABLE OF COLLECTED RUNTIMES
CURRUN:	BLOCK	MAXJOB		;CURRENT RUNTIMES OF THE JOBS
CLSTAB:	BLOCK	MAXJOB		;SCHEDULER CLASS EACH JOB IS IN
CLSNUM:	BLOCK	MAXCLS+1	;NUMBER OF JOBS IN EACH CLASS
HANDLE:	BLOCK	1		;FORK HANDLE OF INFERIOR FORK
DEVUNT:	BLOCK	1		;JOB AND UNIT NUMBERS FOR A DEVICE
COLUMN:	BLOCK	1		;COLUMN COUNTER
REFLST:	BLOCK	1		;TIME OF LAST REFRESH
REFTIM:	BLOCK	1		;NUMBER OF MINUTES BETWEEN REFRESHES
SKPJFN:	BLOCK	1		;NUMBER OF JFNS TO BE SKIPPED
SKPFRK:	BLOCK	1		;NUMBER OF FORKS TO BE SKIPPED
CHNPC1:	BLOCK	1		;PC ON AN INTERRUPT
TTYFLG:	BLOCK	1		;USED TO STOP SLEEPS WHEN TTY COMMANDS TYPED
FRKFLG:	BLOCK	1		;USED TO STOP SLEEPS WHILE WAITING FOR EXEC
MAXRPF:	BLOCK	1		;FLAG FOR WHICH RUNTIME PERCENT CUTOFF IS USED
MAXRPT:	BLOCK	1		;MAXIMUM RUNTIME TO SUPPRESS FOR SHOWN JOBS
MAXIDL:	BLOCK	1		;MAXIMUM IDLE TIME FOR SHOWN JOBS
MAXIDF:	BLOCK	1		;FLAG FOR WHICH IDLE CUTOFF IS DONE
INTCNT:	BLOCK	1		;NUMBER OF CHARS IN INTERRUPT BUFFER
INTPTR:	BLOCK	1		;BYTE POINTER INTO BUFFER FOR INTERRUPT CODE
HLPJFN:	BLOCK	1		;JFN FOR HELP FILE
SBLK:	BLOCK	.MSRBT+1	;ARGUMENT BLOCK FOR MSTR
STRUC:	BLOCK	2		;STRUCTURE NAME
ALIAS:	BLOCK	2		;ALIAS NAME
UDB:	BLOCK	UDBSIZ		;BLOCK FOR READING UDB INTO
CHAN:	BLOCK	1		;CHANNEL NUMBER UDB IS OF
CTRL:	BLOCK	1		;CONTROLLER NUMBER UDB IS OF
UNIT:	BLOCK	1		;UNIT NUMBER UDB IS OF
COLTYP:	BLOCK	1		;FOR HELP OUTPUT
COLDIS:	BLOCK	1		;FOR LOOPING THROUGH DISPLAYED COLUMNS
COLSUP:	BLOCK	1		;FOR LOOPING THROUGH SUPPRESSED COLUMNS
LSTTYP:	BLOCK	1		;LAST TYPE OF COLUMN TYPED OUT
HLPDSP:	BLOCK	1		;DISPATCH FOR SPECIAL HELP
COLHLC:	BLOCK	1		;AOBJN POINTER TO DISPLAYS TO GIVE HELP ON
PAGTIM:	BLOCK	1		;TIME AT WHICH NEXT SCROLLING IS DONE
PAGINT:	BLOCK	1		;AUTOMATIC SCROLLING INTERVAL
LNKNUM:	BLOCK	1		;NUMBER OF LOGICAL LINKS TO TYPE OUT
BEGTIM:	BLOCK	1		;UNIVERSAL TIME SYSTEM STARTED
INTBUF:	BLOCK	1		;BUFFER IN USE BY INTERRUPT CODE
RUNPTR:	BLOCK	1		;BYTE POINTER INTO BUFFER FOR RUNTIME CODE
SAVCHR:	BLOCK	1		;LAST CHARACTER READ OF A COMMAND
TAKJFN:	BLOCK	1		;JFN OF INDIRECT FILE
TAKLVL:	BLOCK	1		;DEPTH OF NESTED TAKE COMMANDS
TAKLBL:	BLOCK	1		;LABEL IN TAKE FILE WE'RE LOOKING FOR
TAKPTR:	BLOCK	TAKMAX+1	;FILE POINTERS FOR EACH LEVEL OF TAKE FILES
TAKSVC:	BLOCK	TAKMAX+1	;SAVED CHARACTERS AND RESCAN FLAG
RUNBUF:	BLOCK	1		;BUFFER IN USE BY RUNTIME CODE
BUFFS:	BLOCK	BUFNUM		;POINTERS TO TTY BUFFERS
BUFFER:	BLOCK	BUFNUM*BUFLEN	;BUFFER AREA FOR TTY INPUT
CTYNUM:	BLOCK	1		;TERMINAL NUMBER OF THE CTY
MYJOB:	BLOCK	1		;MY JOB NUMBER
MYUSER:	BLOCK	1		;MY USER NUMBER
MYNAME:	BLOCK	1		;MY PROGRAM NAME
OPRUSR:	BLOCK	1		;THE OPERATOR'S USER NUMBER
VIRGIN:	BLOCK	1		;COUNT OF TRIES TO GET MONITOR SYMBOLS
SLPTIM:	BLOCK	1		;TIME TO SLEEP BETWEEN UPDATES
HGHJOB:	BLOCK	1		;HIGHEST JOB SYSTEM HAS
HGHTTY:	BLOCK	1		;HIGHEST TERMINAL NUMBER SYSTEM HAS
TTYSTS:	BLOCK	1		;STATUS WORD OF A TERMINAL
LOKNUM:	BLOCK	1		;NUMBER OF CURRENT ENQ LOCK BEING DONE
ENQNUM:	BLOCK	1		;NUMBER OF CURRENT ENQ QUEUE BLOCK
LSTNUM:	BLOCK	1		;LAST LOCK NUMBER OUTPUT
PIDTAB:	BLOCK	PIDSIZ+1	;STORAGE FOR PIDS OF A JOB
PIDJOB:	BLOCK	1		;JOB NUMBER READING PIDS OF
OLDJOB:	BLOCK	1		;PREVIOUS JOB WE PROCESSED
LOKTAB:	BLOCK	LCKMAX		;STORAGE FOR ENQ BLOCK POINTERS
BLK:	BLOCK	.JISTM+1	;DATA FROM GETJI JSYS
TEMP:	BLOCK	TMPSIZ		;TEMPORARY STRING STORAGE
USERS:	BLOCK	USRSIZ		;LINKED LIST OF USERS TO SHOW
USRLST:	BLOCK	1		;ADDRESS OF FIRST USER TO SHOW
USRFRE:	BLOCK	1		;FIRST FREE WORD IN USERS ARRAY
BITS:	BLOCK	<MAXJOB/^D36>+1	;BITS TO SUPPRESS SHOWING OF JOBS
NTIME:	BLOCK	1		;CURRENT UNIVERSAL FORMAT TIME
ACTTAB:	BLOCK	MAXTTY+1	;TABLE OF ACTIVE TIMES FOR TERMINALS
IDLE:	BLOCK	MAXJOB		;NUMBER OF MINUTES OF IDLE TIME
ORUNTM:	BLOCK	MAXJOB		;OLD RUNTIMES OF JOBS
RUNDIF:	BLOCK	MAXJOB		;DIFFERENCE BETWEEN CURRENT AND OLD RUN TIME
CPUPER:	BLOCK	MAXJOB		;CALCULATED CPU PERCENTAGE
TIMDIF:	BLOCK	1		;TIME INTERVAL CPU TABLE USES
OTIME:	BLOCK	1		;TIME THAT OLD RUNTIMES WERE COMPUTED
TIMRUN:	BLOCK	MAXJOB		;TIMES THAT RUNTIMES CHANGED
OLDSTA:	BLOCK	STATNM		;OLD VALUES OF STATISTICS
OLDTIM:	BLOCK	1		;UPTIME THEY WERE COMPUTED
PAGE:	BLOCK	1		;PAGE NUMBER OF OUTPUT WE ARE ON
OLDPAG:	BLOCK	1		;SAVED VALUE OF PAGE WHILE SHOWING HELP
OVRLAP:	BLOCK	1		;NUMBER OF LINES OF OVERLAP WANTED
SLWTIM:	BLOCK	1		;TIMER FOR SLOWDOWN FEATURE
DEVNAM:	BLOCK	2		;DEVICE NAME BEING GRUNGED ON
NEWSTA:	BLOCK	STATNM		;NEW VALUES OF STATISTICS
NEWTIM:	BLOCK	1		;UPTIME THEY WERE COMPUTED
STADIF:	BLOCK	1		;DIFFERENCE BETWEEN OLDTIM AND NEWTIM
KBLK:	BLOCK	10		;BLOCK FOR CLASS SCHEDULER DATA
HDRTXT:	BLOCK	^D50		;TEXT OUTPUT AS HEADER
HDRPTR:	BLOCK	1		;BYTE POINTER INTO HEADER TEXT
HDRPOS:	BLOCK	1		;COLUMN POSITION WE ARE AT
HDRTYP:	BLOCK	1		;CURRENT TYPE OF HEADER
COLSEP:	BLOCK	DISNUM+1	;SEPARATION TO USE BETWEEN COLUMNS
COLTBS:	BLOCK	4		;TAB STOPS FOR THIS OUTPUT
EATNUM:	BLOCK	1		;NUMBER OF LINES TO EAT
IDPGS:	BLOCK	1		;TOTAL PAGES IN USE BY A FORK
IDPAG:	BLOCK	1		;CURRENT PAGE OF FORK WE ARE LOOKING AT
IDNUM:	BLOCK	1		;NUMBER OF IDENTITIES IN TABLE
IDYNM:	BLOCK	1		;NUMBER OF IDENTITIES LEFT TO TYPE
TXTBUF:	BLOCK	TXTLEN		;STORAGE FOR CPYTXT ROUTINE
CURCOL:	BLOCK	1		;CURRENT COLUMN BEING OUTPUT
NXTCOL:	BLOCK	1		;NEXT COLUMN TO BE OUTPUT
COLDSP:	BLOCK	COLNUM+1	;COLUMN OUTPUT DISPATCHES
ORDMIN:	BLOCK	1		;MINIMUM COLUMN NUMBER TO ALLOW
ORDVAL:	BLOCK	1		;CURRENT BEST VALUE FOR COLUMN
ORDHAV:	BLOCK	1		;WHICH COLUMN IS CURRENTLY BEST
ORDIDX:	BLOCK	1		;COUNTER THROUGH COLUMNS
QSRPID:	BLOCK	1		;PID OF QUASAR
MYPID:	BLOCK	1		;MY PID
INFPID:	BLOCK	1		;PID OF SYSTEM INFO
APANUM:	BLOCK	1		;ARPANET HOST NUMBER
APASTS:	BLOCK	1		;HOST STATUS.  MUST FOLLOW APANUM!
PIDSYS:	BLOCK	PIDNUM		;TABLE OF SYSTEM PIDS
PRGWLD:	BLOCK	PRGMAX*3	;STORAGE FOR PROGRAM NAMES TO SHOW
PRGNUM:	BLOCK	1		;NUMBER OF PROGRAM NAMES TO CHECK
MBLK:	BLOCK	10		;ARGUMENT BLOCK FOR IPCF JSYSES
ABLK:	BLOCK	.NCSTS+1	;ARGUMENT BLOCK FOR ARPANET CONNECTIONS
MONSYV:	BLOCK	MAXSYM		;TABLE OF VALUES OF SYMBOLS
MONSYS:	BLOCK	MAXSYM		;TABLE OF SYMBOLS
MONSYO:	BLOCK	MAXSYM		;TABLE OF OFFSETS
MONSYC:	BLOCK	1		;NUMBER OF SYMBOLS IN TABLE
IDVALS:	BLOCK	1000		;TABLE OF IDENTITES OF FORK PAGES
IDCNTS:	BLOCK	1000		;NUMBER OF TIMES EACH IDENTITY WAS USED
RESDAT:	BLOCK	2		;DATA RETURNED ABOUT RESIDENT SPACE
ERRTOT:	BLOCK	1		;COUNTER FOR AGING ERROR CODES
ERRCNT:	BLOCK	1		;NUMBER OF ERROR CODES KNOWN
ERRCOD:	BLOCK	ERRNUM		;THE ERROR CODES WHICH ARE KNOWN
ERRAGE:	BLOCK	ERRNUM		;THE AGES OF EACH ERROR CODE
ERRTAB:	BLOCK	ERRNUM*ERRSIZ	;STRING STORAGE FOR THE ERRORS


	END	3,,ENTRY	;ENTRY VECTOR