Google
 

Trailing-Edge - PDP-10 Archives - BB-KL11M-BM_1990 - t20src/sysdpy.mac
There are 31 other files named sysdpy.mac in the archive. Click here to see a list.
; UPD ID= 36, RIP:<7.TOOLS-TAPE>SYSDPY.MAC.18,  22-Mar-90 08:47:27 by GSCOTT
;Edit 666 - Avoid doing extra GTHST .GTHNS functions at XXANAM for ANH display.
;This edit makes ANH faster as well as showing names that have expired TTLs
;which causes useless DNS queries for hosts with expired TTLs.  Also add
;ANC-PRTPKT and ANC-ZWINDOW columns to ANC display for Frank Wancho.
; UPD ID= 34, RIP:<7.TOOLS-TAPE>SYSDPY.MAC.17,   1-Mar-90 11:25:53 by GSCOTT
;Edit 665 - Add AND command.
; UPD ID= 32, RIP:<7.TOOLS-TAPE>SYSDPY.MAC.16,  19-Jan-90 14:12:55 by GSCOTT
;Edit 664 - Enhance ANT and ANC display.  Requires monitor edit [9140].
;Also remove use of ANADPY by doing handwaving that allows use of ANAUNV.
; UPD ID= 31, RIP:<7.TOOLS-TAPE>SYSDPY.MAC.15,   2-Jan-90 14:44:04 by GSCOTT
;Edit 663 - The job number in TOWNR is the global job number after edit 9115.
; UPD ID= 30, RIP:<7.TOOLS-TAPE>SYSDPY.MAC.14,   1-Dec-89 11:02:39 by GSCOTT
;Edit 662 - Output 30 characters of internet host name
; UPD ID= 28, RIP:<7.TOOLS-TAPE>SYSDPY.MAC.13,  21-Oct-89 16:53:46 by GSCOTT
;Edit 661 - Increase HSHSIZ and GATSIZ to 1000.
; UPD ID= 27, RIP:<7.TOOLS-TAPE>SYSDPY.MAC.12,  11-Oct-88 18:09:15 by RASPUZZI
;Edit 660 - Display the DQS object in the DECnet display (object 66.)
; UPD ID= 26, RIP:<7.TOOLS-TAPE>SYSDPY.MAC.11,  24-May-88 14:22:23 by RASPUZZI
;TCO 7.1291 - Note that GL2LCL is now in CFSUSR.
; UPD ID= 23, RIP:<7.TOOLS-TAPE>SYSDPY.MAC.10,  20-Apr-88 10:44:39 by RASPUZZI
;TCO 7.1277 - Fix problem with 7.1217. Mainly R is not a location in SYSDPY,
;	      it is an AC. Use CPOPJ instead.
; UPD ID= 22, RIP:<7.TOOLS-TAPE>SYSDPY.MAC.9,  26-Feb-88 13:40:41 by GSCOTT
;TCO 7.1236 - Edit 655, update copyright notice.
; UPD ID= 11, RIP:<7.TOOLS-TAPE>SYSDPY.MAC.8,   9-Feb-88 10:47:30 by MCCOLLUM
;TCO 7.1217 - Don't display bogus connect times or CPU percentages.
;             Treat not-logged-in jobs like operator jobs.
;             Implement "QP" command to show plot queues.
;             Add new terminal types to TT display.
; UPD ID= 7, RIP:<7.TOOLS-TAPE>SYSDPY.MAC.7,  14-Dec-87 09:37:25 by BROOKS
;Increment version number for 7.0 ft1
; UPD ID= 6, RIP:<7.TOOLS-TAPE>SYSDPY.MAC.6,  11-Nov-87 10:50:24 by MCCOLLUM
;TCO 7.1128 - VALPID has moves to XCDSEC; fix up IPCFNC. Also, fix the
;             way the GETSYM dealt with 30-bit addresses (it didn't).
; UPD ID= 5, RIP:<7.TOOLS-TAPE>SYSDPY.MAC.5,   4-Nov-87 15:53:12 by MCCOLLUM
;TCO 7.1112 - Fix up DPYSTR to understand Login Structure bits
; UPD ID= 2, RIP:<7.TOOLS-TAPE>SYSDPY.MAC.4,  24-Sep-87 11:22:51 by MCCOLLUM
;TCO 7.1063 - Check MS%OFS and display "Offline" in XXSTST; ST display
; UPD ID= 31, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.27,  15-Sep-87 15:37:33 by MCCOLLUM
;Get scheduler test from FKPGST if BSWTB is lit in FKSWP. Add two new
; function to MONRD% - .RDFSW to read FKSWP and .RDFSP to read FKPGST
; UPD ID= 30, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.26,   6-Apr-87 11:30:05 by MCCOLLUM
; Replace ERJMP R with ERJMP [RET] throughout
; UPD ID= 29, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.25,  16-Sep-86 17:03:40 by MCCOLLUM
; Add number of cached OFNs to RE display.
; UPD ID= 28, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.24,  22-Nov-85 16:35:01 by MCCOLLUM
; Increase the size of DTALOC to 5000 (DATSIZ) so DH will work.
; UPD ID= 27, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.23,  12-Jun-85 18:29:03 by GRANT
;More of previous edit
; UPD ID= 26, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.22,  12-Jun-85 17:55:17 by GRANT
;TCO 6.1.1446 - Display No-Answer when the remote system is ACKing REQUEST-IDs
;but not returning IDRECs.
; UPD ID= 25, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.21,  12-Jun-85 10:01:54 by PAETZOLD
;TCO 6.1.1444 - Fix ANC display to work for TVTs.  Remove the OPSTRM preventing
; them from working.
; UPD ID= 23, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.20,  28-May-85 16:36:19 by MCCOLLUM
;Fix error in last edit.
; UPD ID= 22, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.19,  28-May-85 16:27:00 by MCCOLLUM
;TCO 6.1.1412 - Change value of PD.CNT
; UPD ID= 21, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.18,  14-May-85 14:31:21 by MCCOLLUM
;Fix a display bug in XXLKJB and XXLPRG.
; UPD ID= 19, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.17,   5-May-85 17:21:38 by GROSSMAN
;TCO 6.1.1358 - Fix GBLFNC and JOBFNC to return correct info when job number
;is thyself.
; UPD ID= 18, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.16,  22-Apr-85 23:36:26 by MCCOLLUM
; UPD ID= 17, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.15,   5-Mar-85 12:12:39 by GLINDELL
;TCO 6.1.1230 - DECnet typeout for xmit and rcv counts should be in decimal
; UPD ID= 13, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.14,   2-Jan-85 14:56:26 by GRANT
;TCO 6.1.1106 - Add code for the optional column DSN to the DR display.
; UPD ID= 12, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.13,   2-Jan-85 14:50:23 by GRANT
;TCO 6.1.1105 - In GETUDB, make range check for unit number very large for MSCP server disks.
; UPD ID= 11, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.12,   2-Jan-85 14:41:34 by GRANT
;TCO 6.1.1104 - In XXDVCS, fix check for virtual circuit state to ignore LH.
; UPD ID= 10, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.11,   2-Jan-85 14:29:05 by GRANT
;TCO 6.1.1103 - In SBCNT, output number of system blocks in decimal.
; UPD ID= 9, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.9,  31-Dec-84 13:09:00 by MCCOLLUM
;Controller, channel, unit in decimal. Fix FTNPCS conditional code.
; UPD ID= 7, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.8,  10-Dec-84 10:36:49 by MCCOLLUM
;TABS were disallowed as input as a result of UPD ID=4
; UPD ID= 6, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.6,   4-Dec-84 14:01:48 by MCCOLLUM
;TCO 6.1.1071 - Use NTINF% JSYS for FOREIGN-HOST field.
; UPD ID= 5, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.5,   3-Dec-84 16:46:01 by MCCOLLUM
;TCO 6.1.1068 - Make P command try DEFAULT-EXEC: first. Also, change header
;on SCA path response column to 'Response' with 'Yes' or 'No' as path states
; UPD ID= 4, SNARK:<6.1.TOOLS-TAPE>SYSDPY.MAC.4,   3-Dec-84 15:35:17 by PAETZOLD
;Fix format to conform to TOPS20 coding standard.
;Support TCP.  Support ARP.   Remove old edit history.
; UPD ID= 70, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.61,  12-Nov-84 14:00:10 by MCCOLLUM
;Fix some loose ends in MS display.
; UPD ID= 69, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.60,  15-Oct-84 10:54:51 by MCCOLLUM
;Fix typo in DPYMDT routine that broke MD command.
; UPD ID= 68, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.59,  31-Aug-84 19:30:23 by MCCOLLUM
; Fix up problems with MS display caused by changing symbol definitions.
; UPD ID= 67, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.58,  21-Aug-84 13:36:10 by MCCOLLUM
; SCA symbols have moved modules again...
; UPD ID= 66, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.57,   7-Aug-84 12:28:22 by MCCOLLUM
;TCO 2.2162 - Display NPRIVP in job display.
; UPD ID= 65, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.56,   3-Jul-84 14:03:43 by MCCOLLUM
;TCO 6.2117 - Controller number can be up to 15 decimal now in GETUDB.
; UPD ID= 64, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.55,  29-Jun-84 11:55:04 by MCCOLLUM
;TCO 6.2112 - Add SCD command to display SCA "Don't care queue"
; UPD ID= 63, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.54,  27-Jun-84 12:08:22 by MCCOLLUM
;Fix up the flags that are displayed in the SCA connect block display
; UPD ID= 61, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.53,  14-Jun-84 17:34:05 by MCCOLLUM
;Rearrange the columns in the SC display. FLAGS should be last
; UPD ID= 60, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.52,  13-Jun-84 21:17:31 by MCCOLLUM
;TCO 6.2098 - Remove column SBI from the SC display
; UPD ID= 56, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.51,  11-Jun-84 11:16:11 by GLINDELL
;DECnet object names X29SRV/X25HST as per request of Son VoBa
; UPD ID= 54, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.50,   5-Jun-84 14:19:41 by MCCOLLUM
;TCO 6.2084 - Adjust values of FTPOKE functions to follow .RDGBL
; UPD ID= 53, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.49,  13-May-84 21:19:32 by GRANT
;More of previous edit
; UPD ID= 52, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.48,  13-May-84 21:00:04 by GRANT
;DECnet logical link block - LLSOB is now offset 34
; UPD ID= 46, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.47,  30-Apr-84 15:18:51 by MCCOLLUM
; TCO 6.2053 - Fix connection state codes. They've changed.
; UPD ID= 41, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.46,  26-Apr-84 12:46:36 by MCCOLLUM
; More of TCO 6.1946 - Only print error if symbol lookup fails entire monitor
; UPD ID= 39, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.44,  23-Apr-84 11:28:22 by MCCOLLUM
; TCO 6.2039 - Show EXCLUSIVE/SHARED attribute in structure status.
; UPD ID= 38, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.43,  26-Mar-84 17:02:39 by MCCOLLUM
;TCO 6.2015 - Separate ST display into ST and DR
;TCO 6.2014 - Change RETSKP in GBLFNC to JRST SKP(P1)
; UPD ID= 35, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.40,   9-Mar-84 14:58:28 by MCCOLLUM
; More of TCO 6.1990 - Fix some miscellaneous display problems.
; UPD ID= 34, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.39,   2-Mar-84 18:57:53 by MCCOLLUM
;TCO 6.1990 - Fix for global job numbers. Fix JSBFNC and PSBFNC to take
; global job number and conver to local. Write GBLFNC.
; UPD ID= 33, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.38,  29-Feb-84 14:40:37 by MCCOLLUM
;TCO 6.1988 - Add the state of the KLIPA to the SC header
; UPD ID= 32, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.37,   9-Feb-84 19:57:16 by MCCOLLUM
;TCO 6.1968 - Add MSCP displays. Invoked by MS and MC commands.
;TCO 6.1946 - Retry SNOOP if first lookup fails for SCA and UDB symbols
; UPD ID= 31, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.36,   4-Jan-84 15:44:06 by NICHOLS
;Correct DECnet link state names for 6.1
; UPD ID= 30, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.35,  15-Dec-83 19:32:13 by PAETZOLD
;TCO 6.1911 - Retry symbol lookups in case of module redefinition.
; UPD ID= 29, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.34,   6-Dec-83 19:07:17 by MCCOLLUM
; TCO 6.1891 - Fix MONRD% JSYS to return values for new swappable free space pools
; UPD ID= 28, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.33,  28-Nov-83 16:18:10 by MCCOLLUM
;TCO 6.1878 - Fix references to symbols that have moved out of SCAMPI
; UPD ID= 27, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.32,  19-Oct-83 14:15:17 by MCCOLLUM
;TCO 6.1835 - Make DISK display know about RA80s, RA81s, and RA60s.
; UPD ID= 26, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.31,  22-Sep-83 15:53:01 by MCCOLLUM
;TCO 6.1786 - Add SCA displays. New commands are SC, SCn, and SS
; UPD ID= 25, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.30,   1-Aug-83 16:44:55 by CHALL
;More DECnet-36 updating.
; UPD ID= 21, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.28,  13-Jun-83 13:40:02 by PURRETTA
;TCO 6.1684 - Still more of last edit (sigh) .. PSVAR + PSVARZ moved to STG
; UPD ID= 20, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.27,  13-Jun-83 12:59:26 by PURRETTA
;TCO 6.1683 - More of last edit, JSVAR moved to STG also.
; UPD ID= 19, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.25,   9-Jun-83 14:24:14 by PURRETTA
;TCO 6.1679 - SNOOP JSYS should look for JSVARZ in STG now, not POSTLD.
; UPD ID= 17, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.24,  14-Apr-83 12:15:42 by CHALL
;TCO 6.1614 - Have SNOOP JSYS look for MRPACS and SETMPG in PAGEM, not PAGFIL
; UPD ID= 16, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.23,  18-Mar-83 15:37:12 by CHALL
;Update DECNET routines to understand the DECnet-36 NODE JSYS
;(NDCIN). Put new code under DECN36 conditional; old code under IFE DECN36.
;Note: the MONRD code is unaltered so as not to confuse the old SYSDPY.
;But the new SYSDPY doesn't use that code nor the associated tables, and
;both should be removed eventually.
; UPD ID= 16, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.22,   1-Mar-83 14:32:46 by GRANT
;TCO 6.1481 - logical link block has been rearranged
;MAKE DECNET PER-CONNECTION OUTPUT USE NODE JSYS RATHER THAN MONRD
; UPD ID= 15, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.21,  24-Feb-83 00:27:31 by PAETZOLD
;561 - TCO 6.1521 - Place code in FHDECN under FTNRTS conditional.
;      TCO 6.1522 - Modify code in NOINIG to use GETER%.
;      TCO 6.1523 - Modify RESFNC for new PC section resident free space stuff.
; UPD ID= 14, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.20,  22-Feb-83 11:34:40 by GRANT
;560 - TCO 6.1493 - add new UNITS pool to resident free space display
; UPD ID= 12, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.19,   3-Feb-83 10:15:22 by GRANT
;557 - TCO 6.1492 - In RESFTL, maintain the sum of initial quotas
; UPD ID= 11, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.18,  17-Jan-83 14:26:32 by PAETZOLD
;556 - TCO 6.1466 - Reflect PAGEM module name changes
; UPD ID= 10, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.17,  19-Dec-82 13:11:56 by PAETZOLD
;555 - TCO 6.1425 - Remove monitor version check in CHKFRK in MONRD
; UPD ID= 9, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.16,  14-Dec-82 19:13:30 by PAETZOLD
;554 - TCO 6.1415 - Add the VT102 and VT125 to the terminal types table
; UPD ID= 7, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.15,  22-Sep-82 20:49:27 by PAETZOLD
;553 - TCO 6.1277 - Reformat output from the DH display
; UPD ID= 6, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.14,  22-Aug-82 18:59:22 by PAETZOLD
;552 - Fix assembly error with FR.NOS
; UPD ID= 4, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.13,  22-Aug-82 18:41:40 by PAETZOLD
;551 - TCO 6.1235 - Teach MONRD% how to poke under control of FTPOKE
; UPD ID= 3, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.12,   8-Aug-82 18:43:31 by PAETZOLD
;550 - TCO 6.1218 - Remove DECNET hosts from DN display and make a
;      DH display for DECNET hosts.  Clean up some listing problems.
; UPD ID= 2, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.11,  27-Jun-82 14:17:53 by PAETZOLD
;547 - More TCO 6.1179 - Turn off some bits in left half of priority word
; UPD ID= 1, SNARK:<6.TOOLS-TAPE>SYSDPY.MAC.10,  27-Jun-82 12:51:29 by PAETZOLD
;546 - TCO 6.1179 - Add support for displaying JOBSKD and JOBBIT

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1990.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A  LICENSE AND MAY BE USED AND  COPIED
;	ONLY IN  ACCORDANCE  WITH  THE  TERMS OF  SUCH  LICENSE  AND  WITH  THE
;	INCLUSION OF THE ABOVE  COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY  OTHER
;	COPIES THEREOF MAY NOT BE PROVIDED  OR OTHERWISE MADE AVAILABLE TO  ANY
;	OTHER PERSON.  NO  TITLE TO  AND OWNERSHIP  OF THE  SOFTWARE IS  HEREBY
;	TRANSFERRED.
;
;	THE INFORMATION IN THIS  SOFTWARE IS SUBJECT  TO CHANGE WITHOUT  NOTICE
;	AND SHOULD  NOT  BE CONSTRUED  AS  A COMMITMENT  BY  DIGITAL  EQUIPMENT
;	CORPORATION.
;
;	DIGITAL ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY OF  ITS
;	SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
	TITLE SYSDPY - Program to Watch Everything
	SUBTTL DEFINITIONS/DAVID I. BELL et al.

IF2,<PRINTX SYSDPY - PASS 2>

;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

	.CPYRT <<1976, 1990>>	;[7.1236] 
	.REQUES DPY		;ASK TO LOAD DPY
	.REQUIRE SYS:MACREL.REL	;WE ALSO NEED MACREL
	SALL			;MAKE FOR NICE MACROS

;	SEARCH ANADPY		;ANAUNV WITH CONFLICTING MACROS REMOVED
	SEARCH ANAUNV		;[664] Get monitor's TCP/IP symbols
	DEFINE TCB,<TCB.>	;[664] Monitor AC conflict
	DEFINE JFN,<JFN.>	;[664] Monitor AC conflict
	DEFINE GHT2,<GHT2.>	;[664] Monitor symbol conflict
	DEFINE TEMP,<TEMP.>	;[664] Get around stupid TEMP macro as well

	VWHO==0			;WHO LAST CHANGED
	VMAJOR==7		;[7.1063]MAJOR VERSION NUMBER
	VMINOR==0		;[7.1063]MINOR VERSION NUMBER
	VEDIT==666		;Edit number

;ACCUMULATORS:

	F=0			;FLAGS
	T1=1			;TEMPORARY AC'S
	T2=2
	T3=3
	T4=4
	Q1=13			;GENERAL SCRATCH AC'S
	Q2=14
	Q3=15
	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
	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
	FR.SCS==1B24		;SYMBOLS FOR SCA HAVE BEEN OBTAINED
	FR.MSC==1B25		;SYMBOLS HAVE BEEN OBTAINED FOR MSCP
	FR.ANA==1B26		;SYMBOLS FOR INTERNET HAVE BEEN OBTAINED
	FR.HD1==1B27		;TYPE ONE CRLF AFTER HEADER, NOT TWO
	FR.SCD==1B28		;[31]SCHED SYMBOLS HAVE BEEN SNOOPED

;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,2,17	;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

DEFINE ERSKP,<			;;SKIP ON ERROR
	ERJMP .+2>

;DEFAULT PARAMETERS:

ND DECSW,0			;INCLUDE DEC ONLY FEATURES
ND FTPOKE,0			;INCLUDE MONRD POKE FUNCTIONS IF ON
ND FTPRIV,-1			;-1 IF MONRD% JSYS IS TO BE PRIVILEGED
ND FTMDBG,0			;USE DEBUGING VERSION OF MONRD
IFE FTMDBG,<ND JSYNUM,717>	;SPECIAL SYSTAT JSYS NUMBER WHEN NOT DEBUGING
IFN FTMDBG,<ND JSYNUM,720>	;SPECIAL SYSTAT JSYS NUMBER WHEN DEBUGING
ND FTNPCS,1			;INCLUDE NON PC SECTION RESIDENT FREE SPACE REPORT
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,5000			;SIZE OF THE BLOCK
ND SNPLOC,356000		;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,^D75			;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,1000			;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,^D8			;MAXIMUM CLASS FOR SCHEDULER
ND TTYCHN,0			;TERMINAL INTERRUPT CHANNEL
ND CPUINT,^D10			;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,^D40000		;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)VWHO(9)VMAJOR(6)VMINOR(18)VEDIT

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
	SETZM DOTFLG		;ARPANET DISPLAY DEFAULT IS NOT DOTTED FORM
	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
	CAIGE T1,^D100		;[7.1217]IS IS REASONABLE?
	JRST CENOUT		;[7.1217]YES. GO OUTPUT IT
	RET			;[7.1217]NO. DON'T DISPLAY 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
	JUMPLE T1,CPOPJ		;[7.1277]IF NOT REASONABLE, FAIL
	MULI T1,^D<24*60>	;CONVERT FROM UNIVERSAL TIME
	ASHC T1,^D17		;TO MINUTES
	JRST TMHSPC		;OUTPUT IT AND RETURN

XXNPPG:	MOVE T1,['NPRIVP']	;GET WORD
	CALL GETJS0		;READ NUMBER OF PRIVATE PAGES IN JOB
	 RET			;CAN'T GET IT
	SKIPGE T1		;NPRIVP IS BUGGY AND DISPLAYING
	 SETZM T1		; IN NEGATIVE TRASHES THE SCREEN
	JRST DECSP6		;DISPLAY IT IN DECIMAL

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

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

XXFHST:				;DISPLAY ORIGINATING HOST
	MOVEI T1,.NTBAS		;GET ADR OF NTINF ARG BLOCK
	MOVEI T2,.NWNU1+1	;LENGTH OF ARG BLOCK
	MOVEM T2,.NWABC(T1)
	MOVEI T2,.NWRRH		;RETURN REMOTE HOST NAME FUNCTION CODE
	MOVEM T2,.NWFNC(T1)
	MOVE T2,.JITNO+BLK	;CONTROLLING TTY NUMBER OF JOB
	JUMPL T2,[RET]		;HANDLE DETACHED LINES
	TRO T2,.TTDES		;MAKE THE LINE NUMBER A LINE DESIGNATOR
	MOVEM T2,.NWLIN(T1)	;SAVE IT
	HRROI T2,HSTNAM		;POINTER TO SAVE HOST NAME
	MOVEM T2,.NWNNP(T1)
	NTINF%			;GET NETWORK INFO ON THIS TERMINAL
	 ERJMP CPOPJ		;[665] Forget this if error
	MOVEI T1,.NTBAS		;GET POINTER TO ARG BLOCK AGAIN
	MOVE T2,.NWTTF(T1)	;GET FLAGS WORD
	LDB T3,[POINT 9,T2,17]	;GET NETWORK TYPE
	CAIN T3,NW%NNT		;NON-NETWORK TERMINAL ?
	 RET			;YES
	MOVEI T1,.NTBAS		;GET POINTER TO ARG BLOCK AGAIN
	MOVE T2,.NWTTF(T1)	;GET FLAGS WORD
	LDB T3,[POINT 9,T2,17]	;GET NETWORK TYPE
	CAIN T3,NW%NNT		;NON-NETWORK TERMINAL ?
	 RET			;YES
	CAIE T3,NW%TCP		;TCP ?
	IFSKP.			;YES
	 MOVE T4,TCPDEL		;SET UP HOST PREFIX AND SUFFIX
	 MOVEM T4,HSTDEL	
	 MOVEI T3,.NWNNU(T1)	;YES - GET ADDRESS OF NODE NUMBER
	 CALL TCPHST		;GO TYPE IT
	  RET			;PROBLEM
	 JRST SYST5A		;FINISH UP
	ENDIF.
	CAIE T3,NW%DNA		;DECNET ?
	IFSKP.
	 HRRZ T3,T3		;GET LINE TYPE
	 MOVE T4,NRTDEL		;SET UP HOST PREFIX AND SUFFIX
	 CAIN T3,NW%CH		;CTERM ?
	 MOVE T4,CTMDEL		;SET UP HOST PREFIX AND SUFFIX
	 MOVEM T4,HSTDEL	
	 MOVEI T3,.NWNNU(T1)	;YES - GET ADDRESS OF NODE NUMBER
	 CALL DNAHST		;GO TYPE IT
	  RET			;PROBLEM
	 JRST SYST5A		;FINISH UP
	ENDIF.
	CAIE T3,NW%LAT		;LAT ?
	IFSKP.
	 MOVE T4,LATDEL		;SET UP HOST PREFIX AND SUFFIX
	 MOVEM T4,HSTDEL	
	 MOVEI T3,.NWNNU(T1)	;GET ADDRESS OF NODE NUMBER WORDS
	 CALL LATHST		;GO TYPE THEM
	  RET			;PROBLEM
	 JRST SYST5A
	ENDIF.
	RET			;UNKNOWN NETWORK TYPE
SYST5A:	STR$ HSTNAM		;TYPE THE NAME
	HRRZ T1,HSTDEL		;GET HOST NAME SUFFIX
	STR$ (T1)		;DISPLAY IT
	RET			;DONE
DNAHST:	MOVE T4,(T3)		;GET DECNET NODE NUMBER
	TXNN T2,NW%NNN		;HAVE A NODE NAME ?
	RETSKP			;YES
	HRROI T1,HSTNAM		;OUTPUT TO HSTNAM STRING
	MOVEI T3,^D10		;OUTPUT RADIX IS DECIMAL
	LDB T2,[POINT 6,T4,25]	;GET AREA OF DECNET NODE NUMBER
	JUMPE T2,DNAHS1		;ZERO ? DON'T TYPE AREA
	NOUT			;NO - THEN OUTPUT IT
	 ERJMP CPOPJ		;[665] Get out if error
	MOVEI T2,"."		;PRINT A DOT
	BOUT
DNAHS1:	LDB T2,[POINT 10,T4,35]	;GET HOST NUMBER PART
	NOUT
	 ERJMP CPOPJ		;[665] Get out if error
	RETSKP

LATHST:	SAVEAC <F>
	TXNN T2,NW%NNN		;HAVE A NODE NAME ?
	RETSKP			;YES
	MOVEI F,6		;ETHERNET ADDRESSES ARE 6 BYTES LONG
	MOVE T4,T3		;GET ADDRESS OF ETHERNET ADDRESS
	TXO T4,<POINT 8,0>	;FORM BYTE POINTER TO IT
	HRROI T1,HSTNAM		;OUTPUT TO HSTNAM STRING
	MOVX T3,<NO%LFL!NO%ZRO!<2B17>!^D16> ;HEX OUTPUT, 2 DIGITS, ZERO FILL
	JRST LATHS2		;DON'T PRINT A SEPERATOR
LATHS1:	MOVEI T2,"-"		;PRINT A SEPERATOR
	BOUT
LATHS2:	ILDB T2,T4		;GET A BYTE
	NOUT			;OUTPUT IT
	 ERJMP CPOPJ		;[665] Get out if error
	SOJG F,LATHS1		;LOOP TILL DONE
	RETSKP

TCPHST:	TXNN T2,NW%NNN		;HAVE A NODE NAME ?
	RETSKP			;YES
	HRROI T1,HSTNAM		;TYPE HOST NUMBER LIKE #.#.#.#
	MOVE T4,(T3)		;GET HOST NUMBER
	MOVEI T3,^D10
	LDB T2,[POINT 8,T4,11]	;GET A BYTE
	NOUT			;OUTPUT IT
	  ERJMP CPOPJ		;[665] Get out if error

	MOVEI T2,"."
	BOUT			;TYPE A DOT
	LDB T2,[POINT 8,T4,19]	;GET A BYTE
	NOUT			;OUTPUT IT IN DECIMAL
	  ERJMP CPOPJ		;[665] Get out if error
	MOVEI T2,"."
	BOUT			;TYPE A DOT
	LDB T2,[POINT 8,T4,27]	;GET A BYTE
	NOUT			;OUTPUT IT IN DECIMAL
	  ERJMP CPOPJ		;[665] Get out if error
	MOVEI T2,"."
	BOUT			;TYPE A DOT
	LDB T2,[POINT 8,T4,35]	;GET A BYTE
	NOUT			;OUTPUT IT IN DECIMAL
	  ERJMP CPOPJ		;[665] Get out if error
	RETSKP
	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
	SKIPE T2,BLK+.JIUNO	;[7.1217]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
	CALL SCDSYM		;[31]()GO SNOOP SCHEDULER SYMBOLS
	 RET			;[31]FAILED TO GET SYMBOLS
	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
	SUBTTL Subroutine to Obtain Scheduler Symbols by Snooping

;[31]
; SCDSYM - Read scheduler symbols
;
; This routine snoops the value of the monitor bit BSWTB. This symbol
; is used in the fork display by routine XXSCHD to determine if the
; fork is in a balance set wait.
; Call:
;	CALL SCDSYM
; Return:
;	+1: Failed to get symbol value
;	+2: Symbol's value stored in cell BSWTB

SCDSYM:	TXNE F,FR.SCD		;ALREADY HAVE SYMBOLS?
	RETSKP			;YES. RETURN GOOD
	MOVEI T1,.SNPSY		;SNOOP OUT A SYMBOL VALUE
	MOVE T2,[RADIX50 0,BSWTB] ;GET RADIX50 SYMBOL NAME
	MOVE T3,[RADIX50 0,SCHED] ;GET MODULE NAME
	SNOOP			;READ THE SYMBOL VALUE
	 RET			;FAILED RETURN +1
	MOVEM T2,BSWTB		;SAVE THE SYMBOL VALUE
	TXO F,FR.SCD		;SYMBOLS ARE NOW GOTTEN
	RETSKP			;RETURN GOOD
BSWTB:	BLOCK 1			;SAVE SYMBOL VALUE HERE

