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