;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,.RDFSW		;[31]GET FUNCTION FOR SCHED FLAGS
	MOVE T2,FORK		;[31]AND THE FORK NUMBER
	MONRD%			;[31]GET THE SCHEDULER FLAGS
	 ERJMP CPOPJ		;[31]FAILED
	TDNE T2,BSWTB		;[31]IN BALANCE SET WAIT?
	SKIPA T1,[.RDFSP]	;[31]YES. GET SCHED TEST FROM FKPGST
	MOVEI T1,.RDFST		;[31]ELSE GET SCHED TEST FROM FKSTAT
	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 Routines Dealing With Jobskd and Jobbit

XXFRG:	MOVE T1,['JOBBIT']	;GET THE FORK PRIORITY WORD
	CALL GETPS0		;READ THE WORD FROM THE PSB
	 RET			;CAN'T GET IT
	JRST XXJRG2		;JOIN COMMON CODE

XXJRG:	MOVE T1,['JOBSKD']	;GET THE JOB WIDE PRIORITY WORD
	CALL GETJS0		;READ THE READ FROM THE JSB
	 RET			;CAN'T GET IT
XXJRG2:
	ANDX T1,<777,,777777>	;TURN OFF SOME HIGH ORDER BITS
	SKIPN T1		;ANY SPECIAL PRIORITY?
	 RET			;NO JUST RETURN
	STKVAR <JBSKTM>		;YES...GET US SOME STORAGE
	MOVEM T1,JBSKTM		;SAVE THE PRIORITY WORD
	HLRZS T1		;GET THE LEFT HALF
	JUMPE T1,XXJRG3		;RUN TIME GUARANTEE?
	CALL DECSP3		;OUTPUT THE PERCENT
	CHI$ "%"		;AND THE SYMBOL
	JRST XXJRG5		;CONTINUE WITH FLOW
XXJRG3:				;HERE WHEN NO RUN TIME GUARANTEE
	SPACE
	SPACE
	SPACE
	SPACE
XXJRG5:				;HERE AFTER RUN TIME GUARANTEE
	SPACE			;DO A SPACE
	MOVE T1,JBSKTM		;GET THE PRIORITY WORD
	TXNN T1,JP%SYS		;IS THE SYSTEM BIT ON?
	 JRST XXJRG6		;NO
	CHI$ "S"		;SAY THAT IT IS ON
	JRST XXJRG7		;CONTINUE WITH FLOW
XXJRG6:				;HERE WHEN JP%SYS IS OFF
	SPACE
XXJRG7:				;HERE AFTER JP%SYS CHECK
	LDB T1,[POINT 6,JBSKTM,35] ;GET LOW Q LIMIT
	SKIPN T1		;ANY SPECIAL Q LIMITS?
	 RET			;NO SO RETURN
	LDB T1,[POINT 6,JBSKTM,29] ;GET THE HIGH Q LIMIT
	CALL DECOUT		;OUTPUT IT
	LDB T1,[POINT 6,JBSKTM,35] ;GET THE LOW QUEUE LIMIT
	CALL DECOUT		;OUTPUT IT
	RET			;NOW WE ARE DONE
	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,SC%NWZ		;NETWORK WIZARD?
	CHI$ "N"		;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 T2,T1		;GET FORK NUMBER FOR MONRD%
	MOVEI T1,.RDGBL		;MONRD FUNCTION CODE
	MONRD%			;GET GLOBAL JOB NUMBER
	 ERJMP CPOPJ		;[665] Return +1 on error
	MOVE T1,T2		;GET GLOBAL JOB NUMBER IN T1
	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

PIDNAM:				;TABLE OF SYSTEM PID NAMES
	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:	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 EAT LINES AFTERWARD
	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 DECSP2		;OUTPUT IT AND RETURN

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

XXCTRL:	SKIPL T1,SBLK+.MSRCT	;GET CONTROLLER NUMBER
	JRST DECSP2		;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 DECOUT		;OUTPUT IT
	CHI$ "/"		;THEN A SLASH
	HRRZ T1,SBLK+.MSRNS	;GET TOTAL UNITS IN STRUCTURE
	JRST DECOUT		;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
	XWD .MSR80,[ASCIZ/RA80/] ;RA80 DISK
	XWD .MSR81,[ASCIZ/RA81/] ;RA81 DISK
	XWD .MSR60,[ASCIZ/RA60/] ;RA60 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

XXDSN:	MOVE T1,UDBDSN		;GET DRIVE
	MOVE T1,UDB(T1)		;SERIAL NUMBER
	JRST DECSP6		;OUTPUT IT AND RETURN
	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,^D15		;WHICH CAN ONLY BE FROM -1 TO 15.
	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,777777		;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.UDB		;ALREADY HAVE SYMBOLS?
	RETSKP			;YES. RETURN GOOD
	MOVEI T1,TBSUDB		;ADDRESS OF SYMBOLS
	MOVEI T2,TBMUDB		;TABLE OF MODULE NAMES
	MOVEI T3,TBVUDB		;TABLE OF SCA VALUES RETURNED
	MOVSI T4,-NUMUDB	;LENGTH OF TABLE
	CALL GTSYMS		;GET THE SYMBOLS
	 RET			;FAILED
	TXO F,FR.UDB		;SYMBOLS ARE NOW GOTTEN
	RETSKP			;YES. RETURN GOOD

;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 UDBDSN,PHYSIO	;;DRIVE SERIAL NUMBER
	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%OFS		;[7.1063]IS THE STRUCTURE OFFLINE?
	STR$ [ASCIZ/Offline /]	;[7.1063]YES, SAY SO
	TXNE T1,MS%PS		;[7.1112]Is this the Login Structure?
	STR$ [ASCIZ/Login /]	;[7.1112]Yes, say so
	TXNE T1,MS%BS		;[7.1112]Is this the boot structure?
	STR$ [ASCIZ/Boot /]	;[7.1112]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%EXC		;IS STRUCTURE EXCLUSIVE?
	STR$ [ASCIZ/Exclusive /] ;YES, SAY SO
	TXNN T1,MS%EXC		;IS STRUCTURE SHARED?
	STR$ [ASCIZ/Shared /]	;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
	NT .TT102,VT102
	NT .TT125,<VT125>
	NT .TTH19,H19		;[7.1217]
	NT .TT131,VT131		;[7.1217]
	NT .TT200,VT200		;[7.1217]
	NT .TT300,VT300		;[7.1217]
	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" Info

;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

DONUM:				;ROUTINE TO OUTPUT THE NEW VALUE ITSELF
	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. (ie. 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 Scheduler 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

"]
	CALL  SETEAT		;ALLOW FOR MULTIPLE SCREENS
	SETZM RESDAT		;INITIALIZE TOTAL IN CASE FAIL TOTALLY
	SETZM DPYRFL		;RESET THE RESIDENT FREE SPACE FLAG
	SETO J,			;GET READY FOR LOOP

RESLOP:
	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
	HLRZ T3,T2		;GET FIELD NUMBER
IFN FTNPCS,<			;ONLY IF WE ARE REPORTING NON PC SECTION
	SKIPN DPYRFL
         CAIE T3,1		;FIRST NON-ZERO FIELD?
          JRST RESLP1		;NOT FIRST FIELD
	SETOM  DPYRFL		;SET THE NON PC FREE SPACE FLAG
	SETO J,			;INITIALIZE J AGAIN
	JRST RESLOP		;DO FUNCTION ZERO AGAIN
RESLP1:
	SKIPN T3		;FIELD ZERO?
         SKIPN DPYRFL		;NON PC FLAG SET?
	  SKIPA			;NOT FIELD ZERO OR FLAG IS NOT SET
           HRLI T2,MAXRES	;FIELD ZERO WITH FLAG SET.  USE THIS FIELD.
>				;END OF IFN FTNPCS
	MOVEI T1,.RDRES		;GET FUNCTION CODE
	MONRD%			;READ THE DATA
	 ERJMP RESDON		;FAILED
	JUMPL T1,RESDON		;ALSO
	CALL RESTYP		;TYPE DATA ON THIS POOL
	HLRZ  T3,J		;GET THE FIELD NUMBER
	CAIGE T3,MAXRES-1	;HAVE WE DONE THE LAST FIELD?
         JRST RESLOP		;NO SO LOOP

RESDON:	STR$ [ASCIZ/		0%       20%       40%       60%       80%       100%
/]				;TYPE OUT PERCENTAGE LINE
	RET			;RETURN

RESTYP:	SKIPN T2		;IS THIS POOL EMPTY?
	RET			;YES
				;HERE TO TYPE A LINE ABOUT EACH FREE POOL
	SKIPN J			;IS THIS A RESIDENT SPACE HEADER?
	 JRST [ SKIPL DPYRFL	;YES. IS IT NON PC SECTION HEADER
		 JRST .+1	;NO
		MOVEI T4,MAXRES	;YES. USE RIGHT TEXT
		JRST .+2 ]	;JOIN COMMON CODE		
	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\Sec 0/1 space\] ;(0) TOTAL FREE RESIDENT BLOCKS
	EXP [ASCIZ/Swap free space/];(1) SWAPPABLE STORAGE
	EXP [ASCIZ/  General pool/] ;(2) SPACE IN GENERAL POOL
	EXP [ASCIZ/  ENQ blocks/] ;(3) ENQ USAGE
	EXP [ASCIZ/  IPCF space/] ;(4) IPCF SPACE
	EXP [ASCIZ/  DECnet/]	;(5) SWAPPABLE NETWORK
	EXP 1B0+[ASCIZ/Total OFNs Used/] ;(6) NUMBER OF OFNS
	EXP 1B0+[ASCIZ/Cached OFNs/] ;(7)
	EXP 1B0+[ASCIZ/SPT slots/] ;(7) SPT SLOTS
	EXP [ASCIZ/Swapping pages/] ;(10) PAGES OF SWAPPING
	EXP [ASCIZ/User pages/]	;(11) PAGES OF USER CORE USED
	EXP 1B0+[ASCIZ/Forks/]	;(12) NUMBER OF FORKS USED
	EXP [ASCIZ/Ext. sec space/] ;(13) NON PC RESIDENT BLOCKS
	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/]	;(3) DECNET
	EXP [ASCIZ/  TIMER%/]	;(4) TIMER% BLOCKS
	EXP [ASCIZ/  Units/]	;(5) PHYSIO AND DSKALC POOL

	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 Displays For Decnet Status

;This  mode  is  entered by the "DN" command. The status of all logical
;link blocks is given.

DPYDEC:				;NORMAL DECNET DISPLAY
	MOVEI T1,TP.DLL		;DECNET LINKS LINE
	CALL HDRSET		;SET THE HEADER TYPE
	TXNN F,FR.CMP		;WANT TO SEE TITLES?
         CALL  DNAVER		;YES SO SHOW DECNET VERSION INFORMATION
	CRLF
	CALL SETEAT		;SET UP TO EAT LINES NOW
	JRST DOLLNK		;GO SHOW LOGICAL LINKS

DPYNOD:				;DECNET NODE NAME DISPLAY
	SETOM HDRTYP		;RESET THE HEADER TYPE
	TAB$			;DEFAULT TAB STOPS
	TXNE  F,FR.CMP		;WANT TO SUPPRESS TITLES?
	 JRST  DPYND2		;YES SO SKIP THIS STUFF
        CALL DNAVER		;NO SO OUTPUT TITLES
	STR$ [ASCIZ/
Available Nodes:

/]
DPYND2:
	CALL SETEAT		;EAT SOME LINES
	JRST DONODE		;OUTPUT THE NODE NAMES
	SUBTTL Routine to Type Out Decnet Version Information

DNAVER:	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
	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
	RET			;RETURN TO CALLER
	SUBTTL Routine to Type Out Available Nodes

;This routine outputs the list of available nodes.

DONODE:	STKVAR <DONODR,DONODP,<DONODN,2>>
	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
	MOVEM  T4,DONODR	;SAVE NUMBER OF NODES RETURNED
	MOVEI T3,DATLOC+.NDBK1	;GET ADDRESS OF FIRST POINTER
	MOVEM  T3,DONODP	;SAVE ADDRESS OF FIRST POINTER

NODLOP:
	SOSGE T4,DONODR		;MORE NODES?
	 JRST DOCRLF		;NO SO JUST RETURN
	CALL FULL		;SCREEN FULL?
	 RET			;YES SO JUST RETURN
	CALL LEFT		;GET ROOM LEFT ON THIS LINE
	CAIGE T1,^D7		;ENOUGH FOR ANOTHER NODE NAME?
	STR$ [ASCIZ/
/]				;NO, MOVE TO NEW LINE
	MOVE T1,DONODP		;GET ADDRESS OF THIS BLOCK
	MOVE T1,@.NDNAM(T1)	;GET POINTER TO NODE NAME
	MOVEI  T2,DONODN	;GET NAME BUFFER ADDRESS
	HRLI  T2,440700		;MAKE IT A BYTE POINTER
	MOVEI T3,7		;WE NEED SEVEN CHARACTERS TOTAL
NODLP2:				;COLUMNIZING LOOP
	ILDB  T4,T1		;GET A BYTE
	JUMPE  T4,NODLP3	;LOOP UNTIL A NULL
	IDPB  T4,T2		;DEPOSIT THE BYTE
	SOJG T3,NODLP2		;LOOP UNTIL NULL
NODLP3:				;HERE WHEN WE FOUND THE NULL
	MOVEI T4," "		;GET A SPACE
	IDPB T4,T2		;DEPOSIT THE SPACE
	SOJG T3,NODLP3		;LOOP FOR SPACES
	SETZ T4,		;GET A NULL
	IDPB T4,T2		;APPEND A NULL
	MOVEI  T1,DONODN	;GET THE STRING ADDRESS
	STR$ (T1)		;TYPE IT
	AOS DONODP		;BUMP POINTER ADDRESS
	JRST 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:	SETZRO NBJOB,+NODBLK	;SET TO JOB 0
	SETZRO NBCHN,+NODBLK	; AND FIRST CHANNEL
	MOVEI T1,NB.LEN		;SET UP THE NUMBER OF WORDS REQUESTED
	STOR T1,NBRQW,+NODBLK

JBLNKL:	CALL FULL		;IS SCREEN FULL?
	 RET			;YES, RETURN
	MOVEI T1,.NDCIN		;SET TO READ CHANNEL INFORMATION
	MOVEI T2,NODBLK		;GET THE ADDRESS OF THE NODE BLOCK
	NODE			;GET INFORMATION ABOUT THE NEXT ACTIVE CHANNEL
	 ERJMP JBLNKE		;FAILED OR DONE - SEE WHICH
	SETOM KWNJOB		;CLEAR ANY KNOWN JOB FOR A FORK
	LOAD T1,NBSTA,(T2)	;GET THE STATE OF THE LINK
;	CAIN T1,.NSSCW		;NOT IN CONNECT WAIT?
	CAIN T1,1		;NOT IN CONNECT WAIT?
	TXNN F,FR.ACT		;OR WANT ALL LINKS ANYWAY?
	CALL DOCOLS		;YES, SHOW DATA ABOUT THIS LINK
	JRST JBLNKL		;EITHER WAY, MOVE TO THE NEXT LINK

JBLNKE:	LOAD T1,NBJOB,+NODBLK	;NODE JSYS FAILED - GET THE JOB NUMBER
	JUMPGE T1,LOSE		;IT'S A REAL ERROR IF THERE'S A REAL JOB #
	RET			;ELSE COMMAND IS DONE

;this below should be repeat zero, but is needed by the MONRD code

REPEAT 1,<

;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,16,17,21,31,34>
>
>				;END REPEAT 1

;Routines to type out various things about the links.

XXLKFK:	LOAD T1,NBFRK,+NODBLK	;GET THE FORK WHICH OWNS THIS LINK
	JUMPN T1,OCTSP3		;IF ANY, OUTPUT IT AND RETURN
LNKDIS:	STR$ [ASCIZ /--/]	;SAY NO FORK
	RET			;DONE

XXLKCH:	LOAD T1,NBCHN,+NODBLK	;GET THE DECNET CHANNEL NUMBER
	JRST DECOUT		;OUTPUT IT AND RETURN

XXLKJB:	LOAD T1,NBJOB,+NODBLK	;GET THE JOB WHICH OWNS THIS LINK
	JUMPGE T1,DECSP2	;OUTPUT THE JOB NUMBER, IF THAT'S WHAT IT IS
	STR$ T1			;OTHERWISE OUTPUT NAME OF SPECIAL PROGRAM
	RET			;DONE

XXLPRG:	LOAD T1,NBJOB,+NODBLK	;GET THE JOB WHICH OWNS THIS LINK
	JUMPL T1,XXLPG1		;IF NONE, OUTPUT TTY NUMBER INSTEAD
	MOVSI T1,(T1)		;PUT INTO LEFT HALF
	IORI T1,.JOBPN		;INDEX
	GETAB			;READ PROGRAM NAME
	 ERJMP CPOPJ		;FAILED
	JRST SIXOUT		;GO OUTPUT IT

XXLPG1:	LOAD T1,NBJFN,+NODBLK	;OUTPUT THE TTY NUMBER (DISGUISED AS JFN)
	JUMPLE T1,CPOPJ		;DON'T OUTPUT IT IF THERE'S NOTHING THERE
	STR$ [ASCIZ /TTY/]	;ELSE OUTPUT IT
	JRST OCTOUT		;AND RETURN

XXLBYC:	LOAD T1,NBSSZ,+NODBLK	;GET THE BYTE COUNT IN SEGMENT
	JRST DECSP6		;OUTPUT IT
XXLKID:	LOAD T1,NBRLA,+NODBLK	;GET THE LOCAL LINK ID
	JRST OCTSP6		;OUTPUT IT AND RETURN

XXLKIR:	LOAD T1,NBLLA,+NODBLK	;GET THE REMOTE LINK ID
	JRST OCTSP6		;OUTPUT IT AND RETURN

XXLSEG:	LOAD T1,NBPKS,+NODBLK	;GET THE TRANSMIT SEGMENT COUNTER
	CALL DECSP5		;OUTPUT IT
	LOAD T1,NBPKR,+NODBLK	;GET THE RECEIVE SEGMENT COUNTER
	JRST DECSP6		;OUTPUT AND RETURN

XXLOBJ:	LOAD T2,NBTYP,+NODBLK	;GET THE FLAG DISTINGUSHING DCN FROM A SRV
	LOAD T1,NBOBJ,+NODBLK	;ASSUME THIS IS A SRV - GET OBJECT CODE
;	SKIPN T2		;IS THIS ACTUALLY A DCN?
;	LOAD T1,NBROB,+NODBLK ;GET THE DESTINATION OBJECT CODE
	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 14,DIBOL
	NT 15,T20TRM
	NT 16,T20RSP
	NT 17,TCL
	NT 20,TLK
	NT 21,FAL
	NT 22,RTL
	NT 23,NCU
	NT 24,NETCPY
	NT 25,ONCTH
	NT 26,MAIL
	NT 27,NVT
	NT 30,TCON
	NT 31,LOOP
	NT 32,EVENT
	NT 33,MAIL11		;[7.1291]
	NT 34,FTS
	NT 35,PHONE
	NT 36,DDMF
	NT 37,X25GAT
	NT 40,UETP
	NT 41,VXMAIL
	NT 42,X29SRV
	NT 43,RDS
	NT 44,X25HST
	NT 45,SNAGAT
	NT 46,SNARJE
	NT 47,SNAGIS
	NT 50,MTSS
	NT 51,ELF
	NT 52,CTERM
	NT 53,DNSTA
	NT 54,DNSUL
	NT 55,DHCF
	NT ^D47,POSI
	NT ^D63,DTR
	NT ^D65,TOPOL
	NT ^D66,DQS		;[660]
	NT ^D123,PMR
	NT ^D201,MS

	OBJNUM==.-OBJTAB	;NUMBER OF ENTRIES

XXLKTP:	LOAD T1,NBTYP,+NODBLK	;GET THE FLAG DISTINGUSHING DCN FROM A SRV
	CAIN T1,0		;IS THIS A SRV OR A DCN?
	TDZA T2,T2		;A SRV, MAYBE
	MOVEI T2,1		;A DCN, MAYBE
	STR$ [ASCII /SRV /
		 ASCII /DCN /](T2) ;OUTPUT PROPER NAME
	CHI$ "("		;TYPE OPENING PARENTHESIS
	LOAD T1,NBSSZ,+NODBLK	;GET THE SEGMENT SIZE
	CALL DECOUT		;OUTPUT BYTE SIZE
	CHI$ ")"		;FINISH THE PARANTHESIS
	RET			;DONE

XXLHST:	LOAD T3,NBDNA,+NODBLK	;GET THE REMOTE NODE ADDRESS
	JUMPE T3,NOREM		;IF NONE, IT'S LOCAL
	MOVEI T1,.NDRNM		;GET MAGIC NODE JSYS FUNCTION
	MOVEI T2,T3		;AND ADDRESS OF ARG BLOCK
	HRROI T4,TEMP		;AND POINTER TO NODE NAME
	NODE
	 ERJMP CPOPJ
	SKIPE TEMP		;IF NONE, LOCAL
	JRST TELHST

NOREM:	STR$ LCLNOD		;OUTPUT OUR OWN NODE
	RET			;DONE

XXLUSR:	LOAD T1,NBJOB,+NODBLK	;GET THE JOB OWNING THE LINK
	JUMPGE T1,JOBUSR	;OUTPUT THE USER'S NAME IF THE JOB IS REAL
	LOAD T1,NBJFN,+NODBLK	;ELSE GET THE TTY NUMBER (DISGUISED AS JFN)
	JUMPLE T1,CPOPJ		;IF NONE, DO NOTHING
	ADDI T1,400000
	HRROI T2,T4		;READ RESPONSE IN T4
	MOVEI T3,.JIJNO		;SET TO READ THE JOB NUMBER
	GETJI			;READ IT
	 ERJMP CPOPJ		;CAN'T
	SKIPG T1,T4		;MOVE TO RIGHT AC - IS THERE A REAL JOB?
	  RET			;NO - LET IT BE BLANKS AFTER ALL
				;ELSE FALL INTO JOBUSR TO OUTPUT USER NAME

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:
;what the heck is the task name?
	SETZ T1,
;	LOAD T1,NBTYP,+NODBLK ;GET THE FLAG DISTINGUSHING DCN FROM A SRV
;	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:	LOAD T1,NBXFL,+NODBLK	;GET THE TRANSMIT FLOW CONTROL OPTION
	CAILE T1,MAXFLW		;LEGAL VALUE?
	SETO T1,		;NO, SAY UNKNOWN
	STR$ @FLOWTB(T1)	;OUTPUT THE TYPE
	SPACE			;SEPARATE WITH A SPACE
	LOAD T1,NBRFL,+NODBLK	;GET THE RECEIVE FLOW CONTROL OPTION
	CAILE T1,MAXFLW		;LEGAL VALUE?
	SETO T1,		;NO, SAY UNKNOWN
	STR$ @FLOWTB(T1)	;OUTPUT THE TYPE
	RET			;DONE

	[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:	LOAD T1,NBSTA,+NODBLK	;GET THE 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-EXISTENT
	[ASCIZ /CI wait/]	;(1)  CONNECT WAIT
	[ASCIZ /CI recd/]	;(2)  CONNECT RECEIVED
	[ASCIZ /CI sent/]	;(3)  CONNECT SENT
	[ASCIZ /Rejected/]	;(4)  REMOTE REJECTED CONNECT INIT
	[ASCIZ /Active/]	;(5)  LINK IS ACTIVE (UP AND RUNNING)
	[ASCIZ /DI recd/]	;(6)  DISCONNECT RECEIVED
	[ASCIZ /DI sent/]	;(7)  DISCONNECT SENT
	[ASCIZ /DI cnfm/]	;(10) DISCONNECT CONFIRMED
	[ASCIZ /No conf/]	;(11) NO CONFIDENCE
	[ASCIZ /No link/]	;(12) NO LINK
	[ASCIZ /No comm/]	;(13) NO COMMUNICATION
ABTCOD:	[ASCIZ /Aborted/]	;(14) CONNECTION ABORTED (NO RESOURCES)
	LLSMAX==.-LLSTAB-1	;HIGHEST KNOWN STATE

XXLABT:	LOAD T1,NBSTA,+NODBLK	;GET THE STATE CODE
	CAIE T1,ABTCOD-LLSTAB	;IS IT CONNECTION BROKEN?
	RET			;NO, TYPE NOTHING
	LOAD T1,NBRSN,+NODBLK	;GET THE REASON FOR DISCONNECT
	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

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


DITAB:	NT .DCX0,No special error ;Table of disconnect reasons
	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,T2		;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,.GTHIX		;GET HOST INFO FROM NAME INDEX
	HRROI T2,TEMP		;NAME INTO TEMP BUFFER
	MOVEI T3,(J)		;WITH HOST NAME INDEX
	GTHST%			;GET HOST NAME
	 ERJMP APALPL		;FAILED
	TXNE T4,HS%SRV		;NOT A HOST?
	 TXNE T4,HS%NCK		;OR A HOST NICKNAME?
	  JRST APALPL		;YES, DON'T SHOW IT
	IFXN. F,FR.AAH		;WANT TO SHOW ONLY VALID HOSTS?
	  TXNN T4,HS%VAL	;YES SO MAKE SURE STATUS IS VALID 
	  JRST APALPL		;NOT VALID, SKIP ON
	ENDIF.
	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
	CALLRET PNTHSN		;[665] (T1/) Print dotted number and return

XXANAM:	TXNE F,FR.MOR		;[666] Any more columns?
	SETZM TEMP+6		;[662] Yes, then restrict the name
	STR$ TEMP		;Output the name we got from .GTHIX function
	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)
	[ASCIZ /NETWORK/]	;(13)
	[ASCIZ /FUZZBALL/]	;(14)
	[ASCIZ /VMS/]		;(15)
	[ASCIZ /TAC/]		;(16)
	[ASCIZ /MSDOS/]		;(17)
	APATPX==.-APATPT-1	;HIGHEST KNOWN SYSTEM TYPE

XXASTS:	MOVE T1,APASTS		;GET THE STATUS OF THIS HOST
	TXNN T1,HS%VAL		;INFORMATION VALID?  (ONLY VALID FOR 1822 NETS)
	 RET			;NO, PRINT NOTHING
	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
	LDB T1,[POINTR APASTS,HS%HR] ;RANGE CHECK FOR VALIDITY
	LDB T2,[POINTR APASTS,HS%MIN]
	CAIGE T1,^D24
	 CAIL T2,^D12
	  RET
	LDB T1,[POINTR APASTS,HS%DAY]
	CAIL T1,^D7
	 RET
	STR$ [ASCIZ/, up /]	;HAVE REAL TIME, START OUTPUT
	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/unreachable/]	;[662](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 Internet Status Commands

;Brief display of the state of all TCP connections invoked by the "ANC"
;command

DPYARC:	MOVX T1,TCP%NI		;GET THE AOBJN POINTER
	STAT%			; ....
	IFJER.
	  TMSG <No TCP connections were found.>
	  RET			;JUST QUIT QUIETLY
	ENDIF.
	MOVE J,T2		;SAVE AOBJN POINTER
	MOVEI T1,TP.ANC		;COLUMNS FOR ANC COMMAND
	CALL HDRSET		;SET THEM UP
	TXO F,FR.EAT		;PREVENT ANOREXIA
DPYAC0:	CALL FULL		;SCREEN OVERFLOWED?
	 RET			;YES, RETURN TO CALLER
	HRRZ T1,J		;SET INDEX
	TXO T1,TCP%IX		;SET FLAG THAT INDICATES INDEXING
	MOVSI T2,-TCBSIZ	;-TCB LENGTH,,OFFSET
	MOVE T3,[XWD -TCBSIZ,TCB] ;-TCB LENGTH,,USER BUFFER
	STAT%			;COPY THE TCB INTO OUR ADDRESS SPACE
	 ERJMP DPYAC2		;IGNORE AN ERROR
	LOAD T1,TVTL,+TCB	;GET TVT NUMBER (MAY BE NONE)
	JUMPE T1,DPYAC1		;THERE IS NONE, DESPITE THE FLAG.  GET OWNER.
	MOVEI T1,.TTDES(T1)	;TURN INTO A TTY DESGINATOR
	JN TTVT,+TCB,DPYAC3	;SKIP IF THERE REALLY IS A TVT HERE

DPYAC1:	LOAD T1,TOWNR,+TCB	;[663] Get the global job who owns this TCB
DPYAC3:				;HERE WHEN WE HAVE THE JOB OR TTY DESIGNATOR
	MOVE T2,[-<.JISTM+1>,,BLK] ;PUT DATA IN STANDARD LOCATION
	SETZ T3,		;START AT FIRST WORD
	GETJI%			;READ INFORMATION ABOUT THE JOB
	 ERJMP DPYAC2		;NO JOB?  JUST SKIP THIS ONE, THEN.
	CALL DOCOLS		;PRINT A LINE
DPYAC2:	AOBJN J,DPYAC0		;LOOP OVER ALL TCB'S
	RET			;RETURN TO CALLER

;Display error wait index for this TCB. This is a kludge to associate a
;small,  unique  number  with the TCB. The (JOB,JCN) pair is not unique
;over the TCB's lifetime.

XXANCI:	LOAD T1,TERRF,+TCB	;LOAD ERROR WAIT BIT INDEX
	CALLRET DECSP3		;PRINT IT

XXANCJ:				;DISPLAY JOB ASSOCIATED WITH THIS TCB
	LOAD T1,TOWNR,+TCB	;[663] Get the global job who owns this TCB
	LOAD T2,TVTL,+TCB	;SKIP IF WE HAVE A TVT NUMBER
	JUMPE T2,DECSP3		;PRINT JOB NUMBER IF NOT A TVT
	MOVEI T1,.TTDES(T2)	;GET TTY NUMBER OF TVT
	HRROI T2,T4		;PUT ONE WORD IN T4
	MOVEI T3,.JIJNO		;GET JOB NUMBER
	GETJI%			;DO SO.
XXANCE:	 TDZA T1,T1		;FAILED, SAY JOB ZERO IS OWNER
	MOVE T1,T4		;GET JOB NUMBER INTO PLACE
	CALLRET DECSP3		;AND PRINT IT

XXANCT:				;DISPLAY TVT NUMBER
	OPSTR <SKIPN>,TTVT,+TCB	;SKIP IF THIS IS A TVT TCB
	 RET			;ELSE RETURN HAVING DONE NOTHING
	LOAD T1,TVTL,+TCB	;GET TVT/TTY NUMBER
	CALLRET OCTSP3		;ELSE PRINT OCTAL TTY NUMBER

XXANCU:				;DISPLAY USERNAME
	HRROI T1,TEMP		;INTO TEMP BUFFER
	MOVE T2,BLK+.JIUNO	;GET USER NUMBER
	DIRST%
	 ERJMP CPOPJ		;NO USER, LEAVE BLANK
	TXNE F,FR.MOR		;IS THIS THE LAST FIELD?
	SETZM TEMP+2		;NO, CUT OFF STRING
	STR$ TEMP		;PRINT USERNAME
	RET			;RETURN TO CALLER

XXANCN:				;DISPLAY JOBNAME
	SKIPN T1,BLK+.JIPNM	;GET PROGRAM NAME
	MOVE T1,BLK+.JISNM	;IF NONE, USE SUBSYSTEM NAME
	CALLRET SIXOUT		;GO OUTPUT IT
XXANCS:				;STATUS OF CONNECTION (RCV.SND)
	LOAD T1,TRSYN,+TCB	;RECEIVE STATE
	LOAD T2,TSSYN,+TCB	;SEND STATE
	STR$ @TCPSTA(T1)	;PRINT RCV STATE
	CHI$ "."		;SEPARATING DOT
	STR$ @TCPSTA(T2)	;PRINT SND SATE
	RET			;RETURN TO CALLER

TCPSTA:				;TABLE OF TCP STATES
	[ASCIZ/NOT/]		;NOTSYN
	[ASCIZ/-1-/]
	[ASCIZ/FIN/]		;FINSNT
	[ASCIZ/-3-/]
	[ASCIZ/PND/]		;SYNABL
	[ASCIZ/SYN/]		;SYNSNT
	[ASCIZ/-6-/]
	[ASCIZ/EST/]		;SYNCHED

XXANCQ:				;LOCAL HOST
	LOAD T1,TLH,+TCB	;GET LOCAL HOST NUMBER
	CALLRET PNTHSN		;[665] (T1/) Print dotted form host name

XXANCH:				;FOREIGN HOST
	LOAD T1,TFH,+TCB	;GET FOREIGN HOST NUMBER
	CALLRET PNTHST		;PRINT HOST NUMBER

XXANCL:				;LOCAL PORT
	LOAD T1,TLP,+TCB	;GET LOCAL PORT NUMBER
	CALLRET PNTPRT		;PRINT IT

XXANCF:				;FOREIGN PORT
	LOAD T1,TFP,+TCB	;GET FOREIGN PORT NUMBER
	CALLRET PNTPRT		;PRINT IT
XXANCR:				;[664] Requested MSS
	LOAD T1,TRMXP,+TCB	;[664] Foreign requested MSS
	CALLRET DECSP5		;[664] Print it

XXANCM:				;[664] Max pkt we are using
	LOAD T1,TSMXP,+TCB	;[664] Load max pkt
	CALLRET DECSP5		;[664] Print it

XXANCP:	LOAD T1,TRPP,+TCB	;[666] Load partial packet received flag
	JUMPE T1,CPOPJ		;[666] Get out if not partial packet
	STR$ [ASCIZ/ P/]	;[666] Print the flag
	RET			;[666] Return

XXANCW:	LOAD T1,TSWND,+TCB	;[666] Load send window
	JUMPN T1,CPOPJ		;[666] Get out if non zero send window
	STR$ [ASCIZ/ 0/]	;[666] Print the zero
	RET			;[666] Return

;Display  the  state  of  a  particular  TCB.  Invoked  by the "ANC<N>"
;command. The cell ANCIDX is already set up at this point.

DPYARJ:	CALL FNDTCB		;LOOK FOR THE TCB
	IFNSK.
	  STR$ [ASCIZ/There is no TCB for /] ;
	  MOVE T1,ANCIDX	;
	  CALL DECOUT		;PRINT INDEX NUMBER
	  CRLF
	  RET
	ENDIF.
	MOVEI T1,TP.ANC		;COLUMNS FOR ANC COMMAND
	CALL HDRSET		;SET THEM UP
	TXO F,FR.HDR		;BUT STOP HEADER FROM TYPING
	CALL DOCOLS		;PRINT LINE OF CONNECTION INFORMATION
	SETOM HDRTYP		;NO MORE COLUMNS
	TAB$			;SET UP DEFAULT TABS
	CALL SETEAT		;SET UP PAGING
	CALL ANJFLG		;FLAG BITS
	CALL ANJDEC		;DEC INTERFACE FLAGS
	CALL ANJMSC		;RANDOM PIECES OF INFORMATION
	MOVEI T1,TP.ASR		;WANT SEND/RECV DISPLAY
	TXO F,FR.HD1		;TYPE ONLY ONE CRLF AFTER HEADER
	CALL HDRSET		;SET UP TABS, ETC.
	SETZ J,			;DO SEND SIDE
	CALL DOCOLS		; ...
	SETO J,			;DO RECV SIDE
	CALL DOCOLS		; ...
	RET			;RETURN TO CALLER

;FNDTCB - Find TCB matching ANCIDX.
;RETURNS +1 FAILURE
;	 +2 SUCCESS, TCB AND BLK SET UP

FNDTCB:	MOVX T1,TCP%NI		;GET THE AOBJN POINTER
	STAT%			; ....
	 ERJMP CPOPJ		;[665] No connections, take failure return
	MOVE J,T2		;SAVE AOBJN POINTER
FNDTC0:	HRRZ T1,J		;SET INDEX
	TXO T1,TCP%IX		;SET FLAG THAT INDICATES INDEXING
	MOVSI T2,-TCBSIZ	;-TCB LENGTH,,OFFSET
	MOVE T3,[XWD -TCBSIZ,TCB] ;-TCB LENGTH,,USER BUFFER
	STAT%			;COPY THE TCB INTO OUR ADDRESS SPACE
	 ERJMP FNDTC2		;IGNORE AN ERROR
	LOAD T1,TERRF,+TCB	;GET ERROR WAIT BIT INDEX
	CAME T1,ANCIDX		;MATCH?
	 JRST FNDTC2		;NO, KEEP ON LOOKING
	LOAD T1,TVTL,+TCB	;GET TVT NUMBER (MAY BE NONE)
	JUMPE T1,FNDTC1		;THERE IS NONE, DESPITE THE FLAG.  GET OWNER.
	MOVEI T1,.TTDES(T1)	;TURN INTO A TTY DESGINATOR
FNDTC1:	LOAD T1,TOWNR,+TCB	;[663] Get the global job who owns this TCB
	MOVE T2,[-<.JISTM+1>,,BLK] ;PUT DATA IN STANDARD LOCATION
	SETZ T3,		;START AT FIRST WORD
	GETJI%			;READ INFORMATION ABOUT THE JOB
	 ERJMP CPOPJ		;[665] No job?  take error return.
	RETSKP			;RETURN TO CALLER WITH APPROPRIATE DATA

FNDTC2:	AOBJN J,FNDTC0		;GO ON TO NEXT TCB
	RET			;LOOK AT ALL WITH NO LUCK, TAKE FAILURE RETURN

;NEWLIN - Print a crlf and if eos, exit to caller of caller's caller 

NEWLIN:	CRLF			;PRINT A CRLF
	CALL FULL		;END OF SCREEN YET?
	 TRNA			;YES, TAKE A FUNNY RETURN
	  RET			;MORE TO GO, RETURN TO CALLER
	ADJSP P,-2		;RETURN TWO DEEP INTO STACK
	RET			;RETURN TO CALLER OF CALLER ON EOP

;BITOUT - Pretty print a flag description if the flag is set 
;Takes T1/ Sense of flag, 0 OR 1
;      T2/ Adress of description string
;Returns +1 always

BITOUT:	JUMPE T1,CPOPJ		;IGNORE CLEARED FLAGS
	PUSH P,T2		;SAVE POINTER TO STRING
	SETZ T1,		;USE T1 TO ACCUMULATE STRING LENGTH
	MOVE T3,[POINT 7,(T2)]	;SET UP POINTER TO STRING
BITOU0:	ILDB T4,T3		;GET A BYTE
	SKIPE T4		;SKIP IF EOS
	 AOJA T1,BITOU0		;ELSE COUNT AND LOOP
	PUSH P,T1		;SAVE BYTE COUNT
	CALL LEFT		;GET T1/ SPACES LEFT ON LINE
	POP P,T2		;RESTORE BYTE COUNT
	ADDI T2,2		;ACCOUNT FOR A POSSIBLE COMMA AND SPACE
	SUBI T1,(T2)		;SEE IF WE HAVE ROOM
	IFL. T1			;
	  CRLF			;NO ROOM, PRINT A CRLF
	  CALL FULL		;ARE WE AT END OF PAGE?
	  ANNSK.
	    ADJSP P,-2		;FUDGE STACK TO RETURN TWO DEEP
	    RET			;RETURN TO CALLER OF OUR CALLER'S CALLER
	ELSE.
	  LOC$ T1		;GET OUR CURRENT LOCATION
	  ANDI T1,-1		;SAVE JUST COLUMN NUMBER
	  SKIPE T1		;SKIP IF ON THE SCREEN'S EDGE
	   STR$ [ASCIZ/, /]	;ELSE PRINT A SEPARATING COMMA AND SPACE
	ENDIF.
	POP P,T2		;RESTORE ADDRESS OF DESCRIPTION
	STR$ (T2)		;PRINT DESCRIPTION
	RET			;RETURN TO CALLER

;FLGOUT - Print a flag description

DEFINE FLGOUT(OFFSET,DESC) <
	LOAD T1,OFFSET,+TCB
	MOVEI T2,[ASCIZ/DESC/]
	CALL BITOUT
>

;FLGCMP - Same as FLGOUT, but prints only if 'over' field is not set

DEFINE FLGOIF(OFFSET,OVER,DESC) <
	XLIST			;[664]
	LOAD T1,OFFSET,+TCB
	MOVEI T2,[ASCIZ/DESC/]
	OPSTR <SKIPN>,OVER,+TCB
	 CALL BITOUT
	LIST			;[664]
>

ANJFLG:	CALL NEWLIN		;ANJFLG - PRINT OUT TCB FLAG BITS
	FLGOIF (TWLDN,TSOPN,<Net wild OPEN%>) ;Show only if not open
	FLGOIF (TWLDT,TSOPN,<Host wild OPEN%>) ; ...
	FLGOIF (TWLDP,TSOPN,<Port wild OPEN%>) ; ...
	FLGOUT (TSCR,<Secure conn>)
	FLGOUT (TTVT,<TVT>)
	FLGOUT (TDEC,<DEC TCB>)
	FLGOUT (TSUOP,<TCB open>)
	FLGOIF (TSOPN,TSUOP,<TCB has been opened>) ;Show only if not open
	FLGOUT (TSPRS,<Persist>)
	FLGOUT (TSABT,<TCB aborted>)
	FLGOUT (TSSV,<Sequence valid>)
	FLGOUT (TSURG,<Send urgent>)
	FLGOUT (TRURG,<Rcv urgent>)
	FLGOUT (TSEP,<Encourage pkt>)
	FLGOUT (TSFP,<Force pkt>)
	FLGOUT (TRPP,<Partial pkt rcvd>)
	CALL NEWLIN
	RET			;RETURN TO CALLER
ANJDEC:				;DEC INTERFACE FLAGS
	LOAD T1,TDEC,+TCB	;DEC TCB?
	JUMPE T1,CPOPJ		;NO, DON'T DO ANYTHING
	CALL NEWLIN
	STR$ [ASCIZ/JFN /]	;[664] Label the JFN
	LOAD T1,TJFN,+TCB	;GET JFN
	IDIV T1,MLJFN		;COMPUTE USER JFN
	CALL OCTOUT
	LOAD T1,TCDWT,+TCB	;GET SENSE OF WAIT FLAG
	MOVEI T2,[ASCIZ/, Wait/] ;ASSUME SET
	SKIPN T1		;WELL?
	MOVEI T2,[ASCIZ/, Immediate/] ;NO IMMEDIATE ACTION WANTED
	STR$ (T2)		;PRINT FIRST PART OF OPEN MODE
	LOAD T1,TCDHT,+TCB	;GET SENSE OF HIGH THROUGHPUT FLAG
	MOVEI T2,[ASCIZ/ High-Throughput mode/] ;ASSUME SET
	SKIPN T1		;WELL?
	MOVEI T2,[ASCIZ/ Interactive mode/]
	STR$ (T2)		;PRINT LAST PART OF MODE DESCRIPTION
	LOAD T1,TCDFS,+TCB	;GET ACTIVE/PASSIVE FLAG
	MOVEI T2,[ASCIZ/, Active/] ;ASSUME ACTIVE
	SKIPN T1		;WELL?
	MOVEI T2,[ASCIZ/, Passive/] ;IT'S PASSIVE
	STR$ (T2)
	FLGOUT (TCDB8,<8-bit OPENF%>)
	FLGOIF (TCDOW,TSOPN,<OPENF% block>)
	FLGOIF (TCDGN,TSOPN,<GTJFN% name once>)
	FLGOIF (TCDGE,TSOPN,<GTJFN% ext. once>)
	FLGOUT (TCDPS,<Persist>)
	CALL NEWLIN		;[664] Output CRLF to keep it pretty
	FLGOUT (TCDOB,<Output buffer setup>)
	FLGOUT (TCDIB,<Input buffer setup>)
	FLGOUT (TCDCW,<CLOSF% block>)
	FLGOUT (TCDOQ,<Output queued>)
	FLGOUT (TCDPU,<Push>)
	FLGOUT (TCDUR,<Urgent>)
	CALL NEWLIN
	RET

ANJMSC:				;RANDOM VARIABLES
	CALL NEWLIN		;START OFF ON A NEW LINE
	MOVEI T1,[ASCIZ/TCB is locked/]
	LOAD T2,TCBLCK,+TCB	;GET TCB LOCK WORD
	SKIPL T2		;SKIP IF UNLOCKED (-1)
	 MOVEI T1,[ASCIZ/TCB is unlocked/]
	STR$ (T1)		;PRINT STATUS OF TCB LOCK
	LOAD T1,TOFRK,+TCB	;GET OWNING FORK
	CAIE T1,-1		;IF -1, WE ARE A TVT TCB OWNED BY JOB ZERO
	IFSKP.
	  STR$ [ASCIZ/, owned by TCP fork/]
	ELSE.
	  STR$ [ASCIZ/, owning fork is /]
	  CALL OCTOUT		;PRINT OWNING FORK NUMBER
	  STR$ [ASCIZ/, job /]
	  LOAD T1,TOWNR,+TCB	;GET JOB NUMBER
	  CALL DECOUT		;AND PRINT IT
	ENDIF.
	LOAD T1,TABTFX,+TCB	;GET FORKX OF ABORTER
	IFN. T1
	  STR$ [ASCIZ/, aborting fork is /]
	  CALL OCTOUT		;PRINT ABORTING FORK IF IT EXISTS
	ENDIF.
	LOAD T1,TERR,+TCB	;GET TCP ERROR CODE
	IFN. T1
	  STR$ [ASCIZ/, TCP error /] ;[664] Only if there is a code
	  CALL OCTOUT		;DO WE PRINT ANYTHING
	ENDIF.
	CALL NEWLIN		;START A NEW LINE
	STR$ [ASCIZ/Send timeout /] ;[664] Label the send timeout number
	LOAD T1,TSTO,+TCB
	CALL DECOUT		;TIMEOUT INTERVAL
	STR$ [ASCIZ/ ms, Time to live /] ;[664] Label TTL 
	LOAD T1,TTTL,+TCB	;GET IP TIME TO LIVE
	CALL DECOUT
	STR$ [ASCIZ/ secs/]
	CALL NEWLIN
	STR$ [ASCIZ/IP fragmenting is /] ;LEAD IN
	LOAD T1,TIFDF,+TCB	;GET SENSE OF DON'T FRAGMENT FLAG
	MOVEI T2,[ASCIZ/allowed/] ;ASSUME ALLOWD
	SKIPE T1		;USUALLY OFF
	 MOVEI T2,[ASCIZ/not allowed/] ;(I DON'T THINK TOPS-20 EVEN LOOKS)
	STR$ (T2)		;PRINT IT
	STR$ [ASCIZ/, Buffer misses /] ;[664] 
	LOAD T1,TCTBS,+TCB
	CALL DECOUT		;NO. TIMES PACKETIZER WAITED FOR BUFFERS
	CALL NEWLIN		;START A NEW LINE
	LOAD T1,TTOS,+TCB	;GET TYPE OF SERVICE BYTE
	MOVEI T2,[ASCIZ/High reliability/]
	TXNN T1,1B33
	MOVEI T2,[ASCIZ/Normal reliability/]
	STR$ (T2)
	MOVEI T2,[ASCIZ/, High throughput/]
	TXNN T1,1B32
	MOVEI T2,[ASCIZ/, Normal throughput/]
	STR$ (T2)
	MOVEI T2,[ASCIZ/, Low delay/]
	TXNN T1,1B31
	MOVEI T2,[ASCIZ/, Normal delay/]
	STR$ (T2)
	CALL NEWLIN		;START A NEWLIN

	STR$ [ASCIZ/Precedence /] ;[664] 
	LOAD T1,TTOS,+TCB	;GET TYPE OF SERVICE BYTE
	LSH T1,-5		;SCRAPE OFF FIVE BITS
	STR$ @PRCTAB(T1)	;PRINT PRECEDENCE DESCRIPTION
	STR$ [ASCIZ/, Security level /]	;[664] 
	LOAD T1,TSLVN,+TCB
	CALL DECOUT		;PRINT CURRENT SECURITY LEVEL
	STR$ [ASCIZ/, next level /] ;[664] 
	LOAD T1,TSLVC,+TCB
	CALL DECOUT		;PRINT NEXT SECURITY LEVEL
	CALL NEWLIN		;START A NEW LINE

	STR$ [ASCIZ/Remote offered max segment size /] ;[664] Remote's MSS
	LOAD T1,TRMXP,+TCB	;[664]
	CALL DECOUT		;[664]
	STR$ [ASCIZ/, using max segment size /] ;[664] MSS we are using
	LOAD T1,TSMXP,+TCB	;[664]
	CALL DECOUT		;[664]
	CALL NEWLIN		;[664]
;[664] Output the retransmission statistics that interest us most.

	CALL NEWLIN		;[664] Blank line
	STR$ [ASCIZ/Min RTT /]	;[664]
	LOAD T1,TMNRT,+TCB	;[664] 
	CALL DECOUT		;[664] Min rt time
	STR$ [ASCIZ/ ms, Max RTT /] ;[664] 
	LOAD T1,TMXRT,+TCB	;[664] 
	CALL DECOUT		;[664] Max round trip time
	STR$ [ASCIZ/ ms, Last RTT /] ;[664] 
	LOAD T1,TMEAS,+TCB	;[664] Load last rt time
	CALL DECOUT		;[664] 
	STR$ [ASCIZ/ ms/]	;[664] 
	CALL NEWLIN		;[664] Start new line
	
	STR$ [ASCIZ/Average RTT /] ;[664] 
	LOAD T1,TSAVG,+TCB	;[664] Load scaled average time
	ASH T1,-3		;[664] Scale it back by eight
	CALL DECOUT		;[664] 
	STR$ [ASCIZ/ ms with mean deviation /] ;[664] 
	LOAD T1,TSDEV,+TCB	;[664] Load scaled deviation
	ASH T1,-2		;[664] Scale it back by four
	CALL DECOUT		;[664] 
	CALL NEWLIN		;[664]

	STR$ [ASCIZ/Retransmit interval /] ;[664] 
	LOAD T1,TRXI,+TCB	;[664] 
	CALL DECOUT		;[664] Retransmit interval
	STR$ [ASCIZ/ ms, retransmission count /] ;[664] 
	LOAD T1,TRCNT,+TCB	;[664] Get retransmission count
	CALL DECOUT		;[664]
	OPSTR <SKIPE>,TRXD,+TCB	;[664] Rx in progress?
	STR$ [ASCIZ/, retransmission active/] ;[664] Yes
	CALL NEWLIN		;[664] Start a new line 

	STR$ [ASCIZ/Last send window /] ;[664] 
	LOAD T1,TCURW,+TCB	;[664] Load current window
	CALL DECOUT		;[664] 
	STR$ [ASCIZ/, congestion window /] ;[664] 
	LOAD T1,TCWND,+TCB	;[664] Load congestion window
	CALL DECOUT		;[664] Send that too
	STR$ [ASCIZ/, ss threshold /] ;[664] 
	LOAD T1,TSSTH,+TCB	;[664] Load ssthresh
	CALL DECOUT		;[664] 
	CALL NEWLIN		;[664] Start a new line 
	RET			;ALL DONE, RETURN TO CALLER
PRCTAB:				;PRECEDENCE LEVEL DESCRIPTIONS
	[ASCIZ/Routine/]
	[ASCIZ/Priority/]
	[ASCIZ/Immediate/]
	[ASCIZ/Flash/]
	[ASCIZ/Flash Override/]
	[ASCIZ\CRITIC/ECP\]
	[ASCIZ/Internet Ctrl/]
	[ASCIZ/Network Ctrl/]

;Routines for the Arpanet Send/Receive display

;Print snd or rcv in front of the line

XXASRT:	MOVEI  T1,[ASCIZ/Output/] ;ASSUME SEND
	SKIPE J			;WELL?
	 MOVEI T1,[ASCIZ/Input/] ;NO, IT'S RECEIVE
	STR$ (T1)		;PRINT NAME OF THIS LINE
	RET			;RETURN TO CALLER

;Print left edge for both snd and rcv

XXASRE:	LOAD T1,TSLFT,+TCB	;GET SEND LEFT EDGE
	LOAD T2,TSIS,+TCB	;[664] Get number of bytes transmitted
	IFN. J			;[664] If we are showing rec number
	 LOAD T1,TRLFT,+TCB	;[664] Get recv left edge
	 LOAD T2,TRIS,+TCB	;[664] Get initial sequence number
	ENDIF.			;[664] End of rec code
	SUB T1,T2		;COMPUTE AMOUNT OF DATA SENT/RECEIVED
	MODSEQ T1		;MODULO 2^32
	CALLRET DECSP8		;PRINT IT AND EXIT

;Print snd/rcv window

XXASRW:	LOAD T1,TSWND,+TCB	;GET SIZE OF SEND WINDOW
	SKIPE J			;SKIP IF WE'RE DOING SEND
	 LOAD T1,TRWND,+TCB	;GET SIZE OF RCV WINDOW
	CALLRET DECSP6		;PRINT IT
;[665] Display DNS host stats with the "AND" command.

DPYARD:	MOVEI T1,TP.AND		;[665] Point to header table
	CALL HDRSET		;[665] Set the headers
	TXO F,FR.EAT		;[665] Remember to eat later
	SETZ J,			;[665] Zero index to tables

	DO.			;[665] Loop through all possible indexes
	  CALL FULL		;[665] Full page?
	   RET			;[665] Yes, get out now
	  MOVEI T1,.GTHDN	;[665] Load function code
	  MOVE T2,J		;[665] Load offset to read today
	  MOVEI T3,GTHSTB	;[665] Point to block of words to read into
	  MOVEI T4,TMPSIZ	;[665] Load number of words to return
	  GTHST%		;[665] Try to get this one
	   ERJMP CPOPJ		;[665] All done with index or not in monitor
	  SKIPN GTHSTB+.GTHDA	;[665] Was that the last host?
	  RET			;[665] Yes, get out now
	  CALL DOCOLS		;[665] Display this information
	  AOJA J,TOP.		;[665] Loop for all of them today please
	OD.			;[665] End of loop 

;[665] Column routines for "AND" display.

XXANDI:	MOVE T1,.GTHDA+GTHSTB	;[665] Load internet host number
	CALLRET PNTHSN		;[665] (T1/) Print internet host number

XXANDH:	MOVE T1,.GTHDA+GTHSTB	;[665] Load the internet host address
	CALLRET PNTHSS		;[665] (T1/) Print name and return

XXANDT:	MOVE T1,.GTHDT+GTHSTB	;[665] Load timeout value in seconds
	CALLRET DECSP7		;[665] Print a potentially large decimal number

XXANDS:	SKIPA T1,.GTHDS+GTHSTB	;[665] Load DNS host success counta
XXANDF:	MOVE T1,.GTHDF+GTHSTB	;[665] Load DNS host failure count
	CALLRET DECSP9		;[665] Print a potentially large decimal number

;Display  the state of directly connected gateways invoked by the "ANG"
;command

DPYARG:	CALL ANASYM		;GET SYMBOLS IF NECESSARY
	 JRST LOSE		;TELL USER WHY HE/SHE LOST
	HRRZ T1,GWTAB
	CALL DOPEEK		;GET POINTER TO GW TABLE IN MONITOR
	 JRST LOSE
	MOVE T1,MAXGWA		;T1/ NUMBER OF GW'S (WORDS)
	MOVEI T2,GATTAB		;T2/ USER ADDRESS
	MOVEM T3,GATPTR		;T3/ MONITOR ADDRESS
	CALL .XPEEK		;READ FROM MONITOR VAS
	 JRST CPOPJ		;ERROR, JUST PUNT
	MOVEI T1,TP.ANG		;COLUMNS FOR THE ANG DISPLAY
	CALL HDRSET		;SET UP THE HEADER
	TXO F,FR.EAT		;REMEMBER TO DO EATING LATER
	MOVN J,MAXGWA		;GET NUMBER OF GATEWAYS
	MOVSI J,(J)		;FORM AOBJN POINTER
	PUSH P,I		;SAVE VALUE OF I
	MOVEI I,GATTMP		;SET UP I AS INDEX INTO GATTMP BLOCK
DPYAG0:	CALL FULL		;SCREEN OVERFLOW?
	 JRST DPYAG2		;YES, RETURN TO CALLER
	SKIPN T3,GATTAB(J)	;LOAD POINTER TO THE GW BLOCK
	 JRST DPYAG1		;NO GW BLOCK, SKIP TO NEXT ENTRY
	MOVEI T1,GWBKSZ		;LENGTH OF A GW BLOCK
	MOVEI T2,GATTMP		;USER ADDRESS
	CALL  .XPEEK		;READ FROM MONITOR VAS
	 JRST DPYAG2		;SOME ERROR
	CALL DOCOLS		;INVOKE THE DISPLAY ROUTINES
DPYAG1:	AOBJN J,DPYAG0		;LOOP OVER ALL ENTRIES
DPYAG2:	POP P,I			;RESTORE I
	RET			;RETURN TO CALLER

XXANGN:				;NAME OF THE GATEWAY
	MOVE T1,.GWILS(I)	;GET DIRECTLY CONNECTED INTERFACE NUMBER
	CALLRET PNTHST		;PRINT AS A HOST NAME

XXANGT:				;TYPE OF GATEWAY
	LOAD T1,GWTYP,(I)	;GET TYPE CODE
	CAILE T1,MAXGAT		;RANGE CHECK
	 MOVEI T1,0		;CALL IT UNKNOWN IF OUT OF RANGE
	STR$ @GATTYP(T1)	;PRINT GW TYPE
	RET			;RETURN TO CALLER

GATTYP:	[ASCIZ/Unknown/]
	[ASCIZ/Prime/]
	[ASCIZ/Dumb/]
	[ASCIZ/Host/]
	[ASCIZ/Always-up/]
MAXGAT==.-GATTYP

XXANGS:				;STATE OF GATEWAY
	LOAD T1,GWUP,(I)	;GET UP/DOWN BIT
	CAIN T1,1		;IF SET
	 STR$ [ASCIZ/Up/]	;GATEWAY IS UP
	CAIN T1,0		;IF CLEARED
	 STR$ [ASCIZ/Down/]	;GATEWAY IS DOWN
	RET			;RETURN TO CALLER
XXANGC:				;CONNECTED NETS
	PUSH P,I		;SAVE GLOBAL VALUE OF I
	MOVE I,[XWD -MXGWIC,1]	;SET UP AOBJN POINTER FOR INTERFACES
	SKIPN T1,GATTMP(I)	;LOAD UP FIRST INTERFACE
	 JRST XXANG2		;NOTHING THERE, EXIT NOW
	NETNUM T1,T1		;GET A NETWORK NUMBER
	CALL PNTNET		;PRINT THE NET STRING
	JRST XXANG1		;GO BUMP AOBJN POINTER AND ENTER MAIN LOOP

XXANG0:	SKIPN T1,GATTMP(I)	;IS THERE AN INTERFACE HERE?
	 JRST XXANG1		;NO, GO TRY NEXT SLOT
	STR$ [ASCIZ/, /]	;FOR PRETTY
	NETNUM T1,T1		;CONVERT TO A NETWORK NUMBER
	CALL PNTNET		;PRINT THE NET STRINGK
XXANG1:	AOBJN I,XXANG0		;LOOP OVER ALL INTERFACES
XXANG2:	POP P,I			;RESTORE I
	RET			;RETURN TO CALLER

;Display  the network hash table and what gateways we are using invoked
;by the "ANN" command

DPYARN:	CALL ANASYM		;GET SYMBOLS IF NECESSARY
	 JRST LOSE		;FAILED, RETURN TO CALLER WITH EXPLANATION
	HRLZ T1,NETHSZ
	HRR T1,NETHTB
	MOVEI T2,NTHASH
	CALL DOPEEK		;READ NET HASH TABLE
	 JRST LOSE		;FAILED
	HRLZ T1,NETHSZ
	HRR T1,NETGWX
	MOVEI T2,NTGATE
	CALL DOPEEK		;READ PARALLEL TABLE OF GATEWAYS
	 JRST LOSE
	MOVEI T1,TP.ANN		;GET CODE FOR INTERNET NETWORK DISPLAY
	CALL HDRSET		;AND SET UP HEADERS FOR IT
	TXO F,FR.EAT		;REMEMBER TO DO EATING LATER
	MOVN J,NETHSZ		;GET SIZE OF HASH TABLE
	MOVSI J,(J)		;FORM AOBJN POINTER
DPYAR0:	CALL FULL		;OVERFLOWED SCREEN?
	 RET			;YES, QUIT DISPLAYING
	SKIPLE NTHASH(J)    	;SKIP IF NO NETWORK IN THIS SLOT
	 CALL DOCOLS		;ELSE, DISPLAY A NETWORK LINE
	AOBJN J,DPYAR0		;LOOP OVER ALL HASH TABLE ENTRIES
	RET			;ALL DONE, RETURN TO CALLER

;Display the ethernet gateway-host table (just ARP information for now)
;invoked by the "ARP" command. Does not require monrd.

DPYGHT:	CALL ANASYM		;GET SYMBOLS IF NECESSARY
	 JRST LOSE		;FAILED, RETURN TO CALLER WITH EXPLANATION
	HRRZ T1,GHTCNT		;GET THE NUMBER OF GHT ENTRIES
	CALL DOPEEK
	 JRST LOSE
	CAIL T1,MAXGHT		;MORE ENTRIES THAN WE CAN DEAL WITH?
	 MOVEI T1,MAXGHT	;YES, WELL, MAKE THE BEST OF IT
	MOVEM T1,J		;SAVE THE COUNT
	HRRZ T1,GHTAR1
	CALL DOPEEK		;GET THE ADDRESS OF AREA 1
	 JRST LOSE
	MOVEM T1,GHT1AD		;SAVE IT
	HRRZ T1,GHTAR2
	CALL DOPEEK		;GET THE ADDRESS OF AREA 2
	 JRST LOSE
	MOVEM T1,GHT2AD		;SAVE IT

	MOVE T1,J		;T1/ COUNT
	MOVEI T2,GHT1		;T2/ USER ADDRESS
	MOVE T3,GHT1AD		;T3/ MONITOR ADDRESS
	CALL .XPEEK		;COPY GHT AREA 1
	 JRST LOSE
	MOVE T1,J		;GET GHT ENTRY COUNT
	IMULI T1,GH2MDL		;MULTIPLY BY AREA 2 ENTRY SIZE
	MOVEI T2,GHT2		;T2/ USER ADDRESS
	MOVE T3,GHT2AD		;T3/ MONITOR ADDRESS
	CALL .XPEEK		;COPY GHT AREA 2
	 JRST LOSE
	MOVEI T1,TP.ARP		;COLUMNS FOR THE ARP DISPLAY
	CALL HDRSET		;SET UP THE HEADERS
	TXO F,FR.EAT		;REMEMBER TO DO EATING LATER
	MOVNS J			;NEGATE THE COUNT
	MOVSI J,(J)		;FORM AN AOBJN POINTER
DPYGLP:	CALL FULL		;SCREEN OVERFLOW?
	 RET			;YES, RETURN NOW
	CALL DOCOLS		;PRINT THE COLUMNS
DPYGL1:	AOBJN J,DPYGLP		;LOOP UNTIL WE'VE SEEN THEM ALL
	HRRZ T1,J		;GET THE COUNT
	CAIL T1,MAXGHT		;DID WE FILL THE TABLE?
	 STR$ [ASCIZ /?Table overflow - rebuild SYSDPY with larger MAXGHT/]
	RET			;ALL DONE

XXARPI:				;PRINT INTERNET HOST NUMBER
	MOVE T1,GHT1(J)		;GET INTERNET ADDRESS
	CALLRET PNTHSN		;[665] (T1/) Print dotted form of address

XXARPH:				;PRINT INTERNET HOST NAME
	MOVE T1,GHT1(J)		;GET INTERNET ADDRESS
	CALLRET PNTHSS		;[665] (T1/) Print as a host name string

XXARPE:				;PRINT HEX ETHERNET ADDRESS
	HRRZ T1,J		;GET INDEX INTO GHT
	IMULI T1,GH2MDL		;MULTIPLY BY SIZE OF GHT AREA 2 ENTRY
	DMOVE T1,GHT2+GH.EN1(T1) ;GET THE ETHERNET ADDRESS
	CALLRET PNTHEX		;PRINT IT IN HEX ETHERNET ADDRESS NOTATION

XXARPF:				;PRINT ARP FLAGS
	HRRZ T1,J		;GET GHT INDEX
	IMULI T1,GH2MDL		;CALCULATE INDEX INTO GHT2
	MOVE T1,GHT2+GH.GCF(T1)	;GET GATEWAY CONTROL FLAGS
	TXNE T1,GH%DMB		;DOES THIS HOST DO ARP?
	 STR$ [ASCIZ /Dumb /]	;NO
	TXNE T1,GH%ARP		;VALIDED BY ARP?
	 STR$ [ASCIZ /Valid /]	;YES
	RET
PNTHEX:				;PRINT 48-BIT HEX NUMBER IN T1,T2
	ADJSP P,2		;ALLOCATE SOME STACK SPACE
	DMOVEM T1,-1(P)		;PUT THEM THERE
	MOVEI T4,6		;NUMBER OF 8-BIT BYTES TO PRINT
	MOVE T3,[POINT 8,-1(P)]	;MAKE A BYTE POINTER
PHEXLP:	ILDB T2,T3		;GET AN 8-BIT BYTE
	LDB T1,[POINT 4,T2,31]	;GET THE FIRST NIBBLE
	CHR$ HEXTBL(T1)		;PRINT THE HEX REPRESENTATION
	LDB T1,[POINT 4,T2,35]	;GET THE SECOND NIBBLE
	CHR$ HEXTBL(T1)		;PRINT IT
	CAIE T4,1		;PRINTED LAST BYTE?
	 CHI$ "-"		;NO, PRINT A DASH
	SOJG T4,PHEXLP		;GO BACK FOR MORE
	ADJSP P,-2		;FIX UP THE STACK
	RET

HEXTBL:	EXP "0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F"

XXANNN:				;PRINT NETWORK NUMBER
	MOVE T1,NTHASH(J)	;GET NETWORK NUMBER
	CALLRET PNTNET		;PRINT IT

XXANNC:				;PRINT NETWORK CLASS
	MOVE T1,NTHASH(J)	;GET NETWORK NUMBER
	CALL CNVNET		;FIGURE OUT TYPE
	CAIN T2,1		;IF CODE IS 1
	 STR$ [ASCIZ/  A/]	;CLASS A
	CAIN T2,2		;IF CODE IS 2
	 STR$ [ASCIZ/  B/]	;CLASS B
	CAIN T2,3		;IF CODE IS 3
	 STR$ [ASCIZ/  C/]	;CLASS C
	RET			;RETURN TO CALLER

XXANNG:				;PRINT GATEWAY WE ARE USING
	SKIPE NTGATE(J)		;IS THERE AN ENTRY HERE?
	IFSKP.
	  STR$ [ASCIZ/Inaccessible/] ;NO, SAY WE CAN'T GET THERE
	  RET			;AND RETURN
	ENDIF.
	HLRZ T1,NTGATE(J)	;GET GATEWAY TO NETWORK ENTRY
	SKIPE T1		;0,,NCT
	CAIN T1,-1		;OR -1,,NCT?
	IFNSK.
	  STR$ [ASCIZ/Direct/]	;YES, WE ARE DIRECTLY CONNECTED
	  RET			;AND RETURN
	ENDIF.
	MOVE T1,NTGATE(J)	;GET GATEWAY ADDRESS
	CALLRET PNTHST		;PRINT NAME STRING AND EXIT
XXANNI:				;WHICH INTERFACE ARE WE USING?
	SKIPL T1,NTGATE(J)	;DO WE HAVE AN NCT POINTER HERE?
	 RET			;NO, DO NOTHING HERE
	STR$ [ASCIZ/  /]	;TWO SPACES FOR PRETTY
	HRRZS T1		;CLEAR THE NCT FLAG (A -1)
	ADDI T1,1		;LOOK AT OFFSET ONE
	CALL  DOPEEK		;DO SO
	 RET			;FAIL QUIETLY
	HRRZS T1		;ISOLATE DEVICE TYPE INDEX
	CAIG T1,MAXDEV		;DEVICE TYPE WITHIN RANGE?
	 STR$ @DEVTAB(T1)	;YES, PRINT THE CORRECT DEVICE STRING
	RET			;RETURN TO CALLER

DEVTAB:				;DEVICE CODE IS IN RH OF .NCTX+1
	[ASCIZ/AN20/]		;0 = AN20
	[ASCIZ/IPNI/]		;1 = IPNI
	[ASCIZ/IPCI/]		;2 = IPCI
	[ASCIZ/????/]		;3 = RANDOM INTERFACE
	[ASCIZ/IPNIA/]		;[662] 4 = IPNIA (NI alternate address)
	MAXDEV==.-DEVTAB-1	;[662] 

XXANNS:				;PRINT STATUS OF INTERFACE WE ARE USING
	SKIPN NTGATE(J)		;ANY GW ENTRY?
	 RET			;NO, JUST RETURN
	HLRZ T1,NTGATE(J)	;GET GATEWAY TO NETWORK ENTRY
	CAIN T1,0		;IF ZERO, INTERFACE IS OFF
	 STR$ [ASCIZ/ Down/]
	CAIN T1,-1		;IF -1, INTERFACE IS UP
	 STR$ [ASCIZ/ Up/]
	RET			;HAVE PRINTED NOTHING IF NOT DIRECT CONNECT

;Display  some  local internet activity or traffic invoked by the "ANT"
;command

DPYART:	MOVEI T1,TP.ANT		;DISPLAY IS FOR TCP/IP TRAFFIC
	CALL HDRSET		;SET UP HEADER
	TXO F,FR.EAT		;REMEMBER TO EAT LINES
	MOVX T1,TCP%ST		;WANT TCP STATISTICS
	MOVSI T2,-STTLEN	;-LENGTH,,OFFSET
	MOVE T3,[XWD -STTLEN,STABLK] ;PUT ALL DATA IN STABLK
	STAT%			;GET THE STATISTICS
	 ERJMP LOSE		;TOTAL LOSSAGE

;[664] Compute time interval from last time

	TIME%			;[664] Get uptime in milliseconds
	SUB T1,LSTTIM		;[664] Compute interval in milliseconds
	MOVEM T1,DIFTIM		;[664] Save interval time
	ADDM T1,LSTTIM		;[664] Save the current uptime back there now
	IDIVI T1,^D1000		;[664] Compute seconds in this interval
	MOVEM T1,STABLK-1+ITIME ;[664] Save seconds since last call
	MOVE T1,LSTTIM		;[664] Get the current uptime again
	IDIVI T1,^D1000		;[664] Get uptime in seconds
	MOVEM T1,STABLK-1+UTIME	;[664] Save uptime in seconds
;[664] Compute statistics

	MOVSI T4,-<ANTNUM-1>	;[664] Get AOB pointer to tables
	DO.			;[664] Loop thru display table to compute stats
	  SKIPGE T3,ANTTBS+1(T4) ;[664] Is this a send column entry?
	  IFSKP.		;[664] Yes, calulate this one
	    MOVE T1,STABLK-1(T3) ;[664] Get new highter quantity
	    TLNN T3,-1		;[664] Is it a "per second" display?
	    IFSKP.		;[664] Yes it is
	      HLRZ T2,T3	;[664] Get the multiplier from ANTTBS
	      IMULI T1,(T2)	;[664] Now scale it up to get number*1000*C
	      IDIV T1,DIFTIM	;[664] Get number of these items per second
	    ELSE.		;[664] Othewise it is a difference type
	      SUB T1,STABLO-1(T3) ;[664] Compute difference
	    ENDIF.		;[664] Thing to store is now in T1
	    SKIPL T3,ANTTBO+1(T4) ;[664] Place to store it?
	    MOVEM T1,STABLK-1(T3) ;[664] Yes, put it there for display
	    SKIPGE T3,ANTTBP+1(T4) ;[664] Any percentage to guess at?
	    IFSKP.		;[664] Yep
	      IMULI T1,^D1000	;[664] Scale up to divide by milliseconds
	      IDIV T1,STABLK-1+OPPKCI ;[664] Divide by packets sent in interval
	      IDIVI T1,^D1000/^D100 ;[664] Get percentage 0-100%
	      MOVEM T1,STABLK-1(T3) ;[664] Store the percentage
	    ENDIF.		;[664] End of percenatage calculation
	  ENDIF.		;[664] End of send column case
	  SKIPGE T3,ANTTBR+1(T4) ;[664] Is this a recv column entry?
	  IFSKP.		;[664] Yes, calulate this one
	    MOVE T1,STABLK-1(T3) ;[664] Get new highter quantity
	    TLNN T3,-1		;[664] Is it a "per second" display?
	    IFSKP.		;[664] Yes it is
	      HLRZ T2,T3	;[664] Get the multiplier
	      IMULI T1,(T2)	;[664] Now scale it up to the right number
	      IDIV T1,DIFTIM	;[664] Comput number of these per second
	    ELSE.		;[664] Othewise it is a difference type
	      SUB T1,STABLO-1(T3) ;[664] Compute difference
	    ENDIF.		;[664] Thing to store is now in T1
	    SKIPL T3,ANTTBI+1(T4) ;[664] Place to store interval value?
	    MOVEM T1,STABLK-1(T3) ;[664] Yes, put it there for display
	    SKIPGE T3,ANTTBP+1(T4) ;[664] Any percentage to guess at?
	    IFSKP.		;[664] Yep
	      IMULI T1,^D1000	;[664] Scale up to divide by milliseconds
	      IDIV T1,STABLK-1+IPPKCI ;[664] Divide by packets recv in interval
	      IDIVI T1,^D1000/^D100 ;[664] Get percentage 0-100%
	      MOVEM T1,STABLK-1(T3) ;[664] Store the percentage
	    ENDIF.		;[664] End of percenatage calculation
	  ENDIF.		;[664] End of recv column case
	  AOBJN T4,TOP.		;[664] Loop for all entries in table
	OD.			;[664] End of loop to calculate statistics
;[664] Save new stats as old for next time

	MOVE T1,[STABLK,,STABLO] ;[664] Ready to copy from stablk to stablo
	BLT T1,STABLO+STTLEN	;[664] Save current status for next time

;[664] Now loop over all of the rows and output the by column data.

	MOVSI J,-ANTNUM		;SET UP AOBJN POINTER FOR ROWS
DPYAT0:	SETOM ANTCOL		;INITIALIZE COLUMN COUNTER TO -1
	CALL DOCOLS		;DO COLUMNS
	AOBJN J,DPYAT0		;LOOP OVER ALL ROWS
	RET			;RETURN TO CALLER
;[664] ANT display routines.

XXANTH:	STR$ @ANTTAB(J)		;[664] Print a name
	RET			;[664]  and return

XXANTO:	SKIPA T2,ANTTBO(J)	;[664] Get send/int offset
XXANTI:	MOVE T2,ANTTBI(J)	;[664] Get receive/int offset instead
	JRST XXANT0		;[664] Handle like others

XXANTS:	SKIPA T2,ANTTBS(J)	;[664] Get send offset
XXANTR:	MOVE T2,ANTTBR(J)	;[664] Get receive offset instead
XXANT0:	JUMPL T2,XXANT1		;[664] Jump if illegal offset
	TLNE T2,-1		;[664] Is this a computed statistic?
	JRST XXANT1		;[664] Yes, get out
	MOVE T1,STABLK-1(T2)	;[664] Get the number
	CALLRET DECSP9		;[664] Print a potentially large decimal number

XXANTP:	SKIPGE T2,ANTTBP(J)	;[664] Skip if not percentage
	JUMPL T2,XXANT1		;[664] Output spaces if no field
	MOVE T1,STABLK-1(T2)	;[664] Load the data
	CALL DECSP7		;[664] Output it
	STR$ [ASCIZ/ %/]	;[664] Make it feel pretty
	RET			;[664] And return to caller

XXANT1:	STR$ [ASCIZ/         /] ;[664] If invalid offset, print spaces
	RET			;[664] And return to caller

;[664] Make tables for ANT display.
;	XX(T,S,R,O,I,P)

DEFINE ANTGEN,<
	XLIST			;[664]
	XX (<Interval (secs)>,UTIME,UTIME,ITIME,ITIME,-1)
	XX (<Bytes>,BYTSCT,BYTRCT,BYTSCI,BYTRCI,-1) ;[664] 
	XX (<Bits/second>,<^D8000,,BYTSCI>,<^D8000,,BYTRCI>,BITROU,BITRIN,-1) ;[664]
	XX (<Packets>,OPPKCT,IPPKCT,OPPKCI,IPPKCI,-1) ;[664]
	XX (<Packets/second>,<^D1000,,OPPKCI>,<^D1000,,IPPKCI>,PKTROU,PKTRIN,-1) ;[664]
	XX (<FINs>,FINSCT,FINRCT,FINSCI,FINRCI,-1) ;[664]
	XX (<RSTs>,RSTSCT,RSTRCT,RSTSCI,RSTRCI,-1) ;[664]
	XX (<SYNs>,SYNSCT,SYNRCT,SYNSCI,SYNRCI,-1) ;[664]
	XX (<Duplicates>,-1,DUPKCT,-1,DUPKCI,DUPKCP) ;[664]
	XX (<Retransmissions>,RXPKCT,-1,RXPKCI,-1,RXPKCP) ;[664]
	XX (<Packetizer>,PZPKCT,-1,PZPKCI,-1,-1) ;[664]
	XX (<Reassembler>,-1,RAPKCT,-1,RAPKCI,-1) ;[664]
	LIST
>;[664] End of define ANTGEN

	DEFINE XX(T,S,R,O,I,P),<EXP [ASCIZ\T\]> ;[664]
ANTTAB:	ANTGEN			;[664]  "Header" column data
	ANTNUM==.-ANTTAB	;[664] 

	DEFINE XX(T,S,R,O,I,P),<EXP <S>> ;[664]
ANTTBS:	ANTGEN			;[664]  "Send" column data

	DEFINE XX(T,S,R,O,I,P),<EXP <R>> ;[664]
ANTTBR:	ANTGEN			;[664]  "Receive" column data

	DEFINE XX(T,S,R,O,I,P),<EXP <O>> ;[664]
ANTTBO:	ANTGEN			;[664] "Output" column data

	DEFINE XX(T,S,R,O,I,P),<EXP <I>> ;[664]
ANTTBI:	ANTGEN			;[664] "Input" column data

	DEFINE XX(T,S,R,O,I,P),<EXP <P>> ;[664]
ANTTBP:	ANTGEN			;[664] "Percentage" column data

;These definitions for the statistics area were copied from STG.MAC.
;When STAT% goes away, the definitions will probably need to be changed.

DEFINE NR (OFFSET,SIZE) <
 OFFSET==<..NROF==..NROF+SIZE>
>				;DEFINE NR

..NROF==0			;INITIALIZE MECHANISM

HISTSZ==21			;SIZE OF HISTOGRAMS

				;STATISTICS AREA
NR STAT0,0			;MARKS FIRST CELL CLEARED BY STSINI
NR BYTRCT,1			;BYTES RECEIVED COUNTER
NR BYTSCT,1			;BYTES SENT COUNTER
NR FINRCT,1			;FINS RECEIVED COUNTER
NR FINSCT,1			;FINS SENT COUNTER
NR RSTRCT,1			;RSTS RECEIVED COUNTER
NR RSTSCT,1			;RSTS SENT COUNTER
NR SYNRCT,1			;SYNS RECEIVED COUNTER
NR SYNSCT,1			;SYNS COUNTER
NR DUPKCT,1			;COUNT OF DUPLICATES RECEIVED
NR IPPKCT,1			;PACKETS HANDLED BY INPUTPROCESSOR
NR OPPKCT,1			;PACKETS OUTPUT TO THE NETWORK
NR PZPKCT,1			;PACKETS PRODUCED BY PACKTIZER
NR RAPKCT,1			;PACKETS PROCESSED BY REASSEMBLER
NR RXPKCT,1			;PACKETS RETRANSMITTED
				;TASK COUNTERS
NR BGRNCT,1			;COUNT OF TIMES BACKGROUND HAS RUN
NR DGRNCT,1			;COUNT OF TIMES DELAY ACTION HAS RUN
NR IPRNCT,1			;COUNT OF TIMES INPUTPROCESSOR HAS RUN
NR OPRNCT,1			;COUNT OF TIMES OUTPUTPROCESSOR HAS RUN
NR PZRNCT,1			;COUNT OF TIMES PACKETIZER HAS RUN
NR RARNCT,1			;COUNT OF TIMES REASSEMBLER HAS RUN
NR RXRNCT,1			;COUNT OF TIMES RETRANSMITTER HAS RUN
NR TASKCT,1			;COUNT OF ALL TASKS 
NR BGUSE,1			;CPU USAGE METERS
NR DGUSE,1
NR IPUSE,1
NR OHUSE,1
NR OPUSE,1
NR PZUSE,1
NR RAUSE,1
NR RXUSE,1
NR STATZZ,0			;THE LAST CELL CLEARED BY STSINI IS ...
NR TIMPTR,1			;CURRENT TIMER.  POINTS TO ONE OF THE ABOVE

;[664] ANT display statistics

NR UTIME,1			;[664] Uptime
NR ITIME,1			;[664] Current interval (actual)
NR BYTSCI,1			;[664] Bytes sent in interval
NR BYTRCI,1			;[664] Bytes received in interval
NR BITROU,1			;[664] KBits/sec (output)
NR BITRIN,1			;[664] KBits/sec (input)
NR OPPKCI,1			;[664] Packets sent in interval
NR IPPKCI,1			;[664] Packets received in interval
NR PKTROU,1			;[664] Pkts/sec (output)
NR PKTRIN,1			;[664] Pkts/sec (input)

NR FINSCI,1			;[664] FINs output
NR FINRCI,1			;[664] FINs input
NR RSTSCI,1			;[664] RSTs output
NR RSTRCI,1			;[664] RSTs input
NR SYNSCI,1			;[664] SYNs output
NR SYNRCI,1			;[664] SYNs input
NR DUPKCI,1			;[664] Number of duplicates
NR DUPKCP,1			;[664] Percent duplicates
NR RXPKCI,1			;[664] Number of retransmissions
NR RXPKCP,1			;[664] Percent retransmissions
NR PZPKCI,1			;[664] Packetizer runs
NR RAPKCI,1			;[664] Reassembler runs
NR STATXX,0			;[664] Size of extended stat block

;CNVNET - Convert network number into canonical 32-bit form.
;TAKES T1/ 8, 16, OR 24-BIT NETWORK NUMBER
;RETURNS + ALWAYS, T1/ 32-BIT INTERNET ADDRESS, T2/ NETWORK CLASS CODE

CNVNET:	JFFO T1,.+2		;FIND FIRST ONE
	 RET			;ZERO?  JUST QUIT.
	CAIGE T2,^D29		;IS FIRST ONE ON OTHER SIDE OF 1B28?
	IFSKP.
	  LSH T1,^D24		;SHIFT CLASS A NUMBER FOR GTHST%
	  MOVEI T2,1		;CODE FOR CLASS A
	  RET			;RETURN TO CALLER
	ENDIF.
	CAIE T2,^D20		;IF FIRST ONE IS ON 1B20
	IFSKP.
	  LSH T1,^D16		;SHIFT CLASS B NUMBER FOR GTHST%
	  MOVEI T2,2		;CODE FOR CLASS B
	  RET			;RETURN TO CALLER
	ENDIF.
	LSH T1,^D8		;SHIFT CLASS C NUMBER FOR GTHST%
	MOVEI T2,3		;CODE FOR CLASS C
	RET			;RETURN TO CALLER
;PNTNET - Print network name, either string or dotted form.
;TAKES T1/ 8, 16, OR 24 bit network number
;RETURNS +1 ALWAYS

PNTNET:
	JUMPE T1,CPOPJ		;DO NOTHING IF WE GET A ZERO
	CALL CNVNET		;TURN INTO A 32-BIT NETWORK NUMBER
	MOVE T4,T1		;COPY NUMBER INTO T4 IN CASE OF FAILURE
	SKIPE DOTFLG		;WANTS DOTTED FORMAT?
	 JRST PNTNE0		;YES
	PUSH P,T2		;SAVE NET TYPE IN CASE OF FAILURE
	MOVX T1,.GTHNS		;NUMBER TO STRING FUNCTION
	HRROI T2,TEMP		;PUT NETWORK NAME STRING HERE
	MOVE T3,T4		;NETWORK NUMBER
	GTHST%			;TRANSLATE TO STRING
	 ERJMP PNTNER
	ADJSP P,-1		;TRIM STACK
	MOVX T1,<POINT 7,TEMP>	;GET A BYTE POINTER
	MOVEI T3,^D30		;ONLY LET 30 CHARACTERS THROUGH
PNTNE2:				;BYTE COUNTING LOOP
	ILDB T2,T1		;GET A BYTE
	JUMPE T2,PNTNE1		;NULL?
	SOJG  T3,PNTNE2		;LOOP UNTIL THE MAX
	MOVEI T2,.CHNUL		;GET A NULL
	IDPB T2,T1		;ENSURE GOOD TERMINATION
PNTNE1:				;HERE WHEN WE HAVE A REASONABLE STRING
	STR$ TEMP		;PRINT THE STRING
	RET			;RETURN TO CALLER
PNTNER:				;HERE ON AN ERROR FROM THE GTHST
	POP P,T2		;GET BACK NETWORK TYPE CODE
PNTNE0:	CAIE T2,1		;CLASS A?
	IFSKP.
	  LDB T1,[POINT 8,T4,11] ;YES, PRINT A SINGLE OCTET
	  JRST DECOUT		; ...
	ENDIF.
	CAIE T2,2		;CLASS B?
	IFSKP.
	  LDB T1,[POINT 8,T4,11]
	  CALL DECOUT		;YES, PRINT TWO OCTETS
	  CHI$ "."
	  LDB T1,[POINT 8,T4,19]
	  JRST DECOUT
	ENDIF.
	LDB T1,[POINT 8,T4,11]	;MUST BE CLASS C, PRINT THREE OCTETS 
	CALL DECOUT
	CHI$ "."
	LDB T1,[POINT 8,T4,19]
	CALL DECOUT
	CHI$ "."
	LDB T1,[POINT 8,T4,27]
	CALLRET DECOUT
;PNTHST - Print host name, either string or dotted address depending on DOTFLG.
;[665] PNTHSN - Print internet address in "a.b.c.d" form.
;[665] PNTHSS - Print host name no matter what DOTFLG says.
;Call with T1/ 32-bit internet address
;Returns +1 Always

PNTHSS:	SKIPN T4,T1		;[665] Skip if a host there, copy to T4
	RET			;[665] Return if zero host number
	JRST PNTHS1		;[665] Enter routine to print host name

PNTHST:	JUMPE T1,CPOPJ		;DO NOTHING IF WE GET A ZERO
	MOVE T4,T1		;SAVE NUMBER IN CASE GTHST% FAILS
	SKIPE DOTFLG		;WANT DOTTED FORM?
	 JRST PNTHS0		;YES, GO DO IT
PNTHS1:	MOVE T3,T1		;LOAD HOST NUMBER
	MOVX T1,.GTHNS		;FUNCTION IS NUMBER TO STRING
	HRROI T2,TEMP		;PUT STRING HERE
	GTHST%			;LOOKUP THE STRING
	 ERJMP PNTHS0		;[665] Failed, print address as dotted number
	MOVX T1,.CHNUL		;SUCCESS, GET A NULL
	IDPB T1,T2		;AND TIE OFF STRING
	SETZM TEMP+6		;[662] Up to 30 characters allowed
	STR$ TEMP		;PRINT THE STRING
	RET			;RETURN TO CALLER

PNTHSN:	SKIPN T4,T1		;[665] Copy the host number to T4
	RET			;[665] Return now if host number is zero
PNTHS0:	LDB T1,[POINT 8,T4,11]	;UNKNOWN HOST, MUST PRINT DOTTED FORM
	CALL DECOUT		;FIRST OCTET
	CHI$ "."
	LDB T1,[POINT 8,T4,19]
	CALL DECOUT		;SECOND OCTET
	CHI$ "."
	LDB T1,[POINT 8,T4,27]
	CALL DECOUT		;THIRD OCTET
	CHI$ "."
	LDB T1,[POINT 8,T4,35]
	CALL DECOUT		;FORTH OCTET
	RET

;PNTPRT - Print a port number, symbolic name if possible
;Takes T1/ port number
;Returns +1 always

PNTPRT:	JUMPE T1,CPOPJ		;DO NOTHING IF WE GET A ZERO
	SKIPE DOTFLG		;WANT DOTTED FORM?
	 JRST DECOUT		;YES, PRINT DECIMAL PORT NUMBER
	CAILE T1,TOPPRT		;SMALL PORT NUMBER?
	IFSKP.
	  SKIPN PORTTB(T1)	;YES, DO WE HAVE A NAME FOR IT?
	ANSKP.			;NO, MUST PRINT NUMBER
	  STR$ @PORTTB(T1)	;YES, PRINT NAME
	  RET			;AND RETURN TO CALLER
	ENDIF.
	CALLRET DECOUT		;PRINT PORT NUMBER (TCP PORTS ARE DECIMAL!)
;(incomplete)  Table of named sockets. Note that although this table is
;numbered by octal socket number, TCP sockets are displayed in decimal.

PORTTB:	0			; 0
	[ASCIZ/OTelnt/]		; 1
	0			; 2
	[ASCIZ/OFTP/]		; 3
	0			; 4
	[ASCIZ/RJE/]		; 5
	0			; 6
	[ASCIZ/Echo/]		; 7
	0			; 10
	[ASCIZ/Discrd/]		; 11
	0			; 12
	[ASCIZ/Systat/]		; 13
	0			; 14
	[ASCIZ/Datime/]		; 15
	0			; 16
	[ASCIZ/Netsta/]		; 17
	0			; 20
	[ASCIZ/TxtMsg/]		; 21
	0			; 22
	[ASCIZ/TTYTST/]		; 23
	[ASCIZ/FTPdat/]		; 24
	[ASCIZ/FTP/]		; 25
	0			; 26
	[ASCIZ/Telnet/]		; 27
	0			; 30
	[ASCIZ/SMTP/]		; 31
	0			; 32
	[ASCIZ/NSWUFE/]		; 33
	0			; 34
	[ASCIZ/MSGICP/]		; 35
	0			; 36
	[ASCIZ/MSGAUT/]		; 37
	REPEAT 3,<0>		; 40 - 42
	[ASCIZ/Spool/]		; 43
	0			; 44
	[ASCIZ/Time/]		; 45
	REPEAT 3,<0>		; 46 - 50
	[ASCIZ/Graph/]		; 51
	[ASCIZ/Name/]		; 52
	[ASCIZ/Whois/]		; 53
	0			; 54
	[ASCIZ/MsgRcv/]		; 55
	[ASCIZ/MPM/]		; 56
	[ASCIZ/NIFTP/]		; 57
	REPEAT 66-57,<0>	; 60 - 66
	[ASCIZ/ISIGL/]		; 67
	REPEAT 3,<0>		; 70 - 72
	[ASCIZ/Augmnt/]		; 73
	0			; 74
	[ASCIZ/NIMAIL/]		; 75
	REPEAT 5,<0>		; 76 - 102
	[ASCIZ/Dtcomp/]		; 103
	0			; 104
	[ASCIZ/TFTP/]		; 105
	0			; 106
	REPEAT 4,<[ASCIZ/NETRJS/]> ; 107 - 112
	REPEAT 2,<0>		; 113 - 114
	[ASCIZ/RJE/]		; 115
	0			; 116
	[ASCIZ/Finger/]		; 117
	0			; 120
	[ASCIZ/HOSTS2/]		; 121
	0			; 122
	REPEAT 2,<[ASCIZ/MLDEV/]; 123 / 125
		  0>		; 124 / 126
	[ASCIZ/TLink/]		; 127
	0			; 130
	[ASCIZ/TNGate/]		; 131
	0			; 132
	[ASCIZ/Dover/]		; 133
	0			; 134
	[ASCIZ/Devctl/]		; 135
	0			; 136
	[ASCIZ/SUPDUP/]		; 137
	0			; 140
	[ASCIZ/DCStat/]		; 141
	0			; 142
	[ASCIZ/Metagm/]		; 143
	0			; 144
	[ASCIZ/Hstnam/]		; 145
	0			; 146
	REPEAT 0,<[ASCIZ/CSNet/]; 147, 151
		  0>		; 150, 152
	[ASCIZ/RTN/]		; 153
	REPEAT 202-153,<0>	; 154 - 202
	[ASCIZ/Dtcomp/]		; 203
	TOPPRT==.-PORTTB
	SUBTTL Jacket Routine for Extended PEEK JSYS For ARPANET

;TAKES T1/ WORD COUNT
;	T2/ USER LOCATION
;	T3/ MONITOR LOCATION
;RETURNS +1 FAILURE
;	 +2 SUCCESS

.XPEEK:	MOVX T4,.XPLEN
	MOVEM T4,XPKBLK+.XPABL	;SET LENGTH OF ARGUMENT BLOCK
	MOVX T4,.XPPEK
	MOVEM T4,XPKBLK+.XPFNC	;FUNCTION IS XPEEK%
	MOVEM T1,XPKBLK+.XPCN1	;COUNT OF WORDS TO TRANSFER
	SETZM XPKBLK+.XPCN2	;COUNT OF WORDS TRANSFERRED
	MOVEM T3,XPKBLK+.XPMAD	;MONITOR ADDRESS
	MOVEM T2,XPKBLK+.XPUAD	;USER ADDRESS
	MOVEI T1,XPKBLK		;T1/ ADDRESS OF ARGUMENT BLOCK
	XPEEK%			;GET MONITOR DATA
	 ERJMP CPOPJ		;SOME ERROR
	RETSKP			;GOOD RETURN

;Here  to fill in the table of offsets and such so we can do peeks with
;the data.

ANASYM:	TXNE F,FR.ANA		;DO WE ALREADY HAVE THE SYMBOLS?
	RETSKP			;YES, GOOD RETURN
	MOVSI T4,-NUMANA	;GET READY FOR LOOP
ANASYL:	MOVEI T1,.SNPSY		;GET FUNCTION CODE
	MOVE T2,TBSANA(T4)	;GET WORD OF DATA
	MOVE T3,TBMANA(T4)	;AND PROGRAM NAME
	SNOOP			;GET THE VALUE
	 ERJMP CPOPJ		;FAILED
	MOVEM T2,TBVANA(T4)	;SAVE THE VALUE
	AOBJN T4,ANASYL		;LOOP OVER ALL WORDS
       				;HAVE SYMBOLS, NOW MAKE SOME SANITY CHECKS
	MOVE T1,NETHSZ		;GET SIZE OF NETWORK HASH TABLE
	CAIG T1,HSHSIZ		;CAN WE FIT THOSE TABLES INTO MEMORY?
	IFSKP.
	  TMSG <?HSHSIZ too small.  Reassemble with larger value>
	  RET			;NO, BUILD A NEW SYSDPY
	ENDIF.
	MOVE  T1,MAXGWA		;GET SIZE OF GW TABLE
	CAIG T1,GATSIZ		;FITS?
	IFSKP.
	  TMSG <?GATSIZ too small. Reassemble with larger value>
	  RET			;NO, BUILD A NEW SYSDPY
	ENDIF.
	TXO F,FR.ANA		;SYMBOLS ARE NOW GOTTEN
	RETSKP			;GOOD RETURN

;Table of internet symbols we snoop%

DEFINE ANSYMS <
	XX NETHTB,STG		;NETWORK HASH TABLE
	XX NETHSZ,STG		;LENGTH OF NETWORK HASH TABLE
	XX NETGWY,STG,NETGWX	;NETWORK TO GATEWAY TABLE
	XX GWTAB,STG		;POINTER TO GATEWAY TABLE
	XX MAXGWA,IPIPIP	;MAXIMUM NO. OF GW'S
	XX GHTCNT,STG		;CURRENT NUMBER OF GHT ENTRIES
	XX NIMAXH,STG		;MAXIMUM NUMBER OF GHT ENTRIES
	XX GHTAR1,STG		;GHT AREA 1 - INTERNET ADDRESSES
	XX GHTAR2,STG		;GHT AREA 2 - ARP INFO
	XX NIPON,STG		;NI ENABLED
	XX ARPON,STG		;ARP ENABLED
>				;DEFINE ANSYMS
	SUBTTL Routine to Show Sca Connections

;This mode is entered by the "SC" command.

DPYSCA:	CALL SCASYM		;GET SYMBOLS NEEDED FOR DISPLAY
	 RET			;FAILED
	TXNN F,FR.CMP		;COMPRESSING?
	 CALL DPYSCH		;NO. SHOW SCA TITLE LINE
	JRST DPYSSB		;GO DISPLAY SYSTEM BLOCKS

;This  routine  shows the SCA title line and is diplayed only if we are
;not compressing output.

DPYSCH:	CALL UDBSYM		;THIS WILL GET ADDRESS OF CHNTAB
	 RET			;FAILED TO GET SYMBOLS
	MOVEI T1,XPDAT		;DATA BLOCK FOR XPEEK%
	MOVEI T2,.XPLEN		;LENGTH OF DATA BLOCK
	MOVEM T2,.XPABL(T1)	;STORE IN FUNCTION BLOCK
	MOVEI T2,.XPPEK		;GET XPEEK FUNCTION CODE
	MOVEM T2,.XPFNC(T1)	;SAVE IN FUNCTION BLOCK
	MOVE T2,C%SBLL		;NUMBER OF WORDS TO GET
	MOVEM T2,.XPCN1(T1)	;STORE IN FUNCTION BLOCK
	MOVE T2,SBLIST		;ADDRESS OF SYSTEM BLOCK LIST
	MOVEM T2,.XPMAD(T1)	;SAVE IN FUNCTION BLOCK AS MONITOR ADDRESS
	MOVEI T2,DATLOC		;USER ADDRESS TO RETURN DATA
	MOVEM T2,.XPUAD(T1)	;SAVE IN FUNCTION BLOCK
	XPEEK%			;GET SBLIST
	 ERJMP CPOPJ		;FAILED.
	SETZ T1,		;INIT NUMBER OF SB'S IN USE
	MOVN T2,C%SBLL		;NEGATE NUMBER OF SYSTEM BLOCK
	HRLZS T2		;MAKE AOBJN POINTER
SBCNT:	SKIPE DATLOC(T2)	;SB IN USE?
	 AOJ T1,		;YES. COUNT IT
	AOBJN T2,SBCNT		;LOOP THROUGH SBLIST
	CALL DECOUT		;DISPLAY NUMBER OF BLOCKS IN USE
	STR$ [ASCIZ/ of /]	;SOME TEXT
	MOVE T1,C%SBLL		;GET NUMBER OF SYSTEM BLOCKS
	CALL DECOUT		;DISPLAY IT
	STR$ [ASCIZ/ System Blocks  TODCLK: /] ;SAY WHAT IT IS
	CALL GETTOD		;GET TODCLK READING IN T1
	 RET			;FAILED
	CALL TIMOUT		;DISPLAY AS TIME
	STR$ [ASCIZ/  KLIPA State: /] ;SAY WHAT WE'RE SHOWING
	MOVEI T1,XPDAT		;GET ADDRESS OF XPEEK BLOCK
	MOVE T2,CHNTAB		;GET ADDRESS OF CHANNEL TABLES
	ADD T2,KLPRH2		;PLUS ADDRESS OF KLIPA CHANNEL
	MOVEM T2,.XPMAD(T1)	;MONITOR ADDRESS NEEDED
	XPEEK%			;GET ADDRESS OF CDB
	 ERJMP CPOPJ		;QUIT ON ERROR
	MOVE T4,T3		;SAVE THIS FOR MICROCODE VERSION
	ADD T3,CDBFLG		;ADD OFFSET FOR STATUS
	MOVEM T3,XPDAT+.XPMAD	;STORE IN XPEEK BLOCK
	XPEEK%			;READ IT
	 ERJMP CPOPJ		;FAILED. TAKE ERROR RETURN
	LDB T3,[POINT 6,T3,5]	;GET KLIPA STATE
	SKIPL T3		;LESS THAN ZERO
	 CAILE T3,KLPLEN	;OR GREATER THAN TABLE LENGTH?
	  MOVEI T3,KLPLEN+1	;YES. GET INDEX FOR BAD STATE
	STR$ KLPTAB(T3)		;DISPLAY STATE STRING
	STR$ [ASCIZ/  Microcode: /] ;ANNOUCE UCODE VERSION
	ADD T4,CDBVER		;MONITOR LOCATION OF KLIPA MICROCODE
	MOVEM T4,XPDAT+.XPMAD	;STORE IN XPEEK BLOCK
	XPEEK%			;GET UCODE VERSION
	 ERJMP CPOPJ		;FAILED. TAKE ERROR RETURN
	HRRZ T1,T3		;GET UCODE VERSION
	CALL OCTOUT		;DISPLAY IT
	CRLF			;FORMAT NICELY
	CRLF			;...
	RET			;AND RETURN

;Table  of  possible  KLIPA  states. The last entry in the table is the
;string displayed if the KLIPA  status  code  is  invalid.  The  symbol
;klplen (length of table) does not include this word.

KLPTAB:	ASCIZ/UNK/		;UNKNOWN (SYSTEM STARTUP)
	ASCIZ/STP/		;STOPPED (AND NEEDS TO BE STARTED)
	ASCIZ/NRL/		;NEEDS TO HAVE UCODE RELOADED
	ASCIZ/RIP/		;UCODE RELOAD IN PROGRESS
	ASCIZ/NDM/		;NEEDS TO HAVE DUMP TAKEN
	ASCIZ/DIP/		;DUMP IN PROGRESS
	ASCIZ/MAI/		;MAINTENACE MODE (OWNED BY DIAGNOSTIC)
	ASCIZ/DED/		;DEAD (WE ARE NOT TRYING TO START IT)
	ASCIZ/RUN/		;RUNNING
	ASCIZ/RLC/		;UCODE RELOAD COMPLETE
	ASCIZ/DMC/		;UCODE DUMP COMPLETE
	KLPLEN==.-KLPTAB
	ASCIZ/ERR/		;STATUS CODE IS INVALID

;This  routine gets the TODCLK reading in T1. Returns +2 on success and
;+1 on failure.

GETTOD:	MOVEI T1,XPDAT		;DATA BLOCK FOR XPEEK%
	MOVEI T2,.XPLEN		;LENGTH OF DATA BLOCK
	MOVEM T2,.XPABL(T1)	;STORE IN FUNCTION BLOCK
	MOVEI T2,.XPPEK		;GET XPEEK FUNCTION CODE
	MOVEM T2,.XPFNC(T1)	;SAVE IN FUNCTION BLOCK
	MOVEI T2,1		;NUMBER OF WORDS TO GET
	MOVEM T2,.XPCN1(T1)	;STORE IN FUNCTION BLOCK
	MOVE T2,TODCLK		;ADDRESS OF TODCLK
	MOVEM T2,.XPMAD(T1)	;SAVE IN FUNCTION BLOCK AS MONITOR ADDRESS
	MOVEI T2,T3		;USER ADDRESS TO RETURN DATA
	MOVEM T2,.XPUAD(T1)	;SAVE IN FUNCTION BLOCK
	XPEEK%			;GET SYSTEM BLOCK ADDRESS LIST
	 ERJMP CPOPJ		;FAILED FOR THIS SYSTEM BLOCK
	MOVE T1,T3		;MOVE RESULT INTO T1
	IDIVI T1,^D1000		;MAKE IT INTO SECONDS
	RETSKP			;DONE

;This routine displays the SCA system blocks.

DPYSSB:	MOVEI T1,TP.SSB		;HEADER TYPE
	CALL HDRSET		;SET UP COLUMN HEADERS
	CALL SETEAT		;SET UP TO EAT LINES
	MOVN Q1,C%SBLL		;GET LENGTH OF SYSTEM BLOCK
	HRLZS Q1		;SET UP AOBJN POINTER
SSBSBL:	CALL FULL		;SCREEN FULL?
	 RET			;YES. QUIT THEN
	HRRZ T4,Q1		;GET SBI
	CALL GETSBA		;GET A SYSTEM BLOCK ADDRESS
	 RET			;FAILED
	JUMPE T3,SSBEOL		;NO SYSTEM BLOCK HERE
	CALL GETSB		;GET THE SYTSEM BLOCK
	 RET			;FAILED
	HRRZ T4,Q1		;GET SBI
	CALL GETSTS		;GET SB REQUEST-ID STATUS WORD
	 RET			;FAILED
	MOVEM T3,SBRIST		;SAVE FOR COLUMN DISPLAYS
	CALL DOCOLS		;DISPLAY SYSTEM BLOCK COLUMNS
SSBEOL:	AOBJN Q1,SSBSBL		;LOOP OVER ALL POSSIBLE SYSTEM BLOCKS
	RET			;DONE
;Support routines for dpyssb to display the columns.

XXDSST:				;DISPLAY THE DESTINATION SOFTWARE TYPE.
	SPACE			;BALANCE THE COLUMN
	SPACE			;...
	MOVE T1,.SBDST		;GET OFFSET INTO CONNECT BLOCK
	MOVE T4,[POINT 8,DATLOC(T1)] ;MAKE 8 BIT ASCII POINTER
	MOVNI T3,4		;MAXIMUM NUMBER OF CHARS IN STRING
DSSTLP:	ILDB T2,T4		;GET A BYTE
	JUMPE T2,DSSTDN		;IF ZERO, DONE
	CHI$ (T2)		;PRINT THE CHARACTER
	AOJL T3,DSSTLP		;KEEP LOOPING
DSSTDN:	RET			;DONE


XXDSHT:				;DISPLAY THE DESTINATION HARDWARE TYPE.
	SPACE			;BALANCE THE COLUMN
	SPACE			;...
	MOVE T1,.SBDHT		;GET OFFSET INTO SYSTEM BLOCK
	MOVE T4,[POINT 8,DATLOC(T1)] ;MAKE 8 BIT ASCII POINTER
	MOVNI T3,4		;MAXIMUM NUMBER OF CHARS IN STRING
DSHTLP:	ILDB T2,T4		;GET A BYTE
	JUMPE T2,DSHTDN		;IF ZERO, DONE
	CHI$ (T2)		;PRINT THE CHARACTER
	AOJL T3,DSHTLP		;KEEP LOOPING
DSHTDN:	RET			;DONE

XXDSPT:				;THIS ROUTINE DISPLAYS THE DESTINATION PORT
	MOVE T1,.SBDSP		;GET OFFSET INTO SYSTEM BLOCK
	HRRZ T1,DATLOC(T1)	;GET DESTINATION PORT
	JRST DECSP3		;3 CHARACTER OCTAL NUMBER

XXDVCS:				;THIS ROUTINE DISPLAYS THE DESTINATION VIRTUAL CIRCUIT STATE
	MOVE T1,.SBVCS		;GET OFFSET INTO SYSTEM BLOCK
	HRRZ T1,DATLOC(T1)	;GET VIRTUAL CIRCUIT STATE
	SKIPL T1		;IS IT
	CAIL T1,VCSLEN		; LEGAL?
	SKIPA T2,[ASCIZ/UNK   /] ;NO. UNKNOWN STATE
	MOVE T2,VCSTAB(T1)	;GET CIRCUIT STATE STRING
	STR$ (T2)		;PRINT STRING
	RET			;DONE

XXMXMS:				;THIS ROUTINE DISPLAYS THE MAX MESSAGE SIZE
	SPACE			;BALANCE THE COLUMN
	MOVE T1,.SBMMS		;GET OFFSET INTO SYSTEM BLOCK
	HLRZ T1,DATLOC(T1)	;GET MAX MESSAGE SIZE
	JRST DECSP6		;DISPLAY AS DECIMAL NUMBER

XXMXDG:				;THIS ROUTINE DISPLAYS THE MAX DG SIZE
	MOVE T1,.SBMMS		;GET OFFSET INTO SYSTEM BLOCKS
	HRRZ T1,DATLOC(T1)	;GET MAX DG SIZE
	JRST DECSP6		;DISPLAY AS DECIMAL NUMBER

XXTOD:				;DISPLAY THE TODCLK AT LAST MESSAGE
	MOVE T1,.SBTIM		;GET OFFSET INTO SYSTEM BLOCK
	MOVE T1,DATLOC(T1)	;GET RH OF TODCLK
	IDIVI T1,^D1000		;MAKE INTO SECONDS
	JRST TIMOUT		;DISPLAY AS TIME
XXPTHR:				;THIS ROUTINE DISPLAYS THE PATH RESPONSE
	MOVE T1,SBRIST		;GET SYSTEM BLOCK REQUEST-ID STATUS
	TDNN T1,IDNOR		;IS IT NO-ANSWER?
	IFSKP.
	   STR$ [ASCIZ/No-Answer /] ;YES
	ELSE.
	   STR$ [ASCIZ/A:/]	;NO, SHOW PATH A
	   TDNE T1,IDNRA	;RESPONSE AVAILABLE ON PATH A?
	   SKIPA T2,[ASCIZ/No  /] ;NO.
	   MOVE T2,[ASCIZ/Yes /] ;YES.
	   STR$ T2		;DISPLAY IT
	   STR$ [ASCIZ/B:/]	;SHOW PATH B
	   TDNE T1,IDNRB	;RESPONSE AVAILABLE ON PATH A?
	   SKIPA T2,[ASCIZ/No /] ;NO.
	   MOVE T2,[ASCIZ/Yes/]	;YES.
	   STR$ T2		;DISPLAY IT
	ENDIF.
	RET			;DONE

XXSBFG:				;THIS ROUTINE DISPLAYS THE SYSTEM BLOCK FLAGS
	MOVE T1,.SBFLG		;GET OFFSET INTO SYSTEM BLOCK
	MOVE T1,DATLOC(T1)	;GET SYSTEM BLOCK FLAGS
	TDNE T1,SBFTMG		;TIMED MESSAGE?
	 CHI$ "T"		;FLAG IT
	TDNE T1,SBFOVC		;VD NEED OPEN?
	 CHI$ "O"		;FLAG IT
	TDNE T1,SBFOFL		;NODE OFFLINE?
	 CHI$ "F"		;FLAG IT
	RET			;THAT'S IT

XXDSSV:				;THIS ROUTINE DISPLAYS THE DESTINATION SOFTWARE VERSION
	SPACE			;BALANCE THE COLUMN
	SPACE			;...
	MOVE T1,.SBDSV		;GET OFFSET INTO SYSTEM BLOCK
	MOVE T4,[POINT 8,DATLOC(T1)] ;MAKE 8 BIT ASCII POINTER
	MOVNI T3,4		;MAXIMUM NUMBER OF CHARS IN STRING
DSSVLP:	ILDB T2,T4		;GET A BYTE
	JUMPE T2,DSSVDN		;IF ZERO, DONE
	CHI$ (T2)		;PRINT THE CHARACTER
	AOJL T3,DSSVLP		;KEEP LOOPING
DSSVDN:	RET			;DONE

XXDSHV:				;THIS ROUTINE DISPLAYS THE DESTINATION HARDWARE VERSION AS LH,,RH
	MOVE T1,.SBDHV		;GET OFFSET INTO SYSTEM BLOCK
	HLRZ T1,DATLOC(T1)	;GET LH
	CALL OCTSP6		;DISPLAY IN 6 CHARACTER FIELD
	STR$ [ASCIZ/,,/]	;COMMAS
	MOVE T1,.SBDHV		;GET OFFSET AGAIN
	HRRZ T1,DATLOC(T1)	;GET RH
	CALL OCTOUT		;DISPLAY IT
	RET			;DONE

;This  is  the table of possible virtual circuit states. Indexed by the
;contents of .SCVCS in the system block.

VCSTAB:	[ASCIZ/Closed/]		;CIRCUIT CLOSED
	[ASCIZ/ST Sen/]		;START SENT
	[ASCIZ/ST Rec/]		;START RECEIVED
	[ASCIZ/Open  /]		;CIRCUIT OPEN
VCSLEN=.-VCSTAB			;LENGTH OF TABLE

;GETSBA - THIS ROUTINE RETURNS AN ENTRY FROM THE SYSTEM BLOCK LIST.
;
; T4/ INDEX INTO SYSTEM BLOCK ADDRESS BLIST
;
;	CALL GETSB
;
; RETURN +1:	FAILURE
;
; RETURN +2:	SUCCESS
;  T3/ ADDRESS OF SYSTEM BLOCK

GETSBA:	MOVE T2,SBLIST		;ADDRESS OF TABLE
	ADDI T2,(T4)		;ADD IN TABLE OFFSET
	CALL GETWRD		;GET MONITOR WORD
	 RET			;FAILED
	RETSKP			;SUCCESS. WORD IN T3


;GETSTS - THIS ROUTINE GETS A WORD FROM THE REQUEST-ID STATUS TABLE
;
; T4/ INDEX INTO RIDSTS (REQUEST-ID STATUS TABLE)
;
;	CALL GETSTS
;
; RETURN +1:	FAILURE
;
; RETURN +2:	SUCCESS
;  T3/ REQUEST-ID STATUS

GETSTS:	MOVE T2,RIDSTS		;ADDRESS OF TABLE
	ADDI T2,(T4)		;ADD IN TABLE OFFSET
	CALL GETWRD		;GET MONITOR WORD
	 RET			;FAILED
	RETSKP			;SUCCESS. WORD IN T3
;GETWRD - THIS ROUTINE GETS ONE WORD FROM THE MONITOR.
;
; T2/ ADDRESS OF WORD IN MONITOR'S ADDRESS SPACE
;
;	CALL GETWRD
;
; RETURN +1:	FAILURE
;
; RETURN +2:	SUCCESS
; T3/ WORD FROM MONITOR'S ADDRESS SPACE

GETWRD:	MOVEI T1,XPDAT		;DATA BLOCK FOR XPEEK%
	MOVEM T2,.XPMAD(T1)	;SAVE IN FUNCTION BLOCK AS MONITOR ADDRESS
	MOVEI T2,.XPLEN		;LENGTH OF DATA BLOCK
	MOVEM T2,.XPABL(T1)	;STORE IN FUNCTION BLOCK
	MOVEI T2,.XPPEK		;GET XPEEK FUNCTION CODE
	MOVEM T2,.XPFNC(T1)	;SAVE IN FUNCTION BLOCK
	MOVEI T2,1		;NUMBER OF WORDS TO GET
	MOVEM T2,.XPCN1(T1)	;STORE IN FUNCTION BLOCK
	MOVEI T2,T3		;USER ADDRESS TO RETURN DATA
	MOVEM T2,.XPUAD(T1)	;SAVE IN FUNCTION BLOCK
	XPEEK%			;GET SYSTEM BLOCK ADDRESS LIST
	 ERJMP CPOPJ		;FAILED FOR THIS SYSTEM BLOCK
	RETSKP			;DONE. RETURN +2

;GETSB - THIS ROUTINE GETS A SYSTEM BLOCK FROM THE MONITOR. THE SYSTEM
;BLOCK IS RETURNED STARTING A LOCATION DATLOC.
;
; T3/ ADDRESS OF SYSTEM BLOCK
;
;	CALL GETSB
;
; RETURN +1: FAILED
;
; RETURN +2: SUCCESS. SYSTEM BLOCK READ INTO DATLOC

GETSB:	MOVEI T1,XPDAT		;DATA BLOCK ADDRESS OF EXTENDED PEEK
	MOVE T2,.SBLEN		;COUNT OF WORDS IN A SYSTEM BLOCK
	MOVEM T2,.XPCN1(T1)	;SAVE AS WORD COUNT
	MOVE T2,T3		;GET ADDRESS OF SYSTEM BLOCK
	MOVEM T2,.XPMAD(T1)	;SAVE AS MONITOR ADDRESS
	MOVEI T2,DATLOC		;WHERE TO RETURN DATA
	MOVEM T2,.XPUAD(T1)	;STICK INTO FUNCTION BLOCK
	XPEEK%			;GET A SYSTEM BLOCK
	 ERJMP CPOPJ		;FAILED
	RETSKP			;RETURN +2 ON SUCCESS

; THIS ROUTINE DISPLAYS THE SCA CONNECT BLOCKS

DPYSCB:	CALL SCASYM		;GET SYMBOLS NEEDED FOR DISPLAY
	 RET			;FAILED
	MOVEI T1,TP.SSB		;HEADER TYPE IS FOR SYSTEM BLOCKS
	CALL HDRSET		;SET UP COLUMN HEADERS
	MOVE T4,THESB		;GET SYSTEM BLOCK REQUESTED
	CAML T4,C%SBLL		;VALID BLOCK?
	 RET			;NO. THEN DONE
	TXNN F,FR.CMP		;COMPRESSING?
	 CALL DPYSCH		;NO. SHOW SCA TITLE LINE
	SKIPL T4,THESB		;GET SYSTEM BLOCK WANTED
	 JRST DOSB		;>0 MEANS SPECIFIC SB
	MOVEI T1,XPDAT		;DATA BLOCK FOR XPEEK%
	MOVEI T2,.XPLEN		;LENGTH OF DATA BLOCK
	MOVEM T2,.XPABL(T1)	;STORE IN FUNCTION BLOCK
	MOVEI T2,.XPPEK		;GET XPEEK FUNCTION CODE
	MOVEM T2,.XPFNC(T1)	;SAVE IN FUNCTION BLOCK
	MOVEI T2,1		;NUMBER OF WORDS TO GET
	MOVEM T2,.XPCN1(T1)	;STORE IN FUNCTION BLOCK
	MOVE T2,TOPDC		;ADDRESS OF TOP OF DCQ CHAIN
	MOVEM T2,.XPMAD(T1)	;SAVE IN FUNCTION BLOCK AS MONITOR ADDRESS
	MOVEI T2,T3		;USER ADDRESS TO RETURN DATA
	MOVEM T2,.XPUAD(T1)	;SAVE IN FUNCTION BLOCK
	XPEEK%			;GET SBLIST
	 ERJMP CPOPJ		;FAILED.
	MOVE T1,.SBFCB		;GET ADDRESS OF TOP OF CB QUEUE IN SB
	MOVEM T3,DATLOC(T1)	;STORE TOP OF DC QUEUE THERE
	STR$ [ASCIZ/"Don't care queue":/]
	CRLF			;PUT OUT SPECIAL HEADER
	CRLF			;...
	JRST DOCBS		;GO DISPLAY CB
DOSB:	CALL GETSBA		;GET ADDRESS OF SYSTEM BLOCK
	 RET			;FAILED. QUIT NOW
	JUMPE T3,CPOPJ		;NO SYSTEM BLOCK.
	CALL GETSB		;GET THE SYSTEM BLOCK
	 RET			;FAILED
	CALL DOCOLS		;DISPLAY SYSTEM BLOCK
DOCBS:	MOVEI T1,TP.SCB		;HEADER TYPE FOR CONNECT BLOCKS
	CALL HDRSET		;SET UP COLUMN HEADERS
	CALL SETEAT		;SET UP SCREEN EATING HERE
	MOVE T1,.SBFCB		;OFFSET FOR FIRST CONNECT BLOCK POINTER
	MOVE T3,DATLOC(T1)	;GET IT
NXTCB:	JUMPE T3,CPOPJ		;BLOCK ADDRESS ZERO. DONE WITH CB'S
	MOVEI T1,XPDAT		;ADDRESS OF XPEEK FUNCTION BLOCK
	MOVE T2,.CBPS1		;LENGTH OF CONNECT BLOCK
	MOVEM T2,.XPCN1(T1)	;SAVE IN XPEEK% FUNCTION BLOCK
	MOVEM T3,.XPMAD(T1)	;CONNECT BLOCK ADDRESS IS MONITOR ADDRESS
	MOVEI T2,DATLOC		;WHERE TO RETURN WORDS
	MOVEM T2,.XPUAD(T1)	;STICK INTO FUNCTION BLOCK
	XPEEK%			;GET THE CONNECT BLOCK
	 ERJMP CPOPJ		;RETURN ON ERROR
	CALL DOCOLS		;CALL ROUTINES FOR EACH COLUMN
	MOVE T2,.CBANB		;ADDRESS OF NEXT CONNECT BLOOCK
	MOVE T3,DATLOC(T2)	;GET IT
	JRST NXTCB		;GO FOR NEXT CONNECT BLOCK
	SUBTTL Routines to Print Out Various Sca Connect Block Data

XXRCCR:				;ROUTINE TO DISPLAY RECEIVE CREDITS
	MOVE T1,.CBRCD		;GET OFFSET FOR RECEIVE CREDITS
	HRRZ T1,DATLOC(T1)	;GET RECEIVE CREDITS
	JRST DECSP6		;OUTPUT AS A DECIMAL NUMBER

XXSNCR:				;ROUTINE TO DISPLAY SEND CREDITS
	MOVE T1,.CBSCD		;GET OFFSET FOR SEND CREDITS
	HRRZ T1,DATLOC(T1)	;GET SEND CREDITS
	JRST DECSP6		;OUTPUT AS A DECIMAL NUMBER

XXRQCR:				;ROUTINE TO DISPLAY REQUEUE CREDITS
	MOVE T1,.CBRQC		;GET OFFSET FOR REQUEUE CREDITS
	HRRZ T1,DATLOC(T1)	;GET REQUEUE CREDITS
	JRST DECSP6		;OUTPUT AS A DECIMAL NUMBER

XXDRDG:				;ROUTINE TO DISPLAY NUMBER OF DROPPED DATAGRAMS
	SPACE			;FORMAT NICELY
	SPACE			;...
	MOVE T1,.CBCDD		;GET OFFSET INTO CONNECT BLOCK
	MOVE T1,DATLOC(T1)	;GET NUMBER OF DROPPED DATAGRAMS
	JRST DECSP6		;OUTPUT AS DECIMAL NUMBER

XXRDGB:				;ROUTINE TO DISPLAY NUMBER OF REAL DATAGRAM BUFFERS
	MOVE T1,.CBDGR		;GET OFFSET INTO CONNECT BLOCK
	HRRZ T1,DATLOC(T1)	;GET NUMBER OF REAL DATAGRAM BUFFERS
	JRST DECSP6		;OUTPUT AS A DECIMAL NUMBER

XXJDGB:				;ROUTINE TO DISPLAY NUMBER OF JSYS DATAGRAM BUFFERS
	MOVE T1,.CBDGJ		;GET OFFSET INTO CONNECT BLOCK
	HRRZ T1,DATLOC(T1)	;GET NUMBER OF JSYS DATAGRAM BUFFERS
	JRST DECSP6		;OUTPUT AS A DECIMAL NUMBER

XXSCPN:				;ROUTINE TO DISPLAY THE SOURCE PROCESS NAME
	MOVE T1,.CBSPN		;GET OFFSET INTO CONNECT BLOCK
	MOVE T4,[POINT 8,DATLOC(T1)] ;MAKE 8 BIT ASCII POINTER
	MOVNI T3,16		;MAXIMUM NUMBER OF CHARS IN STRING
SCPNLP:	ILDB T2,T4		;GET A BYTE
	JUMPE T2,SCPNDN		;IF ZERO, DONE
	CHI$ (T2)		;PRINT THE CHARACTER
	AOJL T3,SCPNLP		;KEEP LOOPING
SCPNDN:	RET			;DONE

XXDSPN:				;ROUTINE TO DISPLAY THE DESTINATION PROCESS NAME
	MOVE T1,.CBDPN		;GET OFFSET INTO CONNECT BLOCK
	MOVE T4,[POINT 8,DATLOC(T1)] ;MAKE 8 BIT ASCII POINTER
	MOVNI T3,16		;MAXIMUM NUMBER OF CHARS IN STRING
DSPNLP:	ILDB T2,T4		;GET A BYTE
	JUMPE T2,DSPNDN		;IF ZERO, DONE
	CHI$ (T2)		;PRINT THE CHARACTER
	AOJL T3,DSPNLP		;KEEP LOOPING
DSPNDN:	RET			;DONE

XXSFLG:				;THIS ROUTINE DISPLAYS THE CONNECT BLOCK FLAGS
	MOVE T1,.CBFLG		;GET OFFSET INTO CONNECT BLOCK
	MOVE T1,DATLOC(T1)	;GET THE FLAG WORD
	TDNE T1,CBFJSY		;CB FOR JSYS CONNECT
	 CHI$ "J"		;DISPLAY CHARACTER
	TDNE T1,CBFRAP		;CB IS TO BE REAPED
	 CHI$ "R"		;DISPLAY CHARACTER
	TDNE T1,CBFKIL		;FORK HAS BEEN KILLED
	 CHI$ "K"		;DISPLAY CHARACTER
	TDNE T1,CBFCVC		;VIRTUAL CIRCUIT HAS BEEN CLOSED
	 CHI$ "C"		;DISPLAY CHARACTER
	TDNE T1,CBFPTC		;PROTOCOL COMPLETED
	 CHI$ "P"		;DISPLAY CHARACTER
	TDNE T1,CBFNNC		;NEEDS CREDIT NOTIFY
	 CHI$ "N"		;DISPLAY CHARACTER
;	TDNE T1,CBSOB		;CB STUCK ON BUFFER
;	 CHI$ "S"		;DISPLAY CHARACTER
	RET			;DONE. 6 FLAGS TOTAL

XXSCCI:				;THIS ROUTINE DISPLAYS THE SOURCE CONNECT ID
	MOVE T1,.CBSCI		;GET OFFSET INTO CONNECT BLOCK
	HLRZ T1,DATLOC(T1)	;GET LH
	CALL OCTSP6		;DISPLAY IN 6 CHARACTER FIELD
	STR$ [ASCIZ/,,/]	;COMMAS
	MOVE T1,.CBSCI		;GET OFFSET AGAIN
	HRRZ T1,DATLOC(T1)	;GET RH
	CALL OCTOUT		;DISPLAY IT
	RET			;DONE

XXDSCI:				;DESTINATION CONNECT ID
	MOVE T1,.CBDCI		;GET OFFSET INTO CONNECT BLOCK
	HLRZ T1,DATLOC(T1)	;GET LH
	CALL OCTSP6		;DISPLAY IN 6 CHARACTER FIELD
	STR$ [ASCIZ/,,/]	;COMMAS
	MOVE T1,.CBDCI		;GET OFFSET AGAIN
	HRRZ T1,DATLOC(T1)	;GET RH
	CALL OCTOUT		;DISPLAY IT
	RET			;DONE

XXPRCR:				;THIS ROUTINE DISPLAYS PENDING RECEIVE CREDITS
	MOVE T1,.CBPRC		;GET OFFSET INTO CONNECT BLOCK
	HRRZ T1,DATLOC(T1)	;GET PENDING RECEIVE CREDITS
	JRST DECSP6		;DISPLAY AS A DECIMAL NUMBER

XXCQP:				;DISPLAY NUMBER OF PACKETS ON THE PORT COMMAND Q
	MOVE T1,.CBNPO		;GET OFFSET INTO CONNECT BLOCK
	HRRZ T1,DATLOC(T1)	;GET # OF PACKETS
	JRST DECSP6		;DISPLAY AS A DECIMAL NUMBER

XXBKST:				;THIS ROUTINE DISPLAYS THE BLOCK STATE
	SPACE			;BALANCE THE OUTPUT
	MOVE T1,.CBSTS		;GET OFFSET INTO CONNECT BLOCK
	HLRZ T1,DATLOC(T1)	;GET INDEX INTO BLOCK STATE TABLE
	HRLZI T3,-.CBLEN	;SET UP AOBJN POINTER
BKSTLP:	HLRZ T2,CBSTAT(T3)	;GET BLOCK CODE
	CAMN T2,T1		;MATCH?
	 JRST GOTBKS		;YES
	AOBJN T3,BKSTLP		;NO. LOOP OVER ENTIRE TABLE
	RET			;FAILED TO FIND IT
GOTBKS:	HRRZ T1,CBSTAT(T3)	;GET ADDRESS OF STRING
	STR$ (T1)		;DISPLAY IT
	RET			;DONE

XXCNST:				;THIS ROUTINE DISPLAYS THE CONNECT STATE
	SPACE			;BALANCE THE COLUMN
	MOVE T1,.CBSTS		;GET OFFSET INTO CONNECT BLOCK
	HRRZ T1,DATLOC(T1)	;GET INDEX INTO CONNECT STATE TABLE
	HRLZI T3,-.CNLEN	;SET UP AOBJN POINTER
CNSTLP:	HLRZ T2,CNSTAT(T3)	;GET CONNECT CODE
	CAMN T2,T1		;MATCH?
	 JRST GOTCNS		;YES
	AOBJN T3,CNSTLP		;NO. LOOP OVER ENTIRE TABLE
	RET			;FAILED TO FIND IT
GOTCNS:	HRRZ T1,CNSTAT(T3)	;GET ADDRESS OF STRING
	STR$ (T1)		;DISPLAY STRING
	RET			;DONE

;This  is  the  table of possible connection block states the LH is the
;block state  code  and  the  RH  is  the  address  of  a  string  that
;cooresponds to that code.

CBSTAT:	0,,[ASCIZ/  NB/]	;NOT BLOCKED
	1,,[ASCIZ/CNPEN/]	;CONNECT PENDING
	2,,[ASCIZ/ACPEN/]	;ACCEPT PENDING
	3,,[ASCIZ/ALLOC/]	;ALLOCATE
	4,,[ASCIZ/CRPEN/]	;CREDIT PENDING
	5,,[ASCIZ/RJPEN/]	;REJECT PENDING
	6,,[ASCIZ/DCCRP/]	;DISCONNECT CREDIT PENDING
	7,,[ASCIZ/DCPEN/]	;DISCONNECT PENDING
	.CBLEN==.-CBSTAT	;LENGTH OF TABLE

;This  is  the  table of possible connect states. The LH is the connect
;state code and the RH is the address of the cooresponding  string  for
;that code.

CNSTAT:	1,,[ASCIZ/CLOSE/]	;CLOSED
	2,,[ASCIZ/LIST /]	;LISTENING
	3,,[ASCIZ/CNSEN/]	;CONNECT SENT
	4,,[ASCIZ/CNREC/]	;CONNECT RECIEVED
	5,,[ASCIZ/CNACK/]	;CONNECT ACKNOWLEGED
	6,,[ASCIZ/ACSEN/]	;ACCEPT SENT
	7,,[ASCIZ/RJSEN/]	;ACCEPT SENT
	10,,[ASCIZ/OPEN /]	;OPEN
	11,,[ASCIZ/DCSEN/]	;DISCONNECT SENT
	12,,[ASCIZ/DCREC/]	;DISCONNECT RECIEVED
	13,,[ASCIZ/DCACK/]	;DISCONNECT ACKNOWLEGED
	14,,[ASCIZ/DCMAT/]	;DISCONNECT MATCH
.CNLEN=.-CNSTAT
	SUBTTL Routine to Snoop Symbols For SCA Display

;This routine fills in the table of symbols needed for the SCA display.
;Returns +1 on failure, +2 otherwise.

SCASYM:	TXNE F,FR.SCS		;ALREADY HAVE SYMBOLS?
	RETSKP			;YES. RETURN GOOD
	MOVEI T1,TBSSCA		;ADDRESS OF SYMBOLS
	MOVEI T2,TBMSCA		;TABLE OF MODULE NAMES
	MOVEI T3,TBVSCA		;TABLE OF SCA VALUES RETURNED
	MOVSI T4,-NUMSCA	;LENGTH OF TABLE
	CALL GTSYMS		;GET THE SYMBOLS
	 RET			;FAILED
	TXO F,FR.SCS		;SYMBOLS ARE NOW GOTTEN
	RETSKP			;YES. RETURN GOOD

;This  general purpose routine looks up a list of symbols given symbols
;and module names. It stores the values in a  table  whose  address  is
;passed.  If  the symbol is not found in the given module, it prints an
;error message and looks throught the monitor's entire symbol table.

;CALL:
;	T1/ ADDRESS OF TABLE OF SYMBOLS
;	T2/ ADDRESS OF TABLE MODULE NAMES
;	T3/ ADDRESS OF TABLE WHERE VALUES ARE STORED
;	T4/ -LENGTH OF TABLES,,0
;RETURNS:
;	+1:	FAILED TO LOOKUP ALL SYMBOLS
;	+2:	SUCCESS

GTSYMS:	HRRM T1,SYMNAM		;SAVE ADDRESS SYMBOLS
	HRRM T2,SYMMOD		;SAVE ADDRESS OF MODULES
	HRRM T3,SYMVLU		;SAVE ADDRESS OF VALUES 
SYMLKU:	MOVEI T1,.SNPSY		;GET FUNCTION CODE
	MOVE T2,@SYMNAM		;GET SYMBOL NAME, RAD50
	MOVE T3,@SYMMOD		;AND PROGRAM NAME, RAD50
	SNOOP			;GET THE VALUE
	 ERCAL [CALL SNPMON	;FAILED. TRY WHOLE MONITOR
		 RET		;FAILED. RETURN +1
		JRST .+1]	;GOT IT CONTINUE.
	MOVEM T2,@SYMVLU	;SAVE THE VALUE
	AOBJN T4,SYMLKU		;LOOP OVER ALL WORDS
	RETSKP			;GOOD RETURN
;If the SNOOP failed above, search the whole monitor for the symbol.

SNPMON:
Repeat 0,<
	STR$ [ASCIZ/% Symbol /]	;SAY WHAT'S GOING ON
	MOVE T1,@SYMNAM		;GET SYMBOL
	CALL R50OUT		;OUTPUT IT
	STR$ [ASCIZ/ not found in module /]
	MOVE T1,@SYMMOD		;GET MODULE NAME
	CALL R50OUT		;OUTPUT IT
	CRLF			;FINISH
>
	MOVEI T1,.SNPSY		;SNOOP FOR A SYMBOL
	MOVE T2,@SYMNAM		;GET SYMBOL NAME
	SETZ T3,		;SEARCH ENTIRE MONITOR
	SNOOP%			;DO IT
	 ERJMP NOSYM		;SEARCH FAILED. GO COMPLAIN.
	RETSKP			;SUCESS. RETURN WITH SYMBOL VALUE
NOSYM:	STR$ [ASCIZ/% Symbol /]	;SAY WHAT'S GOING ON
	MOVE T1,@SYMNAM		;GET SYMBOL
	CALL R50OUT		;OUTPUT IT
	STR$ [ASCIZ/ not found in module /]
	MOVE T1,@SYMMOD		;GET MODULE NAME
	CALL R50OUT		;OUTPUT IT
	STR$ [ASCIZ/. Search of entire monitor failed./]
	CRLF			;FINISH
	RET			;AND RETURN TO CALLER

;Table  of symbols we want to snoop. This macro is expanded later on in
;the program.

DEFINE SSYMS,<			;SYMBOLS WE WANT TO KNOW ABOUT

	XX RIDSTS,PHYKLP	;;REQUEST ID STATUS
	XX IDNRA,PHYKLP		;; PATH A STATUS BIT
	XX IDNRB,PHYKLP		;; PATH B STATUS BIT
	XX IDNOR,PHYKLP		;; COUNT OF NO-ANSWER
	XX KLPRH2,PHYKLP	;;CHANNEL WHERE KLIPA RESIDES
	XX CDBFLG,PHYKLP	;;KLIPA STATUS WORD IN CDB
	XX CDBVER,PHYKLP	;;KLIPA UCODE VERSION WORD IN CDB
	XX TODCLK,STG		;;CURRENT TODCLK
	XX SBLIST		;;TABLE OF SYSTEM BLOCKS
	XX C%SBLL		;;LENGTH OF SYSTEM BLOCK LIST
	XX TOPDC		;;TOP OF "DON'T CARE QUEUE"
	XX .SBLEN,PHYKLP	;;LENGTH OF A SYSTEM BLOCK
	XX .SBFCB		;;POINTER TO FIRST CONNECT BLOCK
	XX .CBPS1,SCSJSY	;;LENGTH OF A CONNECT BLOCK
	XX .CBANB		;;POINTER TO NEXT CONNECT BLOCK
	XX .CBRCD		;;RECEIVE CREDITS IN CB
	XX .CBSCD		;;SEND CREDITS IN CB
	XX .CBRQC		;;REQUEUE CREDIT IN CB
	XX .CBDGR		;;# OF REAL DATAGRAM BUFFERS
	XX .CBCDD		;;# OF DROPPED DATAGRAMS
	XX .CBDGJ,SCSJSY	;;# OF JSYS DATAGRAM BUFFERS
	XX .CBSPN,SCAMPI	;;SOURCE PROCESS NAME
	XX .CBDPN		;;DESTINATION PROCESS NAME
	XX .CBFLG		;;CB FLAGS
	XX CBFJSY		;; CB FLAG
	XX CBFRAP		;; CB FLAG
	XX CBFKIL,SCSJSY	;; CB FLAG
	XX CBFCVC		;; CB FLAG
	XX CBFPTC		;; CB FLAG
	XX CBFNNC		;; CB FLAG
;	XX CBSOB		;; CB FLAG
	XX .CBSCI		;;SOURCE CONNECT ID
	XX .CBDCI		;;DESTINATION CONNECT ID
	XX .CBPRC		;;PENDING RECEIVE CREDITS
	XX .CBNPO		;;# OF PACKETS ON PORT COMMAND Q
	XX .CBSTS		;;BLOCK STATE,,CONNECT STATE
	XX .SBTIM		;;TODCLK AT LAST MESSAGE
	XX .SBMMS		;;MAX MESS. SIZE,,MAX DG SIZE
	XX .SBDST		;;DESTINATION SOFTWARE TYPE
	XX .SBDHT		;;DESTINATION HARDARE TYPE
	XX .SBDSV		;;DESTINATION SOFTWARE VERSION
	XX .SBDHV		;;DESTINATION HARDWARE VERSION
	XX .SBDSP		;;DESTINATION PORT
	XX .SBVCS		;;CIRCUIT STATE (RH)
	XX .SBFLG		;;SYSTEM BLOCK FLAGS
	XX SBFTMG		;; TIMED MESSAGE (T)
	XX SBFOVC		;; VC NEED OPEN (O)
;	XX SBFCVC		;; VC CLOSE PLEASE (C)
	XX SBFOFL		;; NODE OFFLINE (F)
	XX SNDTAB		;;TABLE OF SCA MESSAGES SENT
	XX RECTAB		;;TABLE OF SCA MESSAGES RECEIVED
	XX .STLST		;;LENGTH OF ABOVE TABLES
	XX .STORQ		;; CONNECT REQUEST
	XX .STORS		;; CONNECT RESPONSE
	XX .STARQ		;; ACCEPT REQUEST
	XX .STARS		;; ACCEPT RESPONSE
	XX .STRRQ		;; REJECT REQUEST
	XX .STRRS		;; REJECT RESPONSE
	XX .STDRQ		;; DISCONNECT REQUEST
	XX .STDRS		;; DISCONNECT RESPONSE
	XX .STCRQ		;; CREDIT REQUEST
	XX .STCRS		;; CREDIT RESPONSE
	XX .STAMG		;; APPLICATION MESSAGES
	XX .STADG		;; APPLICATION DATAGRAMS
>
	SUBTTL Routines to Show SCA Traffic Information

;This  routine  shows  SCA  traffic to date and is entered via the "SS"
;command.

DPYSCT:	SETOM HDRTYP		;NO SPECIAL HEADERS FOR THIS DISPLAY
	CALL SCASYM		;GET SCA SYMBOLS
	 RET			;FAILED
	TAB$ [$TABS <32,48>]	;SET NEW TAB STOPS
	TXNN F,FR.CMP		;COMPRESSING OUTPUT?
	 CALL SCTHDR		;NO. GO PRINT HEADER INFO
	MOVEI T1,XPDAT		;DATA BLOCK FOR XPEEK%
	MOVEI T2,.XPLEN		;LENGTH OF DATA BLOCK
	MOVEM T2,.XPABL(T1)	;STORE IN FUNCTION BLOCK
	MOVEI T2,.XPPEK		;GET XPEEK FUNCTION CODE
	MOVEM T2,.XPFNC(T1)	;SAVE IN FUNCTION BLOCK
	MOVE T2,.STLST		;NUMBER OF WORDS IS LENGTH OF RECTAB
	MOVEM T2,.XPCN1(T1)	;STORE IN FUNCTION BLOCK
	MOVE T2,SNDTAB		;ADDRESS OF TABLE OF MESSAGES SENT
	MOVEM T2,.XPMAD(T1)	;SAVE IN FUNCTION BLOCK AS MONITOR ADDRESS
	MOVEI T2,DATLOC		;USER ADDRESS TO RETURN DATA
	MOVEM T2,.XPUAD(T1)	;SAVE IN FUNCTION BLOCK
	XPEEK%			;GET SYSTEM BLOCK ADDRESS LIST
	 ERJMP CPOPJ		;FAILED FOR THIS SYSTEM BLOCK
	MOVE T2,RECTAB		;ADDRESS OF TABLE OF MESSAGES RECEIVED
	MOVEM T2,.XPMAD(T1)	;SAVE IN FUNCTION BLOCK AS MONITOR ADDRESS
	MOVEI T2,DATLOC		;WHERE TO RETURN DATA
	ADD T2,.STLST		;PLUS LENGTH OF PREVIOUS DATA
	MOVEM T2,.XPUAD(T1)	;SAVE IN FUNCTION BLOCK
	XPEEK%			;GET SYSTEM BLOCK ADDRESS LIST
	 ERJMP CPOPJ		;FAILED FOR THIS SYSTEM BLOCK
	HRLZI T4,-MSTBLN	;SET TO LOOP OVER TABLE
SCTLOP:	HRRZ T1,MESTAB(T4)	;GET ADDRESS OF STRING
	STR$ (T1)		;DISPLAY IT
	TAB			;READY TO DISPLAY MESSAGE COUNTS
	HLRZ T1,MESTAB(T4)	;GET ADDRESS OF OFFSET INTO SNDTAB AND RECTAB
	MOVE T1,(T1)		;GET OFFSET
	CALL SCTDSP		;GO DISPLAY COUNTS
	CRLF			;READY FOR NEXT LINE
	AOBJN T4,SCTLOP		;DO ENTIRE TABLE
	RET			;DONE

;This  table  contains  in the LH the address of the word that contains
;the offset into the RECTAB and SNDTAB tables  for  the  given  message
;type  and the address of a string in the RH that describes the message
;type.

MESTAB:	.STORQ,,[ASCIZ/Connect Requests:/]
	.STORS,,[ASCIZ/Connect Responses:/]
	.STARQ,,[ASCIZ/Accept Requests:/]
	.STARS,,[ASCIZ/Accept Responses:/]
	.STRRQ,,[ASCIZ/Reject Requests:/]
	.STRRS,,[ASCIZ/Reject Responses:/]
	.STDRQ,,[ASCIZ/Disconnect Requests:/]
	.STDRS,,[ASCIZ/Disconnect Responses:/]
	.STCRQ,,[ASCIZ/Credit Requests:/]
	.STCRS,,[ASCIZ/Credit Responses:/]
	.STAMG,,[ASCIZ/Application Messages:/]
	.STADG,,[ASCIZ/Application Datagrams:/]
	MSTBLN==.-MESTAB       	;LENGTH OF MESTAB

;SCTDSP - DISPLAY MESSAGE SENT AND RECEIVED FOR A GIVEN MESSAGE TYPE.
;
; T1/ MESSAGE TYPE
;
;CALL SCTDPS
;
; RETURNS +1: ALWAYS

SCTDSP:	PUSH P,T1		;SAVE OFFSET
	MOVE T1,DATLOC(T1)	;GET NUMBER OF MESSAGES SENT
	CALL DECOUT		;DISPLAY IT
	TAB
	POP P,T1		;GET BACK OFFSET
	ADD T1,.STLST		;MAKE OFFSET INTO RECTAB
	MOVE T1,DATLOC(T1)	;GET NUMBERS OF MESSAGES RECEIVED
	CALL DECOUT		;AND DISPLAY IT
	RET			;DONE

;This routine prints the header for the "SS" display and is called only
;if we are not compressing output.

SCTHDR:	STR$ [ASCIZ/SCA Traffic to date:/] ;SOME HEADER TEXT
	CRLF			;FORMAT
	CRLF			;BLANK LINE
	STR$ [ASCIZ/Message Type/]
	TAB			;JUMP TO TAB STOP
	STR$ [ASCIZ/Sent/]
	TAB			;NEXT TAB STOP
	STR$ [ASCIZ/Received/]
	CRLF			;FINISH IT UP
	CRLF			;...
	RET			;DONE
	SUBTTL Routines to Print MSCP Data

;This  mode  is  entered  by the "MS" command. It shows the MSCP server
;statistics and counters

DPYMSC:	SETOM HDRTYP		;CLEAR HEADER TYPE
	CALL SETEAT		;SET UP SCREEN EATING
	CALL MSCSYM		;GET MSCP SYMBOLS
	 RET			;FAILED
	CALL MSCSRV		;SHOW SERVER STATISTICS
	CALL MSCFNC		;SHOW MSCP-SCA FUNCTION COUNTS
	CALL MSCCOM		;SHOW MSCP COMMAND COUNTS
	RET

MSCFNC:				;DISPLAY THE MSCP SCA FUNCTION CALLS
	CRLF			;POSITION FOR HEADER
	STR$ [ASCIZ/MSCP SCA call counts:/] ;HEADER
	CRLF			;SPACE IT OUT
	CRLF			;...
	TAB$ [$TABS<1,41>]	;SET UP NICE TAB STOPS
	MOVE T1,.SSAFT		;GET MAX ENTRY NUMBER ALLOWED IN MONITOR
	AOJ T1,			;MAKE NUMBER OF TABLE ENTRIES
	CAIE T1,FNCLEN		;SAME AS OUR TABLE?
	 JRST [	STR$ [ASCIZ/?.SSAFT NOT EQUAL TO FNCLEN/] ;SAY TABLE WRONG
		RET ]		;AND RETURN
	MOVE T2,SVSCAC		;GET ADDRESS OF TABLE
	MOVE T3,T1		;AND LENGTH OF TABLE
	CALL GETBLK		;GET THE TABLE
	 RET			;FAILED
	SETZM LINFLG		;CLEAR LINE FLAG
	MOVSI T4,-FNCLEN	;SET UP AOBJN POINTER
FNCLP:	SKIPGE T2,FNCTAB(T4)	;GET TABLE ENTRY
	 JRST NXTFNC		;-1 MEANS DON'T SHOW IT
	TAB			;JUMP OVER
	STR$ (T2)		;PRINT STRING
	MOVE T1,DATLOC(T4)	;GET VALUE
	CALL DECOUT		;DISPLAY IT
	SETCMM LINFLG		;COMPLEMENT LINE FLAG
	SKIPL LINFLG		;NEED A NEW LINE?
	 CRLF			;YES
NXTFNC:	AOBJN T4,FNCLP		;SHOW ENTIRE TABLE
	CRLF			;GO TO NEXT LINE
	RET			;DONE

;This is the table for MSCP SCA calls.

FNCTAB:	[ASCIZ/Datagram received: /]
	[ASCIZ/Message received: /]
	[ASCIZ/Port broke connection: /]
	[ASCIZ/Connect to listen: /]
	[ASCIZ/Connect response available: /]
	[ASCIZ\Message/datagram send complete: \]
	[ASCIZ/Datagram dropped: /]
	[ASCIZ/Little credit left: /]
	[ASCIZ/Node came online: /]
	[ASCIZ/OK to send data: /]
	[ASCIZ/Remote initiated disconnect: /]
	[ASCIZ/Credit is available: /]
	[ASCIZ/DMA complete: /]
	FNCLEN==.-FNCTAB

;GETBLK
;
;THIS ROUTINE READS A BLOCK OF THE MONITOR'S ADDRESS INTO DATLOC.
;CALL:
;	T2/ MONITOR ADDRESS
;	T3/ LENGTH OF BLOCK OF DATA
;RETURNS:
;	+1:	FAILED
;	+2:	SUCCESS, DATA AT DATLOC

GETBLK:	MOVEI T1,XPDAT		;XPEEK% DATA BLOCK
	MOVEM T2,.XPMAD(T1)	;SAVE WORD TO GET FROM MONITOR
	MOVEM T3,.XPCN1(T1)	;STORE IN FUNCTION BLOCK
	MOVEI T2,.XPLEN		;LENGTH OF DATA BLOCK
	MOVEM T2,.XPABL(T1)	;STORE IN FUNCTION BLOCK
	MOVEI T2,.XPPEK		;GET XPEEK FUNCTION CODE
	MOVEM T2,.XPFNC(T1)	;SAVE IN FUNCTION BLOCK
	MOVEI T2,DATLOC		;USER ADDRESS TO RETURN DATA
	MOVEM T2,.XPUAD(T1)	;SAVE IN FUNCTION BLOCK
	XPEEK%			;GET SBLIST
	 ERJMP CPOPJ		;FAILED.
	RETSKP			;SUCCESS. VALUE IN T2

MSCCOM:				;THIS ROUTINE DISPLAYS THE MSCP COMMAND TABLE
	CRLF			;SEPARATE DISPLAYS
	STR$ [ASCIZ/MSCP Command Counters:/] ;HEADER TEXT
	CRLF			;...
	CRLF
	TAB$ [$TABS<1,41>]	;SET UP NICE TAB STOPS
	MOVE T2,SVCMDC		;GET MONITOR'S ADDRESS OF TABLE
	AOJ T2,			;BUMP BY ONE
	MOVEI T3,COMLEN		;AND LENGTH OF TABLE
	CALL GETBLK		;READ IN THE BLOCK
	 RET			;FAILED
	MOVSI T4,-COMLEN	;SET UP AOBJN POINTER
COMLP:	TAB			;JUMP OVER
	STR$ @COMTAB(T4)	;GET STRING
	MOVE T1,DATLOC(T4)	;GET VALUE
	CALL DECOUT		;DISPLAY IT
	TRNE T4,1		;EVEN NUMBER?
	 CRLF			;YES. NEXT LINE
	AOBJN T4,COMLP		;SHOW ENTIRE TABLE
	CRLF			;GO TO NEXT LINE
	RET			;DONE

;This table is a list of the MSCP command calls.

COMTAB:	[ASCIZ/Read Data: /]
	[ASCIZ/Write Data: /]
	[ASCIZ/Get Command Status: /]
	[ASCIZ/Get Unit Status: /]
	[ASCIZ/Online a Unit: /]
	[ASCIZ/Abort Command: /]
	[ASCIZ/Set Controller Characteristics: /]
	[ASCIZ/Available Command: /]
	COMLEN==.-COMTAB

MSCSRV:				;THIS ROUTINE DISPLAYS THE MSCP SERVER STATISTICS
	STR$ [ASCIZ/MSCP Server Satistics:/] ;HEADER
	CRLF			;SPACE IT OUT
	CRLF			;...
	TAB$ [$TABS<1,27,53>]	;SET UP NICE TAB STOPS
	MOVSI T4,-SRVLEN	;GET LENGTH OF TABLE
SRVLP:	TAB			;SPACE IT OUT
	HLRZ T2,SRVTAB(T4)	;GET ADDRESS OF STRING
	STR$ (T2)		;PRINT IT
	HRRZ T3,SRVTAB(T4)	;GET ADDRESS OF DATA WORD
	HLRZ T2,(T3)		;GET ADDRESS OF SYMBOL'S ADDRESS
	MOVE T2,(T2)		;GET MONITOR ADDRESS OF SYMBOL
	CALL GETWRD		;GET CONTENTS OF SERVER STATISTIC
	 RET			;FAILED
	MOVE T1,T3		;GET VALUE RETURNED
	HRRZ T3,SRVTAB(T4)	;GET ADDRESS OF DATA WORD
	HRRZ T3,(T3)		;GET DISPATCH ADDRESS
	PUSH P,T4		;SAVE AOBJN POINTER
	CALL @T3		;GO TO DISPTACH ADDRESS
	POP P,T4		;RETRIEVE IT
	HRRZ T1,T4		;GET NUMBER DISPLAYED
	IDIVI T1,4		;DIVIDE BY NUMBER OF COLUMNS
	CAIN T2,2		;WHOLE ROW DISPLAYED?
	 CRLF			;YES. NEXT LINE
	AOBJN T4,SRVLP		;LOOP ENTIRE TABLE
	CRLF			;SEPARATE DISPLAYS
	RET			;DONE

;This  is  a  table  of the MSCP server statistic words in the monitor.
;Entry is of the form:
;			ADDRESS,,ADDRESS2
;ADDRESS1  is  the  address  of  the  ASCIZ  string that is the monitor
;symbol. ADDRESS2 is the address of a word which contains in the LH the
;address of the word containing  the  monitor  address  and  the  RH  a
;dispatch routine in the running monitor.

SRVTAB:
	[ASCIZ/Command Errs: /],,[SVILCM,,DECOUT] ;;COUNT OF COMMAND ERRORS
	[ASCIZ/Last Command: /],,[SVLCMD,,SYMOUT] ;;LAST COMMAND
	[ASCIZ/Packets:      /],,[SVPKIU,,DECOUT] ;;PACKETS IN USE
	[ASCIZ/Max packets:  /],,[SVMKIU,,DECOUT] ;;MAX PACKETS
	[ASCIZ/Commands:     /],,[SVCMIU,,DECOUT] ;;COMMANDS BEING HANDLED
	[ASCIZ/Max commands: /],,[SVMCIU,,DECOUT] ;;MAX COMMANDS AT ONCE
	[ASCIZ/IO Pages:     /],,[SVIPIU,,DECOUT] ;;IO PAGES USED
	[ASCIZ/Max IO pages: /],,[SVMPIU,,DECOUT] ;;MAX IO PAGES EVER USED
	[ASCIZ/Broadcasts:   /],,[SVBDKN,,DECOUT] ;;COUNT OF BROADCASTS TO DO
	[ASCIZ/Times NSKED:  /],,[SVBKNS,,DECOUT] ;;TIMES BLOCKED FOR NOSKED EVENTS
SRVLEN==.-SRVTAB
	SUBTTL Subroutine to Obtain MSCP Symbols by Snooping

;Here  to fill in the table of offsets and such so we can do peeks with
;the data.

MSCSYM:	TXNE F,FR.MSC		;ALREADY HAVE SYMBOLS?
	RETSKP			;YES. RETURN GOOD
	MOVEI T1,TBSMSC		;ADDRESS OF SYMBOLS
	MOVEI T2,TBMMSC		;TABLE OF MODULE NAMES
	MOVEI T3,TBVMSC		;TABLE OF SCA VALUES RETURNED
	MOVSI T4,-NUMMSC	;LENGTH OF TABLE
	CALL GTSYMS		;GET THE SYMBOLS
	 RET			;FAILED
	TXO F,FR.MSC		;SYMBOLS ARE NOW GOTTEN
	RETSKP			;YES. RETURN GOOD

;Table  of symbols we want to snoop. This macro is expanded later on in
;the program.

DEFINE MSYMS,<			;SYMBOLS WE WANT TO KNOW ABOUT

	XX SVILCM		;;COUNT OF ILLEGAL (ERROR) COMMANDS
	XX SVLCMD		;;LAST COMMAND
	XX SVPKIU		;;PACKETS IN USE
	XX SVMKIU		;;MAX PACKETS IN USE
	XX SVCMIU		;;NUMBER OF COMMANDS BEING HANDLED
	XX SVMCIU		;;MAXIMUM COMMANDS EVER HANDLED AT ONCE
	XX SVIPIU		;;IO PAGES USED
	XX SVMPIU		;;MAX IO PAGES EVER USED
	XX SVBDKN		;;MSCP SERVER COUNT OF BROADCASTS TO DO
	XX SVBKNS		;;TIMES BLOCKED FOR NOSKED EVENTS
	XX SVSLSX		;;MSCP SERVER LISTNER INDEX (-1 IF NONE)
	XX SVSCAC,STG		;;TABLE OF COUNT OF SCA INTERRUPTS
	XX .SSAFT		;;LENGTH OF MONITOR TABLE SVSCAC
	XX SVCMDC,STG		;;TABLE OF COUNT OF MSCP COMMANDS
	XX CFSNUM,STG		;;NUMBER OF ENTRIES IN SCDB
	XX SCDBTB,STG		;;TABLE OF MSCP CONNECT BLOCKS
	XX LENSVD		;;LENGTH OF MSCP CONNECT BLOCK
	XX .SVCIS		;;CONNECT BLOCK STATE
	XX .SVCID		;;CONNECT BLOCK ID
	XX .SVTMO		;;TIMEOUT TIME
	XX .SVTMV		;;TIMEOUT VALUE
	XX .SVSCL		;;SCA ERROR LOCATIONS
	XX .SVSCE		;;LAST SCA ERROR
>
	SUBTTL Routine to Display MSCP Connection Data Blocks

;This routine displays the MSCP connection blocks. It is invoked by the
;"MC" command and the display name is MSCP-CONNECTIONS.

DPYMCN:	MOVEI T1,TP.MSC		;HEADER TYPE
	CALL HDRSET		;SET UP COLUMN HEADERS
	CALL SETEAT		;SET UP TO EAT LINES
	CALL MSCSYM		;GET MSCP SYMBOLS
	 RET			;FAILED
	CALL SCASYM		;THIS TABLE HAS TODCLK
	 RET			;FAILED
	STR$ [ASCIZ/MSCP Connection Blocks     /] ;HEADER TEXT
	STR$ [ASCIZ/Listener: /] ;WE'RE GOING TO DISPLAY THE LISTENER
	MOVE T2,SVSLSX		;GET LISTENER ADDRESS
	CALL GETWRD		;GET THE VALUE
	 RET			;FAILED. QUIT
	JUMPGE T3,[ MOVE T1,T3	;GET VALUE IN T1
		     CALL OCTOUT ;DISPLAY AS OCTAL
		     JRST .+2 ]	;AND GO BACK
	STR$ [ASCIZ/NONE/]	;IF -1
	STR$ [ASCIZ/    Current TODCLK: /]
	CALL GETTOD		;GET TODCLK READING
	 RET			;FAILED
	CALL TIMOUT		;DISPLAY IT
	CRLF			;...
	CRLF			;...
	MOVN T4,CFSNUM		;GET NUMBER OF BLOCKS
	HRLZS T4		;MAKE AOBJN POINTER
NXTMCN:	MOVE T2,SCDBTB		;GET ADDRESS OF TABLE
	ADDI T2,(T4)		;ADD OFFSET
	CALL GETWRD		;GET BLOCK ADDRESS
	 RET			;FAILED
	JUMPE T3,SKPMCN		;IF ZERO, SKIP THIS ENTRY
	CALL GETMCN		;READ CONNECT BLOCK INTO DATLOC
	 RET			;FAILED
	MOVEM T4,DATLOC		;SAVE FOR XXNNNN ROUTINES TO USE
	CALL DOCOLS		;SHOW DATA
	MOVE T4,DATLOC		;RETRIEVE AOBJN POINTER
SKPMCN:	AOBJN T4,NXTMCN		;SHOW ALL CONNECT BLOCKS
	RET			;DONE
;Support  routine  for above code. Given an address in T2, read an MSCP
;connect block into DATLOC from the address.

GETMCN:	MOVEI T1,XPDAT		;ADDRESS OF BLOCK
	MOVEM T3,.XPMAD(T1)	;SAVE MONITOR ADDRESS
	MOVEI T2,.XPLEN		;LENGTH OF DATA BLOCK
	MOVEM T2,.XPABL(T1)	;STORE IN FUNCTION BLOCK
	MOVEI T2,.XPPEK		;GET XPEEK FUNCTION CODE
	MOVEM T2,.XPFNC(T1)	;SAVE IN FUNCTION BLOCK
	MOVE T2,LENSVD		;NUMBER OF WORDS TO GET
	MOVEM T2,.XPCN1(T1)	;STORE IN FUNCTION BLOCK
	MOVEI T2,DATLOC+1	;USER ADDRESS TO RETURN DATA
	MOVEM T2,.XPUAD(T1)	;SAVE IN FUNCTION BLOCK
	XPEEK%			;GET SBLIST
	 ERJMP CPOPJ		;FAILED.
	RETSKP			;SUCCESS. VALUE IN T2
	SUBTTL MSCP Connect Block Column Routines

XXINDX:				;THIS ROUTINE DISPLAYS THE SCDBTB INDEX
	HRRZ T1,DATLOC		;GET THE SCDBTB INDEX
	JRST OCTSP3		;DISPLAY IT

XXCNID:				;THIS ROUTINE DISPLAYS THE MSCP CONNECT BLOCK ID
	MOVE T1,.SVCID		;GET OFFSET FOR CONNECT ID
	MOVE T1,DATLOC+1(T1)	;GET RH OF CONNECT ID
	TLNN T1,70000		;ANYTHING HERE?
	 SPACE			;NO. LEAD WITH SPACE
	JRST OCTOUT		;DISPLAY IN OCTAL

XXCNTS:				;THIS ROUTINE DISPLAYS THE MSCP CONNECT BLOCK STATE
	MOVE T1,.SVCIS		;GET OFFSET FOR STATUS
	HLRZ T1,DATLOC+1(T1)	;GET LH
	LSH T1,^D-12		;GET STATUS CODE
	SKIPL T1		;LESS THAN ZERO
	CAILE T1,MIDLEN		;OR TOO LARGE
	 RET			;NOTHING
	STR$ @MIDTAB(T1)	;DISPLAY STRING
	RET			;DONE

MIDTAB:	[ASCIZ/Listen/]		;LISTENING
	[ASCIZ/Wait OK/]	;WAITING FOR OK
	[ASCIZ/  OK/]		;OK TO SEND
	[ASCIZ/Disconn/]	;DISCONNECTED
	[ASCIZ/Offline/]	;NODE OFFLINE
	[ASCIZ/Port Er/]	;PORT ERROR
	[ASCIZ/Int Err/]	;INTERNAL OR PROTOCOL ERROR
MIDLEN==.-MIDTAB

XXSLER:				;THIS ROUTINE DISPLAYS THE LAST SCA ERROR
	MOVE T1,.SVSCE		;OFFSET FOR LAST SCA ERROR
	HRRZ T1,DATLOC+1(T1)	;GET RH
	JUMPG T1,ERROUT		;DISPLAY ERROR CODE IF NON ZERO
	STR$ [ASCIZ/  None/]	;OR NONE IF ZERO
	RET			;DONE
XXSELC:				;THIS ROUTINE DISPLAYS THE SCA ERROR LOCATION
	MOVE T1,.SVSCL		;OFFSET FOR SCA ERROR LOCATION
	HRRZ T1,DATLOC+1(T1)	;GET RH
	JUMPG T1,SYMOUT		;DISPLAY LOCATION IF IT EXISTS
	STR$ [ASCIZ/  None/]	;OR NONE IF ZERO
	RET			;DONE

XXTIMT:				;THIS ROUTINE DISPLAYS TIMEOUT TIME
	MOVE T1,.SVTMO		;GET OFFSET INTO BLOCK
	MOVE T1,DATLOC+1(T1)	;GET TIMEOUT TIME
	IDIVI T1,^D1000		;MAKE INTO SECONDS
	JUMPE T1,CPOPJ		;DISPLAY NOTHING IF ZERO
	STR$ [ASCIZ/  /]	;SOME SPACES
	JRST TIMSPC		;DISPLAY TIME OUT TIME

XXTIMV:				;THIS ROUTINE DISPLAYS TIMEOUT VALUE
	MOVE T1,.SVTMV		;GET OFFSET INTO BLOCK
	MOVE T1,DATLOC+1(T1)	;GET TIMEOUT VALUE
	IDIVI T1,^D1000		;MAKE INTO SECONDS (ALWAYS EVEN)
	JUMPE T1,CPOPJ		;DISPLAY NOTHING IF ZERO
	SPACE			;CENTER OUTPUT
	SPACE			;...
	JRST TIMSPC		;DISPLAY TIME OUT TIME
	SUBTTL Routine to Drop Into MDDT

;This  mode  is  entered  by  the  "MD" command. It drops into MDDT, if
;possible, and returns to the previous screen mode when finished.

DPYMDT:	TTY$ $TTCLR		;CLEAR SCREEN AND HOME UP
	MDDT%			;DROP INTO MDDT
	 ERJMP CPOPJ		;FAILED
	TXO F,FR.REF		;NO, THEN SET UP REFRESH
	JRST NEWDPY		;BACK TO PREVIOUS SCREEN
	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 <16,44>]	;[664] Set nice tab stops
	TXNN F,FR.CMP		;SUPPRESS IF COMPRESSING
	STR$ [ASCIZ/Display	Displayed columns	Suppressed columns

/]				;[664] Output the header lines
	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

NOINIG:				;HERE IF FAILED TO FIND THE FILE
	MOVEI T1,.FHSLF		;THIS FORK
	GETER%			;GET MY LAST ERROR
	HRRZ T1,T2		;PUT ERROR CODE WHERE IT CAN BE FOUND
	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",CMDM		;CHECK FOR "M" TYPE 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
	XWD "#",CMDSHP		;TOGGLE NUMERIC DISPLAY IN HOST NAMES
	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

;The "#" command toggles DOTFLG which in turn controls whether we print
;hosts and nets with GTHST% or use 32-bit dotted notation.

CMDSHP:	SETCMM DOTFLG		;COMPLEMENT SENSE OF DOTTED DISPLAY FLAG
	RETSKP			;GIVE GOOD RETURN

SETARP:	GETCHR			;GET NEXT CHARACTER
	SETZ T1,		;CLEAR IN CASE NO MATCH
	CAIN C,"H"		;WANT HOSTS?
	MOVEI T1,DPYARH		;YES
	CAIE C,"C"		;WANTS CONNECTIONS?
	IFSKP.
	  CALL DECINZ		;GET DECIMAL INDEX NUMBER
	  MOVEM T1,ANCIDX	;SAVE INDEX NUMBER
	  MOVEI R,DPYARJ	;GET DISPLAY ROUTINE
	  SKIPL T2		;WAS A NUMBER SPECIFIED?
	  MOVEI R,DPYARC	;NO NUMBERS, WANT DISPLAY OF ALL CONNECTIONS
	  JRST NEWDPY		;GO FINISH UP
	ENDIF.
	CAIN C,"D"		;[665] Wants DNS hosts status?
	MOVEI T1,DPYARD		;[665] Yes
	CAIN C,"N"		;WANTS NETS?
	MOVEI T1,DPYARN		;YES
	CAIN C,"G"		;WANTS GATEWAYS?
	MOVEI T1,DPYARG		;YES
	CAIN C,"T"		;WANTS TRAFFIC
	MOVEI T1,DPYART		;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

SETSCA:	SETO T1,		;-1 IN T1
	GETCHR			;GET FOLLOWING CHAR
	CAIN C,"D"		;WANTS "DON'T CARE QUEUE"?
	JRST SETSCB		;YES, GO DO THAT
	RESCAN			;NO, REREAD THE CHAR
	CALL DECIN		;GET A OCTAL NUMBER
	SKIPGE T2		;ANY SB SPECIFIED?
	 JRST SETSCB		;YES. GO DO CONNECT BLOCK DISPLAY
	MOVEI R,DPYSCA		;SET TO DO SCA DISPLAY
	JRST NEWDPY		;GO FINISH
SETSCB:	MOVEM T1,THESB		;SAVE IT FOR SCB DISPLAY
	MOVEI R,DPYSCB		;THE CONNECT BLOCK DISPLAY
	JRST NEWDPY		;GO FINISH

SETSCT:	MOVEI R,DPYSCT		;SET TO SHOW SCA TRAFFIC
	JRST NEWDPY		;GO FINISH

SETDNA:				;SET TO DO DECNET NODE DISPLAY
	MOVEI  R,DPYNOD		;GET ROUTINE ADDRESS
	JRST NEWDPY		;GO FINISH

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

SETDRV:	MOVEI R,DPYDSK		;SHO DISK STATUS
	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 "P",[TXO T4,LIQLPT]	;[7.1217]PLOTTER 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,"H"		;WANTS TO SHOW DECNET NODE STATUS?
	JRST SETDNA		;YES, GO DO IT
	CAIN C,"V"		;WANTS TO SHOW DEVICES
	JRST SETDEV		;YES, GO DO IT
	CAIN C,"R"		;WANTS DRIVES
	JRST SETDRV		;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

CMDALL:	MOVEI R,DPYALL		;OR OTHER ROUTINE
	JRST NEWDPY		;GO FINISH

CMDM:	GETCHR			;READ FOLLOWING CHAR
	CAIN C,"S"		;MSCP STATS AND COUNTERS?
	 JRST SETMSC		;YES
	CAIN C,"C"		;MSCP CONNECTION BLOCKS
	 JRST SETCON		;YES
	CAIN C,"D"		;D?
	 JRST DPYMDT		;YES. MDDT
	RESCAN			;REREAD THE CHARACTER
SETMON:	SKIPA R,[DPYMON]	;SET UP MONITOR DISPLAY
SETMSC:	MOVEI R,DPYMSC		;SET TO DO MSCP DISPLAY
	JRST NEWDPY		;GO FINISH
SETCON:	MOVEI R,DPYMCN		;SET UP FOR MSCP CONNECTIONS
	JRST NEWDPY		;FINISHED

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 "C",SETSCA		;SET UP SCA DISPLAY
	XWD "S",SETSCT		;SET UP SCA DISPLAY
	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
	CAIE C,"R"		;MAYBE WANT TO SEE ARP/GHT STUFF?
	IFSKP.
	  GETCHR		;GET THE NEXT CHARACTER
	  CAIE C,"P"		;CAN THEY SPELL ARP?
	   RET			;NO, BAD COMMAND
	  MOVEI R,DPYGHT	;YES, SAY WE WANT GHT DISPLAY
	  JRST NEWDPY		;AND GO DO IT
	ENDIF.
	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/DEFAULT-EXEC:/] ;TRY DEFAULT-EXEC: FIRST
	GTJFN			;GET A JFN ON THE FILE
	 ERJMP [MOVX T1,GJ%OLD+GJ%SHT ;GET FLAGS
		HRROI T2,[ASCIZ/SYSTEM:EXEC.EXE/] ;NOW TRY SYSTEM:EXEC.EXE
		GTJFN		;GET A JFN ON THE FILE
		 ERJMP PSHFAI	;FAILED
		JRST .+1]	;KEEP GOING
	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
	TXZE F,FR.HD1		;ONE CRLF AFTER HEADER?
	MOVEI T3,[BYTE (7)12,0]	;YES
	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

UPDORM:				;HERE TO CHECK THE IDLE TIME OF A SINGLE JOB
	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

NOTJOB:				;JOB IS NONEXISTANT, CLEAR TABLES FOR IT.
	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  JSYSi  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

DECSP9:	CAMGE T1,[^D100000000]	;IS THIS AN EIGHT OR LESS DIGIT NUMBER?
	SPACE			;YES, SPACE OVER
DECSP8:	CAMGE T1,[^D10000000]	;IS THIS A SEVEN OR LESS DIGIT NUMBER?
	SPACE			;YES, SPACE OVER
DECSP7:	CAMGE T1,[^D1000000]	;IS THIS A SIX OR LESS DIGIT NUMBER?
	SPACE			;YES, SPACE OVER
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
	 ERSKP			;ON ERROR SKIP NEXT
	  JRST GETSY2		;SYMBOL FOUND
	MOVEI T1,.SNPSY		;SYMBOL LOOKUP FUNCTION
	MOVE T2,SYMS+1(J)	;GET THE SYMBOL NAME
	SETZ T3,		;NON SPECIFIC MODULE LOOKUP
	SNOOP			;LOOKUP THE SYMBOL AGAIN
	 ERJMP UNKSYM		;HANDLE UNKNOWN SYMBOL
	PUSH P,T2		;SAVE T2
	HRROI T1,[ASCIZ/
? SNOOP failed to find value of symbol /]
	MOVE T1,SYMS+1(J)	;GET THE SYMBOL NAME
	CALL R50OTT		;OUTPUT THE SYMBOL NAME
	HRROI  T1,[ASCIZ/ in correct module
 /]
	PSOUT			;OUTPUT THE REST OF THE STRING
	POP P,T2		;RESTORE T2
GETSY2:
	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
	SKIPE T4,@SYMS(T3)	;[7.1128]YES, GET INSTRUCTION THERE
	IFSKP.			;[7.1128]IF IT IS ZERO
	  MOVEM T2,@SYMS(T3)	;[7.1128]THEN JUST SAVE THE SYMBOL
	ELSE.			;[7.1128]IF THERE IS AN INSTRUCTION
	  ADD T4,T2		;[7.1128]ADD IN THE SYMBOL VALUE
	  TLNN T4,-1		;[7.1128]IS LEFT HALF ZERO?
	  MOVEM T4,@SYMS(T3)	;[7.1128]YES, REPLACE WHOLE VALUE
	  TLNE T4,-1		;[7.1128]IS IT NONZERO?
	  HRRM T4,@SYMS(T3)	;[7.1128]YES, ONLY REPLACE RIGHT HALF
	ENDIF.			;[7.1128]
	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,PAGUTL)	;WRITE ENABLE THE MONITOR
	MOVEI T1,$$(JSTAB,LDINIT) ;GET ADDRESS OF START OF JSYS TABLE
	HRRM P2,JSYNUM(T1)	;SETUP DISPATCH ADDRESS
	CALL $$(SWPMWP,PAGUTL)	;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
	.RDGBL==15		;READ GLOBAL JOB NUMBER
	.RDJOB==16		;READ GLOBAL JOB NUMBER GIVEN LOCAL
	.RDFSW==17		;[31]READ FKSWP WORD
	.RDFSP==20		;[31]READ FKPGST WORD
	.PKMON==21		;[31]POKE THE MONITOR ADDRESS SPACE
	.PKJSB==22		;[31]POKE A JOBS JSB
	.PKPSB==23		;[31]POKE A FORKS PSB

	.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
	IFIW GBLFNC(P1)		;RETURN GLOBAL JOB NUMBER
	IFIW JOBFNC(P1)		;RETURN GLOBAL JOB NUMBER GIVEN LOCAL
	IFIW FSWFNC(P1)		;[31]RETURN FKSWP WORD
	IFIW FSPFNC(P1)		;[31]RETURN FKPGST WORD
IFN FTPOKE,<			;ONLY IF WE SUPPORT POKING
	IFIW POKFNC(P1)		;POKE MONITOR ADDRESS SPACE FUNCTION
	IFIW PKJFNC(P1)		;POKE MONITOR JSB FUNCTION
	IFIW PKPFNC(P1)		;POKE MONITOR PSB FUNCTION
>				;END OF IFN FTPOKE
	.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.

FSPFNC:	MOVEI P2,$$(FKPGST,STG)	;[31]ADDRESS OF BALANCE SET WAIT TEST
	JRST FKFNC1(P1)		;[31]JOIN COMMON CODE
FSWFNC:	MOVEI P2,$$(FKSWP,STG)	;[31]ADDRESS OF SCHED FLAG BITS
	JRST FKFNC1(P1)		;[31]JOIN COMMON CODE
WSPFNC:	SKIPA P2,WSPLOC(P1)	;GET ADDRESS OF WORKING SET TABLE
FSTFNC:	MOVEI P2,$$(FKSTAT,STG)	;OR ADDRESS OF SCHEDULER TEST TABLE
FKFNC1:	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,STG)	;GET LAST ADDRESS IN JSB
	HRLI T1,$$(JSVAR,STG)	;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
	CALL $$(GL2LCL,CFSUSR)	;[7.1291] SEE IF LOCAL JOB INDEX EXISTS
	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,STG)	;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(P1)	;[7.1128]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
VALPID:	0!$$(VALPID,IPCF)	;[7.1128]30-BIT ROUTINE ADDRESS

;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:
	MOVEI  P3,$$(RES0TB,STG) ;ASSUME PC SECTION FREE SPACE
	HLRZ T3,T2		;GET THE FUNCTION CODE
	CAIE T3,MAXRES		;IS IT THE NON PC SECTION FREE SPACE?
	 JRST RESFN1(P1)	;NO
	MOVEI P3,$$(RESNTB,STG)	;GET BLOCK FOR NON PC SECTION SPACE
	HRRZS T2		;CHANGE THE FUNCTION CODE INTO FREE SPACE
RESFN1:				;HERE WHEN WE HAVE DETERMINED WHICH FREE SPACE
	<MOVE T3,(P3)>+$$(.RETOT,FREE) ;GET NUMBER OF RESIDENT BLOCKS
	MOVEM  T3,RESTB1(P1)	;SAVE THE VALUE
	<MOVE T3,(P3)>+$$(.REFFB,FREE) ;GET NUMBER OF FREE BLOCKS
	MOVEM  T3,RESTB2(P1)	;SAVE THE VALUE
	CALL SWPMAX(P1)		;GET AND SAVE TOTAL SWAPPABLE FREE SPACE
	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
	<CAML T2,(P3)>+$$(.REPMX,FREE) ;OR IF FUNCTION IS TOO BIG
	RET			;YES, BAD
	<MOVE T3,(P3)>+$$(.REQTA,FREE) ;GET ADDRESS OF INITIAL COUNT TABLE
	ADDI T3,(T2)		;ADD IN THE POOL WE WANT
	MOVE P2,(T3)		;GET THE INITIAL COUNT
	<MOVE T3,(P3)>+$$(.REPFR,FREE) ;GET ADDRESS OF FREE COUNT TABLE
	ADDI T3,(T2)		;ADD IN THE POOL WE WANT
	MOVE  T2,(T3)		;GET THE 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. Value returned in  P2  is  based  on  100%  allocation  of  the
;individual pools.

RESFTL:
	<MOVN T2,(P3)>+$$(.REPMX,FREE) ;GET THE NUMBER OF POOLS
	HRLZS T2		;MAKE AOBJN POINTER
	SETZB T3,P2		;INIT THE COUNTS
RESFT1:
	<MOVE T4,(P3)>+$$(.REQTA,FREE) ;GET ADDRESS OF INITIAL VALUE TABLE
	ADDI T4,(T2)		;ADD IN THE POOL NUMBER WE WANT
	MOVE T4,(T4)		;GET THE INITIAL VALUE FOR THE POOL
	ADD P2,T4		;UPDATE THE TOTAL AMOUNT ASSIGNED
	<MOVE CX,(P3)>+$$(.REPFR,FREE) ;GET ADDRESS OF CURRENT VALUE TABLE
	ADDI CX,(T2)		;ADD IN THE POOL NUMBER WE WANT
	SUB T4,(CX)		;CALCULATE THE AMOUNT USED
	ADD T3,T4		;UPDATE THE TOTAL AMOUNT USED
	AOBJN T2,RESFT1(P1)	;MORE POOLS TO DO?
	MOVE T2,P2		;NO, GET THE TOTAL AMOUNT ASSIGNED
	SUB T2,T3		;CALC WHAT'S IN USE
	XCTU [MOVEM T2,3](P1)	;RETURN IT
	JRST SKP(P1)		;DONE

RESTB1:	Z			;(0) NUM OF PCS RFS BLOCKS WILL BE PUT HERE
	Z			;(1) TOTAL SWAPPABLE WILL GO HERE
	EXP $$(SWFREL,STG)	;(2) AMOUNT OF SWAPABLE SPACE
	EXP $$(ENQFSZ,STG)	;(3) MAXIMUM ENQ USAGE
	EXP $$(IPCFSZ,STG)	;(4) MAXIMUM IPCF FREE SPACE
	EXP $$(DCNFSZ,STG)	;(5) MAXIMUM NETWORK STORAGE
	EXP $$(NOFN,STG)	;(6) SIZE OF OFN TABLE
	EXP $$(NOFN,STG)	;(6) SIZE OF OFN TABLE
	EXP $$(SSPT,STG)	;(7) SIZE OF SPT TABLE
	IFIW $$(DRMTPG,STG)	;(10) NUMBER OF SWAPPING PAGES
	IFIW $$(TOTRC,STG)	;(11) TOTAL USER CORE AVAILABLE
	EXP $$(NFKS,STG)	;(12) NUMBER OF FORKS
				;(13) NON PC SECTION FREE SPACE
	MAXRES==.-RESTB1	;HIGHEST  VALUE

RESTB2:	Z			;(0) FREE RESIDENT BLOCKS WILL BE PUT HERE
	Z SWPCNT(P1)		;(1) ROUTINE TO COUNT SWAPPABLE SPACE
	IFIW  2+$$(SWPFRE,STG)	;(2) GENERAL POOL
	Z ENQCNT(P1)		;(3) ROUTINE TO GET CURRENT ENQ SPACE
	Z IPCFCT(P1)		;(4) ROUTINE TO GET CURRENT IPCF SPACE
	Z DCNCNT(P1)		;(5) ROUTINE TO GET CURRENT DECNET SPACE
	IFIW $$(NOF,STG)	;(6) CURRENT OFNS ASSIGNED
	IFIW $$(NOC,STG)	;(7) CURRENT OFNS CACHED
	IFIW $$(SPTC,STG)	;(7) CURRENT SPT SLOTS ASSIGNED
	IFIW $$(DRMFRE,STG)	;(10) FREE SWAPPING PAGES
	IFIW $$(NRPLQ,STG)	;(11) PAGES ON THE REPLACEABLE QUEUE
	Z FRKCNT(P1)		;(12) ROUTINE TO COUNT USED FORKS
				;(13) NON PC SECTION FREE SPACE

;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

;Routine to get current ENQ, IPCF, or DECNET swappable free space
;remaining. Returns with count of free space remaining in T2.

DCNCNT:	MOVEI T1,2		;OFFSET INTO FSPTAB FOR DECNET SPACE
	SKIPA			;JOIN COMMON CODE
IPCFCT:	MOVEI T1,1		;OFFSET INTO FSPTAB FOR IPCF SPACE
	SKIPA			;JOIN COMMON CODE
ENQCNT:	SETZ T1,		;OFFSET INTO FSPTAB FOR ENQ SPACE
	SETZ T2,		;INIT FREE SPACE VALUE
	<SKIPE T1,(T1)>+$$(FSPTAB,STG) ;GET POINTER TO DESCRIPTOR
	<MOVE T2,(T1)>+$$(FSPCNT,FREE) ;GET COUNT OF SPACE REMAINING
	RET			;AND GIVE IT TO USER

;Routine  to  get  total  amount  of free space in use. It returns this
;value in T2.

SWPCNT:	MOVE T3,2+$$(SWPFRE,STG) ;GET SPACE LEFT IN GENERAL POOL
	CALL DCNCNT(P1)		;GET DECNET SPACE REMAINING
	ADD T3,T2		;ADD IT IN
	CALL IPCFCT(P1)		;GET IPCF SPACE REMAINING
	ADD T3,T2		;ADD IT IN
	CALL ENQCNT(P1)		;GET ENQ/DEQ SPACE REMAINING
	ADD T2,T3		;ADD IN PREVIOUS TOTAL
	RET			;DONE

;Routine  to compute total amount of swappable free space available and
;store it in RESTB1. Uses only T3.

SWPMAX:	MOVEI T3,$$(SWFREL,STG)	;GET AMOUNT IN GENERAL POOL
	ADDI T3,$$(ENQFSZ,STG)	;ADD IN AMOUNT OF ENQ SPACE
	ADDI T3,$$(IPCFSZ,STG)	;ADD IN AMOUNT OF IPCF SPACE
	ADDI T3,$$(DCNFSZ,STG)	;AND AMOUNT OF DECNET SPACE
	MOVEM T3,RESTB1+1(P1)	;SAVE IT IN RESTB1
	RET			;THAT'S IT

;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
	<SKIPL 0(T1)>+$$(FKPT,STG) ;IS FORK ASSIGNED?
	JRST SKP(P1)		;YES, GOOD 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

;Function  to  return global job number given a system wide fork number
;as an argument in T2. returns in T2 the job number.

GBLFNC:	XCTU [MOVE T1,T2](P1)	;GET FORK NUMBER
	<HLRZ T1,(T1)>+$$(FKJOB,STG) ;GET LOCAL JOB NUMBER
	<SKIPGE 0(T1)>+$$(JOBRT,STG) ;JOB EXIST?
	RET			;NO
	NOSKED			;NO SCHEDULING NOW
	CALL $$(SETJSB,FORK)	;MAP JSB OF JOB
	<MOVE P2,(T1)>+$$(GBLJNO,STG) ;GET GLOBAL JOB NUMBER
	CALL $$(CLRJSB,FORK)	;UNMAP JSB
	OKSKED			;SCHEDULE AGAIN
	JRST SKP(P1)		;GO FINISH UP

;Function  to  return  global  job  number  given  a  local job number.
;Argument in T2. Returns in T2 the job number.

JOBFNC:
	XCTU [MOVE T1,T2](P1)	;GET JOB NUMBER
	<SKIPGE 0(T1)>+$$(JOBRT,STG) ;JOB EXIST?
	RET			;NO
	NOSKED			;NO SCHEDULING NOW
	CALL $$(SETJSB,FORK)	;MAP JSB OF JOB
	<MOVE P2,(T1)>+$$(GBLJNO,STG) ;GET GLOBAL JOB NUMBER
	CALL $$(CLRJSB,FORK)	;UNMAP JSB
	OKSKED			;SCHEDULE AGAIN
	JRST SKP(P1)		;GO FINISH UP

IFN FTPOKE,<			;ONLY IF WE SUPPORT POKING

;To  be able to poke the caller must have SC%WHL set and DBUGSW must be
;non-zero

POKEOK:				;HERE TO SEE IF WE CAN POKE
	MOVE T2,$$(CAPENB,STG)	;GET OUR PRIVS
	TXNN T2,SC%WHL		;ARE WE A WHEEL?
	 RET			;NO SO ERROR RETURN
	SKIPN $$(DBUGSW,STG)	;ARE WE DOING SOME KIND OF DEBUGING?
	 RET			;NO SO ERROR RETURN
	JRST SKP(P1)		;DEBUGING AND WE ARE A WHEEL SO OK

;Function to poke current monitor address space.  Out forks JSB and PSB.
;Calling ACs:  T1/ .PKMON, T2/ MONITOR ADR, T3/ NEW VALUE
;Old contents of location is returned in T2

POKFNC:				;POKE FUNCTION (OUR JSB AND PSB ALSO)
	CALL POKEOK(P1)		;ARE WE ALLOWED TO DO THIS?
	RET			;NO SO ERROR RETURN
	XCTU [MOVE T2,T2](P1)	;GET THE DEPOSIT ADDRESS
	TXNE T2,<377777,,0>	;SECTION NUMBER?
	 RET			;YES SO ERROR RETURN
        CALL $$(SWPMWE,PAGUTL)	;ENABLE WRITES
	XCTU [MOVE T2,T2](P1)	;GET THE DEPOSIT ADDRESS
	XCTU [MOVE P2,T3](P1)	;GET THE DEPOSIT WORD FROM THE USER
	EXCH P2,0(T2)		;DEPOSIT THE WORD
        CALL $$(SWPMWP,PAGUTL)	;DISABLE WRITES
	JRST SKP(P1)		;SUCCESS RETURN
;Function to poke desired jobs JSB space.
;Calling ACS:  T1/ .PKJSB, T2/ MONITOR ADR, T3/ NEW VALUE, T4/ JOB NUMBER
;Old contents of location is returned in T2

PKJFNC:				;POKE FUNCTION FOR JSB
	CALL POKEOK(P1)		;ARE WE ALLOWED TO DO THIS?
         RET			;NO SO ERROR RETURN
	XCTU [MOVE T2,T2](P1)	;GET THE DEPOSIT ADDRESS
	CAIL T2,$$(JSVAR,STG)	;IS ADR WITHIN THE JSB?
	 CAILE T2,$$(JSVARZ,STG) ;IS ADR WITHIN THE JSB?
	  RET			;NO SO ERROR RETURN
	XCTU [SKIPL T1,4](P1)	;GET JOB AND SEE IF NONNEGATIVE
	CALL $$(GL2LCL,CFSUSR)	;[7.1291] SEE IF LOCAL JOB INDEX EXISTS
         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
	XCTU [MOVE P2,T2](P1)	;GET ADDRESS
	MOVE T2,P2		;GET THE ADDRESS FOR PAGE CALCULATIONS
	SUBI T2,$$(JSVAR,STG)	;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,PKJFN2(P1)	;NO PAGE SO RETURN WITH ERROR
	POP P,T1		;PAGE IS THERE, RESTORE IDENT
	MOVX T2,<PM%RD!PM%WR>	;WE WANT TO READ AND WRITE THE PAGE
	HRRI 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
	XCTU [MOVE T3,T3](P1)	;GET THE WORD TO DEPOSIT
	<EXCH T3,0(P2)>+$$(FPG1A,STG) ;POKE THE NEW VALUE AND SAVE THE OLD
	MOVE P2,T3		;PUT OLD VALUE SO CALLER WILL FIND IT
	JRST OKSKP(P1)		;GO RETURN TO THE CALLER
PKJFN2:				;HERE WHEN JSB PAGE DID NOT EXIST
	OKSKED			;GIVE BACK THE MACHINE
	RET			;NON-SKIP RETURN
;Function to poke desired forks PSB space.
;CALLING ACS:  T1/ .PKPSB, T2/ MONITOR ADR, T3/ NEW VALUE, T4/ FORK NUMBER
;Old contents of location is returned in T2

PKPFNC:				;POKE FUNCTION FOR PSB
	CALL POKEOK(P1)		;ARE WE ALLOWED TO DO THIS?
	RET			;NO SO ERROR RETURN
	XCTU [MOVE T2,T2](P1)	;GET THE DEPOSIT ADDRESS
	MOVEI T1,$$(PSBPGA,STG)	;GET ADDRESS OF THE PSB
	CAIL T2,(T1)		;IS ADR WITHIN THE PSB?
	 CAILE T2,1777(T1)	;IS ADR WITHIN THE PSB?
	  RET			;NO SO ERROR RETURN
	XCTU [MOVE T1,T4](P1)	;GET FORK USER WANTS?
	CALL CHKFRK(P1)		;IS THIS FORK OK?
	 RET			;NO SO ERROR RETURN
	CALL $$(SETLF3,FORK)	;MAP THE PSB
	OKSKED			;GIVE BACK THE MACHINE SINCE CHKFRK WENT NOSKED
	XCTU [MOVE T2,T2](P1)	;GET THE DEPOSIT ADDRESS
	ADD T2,T1		;ADD IN THE OFFSET
	XCTU [MOVE P2,T3](P1)	;GET THE DEPOSIT WORD
	EXCH P2,(T2)		;DEPOSIT INTO THE PSB
	CALL $$(CLRJSB,FORK)	;UNMAP THE PSB
	JRST SKP(P1)		;YES SO SUCCESS RETURN
>				;END OF IFN FTPOKE

;Table of known symbols we can be told to use

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

	XX JSVAR,STG		;BEGINNING OF JOB STORAGE BLOCK
	XX JSVARZ,STG		;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 NPRIVP		;NUMBER OF PRIVATE PAGES IN JOB
	XX MLJFN		;LENGTH OF EACH JFN BLOCK
	XX JOBSKD		;JOB WIDE SCHEDULING PARAMETERS
	XX PSVAR,STG		;BEGINNING OF PROCESS STORAGE BLOCK
	XX PSVARZ,STG		;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  JOBBIT		;FORK WIDE SCHEDULING PARAMETERS
	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
IFN FTPOKE,<			;ONLY IF WE SUPPORT POKING
	XX DBUGSW		;DEBUGING STATE OF THE SYSTEM
	XX  SWPMWE,PAGUTL	;WRITE ENABLE THE MONITOR
	XX SWPMWP,PAGUTL	;WRITE DISABLE THE MONITOR
	XX  SWPMWF,PAGUTL	;MONITOR WRITE FLAG
>>				;ONLY IF WE SUPPORT FTPOKE

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,ARP,ARP-TABLES		;;ETHERNET ARP INFORMATION
XX 1,ANC,ARPANET-CONN		;;TCP CONNECTIONS
XX 1,AND,ARPANET-DNS		;;[665] DNS host status
XX 2,ANG,ARPANET-GW		;;INTERNET GATEWAYS WE KNOW ABOUT
XX 3,ANH,ARPANET-HOSTS		;;HOSTS ON THE ARPANET
XX 3,ANN,ARPANET-NETS		;;INTERNET NETS WE ARE TALKING TO
XX 3,ASR,ARPANET-SEQ		;;PART OF ANC<N> DISPLAY
XX 3,ANT,ARPANET-TRAFFIC	;;SOME LOCAL TRAFFIC NUMBERS
XX 2,SCB,CONNECT-BLOCKS		;;SCA CONNECT BLOCKS
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,MSC,MSCP-CONNECTS		;;MSCP SERVER DATA
XX 2,STR,STRUCTURES		;;DISK STRUCTURES
XX 2,SSB,SYSTEM-BLOCKS		;;SCA SYSTEM BLOCKS
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 80,ANC,30,ANCH,ANC-FHOST,<Foreign Host> ;;[662] Connection foreign host
XX 70,ANC,6,ANCF,ANC-FPORT,<FPort> ;;CONNECTION FOREIGN PORT
XX 3,ANC,3,ANCI,ANC-INDEX,<TCB>	;;(ERROR WAIT) INDEX FOR TCB
XX 10,ANC,3,ANCJ,ANC-JOB,<Job>	;;JOB OWNING CONNECTION
XX 0,ANC,30,ANCQ,ANC-LHOST,<Local Host> ;;[662] Connection local host
XX 60,ANC,6,ANCL,ANC-LPORT,<LPort> ;;CONNECTION LOCAL PORT
XX 0,ANC,5,ANCM,ANC-MAXPKT,< MXPT> ;;[664] Max packet size
XX 0,ANC,2,ANCP,ANC-PRTPKT,< P>	;;[666] Partial packet
XX 0,ANC,5,ANCR,ANC-REQMSS,< RMSS> ;;[664] Max packet size requested
XX 50,ANC,7,ANCS,ANC-STATUS,<RCV.SND> ;;CONNECTION STATUS
XX 40,ANC,6,ANCN,ANC-SUBSYS,<Subsys> ;;JOBNAME OF OWNING JOB
XX 20,ANC,3,ANCT,ANC-TVT,<TVT>	;;TVT NUMBER IF APPROPRIATE
XX 30,ANC,10,ANCU,ANC-USERNAME,<Username> ;;USERNAME OF OWNER OR TVT JOB
XX 0,ANC,2,ANCW,ANC-ZWINDOW,< W> ;;[666] Zero send window

XX 20,AND,15,ANDI,AND-HOST-ADDRESS,<Host Address> ;[665] DNS host address
XX 50,AND,9,ANDF,AND-FAILURE,<  Failure> ;[665] DNS host failure count
XX 10,AND,30,ANDH,AND-HOST-NAME,<Host Name> ;[665] DNS host name
XX 40,AND,9,ANDS,AND-SUCCESS,<  Success> ;[665] DNS host success count
XX 30,AND,7,ANDT,AND-TIMEOUT,<Timeout> ;[665] DNS host timeout

XX 10,ANG,30,ANGN,ANG-NAME,<Gateway Name> ;;[662] Gateway name
XX 40,ANG,100,ANGC,ANG-NETS,<Connected Nets> ;;GATE CONNECTED NETS
XX 30,ANG,5,ANGS,ANG-STATE,<State> ;;GATEWAY UP/DOWN STATUS
XX 20,ANG,9,ANGT,ANG-TYPE,<Type> ;;TYPE OF INTERNET GATEWAY

XX 30,ASR,10,ASRE,ASR-EDGE,<Byte Count> ;;SEND/RECEIVE LEFT EDGE
XX 10,ASR,6,ASRT,ASR-TYPE,<>	;;"OUTPUT" OR "INPUT"
XX 50,ASR,11,ASRW,ASR-WINDOW,<Window Size> ;;SEND/RECEIVE WINDOW SIZE

XX 20,ANN,5,ANNC,ANN-CLASS,<Class> ;;CLASS OF THAT NETWORK
XX 40,ANN,9,ANNI,ANN-INTERFACE,<Interface> ;;INTERFACE NAME
XX 10,ANN,18,ANNN,ANN-NAME,<Network> ;;NAME OF INTERNET NETWORK
XX 50,ANN,5,ANNS,ANN-STATE,<State> ;;STATE OF INTERFACE
XX 30,ANN,30,ANNG,ANN-VIA,<Via Gateway> ;;[662] GW we use to get there

XX 10,ANT,16,ANTH,ANT-HEADER,<Internet Traffic> ;;[664] Header field
XX 30,ANT,9,ANTR,ANT-TOT-RECEIVE,< Tot Recv> ;;[664] Receive traffic
XX 20,ANT,9,ANTS,ANT-TOT-SEND,< Tot Sent> ;;[664] Send traffic
XX 50,ANT,9,ANTI,ANT-INT-RECEIVE,< Recv/Int> ;;[664] Recv over int
XX 40,ANT,9,ANTO,ANT-INT-SENT,< Sent/Int> ;;[664] Sent over interval
XX 60,ANT,9,ANTP,ANT-INT-PERCENT,<  Percent> ;;[664] Percent

XX 10,ARP,17,ARPE,ARP-ETHERNET-ADDRESS,<Ethernet address> ;;ETHERNET ADDRESS
XX 40,ARP,8,ARPF,ARP-FLAGS,<Flags> ;;[662] ARP flags
XX 20,ARP,30,ARPH,ARP-HOST-NAME,<Internet host name> ;;[662] Host name
XX 30,ARP,15,ARPI,ARP-INTERNET-ADDRESS,<Internet address> ;;HOST NUMBER

XX 5,MSC,6,INDX,BLOCK-INDEX,<Index> ;;SCDBTB INDEX
XX 50,SCB,9,BKST,BLOCK-STATE,<BLK State> ;;BLOCK STATE
XX 0,DLL,10,LBYC,BYTE-COUNT-IN-SEGMENT,<Byte count> ;;BYTES
XX 70,SCB,7,SFLG,CB-FLAGS,<Flags> ;;CB FLAGS
XX 10,DSK,4,CHAN,CHANNEL,<Chan>	;;DISK CHANNEL
XX 50,SSB,6,DVCS,CIRCUIT-STATE,<State> ;;CIRCUIT STATE
XX 60,EQL,15,LCOD,CODE-FOR-LOCK,<Lock code> ;;LOCK CODE
XX 0,SCB,7,CQP,COMMAND-Q-PACKETS,<Packets> ;;COMMAND Q PACKETS
XX 20,MSC,12,CNID,CONNECT-ID,<Connect ID> ;;CONNECT ID
XX 60,SCB,8,CNST,CONNECT-STATE,<CN State> ;;CONNECT STATE
XX 10,MSC,7,CNTS,CONNECT-STATUS,<Status> ;;CONNECT STATUS
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 30,SSB,9,DSHT,DEST-HARDWARE-TYPE,<Hard Type> ;;HARDWARE TYPE
XX 0,SSB,14,DSHV,DEST-HARDWARE-VERSION,<   Hard Ver> ;;HARDWARE VERSION
XX 20,SSB,9,DSST,DEST-SOFTWARE-TYPE,<Soft Type> ;;SOFTWARE TYPE
XX 0,SSB,8,DSSV,DEST-SOFTWARE-VERSION,<Soft Ver> ;;SOFTWARE VERSION
XX 0,SCB,14,DSCI,DESTINATION-CONNECT-ID,<    Dest ID> ;;DESTINATION ID
XX 10,SSB,4,DSPT,DESTINATION-PORT,<Port> ;;DESTINATION PORT
XX 20,SCB,16,DSPN,DESTINATION-PROCESS-NAME,<Dest Name> ;;DESTINATION PROCESS NAME
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 0,SCB,11,DRDG,DROPPED-DATAGRAMS,<Dropped DGs> ;;DROPPED DATAGRAMS
XX 0,DSK,7,DSN,DSN,<  DSN  > ;;DRIVE SERIAL NUMBER
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,54,FHST,FOREIGN-HOST,<Foreign host> ;;ARPANET HOST
XX 10,FRK,3,FORK,FORK,<Frk>	;;THE FORK NUMBER
XX 0,FRK,5,FFLG,FORK-FLAGS,<Flags> ;;FORK FLAGS
XX 0,FRK,8,FRG,FORK-PRIORITY,<Priority> ;;FORK RUNTIME GUARANTEE
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,30,ANAM,HOST-NAME,<Host name> ;;[662] Name of host
XX 10,ANH,15,AHST,HOST-NUMBER,<Host number> ;;HOST NUMBER
XX 50,ANH,19,ASTS,HOST-STATUS,<Host status> ;;[662] Host status
XX 40,ANH,9,ATYP,HOST-TYPE,<Host type> ;;[662] 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,4,JOB,JOB,<Job>	;;JOB NUMBER
XX 0,JOB,10,JRG,JOB-PRIORITY,<Priority> ;;RUN TIME GUARANTEE
XX 0,SCB,7,JDGB,JSYS-DATAGRAM-BUFFERS,<JSYS DG> ;;JSYS DG BUFFERS
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,MSC,25,SLER,LAST-SCA-ERROR,<Last Error> ;;LAST SCA ERROR
XX 40,EQL,6,LLVL,LEVEL-OF-LOCK,<Level> ;;LOCK LEVEL
XX 0,DLL,3,LKCH,LINK-CHANNEL-NUMBER,<Chl> ;;CHANNEL NUMBER OF LINK
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,10,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,EQL,4,LLCK,LOCK-NUMBER,<Lock> ;;ENQ LOCK NUMBER
XX 0,FRK,24,CORE,MAPPED-PAGES,<Mapped pages> ;;PAGE MAP
XX 0,SSB,6,MXDG,MAX-DG-SIZE,<Max DG> ;;MAX DG SIZE
XX 0,SSB,8,MXMS,MAX-MESSAGE-SIZE,<Max Mess> ;;MAX MESSAGE SIZE
XX 0,FRK,10,MPC,MONITOR-PC,<Monitor PC> ;;THE MONITOR PC
XX 20,STR,5,STMC,MOUNT-COUNT,<Mount> ;;NUMBER OF MOUNTS
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 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 60,SSB,11,PTHR,PATH-RESPONSE,< Response> ;;PATH RESPONSE
XX 30,FRK,10,UPC,PC,<   User PC> ;;THE CURRENT USER PC
XX 0,SCB,6,PRCR,PENDING-RECEIVE-CREDIT,< PR Cr> ;;PENDING RECEIVE CREDITS
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,JOB,7,NPPG,PRIVATE-PAGES,<Priv Pg> ;;# OF PRIVATE PAGES
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 0,SCB,7,RDGB,REAL-DATAGRAM-BUFFERS,<Real DG> ;;REAL DG BUFFERS
XX 30,SCB,6,RCCR,RECEIVE-CREDIT,<Rec CR> ;;RECEIVE CREDIT
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 0,SCB,6,RQCR,REQUEUE-CREDIT,< RQ CR> ;;REQUEUE CREDIT
XX 50,JOB,9,JRUN,RUNTIME,< Runtime> ;;RUNTIME OF JOB
XX 70,SSB,5,SBFG,SB-FLAGS,<Flags> ;;SB FLAGS
XX 30,MSC,9,SELC,SCA-ERROR-LOCATION,<Error Loc> ;;SCA ERROR LOC
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 40,SCB,6,SNCR,SEND-CREDIT,<Snd CR> ;;SEND CREDIT
XX 45,STR,6,STSZ,SIZE-OF-STRUCTURE,< Size> ;;SIZE
XX 0,SCB,14,SCCI,SOURCE-CONNECT-ID,<   Source ID> ;;SOURCE ID
XX 10,SCB,16,SCPN,SOURCE-PROCESS-NAME,<Source Name> ;;SOURCE PROCESS NAME
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>	;;FORK SUPERIOR
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 0,MSC,12,TIMT,TIMEOUT-TIME,<Timeout Time> ;;TIMEOUT TIME
XX 0,MSC,13,TIMV,TIMEOUT-VALUE,<Timeout Value> ;;TIMEOUT VALUE
XX 40,SSB,9,TOD,TODCLK-LAST-MESSAGE,< TODCLK> ;;TODCLK
XX 80,DLL,11,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 MONSYM. Unused JSYSi 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 Symbols to Be Snooped for Internet Statistics

	XALL			;LET EXPANSIONS SHOW

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

TBSANA:	ANSYMS			;TABLE OF SYMBOLS

	NUMANA==.-TBSANA	;NUMBER OF SYMBOLS

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

TBMANA:	ANSYMS			;TABLE OF PROGRAM NAMES

DEFINE XX(SYM,MOD<PHYSIO>,A),<
IFB <A>,<SYM: EXP 0>		;;DEFINE LOCATION FOR VALUE TO GO
IFNB <A>,<A: EXP 0>		;;DEFINE LOCATION FOR VALUE TO GO
>

TBVANA: ANSYMS			;TABLE OF VALUES TO FILL IN

	SALL			;RETURN TO NORMAL
	SUBTTL Symbols to Be Snooped for SCA Statistics

	XALL			;LET EXPANSIONS SHOW

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

TBSSCA:	SSYMS			;TABLE OF SYMBOLS
	NUMSCA==.-TBSSCA	;NUMBER OF SYMBOLS

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

TBMSCA:	SSYMS			;TABLE OF PROGRAM NAMES

DEFINE XX(SYM,MOD<SCAMPI>),<
SYM:	EXP 0			;;DEFINE LOCATION FOR VALUE TO GO
>

TBVSCA:	SSYMS			;TABLE OF VALUES TO FILL IN

	SALL			;RETURN TO NORMAL
	SUBTTL Symbols to Be snooped for MSCP Statistics

	XALL			;LET EXPANSIONS SHOW

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

TBSMSC:	MSYMS			;TABLE OF SYMBOLS
	NUMMSC==.-TBSMSC	;NUMBER OF SYMBOLS

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

TBMMSC:	MSYMS			;TABLE OF PROGRAM NAMES

DEFINE XX(SYM,MOD<PHYMVR>),<
SYM:	EXP 0			;;DEFINE LOCATION FOR VALUE TO GO
>

TBVMSC:	MSYMS			;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			;[664] 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		;[664] 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
NODBLK:	BLOCK NB.LEN		;BLOCK TO HOLD DECNET PER-CONNECTION DATA
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
XPDAT:	BLOCK .XPLEN		;SPACE FOR XPEEK ARGUMENT BLOCK
THESB:	BLOCK 1			;FOR SB SPECIFIED BY USER
SBRIST:	BLOCK 1			;FOR SYSTEM BLOCK REQUEST-ID STATUS
LINFLG:	BLOCK 1
SYMNAM:	(T4)			;SET UP WITH T4 AS INDEX REGISTER
SYMMOD:	(T4)			;SET UP WITH T4 AS INDEX REGISTER
SYMVLU:	(T4)			;SET UP WITH T4 AS INDEX REGISTER

				;STORAGE FOR TCP DISPLAYS
GATSIZ==1000			;[661] Up to 1000 gateways supported
HSHSIZ==1000			;[661] Up to 1000 networks supported
TCBSIZ==200			;LENGTH OF A TCB **** MAY CHANGE *****
STTLEN==STATZZ-STAT0		;LENGTH OF STAT% BLOCK
STELEN==STATXX-STAT0		;[664] Length of STAT% block+statistics

NTHASH:	BLOCK HSHSIZ		;STORE NETWORK HASH TABLE HERE
NTGATE:	BLOCK HSHSIZ		;STORE PARALLEL GW TABLE HERE
GATTAB:	BLOCK GATSIZ		;THE SYSTEM GW TABLE
GATTMP:	BLOCK GWBKSZ		;STORE FOR A GW BLOCK IN THE ANG COMMAND
TCB.:	BLOCK TCBSIZ		;[664] Our copy of the current TCB
STABLK:	BLOCK STELEN		;STAT% BLOCK USED IN ANT COMMAND
DIFTIM:	BLOCK 1			;[664] Interval time for DPYART
LSTTIM:	BLOCK 1			;[664] Last uptime for DPYART
STABLO:	BLOCK STTLEN		;[664] Copy of previous STAT% BLOCK
ANTCOL:	BLOCK 1			;COLUMN COUNTER USED BY ANT COMMAND
GATPTR:	BLOCK 1			;STORE POINTER TO SYSTEM GW TABLE
GATCNT:	BLOCK 1			;NUMBER OF GW'S IN SYSTEM TABLE
ANCIDX:	BLOCK 1			;INDEX FOR TCB IN ANC<CONN> DISPLAY
XPKBLK:	BLOCK  .XPLEN+1		;XPEEK% ARGUMENT BLOCK
DPYRFL:	BLOCK	1		;-1 IF NON PC SECTION FREE SPACE

GH.EN1==.NIEN1-1		;[664] GHTAR2 ethernet adr high order bytes
GH.EN2==.NIEN2-1		;[664] GHTAR2 ethernet adr low order bytes
GH.GCF==.NIGCF-1		;[664] GHTAR2 gateway control flags
GH2MDL==NIHMDL-1		;[664] Length of an area 2 entry
MAXGHT==100			;MAXIMUM NUMBER OF GHT ENTRIES WE CAN HANDLE
GHT2SZ==MAXGHT*GH2MDL		;MAXIMUM SIZE FOR GHT AREA 2

GHT1:	BLOCK MAXGHT		;COPY OF GHT AREA 1
GHT2.:	BLOCK GHT2SZ		;[664] Copy of GHT area 2
GHT1AD:	BLOCK 1			;ADDRESS OF GHT AREA 1 IN MONITOR
GHT2AD:	BLOCK 1			;ADDRESS OF GHT AREA 2 IN MONITOR
GTHSTB==GHT1			;[665] Reuse GHT1 storage for GTHSTB

DOTFLG:	BLOCK 1			;-1 IF FOR DISPLAYING DOTTED HOST/NET ADDRESSES


TCPDEL:	[ASCIZ//],,[ASCIZ/(TCP)/] ;SET UP HOST PREFIX AND SUFFIX
NRTDEL:	[ASCIZ//],,[ASCIZ/(NRT)/] ;SET UP HOST PREFIX AND SUFFIX
CTMDEL:	[ASCIZ//],,[ASCIZ/(CTM)/] ;SET UP HOST PREFIX AND SUFFIX
LATDEL:	[ASCIZ//],,[ASCIZ/(LAT)/] ;SET UP HOST PREFIX AND SUFFIX
HSTDEL:	BLOCK 1
.NTBAS:	BLOCK .NWNU1+1		;BLOCK FOR NTINF% JSYS
HSTNAM:	BLOCK 10		;BLOCK FOR HOST NAME RETURNED BY NTINF%

	END 3,,ENTRY		;ENTRY VECTOR