Trailing-Edge
-
PDP-10 Archives
-
BB-M836B-BM
-
tools/sysdpy/sysdpy.mac
There are 31 other files named sysdpy.mac in the archive. Click here to see a list.
; UPD ID= 6, SNARK:<5.TOOLS-TAPE>SYSDPY.MAC.9, 31-Mar-82 14:57:33 by PURRETTA
;545 - TCO 5.1770 - Replace symbol references of UDBDDP with UDBDDD
; UPD ID= 2, SNARK:<5.TOOLS-TAPE>SYSDPY.MAC.6, 14-Oct-81 15:19:53 by PAETZOLD
;544 - Suppress available nodes (in DN display) if suppressing titles
; UPD ID= 1, SNARK:<5.TOOLS-TAPE>SYSDPY.MAC.5, 30-Sep-81 14:51:28 by GRANT
;543 - LL block
;<GRANT>SYSDPY.MAC.2, 21-Sep-81 10:52:43, EDIT BY GRANT
;542 - LL block growing again
;<5.TOOLS-TAPE>SYSDPY.MAC.2, 26-May-81 17:50:53, EDIT BY GRANT
;541 - LL block still growing, fix LLLIST
;<GRANT>SYSDPY.MAC.2, 24-Apr-81 13:23:22, EDIT BY GRANT
;540 - Add new LL state "CC sent"
;<GRANT.DECNET.5>SYSDPY.MAC.20, 13-Apr-81 09:18:35, EDIT BY GRANT
;537 - Add new DECnet object types
; Rewrite XXLHST to reflect new DECnet information
; Change LLLIST to reflect new DECnet data structure
;SNARK:<TCP.BUILD>SYSDPY.MAC.2 12-Mar-81 11:10:50, Edit by LYONS
;536 - Fix some of the bugs in the "re" display
; Get rid if the "unused pool" line
; Expand the "used" field to 5 digits. Some people use more
; than 10000 pages of drum space.
;SNARK:<5.UTILITIES>SYSDPY.MAC.13 19-Feb-81 12:51:49, Edit by LYONS
;535 - Add a DECSW to control DEC only features
; Put slow down prohibit under this switch
;<5.UTILITIES>SYSDPY.MAC.12, 24-Dec-80 11:47:41, EDIT BY GRANT
;534 - DECnet logical link block has changed - LLSOB now word 25
;SNARK:<5.UTILITIES>SYSDPY.MAC.9, 22-Dec-80 14:57:27 by GRANT
;533 - Fix the resident free space output in the RES command
;<LYONS.PRIV>SYSDPY.MAC.5, 7-Oct-80 13:38:06, Edit by LYONS
;532 - Add the "RP" command for Run time Percentage
;<LYONS.ARPAMON>SYSDPY.MAC.3, 8-Sep-80 12:43:07, Edit by LYONS
;531 - Increase max sleep time to 3 min, start after 1 min, and slow
; down faster.
; Also, slow down default display speed to 15 seconds
; Allow a refresh every 30 min by default
; Bump number of terminals to 300 from 178
; Move data pages up some, get rid of overlaps
;<LYONS>SYSDPY.MAC.2, 27-Aug-80 11:55:23, Edit by LYONS
;530 - Report quotas as +INF if the are
;<LYONS.PRIV>SYSDPY.MAC.2, 31-Jul-80 16:05:36, Edit by LYONS
;527 - SHIFT THE INDEX FOR FREE CORE BLOCKS AND FLAG TYPE 0 AS UNUSED
;<4.1.UTILITIES>SYSDPY.MAC.34, 24-May-80 22:22:48, EDIT BY DBELL
;526 - TELL ABOUT DOWNTIME IN INFORMATION LINE
;<4.1.UTILITIES>SYSDPY.MAC.30, 22-May-80 12:19:13, EDIT BY DBELL
;525 - DON'T SHOW SECONDS IN INFORMATION LINE
;524 - REMOVE TITLE LINE FOR HELP DISPLAY, ENFORCE INFO LINE FOR IT
;<4.1.UTILITIES>SYSDPY.MAC.29, 21-May-80 17:05:34, EDIT BY DBELL
;523 - DON'T DO AUTO-SCROLLING FOR HELP DISPLAY
;<4.1.UTILITIES>SYSDPY.MAC.28, 20-May-80 12:18:01, EDIT BY DBELL
;522 - USE FIXOUT ROUTINE INSTEAD OF FLOUT JSYS IN INFORMATION LINE
;<4.1.UTILITIES>SYSDPY.MAC.25, 18-May-80 20:37:16, EDIT BY DBELL
;521 - EAT LEADING SPACES IN HELP FILE TYPEOUT
;520 - ADD GENERAL INFORMATION LINE TO END OF DISPLAY IF DESIRED
;<4.1.UTILITIES>SYSDPY.MAC.23, 11-May-80 23:43:24, EDIT BY DBELL
;517 - MAKE CPYTXT ROUTINE ALLOW CONTROL-V FOR QUOTING ANY CHARACTER
;516 - MAKE "U" AND "PR" COMMANDS APPEND NAMES INSTEAD OF REPLACING THEM
;<4.1.UTILITIES>SYSDPY.MAC.21, 20-Apr-80 22:26:39, EDIT BY DBELL
;515 - MAKE VERSION OF "A" COMMAND SHOW ONLY ACTIVE ARPANET HOSTS
;514 - IF NO COMMANDS ARE BEING TYPED, SLOW DISPLAY RATE DOWN AFTER AWHILE
;<4.1.UTILITIES>SYSDPY.MAC.19, 12-Apr-80 17:05:18, EDIT BY DBELL
;513 - DON'T DO PHYSICAL ONLY GTJFN FOR DOING PUSH
;<4.1.UTILITIES>SYSDPY.MAC.18, 10-Apr-80 16:42:46, EDIT BY DBELL
;512 - TAKE CARE OF TYPE-AHEAD AFTER EXEC HAS TERMINATED
;<4.1.UTILITIES>SYSDPY.MAC.17, 6-Apr-80 15:08:13, EDIT BY DBELL
;511 - ADD TEMPORARY FEATURE TO SHOW FOREIGN HOST FOR DECNET NRTSRV PROGRAM
;510 - CHANGE IPCSIZ TO NOT CONFLICT WITH GALAXY DEFINITIONS
;<4.1.UTILITIES>SYSDPY.MAC.15, 23-Mar-80 22:45:38, EDIT BY DBELL
;507 - FIX UPTIME IN ARPANET DISPLAY, MAKE IDLE COLUMN LINE UP
;<4.1.UTILITIES>SYSDPY.MAC.12, 16-Mar-80 22:07:16, EDIT BY DBELL
;506 - ADD FOREIGN HOST COLUMN FOR JOB DISPLAY
;<4.1.UTILITIES>SYSDPY.MAC.10, 16-Mar-80 21:30:35, EDIT BY DBELL
;505 - IF CONTROLLED BY JOB ZERO JUST INSERT JSYS AND EXIT
;504 - FIX UP ARPANET DISPLAYS SOME
;<4.1.UTILITIES>SYSDPY.MAC.8, 14-Mar-80 14:15:46, EDIT BY DBELL
;503 - CALL SWPMWE AND SWPMWP WHEN CHANGING JSTAB
;<4.1.UTILITIES>SYSDPY.MAC.7, 15-Feb-80 17:01:22, EDIT BY DBELL
;502 - CHANGE NVT OBJECT TYPE FROM 200 TO 23
;<4.1.UTILITIES>SYSDPY.MAC.6, 20-Jan-80 11:57:21, EDIT BY DBELL
;501 - SET UP FR.END AS INITIAL FLAGS SO SPACE IN RSCAN LINE DOESN'T SCROLL
;<4.1.UTILITIES>SYSDPY.MAC.5, 16-Jan-80 21:29:38, EDIT BY DBELL
;500 - ADD RP20 DATA AND CODE TO HANDLE CONTROLLERS IN DISK DISPLAY
;<4.1.UTILITIES>SYSDPY.MAC.3, 14-Jan-80 19:34:03, EDIT BY DBELL
;477 - HAVE SPACE CHARACTER SCROLL THE SCREEN WITHOUT CARRIAGE RETURN NEEDED
;476 - MAKE DECNET CORE IN RESOURCE DISPLAY SHOW RIGHT VALUE
;<4.UTILITIES>SYSDPY.MAC.69, 28-Oct-79 12:16:19, EDIT BY DBELL
;475 - SPLIT UP ARPANET DISPLAY INTO TWO SEPARATE DISPLAYS
;474 - FIX SOME XLISTS SINCE NEW MACRO MAKES CREFS LOOK BAD NOW
;<4.UTILITIES>SYSDPY.MAC.68, 27-Oct-79 22:27:43, EDIT BY DBELL
;473 - SET UP AN INTERRUPT FOR FORK TERMINATIONS
;<4.UTILITIES>SYSDPY.MAC.67, 27-Oct-79 21:08:06, EDIT BY DBELL
;472 - DON'T KILL EXEC WHEN IT POPS BACK, ADD "KE" COMMAND TO KILL IT
;<4.UTILITIES>SYSDPY.MAC.65, 24-Oct-79 20:15:45, EDIT BY DBELL
;471 - CHANGE POPJ P, TO RET AND JRST CPOPJ1 TO RETSKP
;470 - TYPE +INFINITY FOR DISK QUOTAS IF INFINITE
;<4.UTILITIES>SYSDPY.MAC.64, 3-Sep-79 20:19:07, EDIT BY DBELL
;467 - DON'T SHOW AN OFN FOR A JFN WHICH IS NOT OPEN
;<4.UTILITIES>SYSDPY.MAC.63, 31-Jul-79 13:29:30, EDIT BY DBELL
;466 - SET FAILURE FLAG PROPERLY FOR UNKNOWN SYMBOLS AT UNKSYM+1
;<4.UTILITIES>SYSDPY.MAC.62, 30-Jun-79 14:38:48, EDIT BY DBELL
;465 - MAKE THE ENQ DISPLAY SCROLL AS IT SHOULD
;<4.UTILITIES>SYSDPY.MAC.61, 28-Jun-79 21:35:59, EDIT BY DBELL
;464 - DON'T DO A RLJFN AFTER A GET JSYS
;<4.UTILITIES>SYSDPY.MAC.60, 10-Jun-79 16:57:05, EDIT BY DBELL
;463 - CHANGE BUFSIZ TO BUFLEN SO DEFINITION IN ORNMAC ISN'T FOUND
;<4.UTILITIES>SYSDPY.MAC.59, 3-Jun-79 16:48:36, EDIT BY DBELL
;462 - DON'T DO A RLJFN AFTER A CLOSF IN NEWDPY
;<4.UTILITIES>SYSDPY.MAC.58, 2-Jun-79 14:15:54, EDIT BY DBELL
;461 - START USING STANDARD TOPS-20 EDIT HISTORY CONVENTIONS, AND
; REMOVE OLD EDIT HISTORY.
TITLE SYSDPY PROGRAM TO WATCH EVERYTHING
SUBTTL DEFINITIONS/DAVID I. BELL
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;PROGRAM TO DISPLAY VARIOUS SORTS OF INFORMATION ABOUT THE SYSTEM
;SUCH AS GENERAL JOB STATUS, SPECIFIC JOB STATUS, THE QUEUES,
;DECNET INFORMATION, ETC.
SEARCH DPYDEF ;SEARCH DPY DEFINITIONS
SEARCH MACSYM,MONSYM,JOBDAT ;AND MONITOR DEFINITIONS
SEARCH GLXMAC,QSRMAC,ORNMAC ;AND GALAXY DEFINITIONS TOO
.REQUES DPY ;ASK TO LOAD DPY
SALL ;MAKE FOR NICE MACROS
VERSION==5 ;VERSION NUMBER
EDIT==545 ;EDIT NUMBER
;ACCUMULATORS:
F=0 ;FLAGS
T1=1 ;TEMPORARY AC'S
T2=2
T3=3
T4=4
C=5 ;CHARACTER HOLDING
J=6 ;JOB NUMBER CURRENTLY WORKING ON
R=7 ;ROUTINE TO CALL FOR DPYING
I=10 ;INDEX INTO RUNTIME TABLES
P=17 ;STACK
FX==7 ;MONITOR AC - MUST MATCH MONITOR!!
P1==10 ;ANOTHER ONE
P2==11 ;ANOTHER MONITOR AC
P3==12 ;ANOTHER ONE
CX==16 ;AND ANOTHER MONITOR AC
;FLAGS:
FR.JSY==1B0 ;WE CAN USE THE "MONRD% JSYS"
FR.TAC==1B1 ;ONLY SHOW ACTIVE TERMINALS
FR.MOR==1B2 ;MORE COLUMNS ARE AFTER THIS ONE
FR.CPR==1B3 ;THE CPU PERCENTAGE TABLE IS READY
FR.RSN==1B4 ;INPUT CHARACTER NEEDS REREADING
FR.NEG==1B5 ;NEXT COMMAND'S ACTION IS NEGATED
FR.TMP==1B6 ;TEMPORARY USE INSIDE VARIOUS LOOPS
FR.NOC==1B7 ;DON'T CONVERT THE LABEL CHARACTER
FR.ACT==1B8 ;SHOW ONLY ACTIVE DECNET LINKS
FR.CMP==1B9 ;REMOVE HEADER LINES TO COMPRESS OUTPUT
FR.HDR==1B10 ;HEADER LINE HAS BEEN GIVEN
FR.OPR==1B11 ;SHOW OPERATOR JOBS IN DISPLAY
FR.EAT==1B12 ;SET UP EATING AFTER HEADER TYPEOUT
FR.END==1B13 ;PREVIOUS SCREEN WAS LAST ONE OF DISPLAY
FR.NDC==1B14 ;CRLF IS NEEDED BEFORE NEXT DISPLAY
FR.UDB==1B15 ;UDB IS VALID TO LOOK AT
FR.UDS==1B16 ;SYMBOLS FOR UDB HAVE BEEN OBTAINED
FR.INS==1B17 ;WE ONLY WANT TO INSERT THE MONRD% JSYS
FR.REF==1B18 ;REFRESH THE SCREEN
FR.RFC==1B19 ;CLEAR THE SCREEN WHEN REFRESHING
FR.NRT==1B20 ;NRTSRV DATA FILE IS MAPPED INTO CORE
IFE DECSW,<
FR.NOS==1B21 ;DON'T SLOW DOWN THE UPDATE RATE
>
FR.AAH==1B22 ;ONLY SHOW ACTIVE ARPANET HOSTS
FR.INF==1B23 ;USER WANTS TO SEE INFORMATION LINE
;COLUMN DEFINITIONS:
CL.TYP==0 ;TYPE OF COLUMN THIS IS
CL.VAL==1 ;VALUE FOR ORDERING OUTPUT
CL.DSP==2 ;ROUTINE TO TYPE DATA FOR COLUMN
CL.SIZ==3 ;WIDTH OF COLUMN
CL.TXT==4 ;ASCIZ TEXT FOR HEADER TO COLUMN
;THE FOLLOWING SYMBOLS ARE DEFINED IN THE MONITOR IN SUCH A WAY THAT
;ONE CANNOT OBTAIN THEM BY SNOOPING OR LOOKING IN A TABLE (THEY ARE
;ONLY DEFINED IN A DEFSTR MACRO). NONE OF THESE VALUES CHANGING WILL
;EVER CRASH THE MONITOR. INCORRECT VALUES WILL ONLY MAKE THE DATA
;RETURNED BY THE MONRD% JSYS BE INCORRECT.
;FIELDS DEFINED IN HEADER BLOCKS OF IPCF MESSAGES:
PD.CNT==POINT 9,0,35 ;NUMBER OF OUTSTANDING MESSAGES
PD.FLG==POINT 12,1,11 ;FLAG BITS
PD.FKW==POINT 18,1,35 ;FORK WAITING FOR MESSAGE
PD.FKO==POINT 18,2,35 ;FORK WHICH OWNS THIS PID
;FLAG BITS IN THE IPCF HEADER:
PD%DIS==4 ;PID IS DISABLED
;FLAGS IN THE SYSFK TABLE:
SFEXO==1B1 ;FORK IS EXECUTE-ONLY
SFNVG==1B2 ;FORK IS NOT A VIRGIN
SFGXO==1B3 ;FORK IS DOING GET OF EXECUTE-ONLY PROG
;MACROS:
DEFINE $$(SYM,MOD),< ;;PRODUCES SYMBOL DATA FOR SNOOPING
ADDR==.-1 ;;GET LOCATION OF THIS INSTRUCTION
XLIST ;;SUPPRESS LISTING
RELOC ;;RETURN TO NORMAL RELOCATION
EXP ADDR ;;DUMP THE ADDRESS OF THE INSTRUCTION
RADIX50 0,SYM ;;AND THE SYMBOL NAME
RADIX50 0,MOD ;;AND THE MODULE NAME
EXP .FAIL. ;;AND ADDRESS TO SET IF SYMBOL LOOKUP FAILS
LOC ;;RETURN TO ABSOLUTE CODE
LIST ;;ALLOW LISTING AGAIN
>
.FAIL.==0 ;INITIALIZE FAILURE ADDRESS
DEFINE ND(SYM,VAL),< ;;DEFINES DEFAULT VALUES FOR SYMBOLS
IFNDEF SYM,<SYM==VAL> ;;IF NOT DEFINED YET, DO SO NOW
>
DEFINE STS(BIT,TEXT),< ;;GENERATES FORK STATUS INFORMATION
<BIT>B0+[ASCIZ"TEXT"]
>
DEFINE IERR(TEXT),< ;;FOR ERRORS WHEN STARTING "MONRD%" JSYS
JRST [HRROI T1,[ASCIZ/
? TEXT
/] ;;GET STRING
JRST IERRTP] ;;THEN GO TYPE IT
>
;MACROS TO GENERATE MASKS AND OFFSETS FROM A BYTE POINTER:
DEFINE PW(PTR),<<<PTR>&^O777777>>
DEFINE PM(PTR),<<<<1_<<<PTR>_-^D24>&^O77>>-1>_<<PTR>_-^D30>>>
DEFINE SERR(TEXT),< ;;FOR ERRORS WHEN DOING SNOOPS
JRST [HRROI T1,[ASCIZ/
? TEXT: /] ;;GET STRING
JRST SERRTP] ;;THEN GO TYPE IT
>
DEFINE UU(ARGS),< ;;GENERATE TABLE OF UUOS
XLIST
IRP ARGS,<
SIXBIT /ARGS/
>
LIST
>
DEFINE NOSKED,< ;;PREVENT SCHEDULING
JSP CX,$$(NOSKD0,SCHED)
>
DEFINE OKSKED,< ;;ALLOW SCHEDULING AGAIN
JSP CX,$$(OKSKD0,SCHED)
>
DEFINE NOINT,< ;;PREVENT CONTROL-C'S
AOS $$(INTDF,STG)
>
DEFINE OKINT,< ;;ALLOW THEM AGAIN
XCT $$(INTDFF,STG)
>
DEFINE RESCAN,<
TXO F,FR.RSN ;;SET THE REREAD FLAG
>
;DEFAULT PARAMETERS:
ND DECSW,-1 ;INCLUDE DEC ONLY FEATURES
ND FTPRIV,-1 ;-1 IF MONRD% JSYS IS TO BE PRIVILEGED
ND .MSR20,24 ;**TEMPORARY UNTIL IN MONSYM** RP20 UNIT TYPE
ND NWFKPT,2433 ;MONITOR VERSION FOR NEW FKPT FORMAT
ND JSYNUM,717 ;SPECIAL SYSTAT JSYS NUMBER
ND TAKMAX,5 ;MAXIMUM DEPTH OF NESTED TAKE COMMANDS
ND LBLCHR,":" ;CHARACTER IN INDIRECT FILE FOR LABELS
ND ACTTIM,1 ;MINUTES TO CONTINUE SHOWING ACTIVE TERMINALS
ND PERCOL,2 ;COMPRESSION FACTOR FOR HISTOGRAM
ND DFTLBL,'SYSDPY' ;DEFAULT LABEL TO LOOK FOR IN SYSDPY.INI
ND NRTLOC,350000 ;PAGE WHERE NRTSRV DATA FILE GOES
ND DATLOC,351000 ;PAGES FOR COLLECTION OF DATA
ND DATSIZ,3000 ;SIZE OF THE BLOCK
ND SNPLOC,354000 ;LOCATION OF CODE FOR SNOOP JSYS
ND ERRNUM,^D30 ;NUMBER OF ERROR STRINGS TO KNOW ABOUT
ND ERRSIZ,^D15 ;WORDS TO HOLD EACH ERROR STRING
ND ENQSAF,^D55 ;SAFETY MARGIN FOR BUFFER OVERFLOW
ND PIDSIZ,^D100 ;STORAGE FOR PIDS OF A JOB
ND LCKMAX,^D100 ;NUMBER OF ENQ LOCKS WE CAN SHOW
ND UDBSIZ,^D50 ;SIZE OF BLOCK TO READ UDB INTO
ND PDLSIZ,40 ;STACK SIZE
ND TMPSIZ,^D50 ;SIZE OF TEMPORARY USE BUFFER
ND USRSIZ,^D500 ;STORAGE FOR USER NAME STRINGS
ND PRGMAX,^D100 ;MAXIMUM NUMBER OF PROGRAM NAMES TO SPECIFY
ND PSHSLP,^D30000 ;SLEEP TIME DURING A PUSH
ND DWNTIM,^D60 ;MINUTES LEFT FOR SAYING SYSTEM GOING DOWN
ND MAXJOB,^D150 ;MAXIMUM JOBS WE CAN HANDLE
ND MAXTTY,^D300 ;MAXIMUM TERMINAL KNOWN
ND MAXSYM,^D50 ;MAXIMUM NUMBER OF MONITOR SYMBOLS KNOWN
ND MAXSEP,^D10 ;MAXIMUM COLUMN SEPARATION ALLOWED
ND MAXCLS,^D20 ;MAXIMUM CLASS FOR SCHEDULER
ND TTYCHN,0 ;TERMINAL INTERRUPT CHANNEL
ND CPUINT,^D20 ;SECONDS BETWEEN CPU COMPUTATIONS
ND CPUAVG,3 ;NUMBER OF INTERVALS TO AVERAGE
ND DFTLAP,1 ;DEFAULT NUMBER OF LINES SCREENS OVERLAP BY
ND DFTSLP,^D15000 ;DEFAULT SLEEP TIME BETWEEN UPDATES
ND MAXSLP,^D180000 ;MAXIMUM SLEEP TIME WHEN SLOWING DISPLAY DOWN
ND SLWFAC,^D20 ;SECONDS OF ELAPSED TIME PER SECOND OF SLOWING
ND SLWGRC,^D60000 ;TIME PERIOD BEFORE SLOWING DOWN DISPLAY
ND DFTPAG,0 ;DEFAULT SECONDS BETWEEN SCROLLING
ND DFTIDL,.INFIN ;DEFAULT CUTOFF TIME FOR IDLE JOBS
ND DFTRPL,^D0 ;BY DEFAULT, SHOW JOBS WITH MORE THAN 0 % CPU USAGE
ND DFTREF,^D30 ;DEFAULT MINUTES BETWEEN REFRESHINGS
ND MAXID,6 ;MAXIMUM NUMBER OF ID'S TYPED FOR FORK
ND BUFLEN,^D20 ;NUMBER OF WORDS IN TTY BUFFERS
ND BUFNUM,^D10 ;NUMBER OF BUFFERS
ND TXTLEN,^D8 ;WORDS TO HOLD TEXT STRINGS
;OPDEFS:
OPDEF TAB [CHI$ 11] ;TAB CHARACTER
OPDEF SPACE [CHI$ 40] ;SPACE CHARACTER
OPDEF CRLF [CHI$ 12] ;CRLF CHARACTER
OPDEF CALL [PUSHJ P,] ;SUBROUTINE CALL
OPDEF RET [POPJ P,] ;RETURN
OPDEF RETSKP [JRST CPOPJ1] ;GO SKIP RETURN
OPDEF PJRST [JRST] ;STANDARD
OPDEF GETCHR [CALL RUNCHR] ;GET NEXT INPUT CHARACTER IN C
OPDEF MONRD% [JSYS JSYNUM] ;SPECIAL "CUSTOM" SYSTAT JSYS
OPDEF XCTU [XCT 4,] ;PREVIOUS CONTEXT EXECUTE
OPDEF IFIW [1B0] ;FOR EXTENDED INDIRECT WORDS
.NODDT IFIW ;SUPPRESS OUTPUT TOO
SUBTTL INITIALIZATION
;THIS PROGRAM SHOWS A CONSTANTLY UPDATING DISPLAY OF ALL OF THE JOBS ON
;THE SYSTEM, A PARTICULAR JOB IN DETAIL, OR THE GENERAL STATUS OF THE
;MONITOR. NO PRIVILEGES ARE REQUIRED IN GENERAL TO RUN THIS PROGRAM.
ENTRY: JRST SYSDPY ;START ADDRESS
JRST SYSDPY ;REENTER ADDRESS
BYTE (3)0(9)VERSION(6)0(18)EDIT ;VERSION
SYSDPY: RESET ;RESET EVERYTHING
MOVE P,[IOWD PDLSIZ,PDL] ;INITIALIZE STACK
MOVX F,FR.END ;SET UP INITIAL FLAGS
MOVE T1,[CALL DPYUUO] ;GET LUUO INSTRUCTION
MOVEM T1,.JB41 ;SET IT
SETZM ERRCNT ;NO ERRORS ARE STORED
SETZM MYPID ;WE HAVE NO PID
SETZM QSRPID ;AND DON'T KNOW QUASARS
SETZM INFPID ;OR PID OF SYSTEM INFO
SETZM HLPJFN ;CLEAR HELP FILE JFN
SETZM TAKJFN ;CLEAR ANY INDIRECT FILE JFN
SETZM TAKLVL ;AND RESET DEPTH OF TAKE FILES
SETZM HANDLE ;NO FORK HANDLE EXISTS
SETZM REFLST ;CLEAR LAST TIME OF REFRESH
SETZM HLPDSP ;CLEAR OUT ANY HELP DISPATCH
SETZM PAGE ;CLEAR PAGE COUNTER
CALL GETARG ;GO CHECK FOR SPECIAL ACTIONS
GTAD ;READ TIME AND DATE
MOVEM T1,NTIME ;INITIALIZE IT
TIME ;GET THE UPTIME OF THE SYSTEM
MUL T1,[1,,0] ;CONVERT FROM MILLISECONDS
DIV T1,[^D<24*60*60*1000>] ;TO UNIVERSAL TIME
SUB T1,NTIME ;COMPUTE THE TIME THE SYSTEM STARTED
MOVNM T1,BEGTIM ;SAVE FOR LATER
CALL DEFALT ;SET UP ALL DEFAULT PARAMETERS
MOVEI R,DPYALL ;SET UP DEFAULT DISPLAY ROUTINE
HRROI T1,.JOBRT ;GET READY
GETAB ;FIND NUMBER OF JOBS ON SYSTEM
ERJMP DIE ;FAIL
ADDI T1,1 ;ACCOUNT FOR JOB 0
MOVMM T1,HGHJOB ;SAVE MAXIMUM JOB NUMBER ON SYSTEM
MOVEI T1,MAXJOB ;GET NUMBER OF JOBS WE CAN HANDLE
CAMG T1,HGHJOB ;MAKE SURE SYSTEM DOESN'T HAVE MORE
JRST TOOMNY ;YEP, GO COMPLAIN
HRROI T1,.TTYJO ;GET READY
GETAB ;FIND THE NUMBER OF TTYS ON THE SYSTEM
ERJMP DIE ;FAILED
ADDI T1,1 ;ADJUST FOR TTY0
MOVMM T1,HGHTTY ;SAVE MAXIMUM TTY NUMBER
MOVEI T1,.PTYPA ;GET READY
GETAB ;READ PTY DATA
ERJMP DIE ;CAN'T
MOVEI T1,-1(T1) ;MAKE TTY NUMBER OF THE CTY
MOVEM T1,CTYNUM ;SAVE IT
GJINF ;GET INFORMATION ABOUT MY JOB
MOVEM T1,MYUSER ;SAVE MY USER NUMBER
MOVEM T3,MYJOB ;AND MY JOB NUMBER
GETNM ;READ MY PROGRAM NAME
MOVEM T1,MYNAME ;SAVE IT
MOVX T1,RC%EMO ;MATCH STRING EXACTLY
HRROI T2,[ASCIZ/OPERATOR/] ;THE OPERATOR
RCUSR ;GET THE USER NUMBER FOR HIM
TXNE T1,RC%NOM+RC%AMB ;NO MATCH?
SETO T3, ;YES, CLEAR USER NUMBER
MOVEM T3,OPRUSR ;SAVE THE OPERATOR'S USER NUMBER
CALL TBLINI ;INITIALIZE TABLES
CALL BUFINI ;GO INITIALIZE TTY BUFFERS
CALL RDSTAT ;READ MONITOR STATISTICS
CALL STATCP ;THEN COPY AS OLD INFO
CALL ECHOOF ;TURN OFF ECHOING
CALL TAKINI ;GO SET UP TO READ SYSDPY.INI COMMANDS
CALL JSYTST ;SEE IF WE CAN USE "MONRD% JSYS"
CALL CMDINI ;DO RESCANNING OF COMMAND LINE
SETOM TTYFLG ;INITIALIZE INTERRUPT FLAGS
SETOM FRKFLG ;TO NICE STATES
MOVEI T1,.FHSLF ;GET SET
MOVE T2,[LEVTAB,,CHTAB] ;GET TABLE ADDRESSES
SIR ;TELL MONITOR WHERE INTERRUPT TABLES ARE
ERJMP DIE ;FAILED
MOVX T2,1B<TTYCHN> ;GET BIT FOR CHANNEL
AIC ;ACTIVATE THE CHANNEL
ERJMP DIE ;FAILED
EIR ;ENABLE THE INTERRUPTS
ERJMP DIE ;FAILED
MOVE T1,[.TICTI,,TTYCHN] ;SET UP FOR TYPEIN INTERRUPT
ATI ;ACTIVATE INTERRUPT
ERJMP DIE ;FAILED
MOVEI T1,.FHSLF ;GET READY TO INTERRUPT MY FORK
IIC ;GO TAKE CARE OF TYPE-AHEAD
INI$ ;NOW INITIALIZE DPY AND CLEAR SCREEN
SETOM TTYFLG ;ACT LIKE SLEEPING IS OK NOW
SUBTTL MAIN LOOP FOR SHOWING SCREEN DATA
LOOP: GTAD ;READ CURRENT TIME OF DAY
MOVEM T1,NTIME ;SAVE IT
CALL RUNCMD ;SEE IF ANY COMMANDS TO DO
CALL CHKDRM ;CHECK IDLE TIME OF JOBS
CALL CPUCMP ;COMPUTE CPU PERCENTAGES IF NEEDED
TXZ F,FR.EAT!FR.HDR!FR.NDC ;REINITIALIZE THE DISPLAY FLAGS
SET$ [$SEEAT,,0] ;EAT NO LINES AT FIRST
CALL WINSET ;SET UP WHERE WINDOW FOR DISPLAY IS
CALL PAGCHK ;DO SCROLLING OF SCREEN
CALL (R) ;CALL THE PROPER DISPLAY ROUTINE
CALL FULL ;NOW SEE IF THIS WAS LAST SCREEN
TXZA F,FR.END ;NO, CLEAR FLAG FOR NEXT LOOP
TXO F,FR.END ;YES, SET FLAG TO SAY THAT
SET$ [$SEEAT,,0] ;CLEAR EATING SO CAN SEE DASHES
STR$ [ASCIZ/---/] ;FINISH THE DISPLAY
TLNN R,-1 ;SHOWING HELP DISPLAY?
TXNE F,FR.INF ;OR SHOWING INFORMATION LINE?
CALL INFO ;YES, SHOW THAT
MOVE T1,NTIME ;GET CURRENT TIME
SKIPN REFLST ;SEE IF WE REFRESHED BEFORE
MOVEM T1,REFLST ;NO, THEN SET THE TIME
SUB T1,REFLST ;GET TIME SINCE LAST REFRESH
MULI T1,^D<60*24> ;CONVERT FROM UNIVERSAL TIME
ASHC T1,^D17 ;INTO MINUTES
CAML T1,REFTIM ;REACHED TIME YET?
TXO F,FR.REF ;YES, REMEMBER TO DO IT
TXNN F,FR.REF ;WANTS TO REFRESH SCREEN?
DPY$ DP$NOH ;NO, JUST SHOW CHANGES
TXZN F,FR.REF ;WELL?
JRST DOSLP ;NO, JUST GO SLEEP
MOVE T1,[REF$ RE$NOH] ;GET REFRESH INSTRUCTION
TXZE F,FR.RFC ;WANT TO CLEAR THE SCREEN?
IORI T1,RE$CLR ;YES, SET THE FLAG
XCT T1 ;DO THE REFRESH
MOVE T1,NTIME ;GET CURRENT TIME
MOVEM T1,REFLST ;SET IT AS TIME WE REFRESHED LAST
DOSLP: CALL GETSLP ;GET THE SLEEP TIME
JUMPLE T1,LOOP ;IF ZERO, DON'T SLEEP AT ALL
AOSN TTYFLG ;CHECK AND SET SLEEP FLAG
DISMS ;WAIT A WHILE
SLPINT: SETOM TTYFLG ;FLAG NO LONGER SLEEPING
JRST LOOP ;LOOP
SUBTTL ROUTINE TO SHOW ALL JOBS IN A "SYSTAT" DISPLAY
;THIS DISPLAY MODE SHOWS ALL JOBS IN A TYPE OF "SYSTAT" DISPLAY.
;IT WILL GIVE THE GENERAL STATUS OF THE JOBS. NO EXTRANEOUS DATA
;IS GIVEN, SUCH AS SYSTEM DATA. THIS MODE IS THE DEFAULT MODE
;WHEN THE PROGRAM IS STARTED.
DPYALL: MOVEI T1,TP.JOB ;THIS IS JOB OUTPUT
CALL HDRSET ;SO SET UP HEADER FOR IT
TXO F,FR.EAT ;SET UP EATING WHEN HEADER IS TYPED
SETO J, ;INITIALIZE FOR LOOP
JOBLOP: ADDI J,1 ;MOVE TO NEXT JOB
CAMG J,HGHJOB ;DID ALL JOBS YET?
CALL FULL ;OR IS SCREEN FULL?
RET ;YES, DONE
CALL GETDAT ;READ DATA ON THIS JOB
JRST JOBLOP ;NO SUCH JOB, GO ON
CALL SUPPRS ;SEE IF THIS JOB IS TO BE SHOWN
JRST JOBLOP ;NO, GO TO NEXT ONE
CALL DOCOLS ;TYPE ALL REQUIRED COLUMNS
JRST JOBLOP ;LOOP
;HERE TO READ INFO ON A JOB, TO SEE IF IT IS TO BE SHOWN:
GETDAT: MOVE T1,J ;GET JOB NUMBER
MOVE T2,[-<.JISTM+1>,,BLK] ;AND PLACE TO PUT DATA
SETZ T3, ;START AT FIRST WORD
GETJI ;READ INFORMATION ABOUT THE JOB
JRST [CAIE T1,GTJIX1 ;FAIL BECAUSE OF INVALID INDEX?
JRST NOTJOB ;NO, NO SUCH JOB
JRST .+1] ;YES, PROCEED WITH WHAT WE GOT
MOVE T1,BLK+.JIRT ;GET NEW RUNTIME OF JOB
CALL UPDORM ;COMPUTE IDLE TIME FOR THIS JOB
MOVEM T1,IDLE(J) ;THEN SAVE IT
MOVE T1,RUNDIF(J) ;GET RUNTIME JOB HAD IN LAST INTERVAL
MOVE T2,TIMDIF ;AND TIME DIFFERENCE
MOVE T4,T2 ;SAVE THE DENOMINATOR
MULI T1,^D10000 ;MULTIPLY BY HUNDREDS OF A PERCENT
DIV T1,T4 ;THEN DIVIDE BY DENOMINATOR
ADD T2,T2 ;DOUBLE THE REMAINDER
CAMLE T2,T4 ;SHOULD WE ROUND UP?
ADDI T1,1 ;YES, ADD TO HUNDREDS OF A PERCENT
MOVEM T1,CPUPER(J) ;SAVE TO DECIEDE TO DROP THIS ONE
RETSKP ;GOOD RETURN
;FOLLOWING ARE THE ROUTINES TO OUTPUT THE VARIOUS COLUMNS.
XXJOB: MOVE T1,J ;GET JOB NUMBER
CALL DECSP2 ;OUTPUT IT
CAMN J,MYJOB ;IS THIS MY OWN JOB?
CHI$ "*" ;YES, MARK IT WITH A STAR
RET ;DONE
XXTERM: MOVE T1,BLK+.JITNO ;GET TERMINAL NUMBER
JRST TTYOUT ;OUTPUT IT
XXPROG: SKIPN T1,BLK+.JIPNM ;GET PROGRAM NAME
MOVE T1,BLK+.JISNM ;IF NONE, USE SUBSYSTEM NAME
JRST SIXOUT ;GO OUTPUT IT
XXJSTA: MOVE T1,BLK+.JITNO ;GET TERMINAL NUMBER
CALL STATE ;USE IT TO RETURN THE STATE OF THE JOB
STR$ T1 ;THEN OUTPUT IT
RET ;DONE
XXJRUN: MOVE T1,BLK+.JIRT ;GET RUN TIME
IDIVI T1,^D1000 ;CONVERT TO SECONDS
JRST TIMSPC ;OUTPUT IT JUSTIFIED
XXCPU: TXNN F,FR.CPR ;IS THE CPU DATA READY YET?
RET ;NO, DO NOTHING
MOVE T1,CPUPER(J) ;GET THE CPU PERCENTAGES
IDIVI T1,^D100 ;GET PERCENTAGE AND FRACTION
JRST CENOUT ;GO OUTPUT IT
XXCDIR: MOVE T1,BLK+.JIDNO ;GET CONNECTED DIRECTORY
MOVEI T2,4 ;ALLOW 4 WORDS OF OUTPUT
JRST USROUT ;GO OUTPUT IT
XXIDLE: MOVE T1,IDLE(J) ;GET BACK DORMANT TIME
CAIGE T1,^D60 ;AN HOUR?
STR$ [ASCIZ/ /] ;NO, SPACE OVER
CALL TMHSPS ;OUTPUT DORMANCY TIME
SKIPGE TIMRUN(J) ;HAS JOB NOT RUN SINCE WE STARTED?
CHI$ "+" ;YES, APPEND A PLUS THEN
RET ;DONE
XXUSER: MOVE T1,BLK+.JIUNO ;GET THE USER'S NUMBER
MOVEI T2,3 ;GET WORDS OF OUTPUT WE WANT
JRST USROUT ;OUTPUT IT AND RETURN
XXCTIM: SKIPN T2,BLK+.JISTM ;GET TIME USER LOGGED IN
RET ;CAN'T GET IT, FAIL
SPACE ;SPACE OVER ONE TO LOOK NICE
SKIPGE T2 ;KNOWN TIME?
MOVE T2,BEGTIM ;NO, USE SYSTEM STARTUP THEN
MOVE T1,NTIME ;GET TIME RIGHT NOW
SUB T1,T2 ;SUBTRACT TO GET CONNECT TIME
MULI T1,^D<24*60> ;CONVERT FROM UNIVERSAL TIME
ASHC T1,^D17 ;TO MINUTES
JRST TMHSPC ;OUTPUT IT AND RETURN
XXACCT: MOVE T1,J ;GET JOB NUMBER
HRROI T2,TEMP ;POINT TO STORAGE
GACCT ;READ ACCOUNT STRING FOR JOB
ERJMP CPOPJ ;FAILED, HE LOSES
TXNE F,FR.MOR ;MORE COLUMNS AFTER THIS ONE?
SETZM TEMP+3 ;YES, THEN CUT OFF THE OUTPUT SOME
STR$ TEMP ;OUTPUT IT
RET ;DONE
XXLINK: SKIPGE T4,BLK+.JITNO ;GET TERMINAL NUMBER
RET ;DETACHED, FAIL
MOVEI T1,.RDTTY ;FUNCTION TO GET TTY DATA
MOVE T2,['TTLINK'] ;WANT THE LINK WORD
SETZ T3, ;NO OFFSET
MONRD% ;READ THE DATA
ERJMP CPOPJ ;FAILED
JUMPL T1,CPOPJ ;ALSO FAILED
JRST TELLNK ;GO OUTPUT THE DATA
XXFHST: SKIPL T1,BLK+.JICPJ ;ANY CONTROLLING JOB?
JRST FHDECN ;YES, GO SEE IF THIS IS A "NRTSRV" LINK
SKIPL T2,BLK+.JITNO ;GET TERMINAL NUMBER
CAMG T2,CTYNUM ;TERMINAL NUMBER IN RANGE OF ARPANET NVT'S?
RET ;NO, THEN NOT FROM FOREIGN HOST
MOVEI T1,.GTNNI ;ARGUMENT IS INPUT SIDE OF NVT
MOVEI T3,T3 ;LOCATION TO PUT RESULT
HRROI T4,.NCFHS ;WANT TO READ FOREIGN HOST NUMBER
GTNCP% ;READ IT
ERJMP CPOPJ ;FAILED, RETURN
MOVEI T1,.GTHNS ;NOW WANT TO CONVERT NUMBER TO STRING
HRROI T2,TEMP ;POINT TO STORAGE
GTHST% ;STORE THE SITE NAME
ERJMP [MOVE T1,T3 ;FAILED, COPY HOST NUMBER
JRST OCTTEL] ;AND OUTPUT IN OCTAL
TXNE F,FR.MOR ;MORE COLUMNS AFTER THIS ONE?
SETZM TEMP+3 ;YES, CUT OFF THE STRING
STR$ TEMP ;TYPE THE NAME
RET ;DONE
FHDECN: MOVE T2,[-<.JIPNM+1>,,TEMP] ;WANT DATA ON CONTROLLING JOB
SETZ T3, ;FROM OFFSET ZERO
GETJI ;OBTAIN THE INFORMATION
ERJMP CPOPJ ;FAILED
MOVE T1,TEMP+.JIPNM ;GET PROGRAM NAME READY
SKIPN TEMP+.JIUNO ;JOB LOGGED IN?
CAME T1,['NRTSRV'] ;OR HAS THE WRONG NAME?
RET ;YES, NOT THE REAL DECNET "NVT" HACK PROGRAM
TXNE F,FR.NRT ;HAVE DATA FILE MAPPED ALREADY?
JRST FHDECG ;YES, SKIP ONWARD
MOVX T1,GJ%OLD!GJ%SHT!GJ%ACC ;NO, GET READY
HRROI T2,[ASCIZ/SYSTEM:NRTSRV-CONNECTIONS.DATA/] ;FILE NAME
GTJFN ;TRY TO GET IT
ERJMP CPOPJ ;FAILED
MOVE T4,T1 ;REMEMBER JFN IN CASE OF FAILURE
MOVX T2,OF%RD ;WANT TO READ IT
OPENF ;TRY TO DO SO
ERJMP NODECV ;FAILED
MOVSI T1,(T1) ;WANT TO READ PAGE ZERO OF FILE
MOVE T2,[.FHSLF,,<NRTLOC/PAGSIZ>] ;WHERE TO MAP IT
MOVX T3,PM%RD ;WANT READ ACCESS
PMAP ;DO IT
ERJMP DIE ;FAILED
TXO F,FR.NRT ;WE NOW HAVE THE FILE MAPPED
FHDECG: MOVE T1,BLK+.JITNO ;GET TERMINAL NUMBER
SUB T1,CTYNUM ;REMOVE CTY OFFSET
SOJL T1,CPOPJ ;CREATE PTY NUMBER AND CHECK TO MAKE SURE
IMULI T1,2 ;DATA FILE HAS TWO WORDS PER PTY
CAIGE T1,PAGSIZ ;VERIFY THE RANGE
STR$ NRTLOC(T1) ;OK, TYPE THE FOREIGN HOST NAME
RET ;DONE
NODECV: MOVE T1,T4 ;GET BACK JFN
RLJFN ;RELEASE IT
ERJMP DIE ;FAILED
RET ;RETURN
XXJCLS: MOVEI T1,3 ;WANT THREE ARGUMENTS
MOVE T2,J ;GET JOB NUMBER
DMOVEM T1,TEMP ;STORE IN ARGUMENT BLOCK
MOVEI T1,.SKRJP ;GET FUNCTION
MOVEI T2,TEMP ;AND ADDRESS OF BLOCK
SKED% ;READ INFO ON JOB
ERJMP CPOPJ ;FAILED
MOVE T1,TEMP+.SAJCL ;GET THE CLASS
JRST DECSP3 ;OUTPUT IT
XXFKS: MOVE T1,['FKCNT '] ;GET WORD
CALL GETJS0 ;READ NUMBER OF FORKS IN THE JOB
RET ;CAN'T GET IT
AOJA T1,DECSP3 ;ADD 1 FOR TOP FORK AND OUTPUT NUMBER
SUBTTL ROUTINE TO SEE IF A JOB IS TO BE SHOWN
;CALLED FOR EACH JOB TO SELECT WHETHER OR NOT WE WANT TO DISPLAY THE
;JOB. THIS DOES NOT PREVENT ANY DATA COLLECTION FOR CPU TIMES. CALLED
;AFTER READING THE JOB INFO BY GETJI. SKIP RETURN IF JOB IS TO BE SHOWN.
SUPPRS: MOVE T1,IDLE(J) ;GET IDLE TIME FOR THIS JOB
MOVE T2,MAXIDF ;GET FLAG FOR WHICH CHECK TO MAKE
XCT [CAMLE T1,MAXIDL
CAMG T1,MAXIDL](T2) ;CORRECT SIDE OF THE CUTOFF VALUE?
RET ;NO, RETURN
TXNN F,FR.CPR ;IS IT READY?
JRST SUPPR1 ;NO, ALLOW TEH LINE IN ANY CASE
MOVE T1,CPUPER(J) ;GET THE CPU PERCENTAGE USED
MOVE T2,MAXRPF ;AND THE FLAG TO TEST
XCT [CAMGE T1,MAXRPT
CAML T1,MAXRPT](T2) ;TEST AGAINST CUTOFF
RET ;IT FAILED THE TEST
SUPPR1: MOVE T1,J ;GET COPY OF JOB NUMBER
ADJBP T1,[POINT 1,BITS,0] ;CREATE PROPER BYTE POINTER
LDB T1,T1 ;GET BIT FOR THIS JOB
JUMPN T1,CPOPJ ;RETURN FAILURE IF BIT WAS SET
MOVE T2,BLK+.JIUNO ;GET USER NUMBER
CAMN T2,OPRUSR ;IS THIS NOT THE OPERATOR?
TXNE F,FR.OPR ;OR WE WANT TO SHOW THEM ANYWAY?
SKIPA ;YES
RET ;NO, RETURN
SKIPN T1,BLK+.JIPNM ;GET PROGRAM NAME
MOVE T1,BLK+.JISNM ;OR SYSTEM NAME IF NONE
CALL PRGCMP ;SEE IF THE PROGRAM NAME MATCHES
RET ;NO, RETURN
MOVE T1,BLK+.JIUNO ;GET THE JOB'S USER NUMBER
JRST USRCMP ;SEE IF HE MATCHES WHO WE WANT TO SEE
SUBTTL ROUTINE TO DO DISPLAY OF A SINGLE JOB
;THIS DISPLAY WILL SHOW THE STATUS OF A PARTICULAR JOB IN DETAIL,
;INCLUDING THE OPEN JFNS AND THE FORKS.
DPYONE: MOVEI T1,TP.JOB ;THIS IS JOB OUTPUT
CALL HDRSET ;SET UP TAB STOPS AND HEADER
TXO F,FR.HDR ;BUT STOP HEADER FROM TYPING
SKIPN T1,THETTY ;SEE IF A PARTICULAR TTY IS TO BE SHOWN
JRST ONEHAV ;NO, THEN ALREADY HAVE THE JOB
HRROI T2,THEJOB ;ONE WORD STORED AT GIVEN LOCATION
MOVEI T3,.JIJNO ;WANT TO READ THE JOB NUMBER
GETJI ;READ THE JOB NUMBER
ERJMP LOSE ;FAILED
SKIPGE THEJOB ;IS A JOB ON THE TERMINAL?
JRST DPYONT ;NO, GO COMPLAIN
ONEHAV: MOVE J,THEJOB ;GET JOB TO DO
CALL GETDAT ;READ DATA ON THE JOB
JRST DPYONN ;ISN'T THERE
CALL DOCOLS ;OK, SHOW DATA ON THE JOB
CRLF ;THEN DO A CRLF
CALL SETEAT ;SET UP TO EAT LINES NOW
TXZ F,FR.NDC ;DON'T NEED A CRLF NOW
CALL DOFORK ;SHOW THE FORK STATUS
CALL DOJFN ;AND THE JFN STATUS
JRST JOBSUM ;OUTPUT SUMMARY STUFF AND RETURN
DPYONN: STR$ [ASCIZ/Job /] ;TYPE SOME
MOVE T1,J ;GET JOB NUMBER
CALL DECOUT ;OUTPUT IT
STR$ [ASCIZ/ is not in use
/]
RET ;DONE
DPYONT: STR$ [ASCIZ/No job is on line /] ;TYPE SOME
MOVE T1,THETTY ;GET THE TTY NUMBER
SUBI T1,.TTDES ;REMOVE OFFSET
CALL OCTOUT ;OUTPUT IT
JRST DOCRLF ;THEN FINISH WITH A CRLF
SUBTTL SUBROUTINE TO OUTPUT GENERAL INFORMATION ON A JOB
;THIS OUTPUTS STUFF AT THE END OF THE SINGLE JOB DISPLAY SUCH AS
;THE CONNECTED DIRECTORY, TIME LIMIT, DISK SPACE USED, ETC.
JOBSUM: TXOE F,FR.NDC ;CRLF NECESSARY?
CRLF ;YES, TYPE ONE
STR$ [ASCIZ/Job started: /] ;TYPE SOME TEXT
SKIPN T2,BLK+.JISTM ;GET JOB STARTUP TIME IF THERE
MOVE T2,BLK+.JILLN ;OTHERWISE GET LAST LOGIN TIME
SKIPGE T2 ;IS THE TIME KNOWN?
MOVE T2,BEGTIM ;NO, USE SYSTEM STARTUP TIME
HRROI T1,TEMP ;POINT TO BUFFER
SETZ T3, ;NORMAL OUTPUT
ODTIM ;CONVERT TO ASCIZ
STR$ TEMP ;THEN OUTPUT IT
STR$ [ASCIZ/ Time limit: /] ;MORE
SKIPN T1,BLK+.JIRTL ;ANY RUN TIME LIMIT?
STR$ [ASCIZ/None/] ;NO, SAY SO
IDIVI T1,^D1000 ;CONVERT TO SECONDS
SKIPN T1 ;ANY TIME?
SKIPE T2 ;OR EVEN REMAINDER?
CALL TIMOUT ;YES, OUTPUT IT
CALL DOCRLF ;TYPE A CRLF
CALL TYPRSC ;TYPE THE RSCAN BUFFER FOR THE JOB
STR$ [ASCIZ/Connected directory: /] ;MORE OUTPUT
MOVE T1,BLK+.JIDNO ;GET CONNECTED DIRECTORY
SETZ T2, ;WANT ALL OF OUTPUT
CALL USROUT ;OUTPUT IT
MOVE T1,BLK+.JIDNO ;GET READY
GTDAL ;READ DIRECTORY DATA
ERJMP DOCRLF ;FAILED
MOVEM T1,TEMP ;SAVE WORKING QUOTA
MOVEM T3,TEMP+1 ;AND PERMANENT QUOTA
STR$ [ASCIZ/
Used pages: /] ;TYPE MORE
MOVE T1,T2 ;GET CURRENT ALLOCATION
CALL DECOUT ;OUTPUT IT
STR$ [ASCIZ/ Working quota: /] ;MORE
MOVE T1,TEMP ;GET QUOTA
CALL INFOUT ;OUTPUT IT
STR$ [ASCIZ/ Permanent quota: /] ;MORE
MOVE T1,TEMP+1 ;GET QUOTA
CALL INFOUT ;OUTPUT IT
JRST DOCRLF ;TYPE A CRLF
SUBTTL ROUTINE TO SHOW FORK STATUS
;THIS ROUTINE IS CALLED WITH A JOB NUMBER IN AC J, TO FIND THE
;FORKS IN THE JOB AND GIVE A STATUS OF EACH ONE. THIS REQUIRES
;THAT THE MONRD% JSYS BE WORKING.
DOFORK: TXNN F,FR.JSY ;IS THE JSYS THERE?
RET ;NO, RETURN
MOVEI T1,TP.FRK ;THIS IS FORK OUTPUT
CALL HDRSET ;SO SET UP HEADER AND TAB STOPS
MOVE T1,SKPFRK ;GET NUMBER OF FORKS TO SKIP
MOVEM T1,EATNUM ;REMEMBER NUMBER
SETOM JOBFRK ;INITIALIZE JOB FORK INDEX
FRKLOP: AOS T2,JOBFRK ;GET NEXT JOB FORK NUMBER
CAMGE T2,NUFKS ;DID THEM ALL?
CALL FULL ;OR IS SCREEN FULL?
RET ;YES, RETURN
MOVE T1,['SYSFK '] ;WANT TO READ SYSTEM FORK TABLE
CALL GETJSB ;READ WORD
JRST FRKLOP ;FAILED, DO NEXT ONE
JUMPL T2,FRKLOP ;IF NEGATIVE, FORK NOT IN USE
MOVEM T2,SYSFK ;SAVE BITS FOR LATER USE
HRRZ T1,T2 ;KEEP ONLY RIGHT HALF
CAIE T1,-1 ;IS THIS FORK ASSIGNED?
SOSL EATNUM ;AND WE HAVE NO LINES TO EAT?
JRST FRKLOP ;NO, DO NEXT ONE
MOVEM T1,FORK ;SAVE SYSTEM FORK NUMBER
SETZM HAVPC ;WE NEED NEW PC'S FOR THE FORK
SETZM HAVID ;AND NEW ID'S FOR THE FORK
CALL DOCOLS ;DO ALL OF THE COLUMNS
JRST FRKLOP ;THEN DO NEXT FORK
;THE ROUTINES TO HANDLE THE VARIOUS COLUMN OUTPUTS:
XXFORK: MOVE T1,FORK ;GET FORK NUMBER
JRST OCTOUT ;OUTPUT IT AND RETURN
XXSUP: MOVE T1,JOBFRK ;GET JOB FORK NUMBER
CALL GETSUP ;FIND THE SUPERIOR
RET ;FAILED
CAMN T1,FORK ;IS OUR SUPERIOR US?
STR$ [ASCIZ/--/] ;YES, INDICATE THAT
CAME T1,FORK ;WELL?
JRST OCTOUT ;NO, THEN OUTPUT THE FORK WHICH IS
RET ;DONE
XXUPC: CALL GETPC ;READ ALL PC INFORMATION
RET ;FAILED
MOVE T1,USERPC ;GET THE USER PC
JRST PCOUT ;AND OUTPUT IT
XXMPC: CALL GETPC ;READ THE PC INFORMATION
RET ;FAILED
MOVE T1,PC ;GET THE PROCESS PC
MOVE T2,PCFLAG ;AND THE CORRESPONDING FLAGS
TLNN T2,(1B5) ;IS THE FORK IN MONITOR MODE?
JRST PCOUT ;YES, OUTPUT THE MONITOR PC
STR$ [ASCIZ/ --/] ;OTHERWISE TYPE DASHES
RET ;AND RETURN
XXSCHD: MOVEI T1,.RDFST ;GET FUNCTION FOR SCHEDULER TEST
MOVE T2,FORK ;AND FORK NUMBER
MONRD% ;GET THE SCHEDULER TEST
ERJMP CPOPJ ;FAILED
JUMPL T1,CPOPJ ;ALSO FAILED
HRRZM T2,TEMP ;SAVE THE ADDRESS
HLRZ T1,T2 ;GET THE DATA
CALL OCTSP6 ;OUTPUT IN A FIELD OF 6
STR$ [ASCIZ/,,/] ;THEN SOME COMMAS
MOVE T1,TEMP ;GET BACK ADDRESS
JRST SYMOUT ;OUTPUT AS MONITOR SYMBOL
XXCORE: CALL GETID ;GO READ ALL PAGE IDENTIES
RET ;FAILED
JRST TYPID ;THEN TYPE IT OUT AND RETURN
XXPRIV: JRST GETPRV ;GO TYPE PRIVILEGES
XXCALL: CALL GETPC ;OBTAIN ALL PC INFO
RET ;FAILED
MOVE T1,PCFLAG ;GET THE PC FLAGS
TLNN T1,(1B5) ;WAS HE IN USER MODE?
CHI$ "*" ;NO, TYPE A STAR
TLNE T1,(1B5) ;WELL?
SPACE ;YES, TYPE A SPACE
MOVE T1,['KIMUU1'] ;GET READY
CALL GETPS0 ;READ FIRST PART OF MUUO
RET ;CAN'T
MOVEM T1,TEMP ;SAVE THE OPCODE PART
MOVE T1,['KIMUU1'] ;GET READY AGAIN
MOVEI T2,1 ;OFFSET OF 1
CALL GETPSB ;GET OTHER PART
RET ;FAILED
HRL T1,TEMP ;GET BACK OTHER PART OF MUUO
JRST UUOOUT ;OUTPUT IT AND RETURN
XXFFLG: SPACE ;SPACE OVER FIRST
MOVE T1,SYSFK ;GET FORK FLAGS
TXNN T1,SFNVG ;VIRGIN FORK?
CHI$ "V" ;YES, SAY SO
TXNE T1,SFEXO ;EXECUTE ONLY?
CHI$ "E" ;YES, SAY SO
TXNE T1,SFGXO ;DOING A GET OF EXECUTE ONLY PROG?
CHI$ "G" ;YES, SAY SO
RET ;DONE
XXINTD: MOVE T1,['INTDF '] ;GET READY
CALL GETPS0 ;READ THE INTERRUPT DEFER COUNTER
RET ;CAN'T
JRST DECSP3 ;OUTPUT IT
XXTRPC: MOVE T1,['TRAPPC'] ;GET READY
CALL GETPS0 ;READ THE PC OF THE PAGE FAULT
RET ;FAILED
MOVEM T1,TEMP ;SAVE FOR AWHILE
MOVE T1,['TRAPPC'] ;NOW GET READY TO READ FLAGS
SETO T2, ;WHICH ARE IN PREVIOUS WORD
CALL GETPSB ;GET THEM
RET ;FAILED
TXNE T1,1B5 ;WAS THIS IN USER OR EXEC MODE?
SPACE ;USER MODE, JUST SPACE
TXNN T1,1B5 ;WELL?
CHI$ "*" ;EXEC MODE, SAY SO
MOVE T1,TEMP ;GET BACK THE PC
JRST PCOUT ;AND OUTPUT IT
XXSTAT: MOVEI T1,.RDSTS ;GET READY
MOVE T2,FORK ;TO READ STATUS OF FORK
MONRD% ;DO IT
ERJMP CPOPJ ;FAILED
JUMPN T1,CPOPJ ;AS I SAID
MOVE T1,T2 ;PUT RESULT IN RIGHT AC
JRST FRKSTS ;OUTPUT IT
XXTRAP: MOVE T1,['UTRPCT'] ;GET READY
CALL GETPS0 ;READ NUMBER OF PAGE TRAPS
RET ;CAN'T
JRST DECSP4 ;OUTPUT THEM
XXRUN: MOVE T1,['FKRT '] ;GET READY
CALL GETPS0 ;READ FORK'S RUN TIME
RET ;FAILED
IDIVI T1,^D1000 ;CONVERT TO SECONDS
PUSH P,T2 ;SAVE REMAINDER
CALL TIMSPC ;OUTPUT IT
POP P,T1 ;RESTORE REMAINDER
IDIVI T1,^D100 ;GET TENTHS OF A SECOND
CHI$ "." ;TYPE A DOT
CHI$ "0"(T1) ;THEN GIVE TENTHS
RET ;DONE
XXLERR: MOVE T1,['LSTERR'] ;GET THE SYMBOL NAME READY
CALL GETPS0 ;READ IT
RET ;FAILED
JRST ERROUT ;OUTPUT IT AND RETURN
XXWSIZ: MOVEI T1,.RDWSP ;GET FUNCTION CODE
MOVE T2,FORK ;AND FORK NUMBER
MONRD% ;READ THE DATA
ERJMP CPOPJ ;FAILED
JUMPL T1,CPOPJ ;ALSO FAILED
HRRZ T1,T2 ;MOVE TO RIGHT AC
CALL DECSP3 ;OUTPUT IT
CALL GETID ;THEN READ THE IDS OF THE FORK
RET ;CAN'T GET THEM
CHI$ "/" ;TYPE A SLASH TO SEPARATE NUMBERS
MOVE T1,IDPGS ;GET TOTAL PAGES IN USE BY FORK
JRST DECOUT ;AND OUTPUT IT
SUBTTL SUBROUTINES TO READ JSB OR PSB WORDS OF OTHER JOBS
;SUBROUTINE TO READ A WORD FROM THE PSB OF A FORK. CALLED WITH THE
;SIXBIT NAME OF THE WORD IN T1, THE OFFSET IN T2, AND THE FORK
;NUMBER IN FORK. SKIP RETURN IF SUCCESSFUL, WITH VALUE RETURNED IN T1.
;CALL AT GETPS0 IF OFFSET IS ZERO.
GETPS0: SETZ T2, ;CLEAR OFFSET
GETPSB: MOVE T3,T2 ;MOVE OFFSET TO RIGHT AC
MOVE T2,T1 ;MOVE SIXBIT WORD TO RIGHT AC
MOVEI T1,.RDPSB ;SET UP FUNCTION CODE FOR PSB
MOVE T4,FORK ;GET FORK NUMBER
DOMONR: MONRD% ;ASK MONITOR TO READ DATA
ERJMP CPOPJ ;NO SUCH JSYS, FAIL RETURN
SKIPN T1 ;DID IT WORK?
AOS (P) ;YES, SET FOR SKIP RETURN
MOVE T1,T2 ;COPY DATA TO T1
RET ;DONE
;SUBROUTINE TO READ WORDS FROM JSB. SIXBIT NAME OF WORD GOES
;IN T1, THE OFFSET IN T2, AND THE JOB NUMBER IN J. SKIP RETURN IF
;SUCCESSFUL, WITH VALUE RETURNED IN T1. CALLED AT GETJS0 IF THE
;OFFSET IS ZERO.
GETJS0: SETZ T2, ;SET OFFSET TO ZERO
GETJSB: MOVE T3,T2 ;MOVE TO RIGHT AC
MOVE T2,T1 ;AND SYMBOL
MOVEI T1,.RDJSB ;READ JSB FUNCTION
MOVE T4,J ;JOB NUMBER TO READ
JRST DOMONR ;GO READ DATA
SUBTTL SUBROUTINE TO OBTAIN THE USER AND EXEC PC OF A FORK
;CALLED WITH THE FORK NUMBER IN LOCATION FORK, TO FIND THE
;USER MODE AND EXEC MODE PC OF A FORK. SINCE THIS IS CALLED SEVERAL
;TIMES, WE DO NOT RECOMPUTE THE PC IF THE FLAG HAVPC IS SET. SO
;THIS MUST BE CLEARED WHENEVER A NEW PC IS TO BE OBTAINED.
;VALUES RETURNED ARE:
;
;PC THE CURRENT PROCESS PC WITHOUT FLAGS (CAN BE EITHER USER OR EXEC MODE)
;PCFLAG THE FLAGS CORRESPONDING TO PC. USER MODE SET IF THIS IS A USER PC.
;USERPC THE CURRENT USER MODE PC. SAME AS PC UNLESS DOING A MONITOR CALL.
GETPC: SKIPE HAVPC ;DO WE ALREADY HAVE THE PC INFO?
RETSKP ;YES, SKIP RETURN
MOVSI T1,'PPC' ;GET READY TO READ PROCESS PC
CALL GETPS0 ;DO IT
RET ;FAILED
MOVEM T1,PC ;SAVE THE PC
MOVEM T1,USERPC ;HERE TOO UNTIL PROVED WRONG
MOVSI T1,'PPC' ;NOW GET SET TO READ THE PC FLAGS
SETO T2, ;WHICH ARE JUST BEFORE THE PC
CALL GETPSB ;GET THEM
RET ;FAILED
MOVEM T1,PCFLAG ;SAVE THEM
TLNE T1,(1B5) ;IS THE PROCESS PC IN USER MODE?
JRST GETPCY ;YES, ALL DONE
MOVE T1,['UPDL '] ;NO, THEN USER PC IS ON THE STACK
CALL GETPS0 ;READ THE REAL USER PC
RET ;FAILED
MOVEM T1,USERPC ;SAVE IT
GETPCY: SETOM HAVPC ;ALL PC INFO OK NOW
RETSKP ;GOOD RETURN
SUBTTL ROUTINE TO TYPE OUT A FORK'S CAPABILITIES
;CALLED WITH THE FORK INDEX IN FORK, TO TYPE OUT THE CAPABILITIES OF
;A FORK, WHETHER OR NOT THEY ARE ENABLED. SKIP RETURN IF SUCCESSFUL.
GETPRV: MOVE T1,['CAPMSK'] ;GET READY
CALL GETPS0 ;READ POSSIBLE CAPABILITIES
RET ;ERROR
HRRZM T1,TEMP ;SAVE FOR LATER
MOVE T1,['CAPENB'] ;GET READY
CALL GETPS0 ;READ ENABLED CAPABILITIES
RET ;FAILED
ANDCAM T1,TEMP ;ZAP POSSIBLE CAPABILITES WHICH ARE ENABLED
CALL TYPPRV ;TYPE OUT ENABLED PRIVILEGES
SKIPN T1,TEMP ;NOW GET BACK POSSIBLE CAPABILITIES
RET ;NONE, DONE
CHI$ "/" ;SEPARATE WITH A SLASH
;FALL INTO TYPEOUT ROUTINE
;TRIVIAL ROUTINE TO TYPE OUT LETTERS INDICATING WHICH PRIVS ARE THERE.
;ONLY THE MOST IMPORTANT PRIVILEGES ARE TYPED OUT HERE.
TYPPRV: TRNE T1,SC%WHL ;WHEEL?
CHI$ "W" ;YES
TRNE T1,SC%OPR ;OPERATOR?
CHI$ "O" ;YES
TRNE T1,SC%MNT ;MAINTAINANCE PRIVILEGES?
CHI$ "M" ;YES
TRNE T1,-1-<SC%WHL!SC%OPR!SC%MNT> ;ANY OTHERS?
CHI$ "+" ;YES, SAY SO
RET ;DONE
SUBTTL SUBROUTINE TO FIND THE SUPERIOR OF A FORK
;CALLED WITH THE JOB NUMBER IN J, AND THE JOB FORK NUMBER IN T1, TO
;FIND OUT WHAT THE SUPERIOR OF THE FORK IS. SKIP RETURN IF SUCCESSFUL,
;WITH SYSTEM FORK IN T1. CALL AT FNDFRK TO CONVERT JOB FORK NUMBER
;TO SYSTEM FORK NUMBER.
GETSUP: MOVE T2,T1 ;COPY TO RIGHT AC
MOVE T1,['FKPTRS'] ;THE FORK STRUCTURE TABLE
CALL GETJSB ;READ WORD FROM JSB
RET ;FAILED
LDB T2,[POINT 12,T2,11] ;GET FORK NUMBER OF SUPERIOR
FNDFRK: CAML T2,NUFKS ;MAKE SURE IT IS LEGAL
RET ;NO, ERROR
MOVE T1,['SYSFK '] ;WANT TO GET SYSTEM FORK NUMBER
CALL GETJSB ;READ IT
RET ;FAILED
HRRZ T1,T2 ;KEEP ONLY RIGHT HALF
CAIE T1,-1 ;A REAL FORK?
AOS (P) ;YES, GOOD RETURN
RET ;DONE
SUBTTL SUBROUTINE TO FIND THE JOB NUMBER A FORK BELONGS TO
;CALLED WITH A FORK NUMBER IN T1, TO RETURN THE JOB NUMBER THAT FORK
;BELONGS TO. TO SPEED UP SUCCESSIVE CALLS WITH THE SAME FORK NUMBER,
;WE ONLY DO THE WORK IF LOCATION KWNJOB IS NONNEGATIVE. SKIP
;RETURN IF SUCCESSFUL.
FRKJOB: SKIPL KWNJOB ;DO WE ALREADY KNOW THE JOB NUMBER?
JRST FRKJBY ;YES, GO GET IT
MOVEM T1,FORK ;SAVE THE FORK NUMBER
MOVE T1,['JOBNO '] ;WORD CONTAINING THE JOB NUMBER
CALL GETPS0 ;READ IT
RET ;FAILED
MOVEM T1,KWNJOB ;SAVE JOB FOR LATER USE
RETSKP ;GOOD RETURN
FRKJBY: MOVE T1,KWNJOB ;GET THE JOB NUMBER
RETSKP ;GOOD RETURN
SUBTTL SUBROUTINE TO COMPUTE WHAT A FORK'S PAGES ARE
;CALLED WITH FORK NUMBER IN LOCATION FORK, TO CONSTRUCT A TABLE AT
;IDTVAL WHICH CONTAINS THE IDENTITIES OF THE PAGES OF THE FORK. THE
;TABLE WILL CONTAIN EITHER FORK NUMBERS OR NEGATIVE OFNS. SKIP
;RETURN IF SUCCESSFUL, WITH NUMBER OF IDENTITIES IN IDNUM. SINCE THIS IS
;CALLED SEVERAL TIMES, WE SAVE TIME IF WE HAVE BEEN CALLED BEFORE.
GETID: SKIPE HAVID ;ALREADY COLLECTED THE ID'S?
RETSKP ;YES, ALL DONE
SETOM IDPAG ;INITIALIZE CURRENT PAGE
SETZM IDNUM ;AND NUMBER OF DIFFERENT IDENTITIES
SETZM IDPGS ;AND TOTAL NUMBER OF PAGES
IDLOP: AOS T2,IDPAG ;INCREMENT TO NEXT PAGE
TRNE T2,777000 ;WENT OFF OF END?
JRST IDDONE ;YES, HAVE ALL IDS THEN
MOVEI T1,.RDMAP ;FUNCTION TO READ MAP WORD OF FORK
MOVE T3,FORK ;GET FORK HANDLE
MONRD% ;READ THE POINTER FOR THAT PAGE
ERJMP CPOPJ ;FAILED
JUMPL T1,CPOPJ ;ALSO FAILED
TLNN T2,-1 ;IS THIS PAGE NONEXISTANT?
JRST IDNONX ;YES, SEE WHAT TO DO
TLC T2,300000 ;GET READY FOR CHECK
TLCN T2,300000 ;IS THIS A PRIVATE OR SHARED PAGE?
TRNE T2,400000 ;OR INDIRECT TO A FILE?
AOS IDPGS ;YES, COUNT UP TOTAL PAGES FOR FORK
TLNN T2,200000 ;IS THIS A PRIVATE PAGE?
SKIPA T1,[1B0] ;YES, REMEMBER THAT
HRREI T1,(T2) ;NO, GET FORK OR -OFN BY ITSELF
HRLZ T2,IDNUM ;GET CURRENT NUMBER OF TABLE ENTRIES
JUMPE T2,IDNEW ;IF NONE, INSERT THIS ONE
MOVN T2,T2 ;TURN INTO AOBJN POINTER
CAME T1,IDVALS(T2) ;FOUND THIS IDENTITY?
AOBJN T2,.-1 ;NOT YET, KEEP LOOKING
JUMPGE T2,IDNEW ;NOT IN TABLE, GO INSERT IT
AOS IDCNTS(T2) ;FOUND IT, INCREMENT COUNTER
JRST IDLOP ;AND GO BACK TO LOOP
;HERE WHEN THE CURRENT PAGE IS NONEXISTANT:
IDNONX: SUBI T2,1 ;DECREMENT PAGE SINCE AOS'D ABOVE
MOVEM T2,IDPAG ;SAVE NEW PAGE TO START LOOP AT
JUMPGE T2,IDLOP ;GO BACK TO LOOP IF NOT YET DONE
IDDONE: SETOM HAVID ;SAY WE HAVE THE ID'S
RETSKP ;GOOD RETURN
;HERE WHEN THE IDENTITY WASN'T IN THE TABLE PREVIOUSLY, TO INSERT IT:
IDNEW: MOVEM T1,IDVALS(T2) ;SAVE THIS NEW IDENTITY
MOVEI T1,1 ;GET AN INITIAL COUNT
MOVEM T1,IDCNTS(T2) ;AND SET IT
AOS IDNUM ;INCREMENT NUMBER OF IDENTITIES IN TABLE
JRST IDLOP ;AND LOOP
SUBTTL SUBROUTINE TO TYPE OUT THE PAGE ID'S OF A FORK
;CALLED AFTER COLLECTION OF THE PAGE IDENTITIES OF A FORK, TO SCAN
;THEM AND TYPE OUT THE MOST COMMON ONES. THE TYPEOUT SHOWS WHICH
;FORKS WE ARE MAPPED INTO, AND WHICH OFNS WE ARE MAPPED TO.
TYPID: MOVEI T1,MAXID ;GET MAXIMUM NUMBER OF ID'S ALLOWED
CAMGE T1,IDNUM ;ACTUAL NUMBER LESS THAN THIS?
TXNN F,FR.MOR ;OR NO MORE COLUMNS COMING?
MOVE T1,IDNUM ;YES, GET ACTUAL NUMBER THEN
JUMPE T1,CPOPJ ;IF NONE THERE RETURN
MOVEM T1,IDYNM ;SAVE NUMBER TO BE TYPED
TXZ F,FR.TMP ;CLEAR FLAG
IDTYPL: SETZB T1,T2 ;INITIALIZE INDEX AND MAXIMUM COUNT
SOSL IDYNM ;SEE IF TYPED ALL INDENTITIES YET
JRST IDSRCL ;NO, GO GET NEXT ONE
TXNN F,FR.MOR ;MORE COLUMNS COMING?
RET ;NO, THEN WE TYPED EVERYTHING
MOVE T1,IDNUM ;GET TOTAL NUMBER OF ENTRIES
CAILE T1,MAXID ;MORE THAN WE TYPED?
CHI$ "+" ;YES, SAY THERE ARE EVEN MORE
RET ;DONE
IDSRCL: CAML T2,IDCNTS(T1) ;FOUND AN ENTRY WITH HIGHER COUNT?
JRST IDSRCN ;NO, KEEP LOOKING
MOVE T2,IDCNTS(T1) ;YES, REMEMBER NEW MAXIMUM
MOVE T3,T1 ;AND INDEX OF THE ENTRY
IDSRCN: ADDI T1,1 ;ADVANCE TO NEXT ENTRY
CAMGE T1,IDNUM ;LOOKED AT ALL ENTRIES?
JRST IDSRCL ;NO, KEEP LOOPING
SETZM IDCNTS(T3) ;CLEAR COUNT SO WON'T SEE THIS AGAIN
TXOE F,FR.TMP ;ALREADY TYPED ONE IDENTITY?
CHI$ "+" ;YES, TYPE A COMMA FIRST
SKIPL T1,IDVALS(T3) ;GET THE IDENTITY AND SEE IF IT IS A FORK
CHI$ "F" ;YES, THEN TYPE PRECEEDING LETTER
CAMN T1,[1B0] ;IS IT A PRIVATE PAGE?
JRST [CHI$ "P" ;YES, SAY IT IS PRIVATE
JRST IDTYPL] ;CONTINUE LOOPING
MOVM T1,T1 ;MAKE IT POSITIVE
CALL OCTOUT ;THEN OUTPUT EITHER FORK OR OFN NUMBER
JRST IDTYPL ;AND LOOP
SUBTTL ROUTINE TO SHOW JFN STATUS
;THIS ROUTINE IS CALLED WITH A JOB NUMBER IN AC J, TO FIND
;THE JFNS WHICH ARE IN USE BY THE JOB. THIS ROUTINE REQUIRES THAT
;THE MONRD% JSYS BE WORKING.
DOJFN: TXNN F,FR.JSY ;DOES THE JSYS EXIST?
RET ;NO, RETURN
MOVEI T1,TP.FIL ;THIS IS FILE TYPE OUTPUT
CALL HDRSET ;SO SET UP THE HEADER AND TAB STOPS
SETZM JFN ;INITIALIZE JFN NUMBER
MOVE T1,['MAXJFN'] ;GET READY
CALL GETJS0 ;READ HIGHEST JFN TO LOOK AT
RET ;CAN'T
MOVEM T1,MAXJFN ;SAVE IT
MOVE T1,SKPJFN ;GET NUMBER OF JFNS TO SKIP
MOVEM T1,EATNUM ;AND SAVE IT
JFNLOP: AOS T2,JFN ;ADVANCE TO NEXT JFN
CAMG T2,MAXJFN ;DONE WITH ALL JFNS YET?
CALL FULL ;OR IS SCREEN FULL?
RET ;YES, RETURN
MOVE T1,['FILSTS'] ;GET READY TO READ STATUS OF JFN
IMUL T2,MLJFN ;MULTIPLY JFN BY LENGTH OF JFN BLOCK
MOVEM T2,JFNOFF ;SAVE OFFSET FOR LATER USE
CALL GETJSB ;READ JFN STATUS
JRST JFNLOP ;FAILED, LOOK AT NEXT ONE
TXNE T1,GS%NAM!GS%ASG ;IS THIS JFN VALID?
SOSL EATNUM ;AND ARE WE DONE EATING LINES?
JRST JFNLOP ;NO, LOOK AT NEXT ONE
MOVEM T1,FILSTS ;YES, SAVE STATUS FOR LATER USE
CALL DOCOLS ;TYPE OUT LINE ABOUT JFN
JRST JFNLOP ;AND LOOP FOR NEXT ONE
;ROUTINES TO TYPE VARIOUS THINGS ABOUT FILES:
XXJFN: MOVE T1,JFN ;GET JFN
JRST OCTSP2 ;OUTPUT IT AND RETURN
XXOFN: MOVE T1,FILSTS ;GET FILE STATUS BITS
TXNN T1,GS%OPN ;IS THE FILE OPEN?
JRST OFNDSH ;NO, TYPE DASHES
MOVE T1,['FILDEV'] ;GET READY
MOVE T2,JFNOFF ;GET OFFSET TOO
CALL GETJSB ;READ DISPATCH ADDRESS FOR JFN
RET ;FAILED
HRRZ T1,T1 ;KEEP ONLY THE ADDRESS
CAME T1,DSKDTB ;IS THIS A DISK?
JRST OFNDSH ;NO, GO TYPE DASHES
MOVE T1,['FILOFN'] ;GET READY
MOVE T2,JFNOFF ;GET OFFSET
CALL GETJSB ;READ OFNS OF FILE
RET ;FAILED
HRRZ T4,T1 ;REMEMBER THE SUPER INDEX BLOCK OFN
HLRZ T1,T1 ;KEEP THE LOCAL OFN
JUMPE T1,OFNDSH ;IF ZERO, TYPE DASHES
CALL OCTSP3 ;OUTPUT THE OFN
JUMPE T4,CPOPJ ;DONE IF WASN'T A LONG FILE
CHI$ "/" ;SEPARATE THE OFNS
MOVE T1,T4 ;GET OTHER OFN
JRST OCTOUT ;OUTPUT THE SUPER INDEX BLOCK'S OFN
OFNDSH: STR$ [ASCIZ/ --/] ;SAY NO VALID OFN EXISTS
RET ;DONE
XXINIF: MOVE T1,['FILVER'] ;GET READY
MOVE T2,JFNOFF ;GET OFFSET
CALL GETJSB ;READ CREATOR OF JFN
RET ;FAILED
HLRZ T2,T1 ;GET FORK WHICH STARTED JFN
CALL FNDFRK ;CONVERT TO SYSTEM FORK NUMBER
STR$ [ASCIZ/--/] ;IF FORK NOT THERE, INDICATE THAT
CAIE T1,-1 ;WAS THERE A FORK?
JRST OCTOUT ;YES, OUTPUT IT
RET ;OTHERWISE DONE
XXBYTE: MOVE T1,['FILBYN'] ;GET READY
MOVE T2,JFNOFF ;GET OFFSET
CALL GETJSB ;READ BYTE NUMBER
RET ;FAILED
CALL DECOUT ;OUTPUT THE NUMBER
MOVE T1,['FILBYT'] ;GET READY
MOVE T2,JFNOFF ;SAME OFFSET
CALL GETJSB ;READ BYTE POINTER
RET ;FAILED
CHI$ "(" ;OUTPUT STARTING PARENTHESIS
LDB T1,[POINT 6,T1,11] ;GET SIZE OF BYTES
CALL DECOUT ;OUTPUT IT
CHI$ ")" ;THEN GIVE CLOSING PARENTHESIS
RET ;DONE
XXFSTA: MOVE T1,FILSTS ;GET BACK STATUS BITS
JRST TYPSTS ;THEN OUTPUT THEM
XXFILE: JRST TYPFIL ;OUTPUT THE FILE SPEC
SUBTTL SUBROUTINE TO TYPE OUT A FILE SPEC FOR A JFN
;ROUTINE TO TRACE THE DATA IN A JSB DOWN FOR A PARTICULAR JFN, AND
;TO TYPE OUT THE FULL FILE SPEC ASSOCIATED WITH THE JFN. CALLED WITH
;JFN OFFSET IN LOCATION JFNOFF.
TYPFIL: MOVE T1,['FILDDN'] ;POINTER TO DEVICE STRING
MOVE T2,JFNOFF ;OFFSET FOR THIS JFN
CALL GETJSB ;READ THE POINTER
RET ;CAN'T
HLRZ T1,T1 ;KEEP JUST THE POINTER
JUMPE T1,TYPFL1 ;IF NO DEVICE, SKIP ON
CALL TYPPTR ;TYPE OUT DEVICE
RET ;FAILED
CHI$ ":" ;TYPE COLON FOR THE DEVICE
TYPFL1: MOVE T1,['FILDNM'] ;GET READY TO READ DIRECTORY
MOVE T2,JFNOFF ;SAME OFFSET
CALL GETJSB ;READ POINTER
RET ;FAILED
HLRZ T1,T1 ;GET POINTER IN RIGHT HALF
JUMPE T1,TYPFL2 ;IF NO DIRECTORY, JUMP ON
CHI$ "<" ;TYPE STARTING BRACKET
CALL TYPPTR ;TYPE OUT THE DIRECTORY NUMBER
RET ;FAILED
CHI$ ">" ;FINISH DIRECTORY
TYPFL2: MOVE T1,['FILNEN'] ;GET READY
MOVE T2,JFNOFF ;AGAIN SAME OFFSET
CALL GETJSB ;READ THE POINTER WORD
RET ;FAILED
MOVEM T1,TXTTMP ;SAVE IT
HLRZ T1,T1 ;GET POINTER TO FILE NAME
CALL TYPPTR ;TYPE FILE NAME STRING
RET ;FAILED
MOVE T1,['FILVER'] ;GET READY
MOVE T2,JFNOFF ;SAME OFFSET
CALL GETJSB ;READ GENERATION NUMBER
RET ;FAILED
HRLM T1,TXTTMP ;SAVE GENERATION NUMBER
SKIPN T1,TXTTMP ;GET POINTER TO EXTENSION
RET ;IF NO EXTENSION OR GENERATION, DONE
CHI$ "." ;TYPE A DOT
CALL TYPPTR ;TYPE EXTENSION
RET ;FAILED
CHI$ "." ;ONE MORE DOT
HLRZ T1,TXTTMP ;GET GENERATION NUMBER BACK
CALL DECOUT ;OUTPUT THE VERSION
RETSKP ;GOOD RETURN
SUBTTL SUBROUTINE TO OUTPUT FILE STATUS INFORMATION
;CALLED WITH A JFN'S FILE STATUS BITS IN T1, TO OUTPUT INFORMATION
;ABOUT THE FILE. THE STATUS BITS IN THE MONITOR'S STATUS WORD ARE
;THE SAME AS RETURNED BY THE GTSTS JSYS.
TYPSTS: TXNN T1,GS%OPN ;IS FILE OPENED?
TXZ T1,GS%RDF+GS%WRF+GS%XCF+GS%RND ;NO, CLEAR THESE BITS
TXNE T1,GS%RDF ;OPEN FOR READ?
TXZ T1,GS%XCF ;YES, CLEAR EXECUTE ACCESS
TXNN T1,GS%OPN+GS%AST ;CAN FILE BE OPENED BUT ISN'T?
STR$ [ASCIZ/Nopen /] ;YES, SAY NOT OPENED
TXNE T1,GS%AST ;IS THE JFN PARSE ONLY?
STR$ [ASCIZ/Parse /] ;YES, SAY SO
TXNE T1,GS%RDF ;OPEN FOR READ?
STR$ [ASCIZ/Rd /] ;YES, SAY SO
MOVEI T2,[ASCIZ/Wrt /] ;GET STRING
TXNN T1,GS%RND ;APPEND ONLY?
MOVEI T2,[ASCIZ/App /] ;YES, GET OTHER TEXT
TXNE T1,GS%WRF ;OPEN FOR WRITE?
STR$ (T2) ;SAY, SAY SO
TXNE T1,GS%XCF ;OPEN FOR EXECUTE?
STR$ [ASCIZ/Xct /] ;YES, INDICATE THAT
TXNE T1,GS%FRK ;RESTRICTED JFN?
STR$ [ASCIZ/Res /] ;YES, SAY SO
TXNE T1,GS%EOF ;AT END OF FILE?
STR$ [ASCIZ/Eof /] ;SAY, INDICATE IT
TXNE T1,GS%ERR ;ANY ERRORS IN FILE?
STR$ [ASCIZ/Err /] ;YES, SAY SO
TXNN T1,GS%NAM ;ANY FILE FOUND FOR JFN?
STR$ [ASCIZ/Inv/] ;NO, SAY SPEC IS INVALID
RET ;DONE
SUBTTL DISPLAY FOR QUEUES
;THIS DISPLAY ROUTINE LISTS THE QUEUES. SET BY THE "Q" COMMAND.
;IPCF PACKETS ARE SENT TO QUASAR, AND THE RETURN MESSAGES ARE OUTPUT
;TO THE SCREEN. THUS THE FORMAT OF THE OUTPUT IS TOTALLY UP TO
;QUASAR.
DPYQUE: SETOM HDRTYP ;CLEAR HEADER TYPE
TAB$ ;USE DEFAULT TAB STOPS
TXNE F,FR.CMP!FR.INF ;COMPRESSED OUTPUT OR SHOWING INFO LINES?
JRST QUENOC ;YES, SKIP THIS
STR$ [ASCIZ/Queues as of /] ;TYPE SOME
HRROI T1,TEMP ;POINT TO TEMPORARY DATA
SETOB T2,T3 ;CURRENT TIME, VERBOSE OUTPUT
ODTIM ;COMPUTE AND STORE IT
STR$ TEMP ;THEN OUTPUT IT
STR$ [ASCIZ/
/] ;SPACE DOWN SOME
QUENOC: CALL GETPID ;GO OBTAIN PIDS FOR MYSELF AND QUASAR
JRST LOSE ;FAILED, GO COMPLAIN
CALL SETEAT ;GO SET UP HOW MANY LINES TO EAT
MOVEI T1,MBLK-1 ;POINT AT DATA BLOCK
PUSH T1,[0] ;NO FLAGS
PUSH T1,MYPID ;STORE SENDER
PUSH T1,QSRPID ;AND RECEIVER
PUSH T1,[XWD QSRLEN,QSRMSG] ;AND POINTER TO DATA
MOVEI T1,4 ;SIZE OF PACKET DESCRIPTER BLOCK
MOVEI T2,MBLK ;ADDRESS OF BLOCK
MSEND ;SEND THE PACKET TO QUASAR
ERJMP [SETZM QSRPID ;FAILED, CLEAR PID IN CASE NOT VALID
JRST LOSE] ;AND GO COMPLAIN
TXZ F,FR.TMP ;INITIALIZE FIRST TIME FLAG
;NOW READ THE REPLY FROM QUASAR AND TYPE IT:
RECLOP: MOVEI T1,MBLK-1 ;POINT AT DATA BLOCK
PUSH T1,[IP%CFV] ;SET UP FLAGS
PUSH T1,QSRPID ;INTENDED SENDER (IGNORED)
PUSH T1,MYPID ;AND RECEIVER
PUSH T1,[1000,,DATLOC/1000] ;AND POINTER TO DATA
MOVEI T1,4 ;LENGTH OF BLOCK
MOVEI T2,MBLK ;ADDRESS OF BLOCK
MRECV ;BLOCK UNTIL A MESSAGE IS RETURNED
ERJMP [SETZM QSRPID ;FAILED, CLEAR PID IN CASE NO LONGER VALID
JRST LOSE] ;AND SAY WHAT HAPPENED
MOVE T1,MBLK+.IPCFS ;GET PID WHO SENT TO US
CAME T1,QSRPID ;FROM QUASAR?
JRST RECLOP ;NO, IGNORE THE PACKET
MOVEI T1,DATLOC+.OHDRS ;POINT AT FIRST BLOCK
HLRZ T2,(T1) ;GET SIZE OF THE BLOCK
TXOE F,FR.TMP ;FIRST PAGE OF DATA?
JRST QUETYP ;NO, JUST TYPE THE STRING
ADDB T1,T2 ;MOVE TO BLOCK WE WANT
MOVEI T3,177 ;YES, GET SET TO EAT LEADING CRLFS
TLOA T2,(POINT 7,0,34) ;MAKE A BYTE POINTER
RUBSTR: DPB T3,T2 ;STORE A RUBOUT
ILDB T4,T2 ;GET NEXT CHARACTER
CAIE T4,15 ;CARRIAGE RETURN?
CAIN T4,12 ;OR LINE FEED?
JRST RUBSTR ;YES, GO REPLACE WITH RUBOUT
QUETYP: STR$ 1(T1) ;OUTPUT THE TEXT
MOVE T1,DATLOC+.OFLAG ;GET FLAGS
TXNE T1,WT.MOR ;MORE MESSAGES COMING?
JRST RECLOP ;YES, LOOP
RET ;NO, ALL DONE
SUBTTL ROUTINE TO OBTAIN ALL NECESSARY PIDS
;CALLED TO OBTAIN PIDS FOR SYSTEM INFO, QUASAR, AND MYSELF.
;SKIP RETURN IF SUCCESSFUL, NON-SKIP IF FAILED.
GETPID: SKIPE INFPID ;HAVE A PID FOR SYSTEM INFO?
JRST GETQSP ;YES, GO SEE ABOUT QUASAR
MOVEI T1,3 ;SIZE OF BLOCK
MOVEI T2,MBLK ;ADDRESS OF IT TOO
MOVEI T3,.MURSP ;FUNCTION TO READ SYSTEM PIDS
MOVEM T3,MBLK ;SET IT UP
MOVEI T3,.SPINF ;WANT TO GET SYSTEM INFO
MOVEM T3,MBLK+1 ;STORE IT
MUTIL ;DO THE WORK
ERJMP CPOPJ ;FAILED
MOVE T1,MBLK+2 ;GET THE PID
MOVEM T1,INFPID ;SAVE FOR LATER
GETQSP: SKIPE QSRPID ;DO WE HAVE QUASAR'S PID?
JRST GETMYP ;YES, GO SEE ABOUT MY OWN PID
MOVEI T1,3 ;SIZE OF ARGUMENT BLOCK
MOVEI T2,MBLK ;AND ADDRESS OF ARGUMENT BLOCK
MOVEI T3,.MURSP ;FUNCTION TO RETURN A PID
MOVEM T3,MBLK ;SET IT
MOVEI T3,.SPQSR ;CODE FOR QUASAR
MOVEM T3,MBLK+1 ;SET IT
MUTIL ;ASK MONITOR FOR THE PID
ERJMP CPOPJ ;FAILED, ERROR RETURN
MOVE T1,MBLK+2 ;GET THE PID
MOVEM T1,QSRPID ;AND REMEMBER IT FOR LATER
GETMYP: SKIPE MYPID ;SEE IF ALREADY HAVE OUR PID
RETSKP ;YES, GOOD RETURN
MOVEI T1,3 ;A FEW ARGUMENTS
MOVEI T2,MBLK ;NORMAL ARGUMENT BLOCK
MOVEI T3,.MUCRE ;FUNCTION TO CREATE A PID
MOVEM T3,MBLK ;SET IT UP
MOVEI T3,.FHSLF ;WANT A PID FOR MY PROCESS
MOVEM T3,MBLK+1 ;STORE THE ARGUMENT
MUTIL ;ASK TO HAVE A PID CREATED FOR US
ERJMP CPOPJ ;FAILED
MOVE T1,MBLK+2 ;GET THE PID THAT WAS OBTAINED
MOVEM T1,MYPID ;REMEMBER IT
RETSKP ;GOOD RETURN
SUBTTL DISPLAY ROUTINE TO TYPE PIDS ON THE SYSTEM
;CALLED TO DISPLAY INFORMATION ABOUT IPCF DATA SYSTEM-WIDE.
;MOST THINGS CAN BE OBTAINED BY THE MUTIL JSYS, BUT SOME THINGS
;NEED THE MONRD% JSYS TO DO.
DPYIPC: MOVEI T1,TP.IPC ;THIS IS IPCF DATA
CALL HDRSET ;SO SET UP THE HEADER
TXO F,FR.EAT ;DO EATING OF LINES AFTER HEADER
SETOM PIDJOB ;CLEAR JOB NUMBER FOR LOOP
SETOM OLDJOB ;CLEAR OLD JOB NUMBER TOO
IPCLOP: AOS T2,PIDJOB ;MOVE TO NEXT JOB
CAMG T2,HGHJOB ;DID ALL JOBS?
CALL FULL ;OR IS SCREEN FULL?
RET ;YES, DONE
MOVEM T2,PIDTAB+1 ;NO, SET JOB NUMBER IN BLOCK
MOVEI T1,PIDSIZ ;GET SIZE OF BLOCK
MOVEI T2,PIDTAB ;AND ADDRESS OF BLOCK
MOVEI T3,.MUFJP ;GET FUNCTION CODE
MOVEM T3,PIDTAB ;AND SET IT
MUTIL ;ASK MONITOR TO READ INFO
ERJMP IPCLOP ;FAILED, ASK ABOUT NEXT JOB
MOVEI J,PIDTAB ;POINT AT START OF PID LIST
PIDLOP: ADDI J,2 ;MOVE TO NEXT PID PAIR
SKIPN (J) ;ANOTHER PID TO SHOW?
JRST IPCLOP ;NO, GO DO NEXT JOB
CALL DOCOLS ;YES, SHOW INFO ON THIS PID
JRST PIDLOP ;THEN GO DO ANOTHER ONE
;HERE TO OUTPUT THE VARIOUS THINGS ABOUT EACH PID FOUND.
XXPIDJ: MOVE T1,PIDJOB ;GET JOB NUMBER THIS PID IS FROM
CAMN T1,OLDJOB ;SAME AS LAST TIME?
RET ;YES, RETURN
MOVEM T1,OLDJOB ;NO, SET IT
JRST DECSP2 ;AND OUTPUT IT
XXPID: HLRZ T1,0(J) ;GET LEFT HALF OF PID
CALL OCTSP6 ;OUTPUT IN FIELD OF 6
STR$ [ASCIZ/,,/] ;THEN COMMAS
HRRZ T1,0(J) ;GET RIGHT HALF OF PID
JRST OCTOUT ;OUTPUT IT AND RETURN
XXPIDF: MOVE T1,1(J) ;GET WORD OF FLAGS
TXNE T1,IP%JWP ;IS THIS A JOB-WIDE PID?
STR$ [ASCIZ/Job /] ;YES, SAY SO
TXNE T1,IP%NOA ;ACCESSIBLE BY OTHER PROCESSES?
STR$ [ASCIZ/Res /] ;NO, SAY SO
MOVE T1,[PD.FLG] ;GET BYTE POINTER
CALL PIDMON ;ASK MONITOR FOR DATA
RET ;FAILED
TXNE T1,PD%DIS ;IS THE PID DISABLED?
STR$ [ASCIZ/Dis/] ;YES, SAY SO
RET ;DONE
XXPQTA: MOVEI T1,3 ;THREE WORDS
MOVEI T2,MBLK ;POINT TO ARGUMENT BLOCK
MOVEI T3,.MUFSQ ;GET FUNCTION CODE
MOVEM T3,MBLK ;SET IT
MOVE T3,0(J) ;GET THE PID TO ASK ABOUT
MOVEM T3,MBLK+1 ;STORE AS ARGUMENT
MUTIL ;ASK MONITOR ABOUT THE PID
ERJMP CPOPJ ;FAILED
LDB T1,[POINT 9,MBLK+2,26] ;GET SEND QUOTA
CALL DECSP4 ;OUTPUT IT
CHI$ "/" ;TYPE A SLASH
LDB T1,[POINT 9,MBLK+2,35] ;GET RECEIVE QUOTA
JRST DECOUT ;OUTPUT IT AND RETURN
XXSYSP: CALL SYSPID ;READ ALL OF THE SYSTEM PIDS
MOVE T1,0(J) ;GET THE PID
MOVSI T2,-PIDNUM ;AND A COUNTER FOR LOOPING
CAME T1,PIDSYS(T2) ;FOUND THE PID YET?
AOBJN T2,.-1 ;NO, KEEP SEARCHING
JUMPGE T2,CPOPJ ;RETURN IF NOT A SYSTEM PID
STR$ [ASCIZ/ /] ;SPACE OVER SOME
STR$ @PIDNAM(T2) ;OUTPUT THE NAME OF THIS PID
RET ;DONE
;TABLE OF SYSTEM PID NAMES:
PIDNAM: EXP [ASCIZ/IPCC/] ;(0) SYSTEM IPCC
EXP [ASCIZ/INFO/] ;(1) <SYSTEM>INFO
EXP [ASCIZ/QUASAR/] ;(2) QUEUEING SYSTEM CONTROLLER
EXP [ASCIZ/QSRMDA/] ;(3) MOUNTABLE DEVICE ALLOCATOR
EXP [ASCIZ/ORION/] ;(4) OPERATOR SERVICE PROGRAM
EXP [ASCIZ/NETCON/] ;(5) DECNET CONTROLLER
PIDNUM==.-PIDNAM ;NUMBER OF ENTRIES
XXPPRG: HRLZ T1,PIDJOB ;GET JOB NUMBER
HRRI T1,.JOBPN ;INDEX FOR PROGRAM NAME
GETAB ;GET IT
ERJMP CPOPJ ;FAILED
JRST SIXOUT ;OUTPUT IN SIXBIT
XXRECC: MOVE T1,[PD.CNT] ;GET POINTER TO OUTSTANDING PACKETS
CALL PIDMON ;ASK MONITOR FOR DATA
RET ;FAILED
JRST OCTSP4 ;OUTPUT AND RETURN
XXPOWN: MOVE T1,[PD.FKO] ;GET OWNER FORK POINTER
CALL PIDMON ;ASK MONITOR FOR DATA
RET ;FAILED
JRST OCTSP3 ;OUTPUT IT
XXPDWT: MOVE T1,[PD.FKW] ;GET FORK WAIT FIELD
CALL PIDMON ;ASK MONITOR FOR DATA
RET ;FAILED
CAIN T1,-1 ;NO FORK IN A WAIT?
STR$ [ASCIZ/--/] ;YES, SAY SO
CAIE T1,-1 ;WELL?
JRST OCTOUT ;YES, GO OUTPUT IT
RET ;DONE
;LOCAL SUBROUTINE TO READ DATA ABOUT A PID BY USE OF MONRD% JSYS.
;BYTE POINTER TO DATA IS IN T1. RETURNS VALUE IN T1 IF SUCCESSFUL.
;NON-SKIP IF FAIL.
PIDMON: HRRZ T3,T1 ;PUT OFFSET IN RIGHT PLACE
HLLZ T4,T1 ;SAVE BYTE POINTER
MOVEI T1,.RDPID ;FUNCTION CODE
MOVE T2,0(J) ;GET PID TO READ DATA OF
MONRD% ;DO THE WORK
ERJMP CPOPJ ;FAILED
JUMPL T1,CPOPJ ;ALSO FAILED
HRRI T4,T2 ;MAKE BYTE POINTER POINT TO DATA
LDB T1,T4 ;GET THE DATA
RETSKP ;GOOD RETURN
XXPNAM: CALL GETPID ;OBTAIN A PID FOR MYSELF
RET ;FAILED, CAN'T FIND NAME
MOVEI T1,MBLK-1 ;POINT AT ARGUMENT BLOCK
PUSH T1,[0] ;NO FLAGS
PUSH T1,MYPID ;SET MY PID AS THE SENDER
PUSH T1,[0] ;RECEIVER IS SYSTEM INFO
PUSH T1,[3,,INFMSG] ;POINT AT DATA TO SEND
MOVE T1,0(J) ;GET THE PID TO ASK ABOUT
MOVEM T1,INFDAT ;SET AS DATA FOR SYSTEM INFO
MOVEI T1,4 ;LENGTH OF ARGUMENT BLOCK
MOVEI T2,MBLK ;ADDRESS
MSEND ;SEND THE PACKET
ERJMP LOSE ;FAILED
INFREC: MOVE T1,[TEMP,,TEMP+1] ;GET SET
SETZM TEMP ;TO CLEAR SOME WORDS
BLT T1,TEMP+TMPSIZ-1 ;DO IT
MOVEI T1,MBLK-1 ;POINT AT DATA BLOCK
PUSH T1,[0] ;NO FLAGS
PUSH T1,[0] ;SENDER IS IGNORED
PUSH T1,MYPID ;MY PID IS THE RECEIVER
PUSH T1,[TMPSIZ,,TEMP] ;PLACE TO STORE ANSWER
MOVEI T1,4 ;GET LENGTH
MOVEI T2,MBLK ;AND ADDRESS OF BLOCK
MRECV ;RECEIVE THE ANSWER
ERJMP LOSE ;FAILED
MOVE T1,MBLK+.IPCFS ;GET SENDER
CAME T1,INFPID ;IS IT FROM SYSTEM INFO?
JRST INFREC ;NO, IGNORE IT
TXNE F,FR.MOR ;ANY MORE COLUMNS COMING?
SETZM TEMP+5 ;YES, THEN RESTRICT THE NAME
STR$ TEMP+1 ;OUTPUT THE NAME
RET ;DONE
SUBTTL SUBROUTINE TO READ ALL SYSTEM PIDS
;CALLED TO OBTAIN THE SYSTEM PIDS AND STORE THEM IN A TABLE FOR
;LATER USE. ANY PID WHICH DOES NOT EXIST WILL BE ZERO.
SYSPID: MOVEI T1,.MURSP ;FUNCTION TO READ SYSTEM PID TABLE
MOVEM T1,MBLK ;SET IT
SETOM MBLK+1 ;AND INITIALIZE OFFSET
SYSPIL: AOS T1,MBLK+1 ;ADVANCE TO THE NEXT OFFSET
CAIL T1,PIDNUM ;DID ALL KNOWN SYSTEM PIDS?
RET ;YES, DONE
SETZM PIDSYS(T1) ;CLEAR WORD IN CASE MUTIL FAILS
MOVEI T1,3 ;SIZE OF ARGUMENT BLOCK
MOVEI T2,MBLK ;ADDRESS OF THE BLOCK
MUTIL ;READ THE PID VALUE
ERJMP SYSPIL ;FAILED, TRY NEXT ONE
DMOVE T1,MBLK+1 ;GET THE OFFSET AND THE PID
MOVEM T2,PIDSYS(T1) ;REMEMBER THE PID
JRST SYSPIL ;LOOP
SUBTTL DISPLAY FOR DISK STATUS
;THIS DISPLAY TYPES OUT THE STATUS OF ALL THE DISK DRIVES ON THE
;SYSTEM. UNFORTUNATELY, THIS CURRENTLY REQUIRES WHEEL PRIVILEGES
;TO WORK. ONLY USES THE MSTR JSYS.
DPYDSK: CALL DOSTR ;GO TYPE THE STATUS OF ALL STRUCTURES
MOVEI T1,TP.DSK ;THIS IS THE DISK OUTPUT DISPLAY
CALL HDRSET ;SO SET UP HEADERS AND TAB STOPS
TXO F,FR.EAT ;REMEMBER TO SET UP EATING LATER
SETOM SBLK+.MSRCH ;INITIALIZE CHANNEL NUMBER
SETOM SBLK+.MSRCT ;CONTROLLER NUMBER
SETOM SBLK+.MSRUN ;AND UNIT NUMBER
DSKLOP: HRROI T1,STRUC ;GET POINTER TO STRUCTURE NAME
MOVEM T1,SBLK+.MSRSN ;SET IN ARGUMENT BLOCK
HRROI T1,ALIAS ;GET POINTER TO ALIAS NAME
MOVEM T1,SBLK+.MSRSA ;PUT IN ARGUMENT BLOCK
SETZM STRUC ;CLEAR NAMES IN CASE NOT FILLED IN
SETZM ALIAS ;SO WON'T BE CONFUSED
MOVE T1,[.MSRBT+1,,.MSRNU] ;GET LENGTH AND FUNCTION
MOVEI T2,SBLK ;AND ADDRESS OF ARGUMENT BLOCK
MSTR ;DO THE WORK
ERJMP DSKDON ;FAILED, GO SEE WHY
MOVE T1,SBLK+.MSRCH ;GET CHANNEL
MOVE T2,SBLK+.MSRCT ;AND CONTROLLER NUMBER
MOVE T3,SBLK+.MSRUN ;AND UNIT NUMBER
CALL GETUDB ;GO READ IN THE UDB FOR THIS DISK
TXZA F,FR.UDB ;UDB IS INVALID
TXO F,FR.UDB ;UDB IS OK
CALL DOCOLS ;SHOW DATA ABOUT THIS UNIT
JRST DSKLOP ;DO NEXT UNIT
DSKDON: MOVEI T1,.FHSLF ;GET READY
GETER ;READ LAST ERROR IN MY JOB
ANDI T2,-1 ;REMOVE THE FORK HANDLE
CAIE T2,MSTX18 ;NO MORE UNITS?
JRST LOSE ;NO, SOME OTHER ERROR
RET ;YES, DONE
;ROUTINES CALLED TO OUTPUT THE COLUMNS ABOUT THE DISK UNITS:
XXCHAN: MOVE T1,SBLK+.MSRCH ;GET CHANNEL NUMBER
JRST OCTSP2 ;OUTPUT IT AND RETURN
XXUNIT: MOVE T1,SBLK+.MSRUN ;GET UNIT NUMBER
JRST OCTSP3 ;OUTPUT IT AND RETURN
XXCTRL: SKIPL T1,SBLK+.MSRCT ;GET CONTROLLER NUMBER
JRST OCTSP2 ;IF ONE, TYPE IT
STR$ [ASCIZ/ -/] ;OTHERWISE SAY THERE IS NONE
RET ;DONE
XXSTR: STR$ STRUC ;OUTPUT THE STRUCTURE NAME
RET ;DONE
XXALIS: STR$ ALIAS ;OUTPUT THE ALIAS NAME
RET ;DONE
XXLUNT: MOVE T1,SBLK+.MSRST ;GET STATUS
TXNE T1,MS%OFL ;IS DISK OFF LINE?
RET ;YES, CAN'T KNOW THIS THEN
HLRZ T1,SBLK+.MSRNS ;GET LOGICAL UNIT NUMBER
ADDI T1,1 ;INCREMENT BY 1
CALL OCTOUT ;OUTPUT IT
CHI$ "/" ;THEN A SLASH
HRRZ T1,SBLK+.MSRNS ;GET TOTAL UNITS IN STRUCTURE
JRST OCTOUT ;OUTPUT IT
XXSWAP: MOVE T1,SBLK+.MSRST ;GET STATUS BITS
TXNE T1,MS%OFL ;OFF LINE?
RET ;YES, THEN NO INFORMATION AVAILABLE
MOVE T1,SBLK+.MSRSW ;GET NUMBER OF SWAPPING SECTORS
IDIV T1,SBLK+.MSRSP ;CONVERT FROM SECTORS TO PAGES
JRST DECSP6 ;OUTPUT IT AND RETURN
XXUSTS: MOVE T1,SBLK+.MSRST ;GET STATUS BITS
TXNE T1,MS%MNT ;MOUNTED?
STR$ [ASCIZ/Mount /] ;YES, SAY SO
TXNE T1,MS%DIA ;DOING DIAGNOSTICS?
STR$ [ASCIZ/Diag /] ;YES, SAY SO
TXNE T1,MS%OFL ;IS IT OFF-LINE?
STR$ [ASCIZ/Offline /] ;YES, SAY SO
TXNN T1,MS%MNT!MS%DIA!MS%OFL ;READY BUT NOT IN USE?
STR$ [ASCIZ/Free /] ;YES, SAY ITS FREE
TXNE T1,MS%ERR ;ERROR DURING READING?
STR$ [ASCIZ/Err /] ;YES, SAY SO
TXNE T1,MS%BBB ;BAD BAT BLOCKS?
STR$ [ASCIZ/BadBAT /] ;YES, SAY SO
TXNE T1,MS%HBB ;BAD HOME BLOCK?
STR$ [ASCIZ/BadHOM /] ;YES, SAY SO
TXNE T1,MS%WLK ;WRITE LOCKED?
STR$ [ASCIZ/Wrtlck/] ;YES, SAY SO
RET ;DONE
XXTYPE: LDB T1,[POINT 9,SBLK+.MSRST,17] ;GET TYPE FIELD
MOVSI T2,-TYPNUM ;GET SET FOR SEARCH
HLRZ T3,TYPTAB(T2) ;GET NEXT POSSIBLE MATCH
CAME T1,T3 ;FOUND IT?
AOBJN T2,.-2 ;NO, KEEP SEARCHING
JUMPGE T2,OCTSP3 ;IF NOT FOUND, TYPE IN OCTAL
HRRZ T1,TYPTAB(T2) ;GET ADDRESS OF STRING
STR$ (T1) ;TYPE IT
RET ;DONE
TYPTAB: XWD .MSRP4,[ASCIZ/RP04/] ;RP04 DISK
XWD .MSRP5,[ASCIZ/RP05/] ;RP05 DISK
XWD .MSRP6,[ASCIZ/RP06/] ;RP06 DISK
XWD .MSRP7,[ASCIZ/RP07/] ;RP07 DISK
XWD .MSRM3,[ASCIZ/RM03/] ;RM03 DISK
XWD .MSR20,[ASCIZ/RP20/] ;RP20 DISK
TYPNUM==.-TYPTAB ;NUMBER OF ENTRIES
XXSEEK: TXNN F,FR.UDB ;IS THE UDB VALID?
RET ;NO, TYPE NOTHING
MOVE T1,UDBSEK ;GET OFFSET
MOVE T1,UDB(T1) ;GET THE DATA TO TYPE
JRST DECSP6 ;GO OUTPUT IT
XXREAD: SKIPA T1,UDBRED ;GET OFFSET FOR READS
XXWRIT: MOVE T1,UDBWRT ;OR OFFSET FOR WRITES
TXNN F,FR.UDB ;IS THE UDB VALID?
RET ;NO, QUIT
MOVE T1,UDB(T1) ;GET THE NUMBER OF READS OR WRITES
IDIV T1,SBLK+.MSRSP ;DIVIDE TO GET PAGES
JRST DECSP6 ;GO OUTPUT IT
XXRDER: MOVE T1,UDBSRE ;SOFT READ ERRORS
MOVE T4,UDBHRE ;AND HARD READ ERROS
TYPERR: TXNN F,FR.UDB ;IS THE UDB VALID?
RET ;NO
MOVE T1,UDB(T1) ;GET NUMBER OF SOFT ERRORS
MOVE T4,UDB(T4) ;AND NUMBER OF HARD ERRORS
JUMPN T1,TYPERY ;GO ON IF HAVE ANY ERRORS
JUMPN T4,TYPERY ;OF EITHER TYPE
STR$ [ASCIZ/ -- --/] ;NONE, SAY SO
RET ;DONE
TYPERY: CALL DECSP3 ;OUTPUT NUMBER OF SOFT ERRORS
STR$ [ASCIZ/S /] ;MARK THEM AS SOFT AND SPACE OVER
MOVE T1,T4 ;GET ERROR COUNT
CALL DECSP3 ;OUTPUT NUMBER OF HARD ERRORS
CHI$ "H" ;MARK THEM AS HARD
RET ;DONE
XXWTER: MOVE T1,UDBSWE ;SOFT WRITE ERROR
MOVE T4,UDBHWE ;AND HARD WRITE ERROR
JRST TYPERR ;GO OUTPUT THEM
XXPSER: MOVE T1,UDBSPE ;SOFT POSITIONING ERROR
MOVE T4,UDBHPE ;HARD POSITIONING ERROR
JRST TYPERR ;GO OUTPUT THEM
SUBTTL SUBROUTINE TO READ THE UDB OF A DISK OR MAGTAPE UNIT
;CALLED WITH CHANNEL NUMBER IN T1, CONTROLLER ON THAT CHANNEL IN T2, AND
;UNIT ON THE CONTROLLER IN T3, TO RETURN STARTING IN LOCATION UDB THE
;UNIT DATA BLOCK FOR THAT DEVICE. THIS ROUTINE REQUIRES PRIVILEGES AS
;PEEKS ARE USED TO OBTAIN THE INFORMATION. SKIP RETURN IF SUCCESSFUL.
GETUDB: SKIPL T1 ;RANGE CHECK CHANNEL NUMBER
CAILE T1,7 ;WHICH CAN ONLY BE FROM 0 TO 7
RET ;BAD, GIVE ERROR
CAML T2,[-1] ;RANGE CHECK THE CONTROLLER NUMBER
CAILE T2,7 ;WHICH CAN ONLY BE FROM -1 TO 7
RET ;BAD, GIVE ERROR
JUMPL T3,CPOPJ ;NEGATIVE UNIT NUMBER IS ILLEGAL
SKIPGE T2 ;ANY CONTROLLER?
CAIG T3,7 ;NO, THEN UNIT HAS TO BE FROM 0 TO 7
CAILE T3,377 ;YES, THEN UNIT CAN BE FROM 0 TO 377
RET ;NOPE, FAIL
MOVEM T1,CHAN ;SAVE CHANNEL
MOVEM T2,CTRL ;CONTROLLER
MOVEM T3,UNIT ;AND UNIT TOO
CALL UDBSYM ;GO OBTAIN ALL UDB SYMBOLS NEEDED
RET ;FAILED
MOVE T1,CHAN ;GET BACK CHANNEL NUMBER
ADD T1,CHNTAB ;CREATE ADDRESS OF CHANNEL POINTER
CALL DOPEEK ;OBTAIN THE CDB ADDRESS
RET ;FAILED
JUMPE T1,CPOPJ ;IF ZERO, NO SUCH CHANNEL
ADD T1,CDBUDB ;ADD IN ADDRESS OF THE UDB/KDB POINTERS
SKIPGE T2,CTRL ;ANY CONTROLLER?
MOVE T2,UNIT ;NO, THEN GET UNIT INSTEAD
ADD T1,T2 ;ADD IN CONTROLLER/UNIT NUMBER
CALL DOPEEK ;OBTAIN THE UDB/KDB ADDRESS
RET ;FAILED
JUMPE T1,CPOPJ ;IF ZERO, NO SUCH UNIT
SKIPGE CTRL ;ANY CONTROLLER?
JRST HAVUDB ;NO, THEN WE HAVE THE UDB ADDRESS NOW
ADD T1,KDBIUN ;ADD OFFSET OF UDB POINTERS
CALL DOPEEK ;READ AOBJN WORD TO UNITS OF CONTROLLER
RET ;FAILED
JUMPGE T1,CPOPJ ;IF NO UNITS, FAIL
MOVE T4,T1 ;MOVE TO SAFE AC
UDBSRC: HRRZ T1,T4 ;GET ADDRESS OF NEXT UDB POINTER
CALL DOPEEK ;READ THE POINTER
RET ;FAILED
JUMPE T1,UDBSRN ;IF NONE, TRY NEXT UNIT
MOVEM T1,TEMP ;REMEMBER UDB ADDRESS FOR LATER
ADD T1,UDBSLV ;ADD IN OFFSET TO GET SLAVE NUMBER
CALL DOPEEK ;READ THE SLAVE NUMBER
RET ;FAILED
ANDI T1,-1 ;KEEP ONLY THE RIGHT HALF
CAME T1,UNIT ;IS THIS THE REQUIRED UNIT?
UDBSRN: AOBJN T4,UDBSRC ;NO, SEARCH SOME MORE
JUMPGE T4,CPOPJ ;FAIL IF NOT FOUND
MOVE T1,TEMP ;RESTORE THE UDB ADDRESS
HAVUDB: MOVE T2,UDBDDD ;GET SIZE OF UDB
CAIL T2,UDBSIZ ;MAKE SURE BLOCK IS LARGE ENOUGH
RET ;NO, THEN FAIL
HRL T1,T2 ;PUT SIZE IN LEFT HALF
MOVEI T2,UDB ;SET UP ADDRESS WHERE DATA GOES
DOPEEK: TLNN T1,-1 ;WANT A SINGLE WORD OF DATA?
MOVEI T2,T3 ;YES, POINT TO AC TO RECEIVE ANSWER
TLNN T1,-1 ;WELL?
HRLI T1,1 ;YES, WANT ONLY ONE WORD
PEEK ;ASK MONITOR FOR DATA
ERJMP CPOPJ ;FAILED
MOVE T1,T3 ;PUT ANSWER IN RIGHT AC
RETSKP ;GOOD RETURN
SUBTTL SUBROUTINE TO OBTAIN UDB SYMBOLS BY SNOOPING
;HERE TO FILL IN THE TABLE OF OFFSETS AND SUCH SO WE CAN DO PEEKS
;WITH THE DATA.
UDBSYM: TXNE F,FR.UDS ;DO WE ALREADY HAVE THE SYMBOLS?
RETSKP ;YES, GOOD RETURN
MOVSI T4,-NUMUDB ;GET READY FOR LOOP
UDBSYL: MOVEI T1,.SNPSY ;GET FUNCTION CODE
MOVE T2,TBSUDB(T4) ;GET WORD OF DATA
MOVE T3,TBMUDB(T4) ;AND PROGRAM NAME
SNOOP ;GET THE VALUE
ERJMP CPOPJ ;FAILED
MOVEM T2,TBVUDB(T4) ;SAVE THE VALUE
AOBJN T4,UDBSYL ;LOOP OVER ALL WORDS
TXO F,FR.UDS ;SYMBOLS ARE NOW GOTTEN
RETSKP ;GOOD RETURN
;TABLE OF SYMBOLS WE WANT TO SNOOP. THIS MACRO IS EXPANDED LATER ON
;IN THE PROGRAM.
DEFINE USYMS,< ;SYMBOLS WE WANT TO KNOW ABOUT
XX CHNTAB,STG ;;TABLE OF CHANNEL ADDRESSES
XX CDBUDB ;;OFFSET IN CDB TO START OF UDBS
XX KDBIUN,PHYSIO ;;POINTER TO UDB ADDRESSES
XX UDBDDD,PHYP4 ;;FIRST WORD OF DEVICE DEPENDENT PART
XX UDBSEK ;;NUMBER OF SEEKS
XX UDBRED ;;READS
XX UDBWRT ;;WRITES
XX UDBSRE ;;SOFT READ ERRORS
XX UDBSWE ;;SOFT WRITE ERRORS
XX UDBHRE ;;HARD READ ERRORS
XX UDBHWE ;;HARD WRITE ERRORS
XX UDBSPE,PHYP4 ;;SOFT POSITIONING ERROR
XX UDBHPE,PHYP4 ;;HARD POSITIONING ERROR
XX UDBSLV,PHYSIO ;;UNIT NUMBER ON CONTROLLER
>
SUBTTL SUBROUTINE TO TYPE STRUCTURE STATUS
;CALLED TO OUTPUT THE STATUS OF EACH MOUNTED STRUCTURE ON THE SYSTEM,
;SUCH AS THE AMOUNT OF SPACE USED ON EACH ONE, AND THE MOUNT COUNTS.
;NO PRIVILEGES REQUIRED FOR THIS OUTPUT.
DOSTR: MOVEI T1,TP.STR ;THIS IS THE STRUCTURE DISPLAY
CALL HDRSET ;SO SET IT UP
TXO F,FR.EAT ;REMEMBER TO EAT LINES AFTERWARD
SETO J, ;GET READY FOR LOOP
STRSTL: ADDI J,1 ;MOVE TO NEXT POSSIBLE DEVICE
MOVSI T1,(J) ;GET READY
IORI T1,.DEVCH ;TO GET DATA ON THIS DEVICE
GETAB ;GET IT
ERJMP CPOPJ ;FAILED, ASSUME NO MORE
LDB T1,[POINTR T1,DV%TYP] ;GET DEVICE TYPE
CAIE T1,.DVDSK ;IS THIS A DISK?
JRST STRSTL ;NO, TRY NEXT DEVICE
MOVSI T1,(J) ;GET READY
IORI T1,.DEVNA ;TO OBTAIN THE DEVICE NAME
GETAB ;GET IT
ERJMP CPOPJ ;FAILED
CAMN T1,['DSK '] ;IS THIS THE GENERIC DISK?
JRST STRSTL ;YES, DON'T USE IT
CALL SIXASC ;CONVERT FROM SIXBIT TO ASCIZ
DMOVE T1,TEMP ;GET THE NAME
DMOVEM T1,DEVNAM ;SAVE IT AWAY
HRROI T1,DEVNAM ;GET A POINTER
MOVEM T1,MBLK+.MSGSN ;AND SET IN ARGUMENT BLOCK
MOVE T1,[.MSGFC+1,,.MSGSS] ;GET READY
MOVEI T2,MBLK ;POINT TO DATA AREA
MSTR ;ASK ABOUT THIS STRUCTURE
ERJMP STRSTL ;FAILED, LOOP
SETZM HAVALC ;CLEAR FLAG SAYING HAVE ALLOCATION INFO
CALL DOCOLS ;NOW SHOW THE DATA
JRST STRSTL ;LOOP
;ROUTINES TO OUTPUT DATA ABOUT EACH STRUCTURE:
XXSTNM: SPACE ;SPACE OVER FIRST
STR$ DEVNAM ;OUTPUT THE NAME OF THE STRUCTURE
RET ;DONE
XXSTST: MOVE T1,MBLK+.MSGST ;GET THE STATUS BITS
TXNE T1,MS%PS ;IS THIS PUBLIC?
STR$ [ASCIZ/Public /] ;YES, SAY SO
TXNE T1,MS%DIS ;IS IT BEING DISMOUNTED?
STR$ [ASCIZ/Dismount /] ;YES, SAY SO
TXNE T1,MS%DOM ;IS IT DOMESTIC?
STR$ [ASCIZ/Domestic /] ;YES
TXNN T1,MS%DOM ;IS IT FOREIGN?
STR$ [ASCIZ/Foreign /] ;YES, SAY SO
TXNE T1,MS%LIM ;IS STRUCTURE LIMITED?
STR$ [ASCIZ/Limit /] ;YES, SAY SO
TXNN T1,MS%NRS ;IS STRUCTURE REGULATED?
STR$ [ASCIZ/Regulated /] ;YES, SAY SO
TXNE T1,MS%INI ;IS IT BEING INITIALIZED?
STR$ [ASCIZ/Init/] ;YES, SAY SO
RET ;DONE
XXSTMC: MOVE T1,MBLK+.MSGMC ;GET THE MOUNT COUNT
JRST DECSP3 ;OUTPUT IT
XXSTOF: MOVE T1,MBLK+.MSGFC ;GET OPEN FILE COUNT
JRST DECSP3 ;OUTPUT IT
XXSTPG: CALL GETALC ;OBTAIN ALLOCATION DATA FOR STRUCTURE
RET ;FAILED
MOVE T1,T2 ;GET FREE PAGES
JRST DECSP5 ;OUTPUT IT
XXSTSZ: CALL GETALC ;GET ALLOCATION INFORMATION
RET ;FAILED
ADD T1,T2 ;ADD TOGETHER TO GET SIZE
JRST DECSP6 ;OUTPUT IT
SUBTTL ROUTINE TO GET ALLOCATION INFO
;CALLED TO GET THE ALLOCATION DATA FOR A STRUCTURE WHOSE NAME IS
;IN LOCATION STRNAM. SKIP RETURN IF SUCCESSFUL. TO SAVE TIME,
;WE DON'T RECOMPUTE THE DATA IF THE FLAG HAVALC IS SET.
GETALC: DMOVE T1,STRALC ;GET ALLOCATION INFORMATION
SKIPE HAVALC ;IS IT CORRECT?
RETSKP ;YES, GOOD RETURN
HRROI T1,DEVNAM ;GET READY
STDEV ;CONVERT NAME TO DESIGNATOR
ERJMP CPOPJ ;FAILED, CAN'T DO THIS
MOVE T1,T2 ;MOVE TO RIGHT AC
GDSKC ;READ DISK ALLOCATION INFO
ERJMP CPOPJ ;FAILED
DMOVEM T1,STRALC ;SAVE FOR LATER
SETOM HAVALC ;SAY HAVE THE DATA
RETSKP ;GOOD RETURN
SUBTTL DISPLAY FOR ENQ/DEQ STATUS
;THIS DISPLAY TYPES ALL OF THE ENQ LOCKS AND THE QUEUES FOR THOSE
;LOCKS. WHEEL PRIVILEGES ARE REQUIRED FOR THIS DISPLAY, SINCE WE
;USE THE ENQC JSYS TO COLLECT THE DATA.
DPYENQ: MOVEI T1,.ENQCD ;FUNCTION TO DUMP THE QUEUES
MOVEI T2,DATLOC ;ADDRESS OF WHERE TO DUMP THEM
MOVEI T3,DATSIZ ;GET SIZE OF AREA
MOVEM T3,DATLOC ;SET FOR MONITOR
ENQC ;READ ALL OF THE DATA
ERJMP LOSE ;FAILED, GO EXPLAIN TO USER
MOVEI T1,TP.EQL ;TYPE OF HEADER IS ENQ-LOCKS
CALL HDRSET ;SET UP TAB STOPS AND TITLE
TXO F,FR.EAT ;EAT LINES AFTER THE TITLE
SETZM LOKNUM ;CLEAR NUMBER OF LOCKS FOUND
MOVEI J,DATLOC+1 ;SET UP POINTER
LOKLUP: CALL FULL ;IS SCREEN FULL?
RET ;YES, RETURN NOW
CAIL J,DATLOC+DATSIZ-ENQSAF ;RAN OFF OF END?
JRST ENQOVF ;YES, GO SAY WE OVERFLOWED
MOVE T1,.ENQDF(J) ;GET FLAG WORD
CAMN T1,[-1] ;REACHED END?
JRST ENQQUE ;YES, GO DO QUEUES NOW
TXNN T1,EN%QCL ;IS THIS A LOCK BLOCK?
JRST ISQUE ;NO, IS A QUEUE BLOCK
AOS T1,LOKNUM ;COUNT ANOTHER LOCK BLOCK
CAIL T1,LCKMAX ;OVERFLOWED TABLE OF LOCKS?
JRST ENQOVF ;YES, SAY WE OVERFLOWED
HRLZM J,LOKTAB(T1) ;REMEMBER WHERE THE LOCK BLOCK IS
CALL DOCOLS ;DO ALL COLUMNS ABOUT THE LOCK
MOVE T1,.ENQDF(J) ;GET FLAGS AGAIN
ADDI J,.ENQDC ;MOVE TO LAST WORD OF BLOCK, MAYBE
TXNN T1,EN%QCT ;IS LAST WORD A USER CODE?
AOJA J,LOKLUP ;YES, MOVE TO NEXT BLOCK AND CONTINUE
HRLI J,(POINT 7,) ;NO, IS A STRING, SET UP
ILDB T1,J ;GET NEXT BYTE
JUMPN T1,.-1 ;KEEP GOING UNTIL FIND A NULL
MOVEI J,1(J) ;THEN MOVE TO NEXT WORD
JRST LOKLUP ;PROCEED WITH NEXT BLOCK (HOPEFULLY!)
ISQUE: MOVE T1,LOKNUM ;GET THE NUMBER OF THE LOCK
MOVEI T2,-1 ;GET A MASK TOO
TDNN T2,LOKTAB(T1) ;FIRST QUEUE BLOCK FOR THIS LOCK?
HRRM J,LOKTAB(T1) ;YES, REMEMBER WHERE IT IS
ADDI J,2 ;MOVE BEYOND THE BLOCK
JRST LOKLUP ;AND GO BACK TO LOOP
;NOW LOOP OVER THE QUEUE BLOCKS. TYPING DATA ON THEM. THE ADDRESSES
;OF THE FIRST QUEUE BLOCK FOR EACH LOCK WAS REMEMBERED IN THE FIRST
;PASS IN THE TABLE LOKTAB.
ENQOVF: STR$ [ASCIZ/ [Table overflow, further entries not reported]
/] ;SAY WE OVERFLOWED
ENQQUE: MOVEI T1,TP.EQQ ;TYPE OF DISPLAY IS THE ENQ QUEUES
CALL HDRSET ;SET UP TAB STOPS AND TITLE LINE
SETZM ENQNUM ;CLEAR COUNTER
SETOM LSTNUM ;CLEAR LAST NUMBER
ENQQLP: AOS T2,ENQNUM ;GET NEXT NUMBER TO LOOK FOR
CAMG T2,LOKNUM ;DONE WITH ALL LOCKS?
CALL FULL ;OR IS SCREEN FULL?
RET ;YES, RETURN
HRRZ J,LOKTAB(T2) ;GET FIRST QUEUE BLOCK FOR THIS LOCK IF ANY
JUMPE J,ENQQLP ;NONE, GO TO NEXT BLOCK
DMPQUE: MOVE T1,.ENQDF(J) ;GET FLAG WORD
CAIGE J,DATLOC+DATSIZ-ENQSAF ;OVERFLOWED?
TXNE T1,EN%QCL ;OR REACHED A LOCK BLOCK?
JRST ENQQLP ;YES, GO LOOK AT NEXT ONE
CALL DOCOLS ;SHOW DATA ON THIS QUEUE BLOCK
ADDI J,2 ;MOVE OUT OF BLOCK
JRST DMPQUE ;AND DO NEXT QUEUE BLOCK TOO
;FOLLOWING ARE THE ROUTINES FOR TYPING THE FIELDS OF THE LOCK BLOCKS
;AND OF THE QUEUE BLOCKS.
XXLLCK: MOVE T1,LOKNUM ;GET THE NUMBER OF THIS LOCK
JRST DECSP2 ;OUTPUT IT
XXLLVL: LDB T1,[POINT 9,.ENQDF(J),17] ;GET LEVEL NUMBER
JRST DECSP3 ;OUTPUT IT
XXLTYP: HRRZ T1,.ENQDF(J) ;GET THE TYPE OF THIS ENTRY
CAIN T1,-2 ;RANDOM ENQ PRIVILEGES NEEDED?
STR$ [ASCIZ/ENQ jobs/] ;YES, SAY THAT
CAIN T1,-3 ;WHEEL PRIVILEGES NEEDED?
STR$ [ASCIZ/WHEEL jobs/] ;YES, SAY THAT
CAIE T1,-2 ;ONE OF THE ABOVE?
CAIN T1,-3 ;WELL?
RET ;YES, DONE
CAIL T1,400000 ;A JOB NUMBER OR AN OFN
JRST XXLTYJ ;JOB
STR$ [ASCIZ/OFN /] ;TYPE SOME
JRST OCTOUT ;OUTPUT THE OFN
XXLTYJ: STR$ [ASCIZ/Job /] ;TYPE TEXT
SUBI T1,400000 ;REMOVE OFFSET
JRST DECOUT ;OUTPUT IT
XXLRES: MOVE T1,.ENQDR(J) ;GET RESOURCE WORD
TLZN T1,-1 ;IS THIS A GROUP?
JRST XXLREG ;YES
CALL DECOUT ;OUTPUT REMAINING RESOURCES
CHI$ "/" ;THEN A SLASH
HLRZ T1,.ENQDR(J) ;GET TOTAL RESOURCES IN POOL
JRST DECOUT ;OUTPUT IT AND RETURN
XXLREG: SKIPE .ENQDT(J) ;IS THE ONE LOCK FREE?
TDZA T1,T1 ;NO, GET ZERO
MOVEI T1,1 ;OTHERWISE ONE
CHI$ "0"(T1) ;SAY IF IT IS FREE OR NOT
CHI$ "/" ;THEN TYPE A SLASH
SKIPN T1,.ENQDR(J) ;GROUP NUMBER OF ZERO?
AOJA T1,DECOUT ;YES, OUTPUT AVAILABILITY OF 1
STR$ [ASCIZ/Group /] ;OTHERWISE SAY WHAT GROUP THIS IS
JRST DECOUT ;AND OUTPUT GROUP NUMBER
XXLTIM: SKIPN T4,.ENQDT(J) ;GET TIME STAMP IF ANY
STR$ [ASCIZ/ --/] ;NONE, SAY SO
JUMPE T4,CPOPJ ;RETURN IF NO DATE
SKIPGE T4 ;WAS TIME SET BACK THEN?
MOVE T4,BEGTIM ;NO, USE SYSTEM STARTUP TIME THEN
HRROI T1,TEMP ;POINT TO BUFFER
MOVE T2,T4 ;GET TIME
MOVX T3,OT%NDA ;DON'T OUTPUT THE DATE
ODTIM ;OUTPUT TO CORE
STR$ TEMP ;THEN GIVE TO DPY
MOVE T1,NTIME ;GET NOW'S TIME
SUB T1,T4 ;GET DIFFERENCE BETWEEN NOW AND THEN
HLRZ T1,T1 ;KEEP JUST DAYS OF DIFFERENCE
JUMPE T1,CPOPJ ;LESS THAN A DAY, NO OUTPUT
STR$ [ASCIZ/ -/] ;START OUTPUT
CALL DECOUT ;OUTPUT NUMBER OF DAYS
CHI$ "D" ;SAY IT IS DAYS
RET ;DONE
XXLCOD: MOVE T1,.ENQDC(J) ;GET CODE OR USER STRING
MOVE T2,.ENQDF(J) ;AND GET FLAGS
TXNN T2,EN%QCT ;IS THIS A TEXT STRING?
JRST XXLCOO ;NO, IS OCTAL NUMBER
MOVEI T1,.ENQDC(J) ;GET ADDRESS OF THE STRING
HRLI T1,(POINT 7,) ;MAKE BYTE POINTER TO IT
MOVE T2,[POINT 7,TEMP] ;POINT TO TEMP AREA TOO
MOVEI T3,TMPSIZ*5-1 ;GET A COUNT TOO
XXLCLP: ILDB T4,T1 ;GET NEXT CHAR
JUMPE T4,XXLCTP ;DONE WHEN GET A NULL
CAIL T4," " ;SEE IF A NORMAL CHAR
CAILE T4,176 ;WELL?
MOVEI T4,"?" ;NO, TURN TO SOMETHING VISIBLE
IDPB T4,T2 ;STORE THE CHAR
SOJG T3,XXLCLP ;LOOP UNLESS TOO MANY CHARS
SETZ T4, ;MAKE A NULL
XXLCTP: IDPB T4,T2 ;MAKE STRING ASCIZ
SPACE ;SPACE OVER FIRST
TXNE F,FR.MOR ;MORE OUTPUT COMING?
SETZM TEMP+3 ;YES, CUT OFF THE NAME
STR$ TEMP ;OUTPUT IT
RET ;DONE
XXLCOO: CHI$ "#" ;SAY THIS IS A NUMBER
TLZ T1,700000 ;CLEAR OUT THE 5B2
JRST OCTOUT ;GO OUTPUT IT
XXQLCK: MOVE T1,ENQNUM ;GET NUMBER OF LOCK THIS IS FOR
CAMN T1,LSTNUM ;SAME AS LAST TIME?
RET ;YES, RETURN
MOVEM T1,LSTNUM ;NO, SAVE NEW NUMBER
JRST DECSP2 ;OUTPUT IT
XXQJOB: HRRZ T1,.ENQDF(J) ;GET JOB NUMBER OF ORIGINATOR
JRST DECSP2 ;OUTPUT IT
XXQPRG: HRLZ T1,.ENQDF(J) ;GET JOB NUMBER
HRRI T1,.JOBPN ;AND INDEX
GETAB ;READ PROGRAM NAME
ERJMP CPOPJ ;FAILED
JRST SIXOUT ;OUTPUT IT
XXQREQ: HLRZ T1,.ENQDI(J) ;GET REQUEST DATA
MOVE T2,ENQNUM ;GET INDEX INTO LOKTAB
HLRZ T2,LOKTAB(T2) ;THEN ADDRESS OF LOCK BLOCK
MOVE T2,.ENQDR(T2) ;FINALLY GET RESOURCES WORD
TLNN T2,-1 ;GROUP NUMBER?
STR$ [ASCIZ/Group /] ;YES, SAY SO
JRST DECOUT ;OUTPUT GROUP OR REQUESTS WANTED
XXQID: HRRZ T1,.ENQDI(J) ;GET REQUEST ID
JRST OCTSP6 ;OUTPUT IT
XXQFLG: MOVE T1,.ENQDF(J) ;GET FLAGS
TXNE T1,EN%QCO ;DOES THIS GUY OWN THE LOCK?
STR$ [ASCIZ/Owner /] ;YES, SAY SO
TXNE T1,EN%QCB ;BLOCKED WAITING FOR EXCLUSIVE ACCESS?
STR$ [ASCIZ/Blocked/] ;YES, SAY SO
RET ;DONE
SUBTTL DISPLAY FOR TERMINAL INFORMATION
;THIS MODE OF OUTPUT TELLS THINGS ABOUT THE ACTIVE TERMINALS ON
;THE SYSTEM. THIS IS SET BY THE "TT" COMMAND.
DPYTTY: MOVEI T1,TP.TTY ;THIS IS TERMINAL DISPLAY
CALL HDRSET ;SO SET UP HEADERS FOR IT
TXO F,FR.EAT ;REMEMBER TO EAT AFTER HEADER IS TYPED
SETO J, ;INITIALIZE FOR LOOP
TTYLOP: ADDI J,1 ;MOVE TO NEXT TERMINAL
CAMG J,HGHTTY ;DID ALL TERMINALS?
CALL FULL ;OR IS SCREEN FULL?
RET ;YES, DONE
MOVE T1,['TTFLG1'] ;WANT THE STATUS WORD
CALL GETTT0 ;READ THE DATA
JRST TTYLOP ;TERMINAL NOT IN USE, GO LOOP
MOVEM T1,TTYSTS ;SAVE FOR LATER
CALL TTYACT ;SEE IF TERMINAL IS ACTIVE ENOUGH
JRST TTYLOP ;NO, DON'T SHOW IT
SETOM TTJBVL ;SAY WE NEED NEW JOB FROM TTY DATA
CALL DOCOLS ;TYPE DATA ABOUT THIS TERMINAL
JRST TTYLOP ;AND LOOP
;FOLLOWING ARE THE ROUTINES TO TYPE THINGS ABOUT EACH TERMINAL.
XXTNUM: MOVE T1,J ;GET TERMINAL NUMBER
JRST OCTSP3 ;OUTPUT AND RETURN
XXTTYP: MOVEI T1,.TTDES(J) ;GET DEVICE DESIGNATOR
GTTYP ;ASK MONITOR TO GET TERMINAL TYPE
ERJMP CPOPJ ;CAN'T GET IT, RETURN
MOVE T1,T2 ;MOVE TO RIGHT AC
MOVSI T2,-TTTNUM ;GET READY FOR SEARCH
HLRZ T3,TTTTAB(T2) ;GET NEXT POSSIBLE TERMINAL
CAME T1,T3 ;FOUND IT?
AOBJN T2,.-2 ;NO, KEEP SEARCHING
JUMPGE T2,OCTTEL ;CAN'T FIND IT, GIVE IN OCTAL
HRRZ T1,TTTTAB(T2) ;GET THE STRING ADDRESS
STR$ (T1) ;OUTPUT TYPE
RET ;DONE
DEFINE NT(CODE,TEXT),<
XWD CODE,[ASCIZ/TEXT/] ;;TERMINAL TYPES
>
TTTTAB: NT .TT33,<Model 33>
NT .TT35,<Model 35>
NT .TT37,<Model 37>
NT .TTEXE,Execuport
NT .TTDEF,Default
NT .TTIDL,Ideal
NT .TTV05,VT05
NT .TTV50,VT50
NT .TTL30,LA30
NT .TTG40,GT40
NT .TTL36,LA36
NT .TTV52,VT52
NT .TT100,VT100
NT .TTL38,LA38
NT .TT120,LA120
TTTNUM==.-TTTTAB ;NUMBER OF TERMINALS IN TABLE
XXTINC: SKIPA T1,['TTICT '] ;GET WORD
XXTOUC: MOVE T1,['TTOCT '] ;OR GET OTHER WORD
SKIPL TTYSTS ;FAIL IF THIS IS A SHORT BLOCK
CALL GETTT0 ;NORMAL BLOCK, READ WORD
RET ;CAN'T GET IT
JRST DECSP3 ;OUTPUT IT
XXTSPD: MOVEI T1,.TTDES(J) ;GET TERMINAL DESIGNATOR
MOVEI T2,.MORSP ;FUNCTION TO READ LINE SPEEDS
MTOPR ;READ IT
ERJMP CPOPJ ;FAILED
SKIPGE T4,T3 ;SAVE SPEED AND SEE IF UNKNOWN
JRST NOSPED ;ISN'T VALID
HLRZ T1,T4 ;GET INPUT SPEED
CALL DECSP5 ;OUTPUT IT
HRRZ T1,T4 ;GET OUTPUT SPEED
JRST DECSP6 ;OUTPUT IT AND RETURN
NOSPED: STR$ [ASCIZ/ -- --/] ;SAY SPEED IS IRREVELANT
RET ;DONE
XXTJOB: CALL TTYJOB ;GET JOB DATA FOR THIS TERMINAL
RET ;FAILED
HLRZ T1,T1 ;KEEP ONLY THE JOB NUMBER
CAIN T1,-1 ;NOT ASSIGNED?
JRST TTYNTA ;YES, GO SAY THAT
CAIE T1,-2 ;BECOMING ASSIGNED?
JRST DECSP2 ;NO, TELL JOB NUMBER
STR$ [ASCIZ/Ass/] ;SAY BECOMING ASSIGNED
RET ;DONE
TTYNTA: STR$ [ASCIZ/--/] ;SAY UNASSIGNED
RET ;DONE
XXTLNK: MOVE T1,['TTLINK'] ;GET WORD
CALL GETTT0 ;READ THE DATA
RET ;FAILED
TELLNK: MOVEM T2,TEMP ;SAVE AWAY THE LINK DATA
MOVE T4,[POINT 9,TEMP] ;GET BYTE POINTER
TXZ F,FR.TMP ;INITIALIZE FLAG
LNKLOP: TXNN T4,77B5 ;DID ALL FOUR BYTES?
RET ;YES, DONE
ILDB T1,T4 ;GET NEXT BYTE
CAIN T1,777 ;REAL TERMINAL LINKED HERE?
JRST LNKLOP ;NO, TRY NEXT BYTE
TXOE F,FR.TMP ;ANY PREVIOUS OUTPUT?
SPACE ;YES, SPACE OVER
CALL OCTSP3 ;OUTPUT THE TERMINAL NUMBER
JRST LNKLOP ;LOOP
XXTUSR: CALL TTYJOB ;FIND THE JOB INFO FOR THIS TERMINAL
RET ;CAN'T GET IT
HLRZ T1,T1 ;KEEP ONLY THE JOB NUMBER
CAIGE T1,-2 ;IS TERMINAL ASSIGNED TO A JOB?
JRST JOBUSR ;YES, GO SAY WHO IT IS
STR$ [ASCIZ/None/] ;NO, SAY NOBODY IS THERE
RET ;DONE
TT%SAL==1B0 ;SEND-ALL BEING DONE
TT%SHT==1B1 ;THIS IS A SHORT BLOCK
TT%MES==1B2 ;THIS IS A SYSTEM MESSAGE BLOCK
TT%OTP==1B3 ;OUTPUT ON ROUTE
TT%SFG==1B5 ;CONTROL-S WAS TYPED
TT%PRM==1B8 ;DON'T DEALLOCATE BLOCK
TT%FEM==1B0 ;LINE IS REMOTE
TT%CON==1B3 ;CARRIER IS ON
TT%AUT==1B7 ;LINE IS AUTO-SPEED
XXTFLG: MOVE T1,TTYSTS ;GET THE STATUS WORD
TXNE T1,TT%PRM ;IS THIS A PERMANENT BLOCK?
STR$ [ASCIZ/Prm /] ;YES, SAY SO
TXNE T1,TT%SHT ;IS THIS A SHORT BLOCK?
STR$ [ASCIZ/Sht /] ;YES, SAY SO
TXNE T1,TT%MES ;IS THIS A SYSTEM MESSAGE BLOCK?
STR$ [ASCIZ/Msg /] ;YES, SAY SO
TXNE T1,TT%SAL ;SEND-ALL BEING DONE?
STR$ [ASCIZ/Sndal /] ;YES, SAY SO
TXNE T1,TT%SFG ;CONTROL-S TYPED?
STR$ [ASCIZ/Pag /] ;YES, SAY SO
TXNE T1,TT%OTP ;OUTPUT ON ROUTE?
STR$ [ASCIZ/Out /] ;YES, SAY SO
CALL TTYJOB ;GET JOB DATA FOR THIS TTY
MOVEI T1,-1 ;FAILED, DEFAULT IT
ANDI T1,-1 ;KEEP ONLY THE FORK NUMBER
CAIE T1,-1 ;ANY FORK IN INPUT WAIT?
STR$ [ASCIZ/In /] ;YES, SAY SO
MOVEI T1,.RDTTS ;GET FUNCTION
MOVE T2,J ;AND TERMINAL NUMBER
MONRD% ;GET THE TTSTAT WORD
ERJMP CPOPJ ;FAILED
JUMPL T1,CPOPJ ;ALSO FAILED
TXNE T2,TT%FEM ;IS THIS A REMOTE LINE?
STR$ [ASCIZ/Rmt /] ;YES, SAY SO
TXNE T2,TT%CON ;IS CARRIER ON?
STR$ [ASCIZ/Car /] ;YES, SAY SO
TXNE T2,TT%AUT ;IS LINE AUTO-BAUD?
STR$ [ASCIZ/Auto /] ;YES, SAY SO
CAMN J,CTYNUM ;IS THIS THE CTY?
STR$ [ASCIZ/Cty /] ;YES, SAY SO
CAMLE J,CTYNUM ;IS THIS A PTY?
STR$ [ASCIZ/Pty /] ;YES, SAY SO
RET ;DONE
SUBTTL SUBROUTINE TO CHECK FOR AN ACTIVE TERMINAL
;CALLED FOR EACH TERMINAL TO SEE IF THAT TERMINAL IS ACTIVE. TERMINAL
;NUMBER IS SPECIFIED IN AC J. SKIP RETURN IF TERMINAL SHOULD BE SHOWN
;BECAUSE OF SOMETHING INTERESTING. ACTIVE TERMINALS STAY THAT WAY FOR
;ABOUT A MINUTE BEFORE THEY WILL DISAPPEAR FROM THE DISPLAY.
TTYACT: CAILE J,MAXTTY ;SEE IF NUMBER LARGER THAN OUR TABLE
RETSKP ;YES, ACT LIKE ACTIVE THEN
MOVE T1,TTYSTS ;GET THE STATUS
TXNE T1,TT%SHT+TT%MES+TT%OTP ;ANYTHING HAPPENING?
JRST NEWACT ;YES, NOW ACTIVE
MOVE T1,['TTOCT '] ;GET READY
CALL GETTT0 ;READ NUMBER OF OUTPUT CHARS
SETZ T1, ;FAILED, ASSUME NONE
JUMPN T1,NEWACT ;IF ANY, IS ACTIVE
MOVE T1,['TTICT '] ;GET READY
CALL GETTT0 ;READ NUMBER IF INPUT CHARACTERS
SETZ T1, ;FAILED
JUMPN T1,NEWACT ;IF ANY THERE, IT'S ACTIVE
SKIPE T1,ACTTAB(J) ;SEE IF TERMINAL HAS BEEN ACTIVE
CAMGE T1,NTIME ;AND SEE IF RECENT ENOUGH TO WANT IT
TXNN F,FR.TAC ;OR SEE IF WANT ALL TERMINALS ANYWAY
RETSKP ;YES, SHOW IT
RET ;NO, FORGET IT
NEWACT: MOVX T1,<<ACTTIM,,0>/^D<60*24>> ;GET TIME INTERVAL
ADD T1,NTIME ;ADD CURRENT TIME
MOVEM T1,ACTTAB(J) ;REMEMBER WHEN WILL NO LONGER BE ACTIVE
RETSKP ;GOOD RETURN
SUBTTL SUBROUTINES USED FOR TERMINAL DISPLAY
;CALLED TO USE THE MONRD% JSYS TO RETURN A WORD FROM THE TTACTL BLOCK
;OF A TERMINAL. CALL WITH SIXBIT NAME IN T1, AND OFFSET FROM THAT NAME
;IN T2, AND TERMINAL NUMBER IN AC J. SKIP RETURN WITH DATA IN T1 IF
;SUCCESSFUL. CALL AT GETTT0 IF OFFSET IS ZERO.
GETTT0: SETZ T2, ;MAKE OFFSET ZERO
GETTTY: MOVE T3,T2 ;MOVE OFFSET TO RIGHT AC
MOVE T2,T1 ;MOVE SYMBOL TO RIGHT AC
MOVEI T1,.RDTTY ;SET UP FUNCTION CODE
MOVE T4,J ;GET TERMINAL NUMBER
JRST DOMONR ;GO DO THE JSYS
;SUBROUTINE TO READ THE GETAB ENTRY WHICH CONVERTS TERMINAL NUMBER TO
;JOB NUMBER. TO SAVE TIME, LOCATION TTJBVL IS NONNEGATIVE IF WE ALREADY
;HAVE COLLECTED THE INFORMATION. SKIP RETURN IF SUCCESSFUL WITH WORD
;IN T1. TERMINAL NUMBER GIVEN IN AC J.
TTYJOB: SKIPL T1,TTJBVL ;GET DATA IF ALREADY KNOWN
RETSKP ;YES, GOOD RETURN
MOVSI T1,(J) ;SET UP INDEX
IORI T1,.TTYJO ;AND TABLE NUMBER
GETAB ;READ THE WORDD
ERJMP CPOPJ ;FAILED
MOVEM T1,TTJBVL ;REMEMBER FOR NEXT TIME
RETSKP ;GOOD RETURN
SUBTTL ROUTINE TO GIVE MONITOR STATISTICS
;THIS MODE OF OUTPUT IS USED TO OUTPUT MONITOR DATA, ON THE SYSTEM
;PERFORMANCE AS A WHOLE. THIS MODE IS SET BY THE "M" COMMAND.
DPYMON: SETOM HDRTYP ;NO HEADERS ARE VALID ANYMORE
TAB$ ;SET UP DEFAULT TABS
SETZB T2,T3 ;INITIALIZE FOR LOOP
VERLOP: MOVSI T1,(T3) ;GET READY
IORI T1,.SYSVE ;TO READ MONITOR VERSION
GETAB ;READ A WORD OF IT
JRST VERDON ;IF FAILED, ALL DONE
JUMPE T1,VERDON ;PROCEED IF DONE
STR$ T1 ;OUTPUT PART OF NAME
AOJA T3,VERLOP ;LOOP OVER ALL PARTS
VERDON: CRLF ;TYPE A CRLF
HRROI T1,TEMP ;POINT TO TEMPORY AREA
SETO T2, ;WANT CURRENT TIME
MOVX T3,OT%DAY+OT%FDY+OT%FMN+OT%4YR+OT%DAM+OT%SPA+OT%SCL+OT%TMZ
ODTIM ;STORE TIME WITH TIME ZONE
STR$ TEMP ;THEN OUTPUT IT
STR$ [ASCIZ/ Uptime: /] ;TYPE MORE
TIME ;READ TIME
IDIVI T1,^D1000 ;TURN MILLISECONDS TO SECONDS
CALL TIMOUT ;OUTPUT IT
CRLF ;THEN A CRLF
CALL SETEAT ;SET UP HOW MANY LINES TO BE EATEN
CALL DOSTAT ;GO TYPE OUT THE STATUS INFORMATION
CALL DOCLAS ;TYPE OUT CLASS INFORMATION
CALL DOLOAD ;TYPE OUT THE LOAD AVERAGES
PJRST DOACT ;FINISH WITH ACTIVE JOB INFO
SUBTTL ROUTINE TO TYPE OUT "WATCH" INTO
;THE FOLLOWING CODE TYPES OUT MONITOR STATISTICS IN A MANNER SIMILAR
;TO WHAT WATCH TYPES. THE COLUMNS ARE ARRANGED FOUR TO A LINE.
DOSTAT: CALL RDSTAT ;GO READ NEW VALUES
TAB$ [$TABS<14,29,41,51,62,63,64,65,66,67>] ;SET UP NICE TAB STOPS
STR$ [ASCIZ/
Statistics for an interval of /] ;TYPE SOME HEADER
MOVE T1,STADIF ;GET INTERVAL
IDIVI T1,^D100 ;CONVERT TO TENTHS OF A SECOND
CAIL T2,^D50 ;SHOULD WE ROUND UP?
ADDI T1,1 ;YES
MOVEI T4,DECOUT ;SET UP ROUTINE TO CALL
CALL FIXOUT ;OUTPUT AS FIXED POINT NUMBER
STR$ [ASCIZ/ seconds:
/] ;FINISH HEADER
MOVSI J,-STATNM ;GET NUMBER OF ENTRIES TO TYPE
STATLP: TRNE J,3 ;TIME FOR A TAB?
TAB ;YES, TYPE ONE
TRNN J,3 ;TIME FOR A CRLF INSTEAD?
CRLF ;YES, GIVE ONE
HRRZ T1,STATTB(J) ;GET THE NAME OF THE ENTRY
STR$ (T1) ;OUTPUT IT
STR$ [ASCIZ/: /] ;FOLLOW WITH COLON AND SPACE
CALL @STATCD(J) ;GO TYPE OUT THE VALUE
AOBJN J,STATLP ;LOOP OVER ALL ENTRIES
CRLF ;END WITH A CRLF
STATCP: MOVE T1,[NEWSTA,,OLDSTA] ;GET READY
BLT T1,OLDTIM ;COPY NEW STATISTICS AS OLD ONES
RET ;ALL DONE
;FOLLOWING ARE THE ROUTINES CALLED TO OUTPUT THE VARIOUS VALUES.
;THE DATA FOR EACH ROUTINE IS IN THE TABLES NEWSTA AND OLDSTA.
;ROUTINE TO OUTPUT THE DIFFERENCE BETWEEN NEW AND OLD VALUES, AND
;ALSO TYPE THE TOTAL VALUE:
DODIF: MOVE T1,NEWSTA(J) ;GET NEW VALUE
SUB T1,OLDSTA(J) ;SUBTRACT OLD VALUE
CALL DECOUT ;OUTPUT IT
TAB ;TAB OVER
;THEN OUTPUT TOTAL VALUE
;ROUTINE TO OUTPUT THE NEW VALUE ITSELF:
DONUM: MOVE T1,NEWSTA(J) ;GET THE NEW VALUE
PJRST DECOUT ;OUTPUT IT AND RETURN
;ROUTINE TO COMPUTE AN AVERAGE OVER THE TIME INTERVAL:
DOAVG: MOVE T1,NEWSTA(J) ;GET THE NEW TIME
SUB T1,OLDSTA(J) ;SUBTRACT THE OLD TIME
IMULI T1,^D10 ;SINCE HAVE ONE PLACE AFTER DECIMAL POINT
MOVEI T4,DECSP3 ;GET READY
JRST DOPCT1 ;JOIN OTHER CODE
;ROUTINE TO OUTPUT THE PERCENTAGE OF TIME TAKEN IN THE LAST INTERVAL:
DOPCT: MOVE T1,NEWSTA(J) ;GET THE NEW TIME
SUB T1,OLDSTA(J) ;SUBTRACT THE OLD TIME
IMULI T1,^D1000 ;GET READY TO GET TENTHS OF PERCENT
MOVEI T4,DECSP2 ;GET READY
DOPCT1: IDIV T1,STADIF ;DIVIDE BY TIME INTERVAL
LSH T2,1 ;DOUBLE REMAINDER
CAML T2,STADIF ;SHOULD WE ROUND UP?
ADDI T1,1 ;YES, DO IT
PJRST FIXOUT ;OUTPUT AS FIXED POINT NUMBER
SUBTTL ROUTINE TO COLLECT DATA FOR WATCH TYPE OUTPUT
;CALLED TO FILL IN THE TABLE NEWSTA WITH THE RESULTS OF GETABS ON
;THE ENTRIES GIVEN IN THE STATTB TABLE. LATER ON THE DATA IS OUTPUT
;TO THE USER.
RDSTAT: TIME ;READ TIME SINCE SYSTEM STARTED
MOVEM T1,NEWTIM ;SAVE IT
SUB T1,OLDTIM ;GET DIFFERENCE FROM OLD TIME
MOVEM T1,STADIF ;SAVE IT
MOVSI J,-STATNM ;GET READY FOR A LOOP
RDSTAL: MOVE T1,STATTB(J) ;GET THE TABLE INDEX
HRRI T1,.SYSTA ;AND THE TABLE NUMBER
GETAB ;READ THE INFORMATION
SETZ T1, ;FAILED, MAKE IT ZERO
MOVEM T1,NEWSTA(J) ;SAVE THE VALUE
AOBJN J,RDSTAL ;LOOP OVER ALL ENTRIES
RET ;DONE
SUBTTL SUBROUTINE TO OUTPUT LOAD AVERAGES
;THIS IS CALLED TO TYPE THE LOAD AVERAGES OUT. THE LOAD AVERAGES
;KEPT AS FLOATING POINT NUMBERS.
DOLOAD: STR$ [ASCIZ/
Load averages:/] ;START OUT TYPEOUT
MOVSI T1,14 ;GET INDEX OF 1 MINUTE AVERAGE
MOVX T3,1B1!1B4!1B6!37B17!4B23!2B29 ;GET BITS
CALL LOADTP ;TYPE IT OUT
MOVSI T1,15 ;GET INDEX OF 5 MINUTE AVERAGE
CALL LOADTP ;TYPE IT OUT
MOVSI T1,16 ;GET INDEX OF 15 MINUTE AVERAGE
CALL LOADTP ;TYPE IT
JRST DOCRLF ;FINISH WITH A CRLF
LOADTP: HRRI T1,.SYSTA ;DATA IS IN THE SYSTAT TABLE
GETAB ;READ IT
SETZ T1, ;FAILED, MAKE ZERO
MOVE T2,T1 ;PUT INTO RIGHT AC
HRROI T1,TEMP ;POINT TO STORAGE AREA
FLOUT ;OUTPUT THE NUMBER
JFCL ;SHOULD NOT FAIL
STR$ TEMP ;NOW OUTPUT THE NUMBER
RET ;DONE
SUBTTL SUBROUTINE TO OUTPUT NUMBER OF JOBS ON SYSTEM
;CALLED TO OUTPUT THE NUMBER OF JOBS ON THE SYSTEM, AND HOW MANY OF
;THEM ARE ACTIVE. (THEIR IDLE TIME IS 1 MINUTE OR LESS).
DOACT: STR$ [ASCIZ/Jobs: /] ;TYPE SOME
SETZB T1,T4 ;CLEAR COUNTERS
MOVE J,HGHJOB ;GET HIGHEST JOB
DOACTL: SKIPN CURRUN(J) ;DOES THIS JOB HAVE RUNTIME?
JRST DOACTN ;NO, LOOK AT NEXT ONE
ADDI T1,1 ;YES, COUNT IT
SKIPN IDLE(J) ;IS THE JOB ACTIVE?
ADDI T4,1 ;YES, COUNT IT
DOACTN: SOJGE J,DOACTL ;LOOP OVER ALL JOBS
CALL DECOUT ;OUTPUT TOTAL NUMBER
CHI$ "/" ;THEN A SLASH
MOVE T1,HGHJOB ;GET HIGHEST JOB NUMBER
ADDI T1,1 ;ADD SINCE WE COUNT JOB 0
CALL DECOUT ;OUTPUT TOTAL JOBS POSSIBLE
STR$ [ASCIZ/ Active: /] ;GET READY
MOVE T1,T4 ;GET NUMBER OF ACTIVE JOBS
CALL DECOUT ;OUTPUT THEM
JRST DOCRLF ;END IN CRLF
SUBTTL SUBROUTINE TO TYPE OUT SCHEDULAR CLASSES
;CALLED AS PART OF THE MONITOR STATISTICS, TO OUTPUT THE SCHEDULER CLASSES
;CURRENTLY IN USE. USES THE SKED% JSYS TO COLLECT THE DATA.
DOCLAS: MOVEI T1,.SKRBC ;FUNCTION TO READ BIAS KNOB
MOVEI T2,T3 ;ADDRESS OF BLOCK
MOVEI T3,2 ;TWO ARGUMENTS
SKED% ;READ THE KNOB
ERJMP CPOPJ ;FAILED, ASSUME NO JSYS EXISTS
MOVE T1,T4 ;GET VALUE OF KNOB
STR$ [ASCIZ/
Bias knob: /] ;START OUTPUT
CALL DECOUT ;OUTPUT THE VALUE
MOVEI T1,.SKRCV ;FUNCTION
MOVEI T2,T3 ;LOCATION FOR BLOCK
MOVEI T3,2 ;TWO ARGUMENTS AGAIN
SKED% ;READ THE CLASS PARAMETERS
ERJMP DOCRLF ;FAILED
STR$ [ASCIZ/ Class scheduler is /] ;TYPE SOME
TXNE T4,SK%STP ;IS IT ON?
STR$ [ASCIZ/off/] ;NO, SAY SO
TXNN T4,SK%STP ;WELL?
STR$ [ASCIZ/on/] ;YES
CRLF ;THEN A CRLF
CALL GETCLS ;READ CLASSES FOR ALL JOBS
TAB$ [$TABS<6,12,18,25,32,40>] ;SET NEW TAB STOPS
TXZ F,FR.HDR ;CLEAR HEADER FLAG
SETO J, ;INITIALIZE CLASS FOR LOOP
CLSLOP: MOVEI T1,.SA15L+1 ;NUMBER OF ARGUMENTS
AOS T2,J ;GET NEXT CLASS
DMOVEM T1,KBLK ;STORE AWAY
MOVEI T1,.SKRCS ;FUNCTION CODE
MOVEI T2,KBLK ;ADDRESS OF ARGUMENT BLOCK
SKED% ;READ THE INFORMATION
ERJMP CPOPJ ;FAILED, RETURN
SKIPN KBLK+.SASHR ;ANY SHARE?
SKIPE KBLK+.SAUSE ;OR UTILIZATION?
JRST SHWCLS ;YES, THEN SHOW THIS CLASS
CAIG J,MAXCLS ;GREATER THAN OUR HIGHEST CLASS?
SKIPN CLSNUM(J) ;OR NO JOBS IN THE CLASS?
JRST CLSLOP ;YES, DON'T SHOW IT
SHWCLS: TXON F,FR.HDR ;ALREADY OUTPUT THE HEADER?
STR$ [ASCIZ/Class Share Use 1-Load 5-Load 15-Load Jobs in class
/] ;NO, THEN OUTPUT IT
MOVE T1,J ;GET CLASS
CALL DECSP3 ;OUTPUT IT
TAB ;THEN TAB OVER
MOVE T1,KBLK+.SASHR ;GET THE SHARE
CALL FLTOUT ;OUTPUT A FLOATING POINT NUMBER
TAB ;THEN TAB AGAIN
MOVE T1,KBLK+.SAUSE ;GET THE UTILIZATION
CALL FLTOUT ;OUTPUT IT AS FLOATING POINT TOO
TAB ;THEN TAB AGAIN
MOVE T1,KBLK+.SA1ML ;GET ONE MINUTE LOAD AVERAGE
CALL FLTOUT ;OUTPUT IT
TAB ;THEN TAB
MOVE T1,KBLK+.SA5ML ;GET FIVE MINUTE LOAD AVERAGE
CALL FLTOUT ;OUTPUT IT
TAB ;THEN TAB
MOVE T1,KBLK+.SA15L ;GET FIFTEEN MINUTE LOAD AVERAGE
CALL FLTOUT ;OUTPUT IT
TAB ;ANOTHER TAB
CALL TYPCLS ;AND LIST ALL JOBS IN THAT CLASS
CRLF ;THEN DO A CRLF
JRST CLSLOP ;LOOP
SUBTTL SUBROUTINES TO COLLECT AND LIST JOBS IN A CLASS
;HERE TO CREATE A TABLE OF CLASSES FOR ALL THE JOBS. USED LATER
;TO LIST THOSE JOBS IN EACH SCHEDULER CLASS.
GETCLS: MOVE T1,[CLSTAB,,CLSTAB+1] ;GET READY
SETOM CLSTAB ;TO CLEAR INFO IN TABLE
BLT T1,CLSTAB+MAXJOB-1 ;DO IT
MOVE T1,[CLSNUM,,CLSNUM+1] ;GET READY
SETZM CLSNUM ;CLEAR NUMBER OF JOBS IN CLASSES
BLT T1,CLSNUM+MAXCLS ;DO IT
SETO J, ;GET READY FOR LOOP
GETCLL: ADDI J,1 ;MOVE TO NEXT JOB
CAMLE J,HGHJOB ;DID THEM ALL?
RET ;YES, RETURN
MOVEM J,KBLK+.SAJOB ;SET IN ARGUMENT BLOCK
MOVEI T1,3 ;GET NUMBER OF WORDS
MOVEM T1,KBLK ;PUT IN ARGUMENT BLOCK TOO
MOVEI T1,.SKRJP ;GET FUNCTION CODE
MOVEI T2,KBLK ;POINT TO FUNCTION BLOCK
SKED% ;READ THE INFO
ERJMP GETCLL ;FAILED, DO NEXT JOB
MOVE T1,KBLK+.SAJCL ;GET THE SCHEDULER CLASS
MOVEM T1,CLSTAB(J) ;REMEMBER FOR LATER
SKIPL T1 ;SEE IF IN RANGE OF OUR TABLE
CAILE T1,MAXCLS ;WELL?
JRST GETCLL ;NO, IGNORE INCREMENTING COUNT
AOS CLSNUM(T1) ;YES, INCREMENT COUNT
JRST GETCLL ;LOOP
;HERE TO TYPE ALL OF THE JOBS WHICH BELONG TO A PARTICULAR SCHEDULER
;CLASS. THE DATA HAD PREVIOUSLY BEEN COLLECTED BY THE GETCLS ROUTINE.
;SCHEDULER CLASS TO BE LISTED IN IN AC J.
TYPCLS: SKIPN CLSNUM(J) ;ANY JOBS IN THIS CLASS?
STR$ [ASCIZ/None/] ;NO, SAY SO
SKIPN CLSNUM(J) ;WELL?
RET ;NO, SO QUIT NOW
SETOB T4,TEMP ;GET READY FOR THE LOOP
TYPCLL: AOS T4 ;ADVANCE TO NEXT JOB
CAMG T4,HGHJOB ;DONE WITH ALL JOBS?
CAME J,CLSTAB(T4) ;OR DONE WITH A RANGE?
JRST TYPCLR ;YES, GO TYPE IT
SKIPGE TEMP ;SEE IF HAVE TO INITIALIZE THE RANGE
MOVEM T4,TEMP ;YES, SAVE JOB NUMBER
JRST TYPCLL ;GO BACK TO THE LOOP
TYPCLR: SKIPGE TEMP ;HAVE A RANGE TO TYPE?
JRST TYPCLE ;NO, GO SEE IF DONE
CALL LEFT ;GET AMOUNT OF SPACE LEFT ON LINE
CAIGE T1,^D6 ;ENOUGH FOR ANOTHER RANGE?
STR$ [BYTE(7)12,11,11,11,11,11,11] ;NO, MOVE TO NEXT LINE
MOVE T1,TEMP ;GET FIRST JOB NUMBER
CALL DECOUT ;OUTPUT IT
MOVEI T1,-1(T4) ;GET LAST JOB OF RANGE
CAME T1,TEMP ;SAME AS FIRST JOB?
CHI$ "-" ;NO, SEPARATE WITH DASH
CAME T1,TEMP ;WELL?
CALL DECOUT ;NO, TYPE LAST JOB OF RANGE
SPACE ;THEN TYPE A SPACE
SETOM TEMP ;REINITIALIZE FIRST JOB OF RANGE
TYPCLE: CAMGE T4,HGHJOB ;LOOKED AT ALL JOBS?
JRST TYPCLL ;NO, TRY NEXT ONE
RET ;YES, DONE
SUBTTL DISPLAY TO SHOW STATUS OF SYSTEM RESOURCES
;THIS DISPLAY SHOWS THE AMOUNT OF RESOURCES USED, SUCH AS SPT SLOTS,
;FREE CORE, SWAPPING SPACE, ETC. A BAR GRAPH IS SHOWN AS PART OF THE
;DISPLAY TO MAKE THESE NUMBERS OBVIOUS.
DPYRES: TAB$ [$TABS <0,16,28>] ;SET NICE TAB STOPS
SETOM HDRTYP ;NO SPECIAL HEADERS FOR THIS DISPLAY
TXNN F,FR.CMP ;SKIP HEADER IF COMPRESSING
STR$ [ASCIZ"Resource Used/Total Percentage used
"]
SETZM RESDAT ;INITIALIZE TOTAL IN CASE FAIL TOTALLY
SETO J, ;GET READY FOR LOOP
RESLOP: MOVEI T1,.RDRES ;GET FUNCTION CODE
TLNN J,-1 ;NOT A RESIDENT SUBFIELD?
CAML J,RESQTL ;OR NO MORE SUBFIELDS?
IORI J,-1 ;YES, SET TO DO NEXT FIELD
AOS T2,J ;ADVANCE TO NEXT ENTRY
MONRD% ;READ THE DATA
ERJMP RESDON ;FAILED
JUMPL T1,RESDON ;ALSO
CALL RESTYP ;TYPE DATA ON THIS POOL
JRST RESLOP ;LOOP
RESDON: STR$ [ASCIZ/ 0% 20% 40% 60% 80% 100%
/] ;TYPE OUT PERCENTAGE LINE
RET ;RETURN
;HERE TO TYPE A LINE ABOUT EACH FREE POOL:
RESTYP: HLRZ T4,J ;GET TYPE OF FIELD THIS IS
TRNE J,-1 ;ACTUALLY A SUBFIELD OF RESIDENT SPACE?
MOVEI T4,RESPOL-RESFLD-1(J) ;YES, FIX UP TO POINT TO OTHER TABLE
CAIN T4,RESPOL-RESFLD;SUB FIELD 0?
RET ;YES, FORGET IT
STR$ @RESFLD(T4) ;OUTPUT PROPER TEXT
TAB ;THEN TAB
MOVE T1,T2 ;COPY TOTAL
SKIPGE RESFLD(T4) ;WANTS THE VALUE ITSELF?
SKIPA T1,T3 ;YES, GET IT
SUB T1,T3 ;NO, THEN GET DIFFERENCE
DMOVEM T1,TEMP ;SAVE VALUES
CALL DECSP5 ;OUTPUT CURRENT VALUE
SPACE ;THEN SPACE ONE
MOVE T1,TEMP+1 ;GET ORIGINAL VALUE
CALL DECOUT ;OUTPUT IT TOO
TAB ;TAB OVER MORE
DMOVE T1,TEMP ;GET BACK VALUES
CALL DOHIST ;OUTPUT HISTOGRAM
JRST DOCRLF ;END IN A CRLF
;EACH INDIVIDUAL RESOURCE:
RESFLD: EXP [ASCIZ/Res free core/] ;(0) TOTAL FREE RESIDENT BLOCKS
EXP [ASCIZ/Swap free core/] ;(1) SWAPPABLE STORAGE
EXP [ASCIZ/ ENQ blocks/] ;(2) ENQ USAGE
EXP 1B0+[ASCIZ/ DECnet core/] ;(3) SWAPPABLE NETWORK
EXP 1B0+[ASCIZ/Open files/] ;(4) NUMBER OF OFNS
EXP 1B0+[ASCIZ/SPT slots/] ;(5) SPT SLOTS
EXP [ASCIZ/Swapping pages/] ;(6) PAGES OF SWAPPING
EXP [ASCIZ/User core/] ;(7) PAGES OF USER CORE USED
EXP 1B0+[ASCIZ/Forks/] ;(10) NUMBER OF FORKS USED
MAXRES==.-RESFLD-1 ;HIGHEST RESOURCE
;SUBFIELDS OF THE RESIDENT STORAGE FIELD:
RESPOL: EXP [ASCIZ/ Unused pool/] ;(0) CATCH22 POOL
EXP [ASCIZ/ General pool/] ;(1) GENERAL
EXP [ASCIZ/ Terminals/] ;(2) TERMINAL DATA
EXP [ASCIZ/ DECnet core/] ;(3) NETWORK
EXP [ASCIZ/ Timer blocks/] ;(4) TIMER BLOCKS
MAXPOL==.-RESPOL ;HIGHEST KNOWN TYPE
SUBTTL SUBROUTINE TO TYPE OUT HISTOGRAM DATA
;CALLED WITH A FRACTION GIVEN BY THE NUMBERS IN ACS T1 AND T2, TO
;OUTPUT A BAR GRAPH WHICH GIVES THE PERCENTAGE OF THE FRACTION.
;ILLEGAL VALUES ARE TAMED BEFORE TRYING TO USE THEM. THE PATTERN
;IS SEVERAL PERCENTAGE POINTS TO A COLUMN.
DOHIST: SKIPL T3,T1 ;MOVE AND CHECK SIGN OF NUMBER
SKIPG T2 ;AND OF DENOMINATOR
SETZB T2,T3 ;BAD, CLEAR THEM
CAMLE T3,T2 ;SEE IF HAVE AN IMPROPER FRACTION
MOVE T3,T2 ;YES, REDUCE TO UNITY
MULI T3,^D100 ;TURN INTO A PERCENTAGE
DIV T3,T2 ;FROM THE FRACTION
IDIVI T3,PERCOL ;CONVERT PERCENTAGE
IMULI T3,PERCOL ;TO A MULTIPLE OF THE COMPRESSION
SETZ T1, ;START WITH ZERO
STARLP: ADDI T1,PERCOL ;ADVANCE TO NEXT PERCENTAGE
CHI$ "*" ;TYPE A STAR
CAMG T1,T3 ;DONE?
JRST STARLP ;NO
HSTLOP: ADDI T3,PERCOL ;INCREMENT TO NEXT NUMBER
CAILE T3,^D100 ;REACHED THE END?
RET ;YES, DONE
MOVE T1,T3 ;COPY NUMBER
IDIVI T1,^D10 ;SEE IF AT A MULTIPLE OF 10
SKIPN T2 ;AT A MULTIPLE?
CHI$ "!" ;YES, THEN TYPE MARKER
SKIPE T2 ;WELL?
SPACE ;NO, JUST SPACE OVER
JRST HSTLOP ;LOOP
SUBTTL DISPLAY WHICH SHOWS BUSY DEVICES
;THIS DISPLAY SHOWS WHO OWNS THE DEVICES ON THE SYSTEM. ALL
;DEVICES WHICH ARE NOT DISKS AND CONTROLLING TERMINALS ARE DISPLAYED.
DPYDEV: MOVEI T1,TP.DEV ;THIS IS THE DEVICE DISPLAY
CALL HDRSET ;SO SET UP HEADERS FOR IT
TXO F,FR.EAT ;REMEMBER TO EAT LINES LATER
SETO J, ;SET UP FOR LOOP
DEVLOP: ADDI J,1 ;MOVE TO NEXT INDEX
MOVSI T1,(J) ;SET UP INDEX
IORI T1,.DEVUN ;TABLE OF OWNERS AND UNITS
GETAB ;READ IT
ERJMP CPOPJ ;FAILED, ALL DONE
HLRZ T2,T1 ;GET JOB NUMBER
CAIE T2,-1 ;NOT ASSIGNED TO ANY JOB?
CAIN T2,-2 ;OR ASSIGNED TO RESOURCE ALLOCATOR?
JRST DEVLOP ;YES, TRY NEXT ONE
MOVEM T1,DEVUNT ;SAVE WORD FOR LATER
MOVSI T1,(J) ;SET UP INDEX AGAIN
IORI T1,.DEVCH ;TABLE OF DEVICE CHARACTERISTICS
GETAB ;READ IT
ERJMP DEVLOP ;CAN'T, GO TO NEXT ONE
LDB T2,[POINT 9,T1,17] ;GET DEVICE TYPE
CAIN T2,.DVDSK ;IS IT A DISK?
JRST DEVLOP ;YES, DON'T SHOW IT
CAIE T2,.DVTTY ;IS IT A TTY?
JRST DEVSHW ;NO, GO SHOW IT
HLLZ T1,DEVUNT ;GET BACK JOB NUMBER
IORI T1,.JOBTT ;INDEX FOR JOB TO TERMINAL
GETAB ;GET IT
ERJMP DIE ;FAILED
TSC T1,DEVUNT ;GET DIFFERENCES WITH SAVED UNIT
TLNN T1,-1 ;CONTROLLING TERMINAL?
JRST DEVLOP ;YES, DON'T SHOW IT
DEVSHW: MOVSI T1,(J) ;GET INDEX
IORI T1,.DEVNA ;WANT NAME
GETAB ;READ IT
SETZ T1, ;CAN'T, USE ZERO
MOVEM T1,DEVNAM ;SAVE FOR LATER
CALL DOCOLS ;DO THE COLUMNS
JRST DEVLOP ;THEN LOOP
;FOLLOWING ARE THE ROUTINES TO OUTPUT THINGS ABOUT DEVICES:
XXDEVN: MOVE T1,DEVNAM ;GET THE DEVICE NAME
JRST SIXOUT ;OUTPUT IT
XXDEVC: MOVE T1,DEVNAM ;GET DEVICE NAME
CALL SIXASC ;CONVERT IT TO ASCIZ
HRROI T1,TEMP ;POINT TO NAME
STDEV ;CONVERT TO DESIGNATOR
ERJMP CPOPJ ;FAILED
MOVE T1,T2 ;MOVE TO RIGHT AC
JRST OCTFUL ;OUTPUT IT
XXDEVJ: HLRZ T1,DEVUNT ;GET THE JOB NUMBER
JRST DECSP3 ;THEN OUTPUT IT
XXDEVU: HLRZ T1,DEVUNT ;GET THE JOB NUMBER AGAIN
JRST JOBUSR ;AND OUTPUT THE USER
SUBTTL DISPLAY FOR DECNET STATUS
;THIS MODE IS ENTERED BY THE "DN" COMMAND. THE STATUS OF ALL NODES
;ON THE NETWORK IS GIVEN, AND THE STATUS OF ALL LOGICAL LINK
;BLOCKS IS ALSO GIVEN.
DPYDEC: MOVEI T1,.NDGLN ;FUNCTION TO READ LOCAL NODE NAME
MOVEI T2,T3 ;ARGUMENT BLOCK ADDRESS
HRROI T3,LCLNOD ;POINT TO STORAGE
NODE ;GET THE INFORMATION
ERJMP LOSE ;FAILED
TXNE F,FR.CMP ;DON'T WANT TO SEE TITLES?
JRST DECNOH ;YEP, SKIP IT
STR$ [ASCIZ/This is node /] ;TYPE SOME
STR$ LCLNOD ;THEN GIVE THE NODE NAME
MOVEI T1,2 ;WANT TWO VERSIONS RETURNED
MOVEM T1,TEMP ;STORE
MOVEI T1,DATLOC ;GET ADDRESS OF FIRST BLOCK
MOVEM T1,TEMP+1 ;STORE
MOVEI T1,DATLOC+10 ;GET ADDRESS OF SECOND BLOCK
MOVEM T1,TEMP+2 ;STORE THAT TOO
MOVEI T1,.NDGVR ;FUNCTION CODE
MOVEI T2,TEMP ;POINT TO ARGUMENTS
NODE ;READ THE DATA
ERJMP LOSE ;FAILED
STR$ [ASCIZ/ NSP version /] ;TYPE SOME MORE
MOVEI T1,DATLOC ;POINT TO VERSION STUFF
CALL VEROUT ;OUTPUT STRANGE VERSION STYLE
STR$ [ASCIZ/ Routing version /] ;TYPE MORE
MOVEI T1,DATLOC+10 ;POINT TO DATA
CALL VEROUT ;OUTPUT THAT TOO
CRLF ;DO A CRLF
DECNOH:
TXNN F,FR.CMP ;SUPPRESING TITLES?
CALL DONODE ;NO...SO SHOW THE AVAILABLE NODES
CRLF ;THEN DO ANOTHER CRLF
CALL SETEAT ;SET UP TO EAT LINES NOW
JRST DOLLNK ;GO SHOW LOGICAL LINKS
SUBTTL ROUTINE TO TYPE OUT AVAILABLE NODES
;THIS ROUTINE OUTPUTS THE LIST OF AVAILABLE NODES.
DONODE: MOVEI T1,.NDGNT ;FUNCTION TO READ DECNET STRUCTURE
MOVEI T2,DATLOC ;POINT TO STORAGE AREA
MOVEI T3,DATSIZ ;GET SIZE OF AREA
MOVEM T3,DATLOC+.NDNND ;SET IN ARGUMENT BLOCK
NODE ;READ THE DATA
ERJMP LOSE ;FAILED, GO SAY WHY
HLRZ T4,DATLOC+.NDNND ;GET NUMBER OF NODES RETURNED
MOVEI T3,DATLOC+.NDBK1 ;GET ADDRESS OF FIRST POINTER
TXZ F,FR.TMP ;CLEAR TEMP FLAG
STR$ [ASCIZ/Available nodes: /] ;TYPE SOME
NODLOP: SOJL T4,DOCRLF ;IF NO MORE NODES, DO CRLF AND RETURN
TXOE F,FR.TMP ;TIME FOR A COMMA?
STR$ [ASCIZ/, /] ;YES, SEPARATE THE NODES
CALL LEFT ;GET ROOM LEFT ON THIS LINE
CAIGE T1,^D8 ;ENOUGH FOR ANOTHER NODE NAME?
STR$ [ASCIZ/
/] ;NO, MOVE TO NEW LINE
MOVE T1,(T3) ;GET ADDRESS OF THIS BLOCK
MOVE T1,.NDNAM(T1) ;GET POINTER TO NODE NAME
STR$ (T1) ;TYPE IT
AOJA T3,NODLOP ;DO NEXT ONE
SUBTTL SUBROUTINE TO DUMP INFORMATION ABOUT LOGICAL LINKS
;CALLED TO TYPE OUT ALL OF THE LOGICAL LINKS ON THIS NODE, AND THEIR
;STATUS, ETC. THIS CURRENTLY REQUIRES THE MONRD% JSYS TO COLLECT THE
;DATA.
DOLLNK: TXNN F,FR.JSY ;IS THE MONRD% JSYS IN?
RET ;NO, CAN'T GET THIS
MOVEI T1,TP.DLL ;TYPE OF DISPLAY
CALL HDRSET ;SET UP HEADERS
MOVEI T1,.RDDLL ;GET FUNCTION CODE
MOVE T2,[-DATSIZ,,DATLOC] ;POINT TO BUFFER AREA
MONRD% ;READ THE DATA
ERJMP CPOPJ ;FAILED, CAN'T GET IT
JUMPL T1,CPOPJ ;ALSO CAN'T GET IT
HRRZM T2,LNKNUM ;SAVE NUMBER OF LINKS WE GOT
MOVEI J,DATLOC ;POINT TO THE DATA
JBLNKL: SOSL LNKNUM ;ANY MORE LOGICAL LINKS TO SHOW?
CALL FULL ;OR IS SCREEN FULL?
RET ;YES, RETURN
SETOM KWNJOB ;CLEAR ANY KNOWN JOB FOR A FORK
LDB T1,[POINT 4,DL.2(J),5] ;GET STATE OF LINK
CAIN T1,1 ;ACTIVE?
TXNN F,FR.ACT ;OR WANT ALL LINKS ANYWAY?
CALL DOCOLS ;YES, SHOW DATA ABOUT THIS LINK
ADDI J,DLLNUM ;ADVANCE TO NEXT LINK
JRST JBLNKL ;AND SHOW IT
;BITS AND FIELDS IN THE LOGICAL LINK BLOCKS. REFER TO NSPPAR.MAC FOR
;THE ORIGINAL DEFINITIONS.
LLSTA==POINT 4,DL.2(J),5 ;STATE CODE
LLFLG==POINT 12,DL.2(J),17 ;FLAGS FOR THIS LL BLOCK
LLSDE==POINT 1,DL.2(J),7 ;LL BLOCK IS DISASSOCIATED FROM FORK
LLFOB==POINT 1,DL.2(J),17 ;THIS IS A SRV
LLINT==POINT 1,DL.2(J),6 ;THIS IS AN INTERNAL LINK
LLLNK==POINT 18,DL.2(J),35 ;LINK ID
LLFRK==POINT 18,DL.3(J),17 ;FORK WHICH OWNS LL BLOCK
LLFNM==POINT 8,DL.4(J),19 ;REMOTE OBJECT NUMBER
LLHLK==POINT 16,DL.4(J),35 ;LINK ID ON REMOTE HOST
LLBRP==POINT 1,DL.7(J),0 ;TRANSBIT BACK-PRESSURE BIT
LLBRL==POINT 1,DL.7(J),1 ;RECEIVE BACK-PRESSURE BIT
LLMFC==POINT 2,DL.7(J),3 ;FLOW CONTROL CODE
LLMSM==POINT 8,DL.7(J),27 ;MAXIMUM MESSAGES ALLOWED
LLDSN==POINT 12,DL.11(J),11 ;TRANSMIT COUNTER
LLIDN==POINT 12,DL.11(J),35 ;RECEIVE COUNTER
LLTSK==POINT 30,DL.13(J),35 ;POINTER TO TASK NAME
LLBPCT==POINT 36,DL.17(J),35 ;CURRENT BYTE COUNT
LLBSZ==POINT 6,DL.20(J),5 ;BYTE SIZE FOR IO
LLRSN==POINT 16,DL.20(J),35 ;REASON CODE FOR ABORT
LLHSN==POINT 18,DL.22(J),17 ;REMOTE NODE NUMBER
LLSOB==POINT 18,DL.33(J),17 ;OBJECT CODE FOR A SRV
;THE FOLLOWING MACRO DEFINES WHICH WORDS WE WANT TO KNOW ABOUT,
;AND IS USED TO RETURN THEM IN THE MONRD% JSYS.
DEFINE LLNUMS,<
LLLIST <2,3,4,7,10,11,13,17,20,22,33>
>
;ROUTINES TO TYPE OUT VARIOUS THINGS ABOUT THE LINKS.
XXLKFK: LDB T1,[LLSDE] ;GET FLAG FOR DISASSOCIATED LL BLOCK
JUMPN T1,LNKDIS ;JUMP IF IT IS DISASSOCIATED
LDB T1,[LLFRK] ;GET FORK WHICH OWNS THIS LINK
JRST OCTSP3 ;OUTPUT IT
LNKDIS: STR$ [ASCIZ/--/] ;SAY NO FORK
RET ;DONE
XXLKJB: LDB T1,[LLSDE] ;SEE IF THIS BLOCK IS DISACCOCIATED
JUMPN T1,LNKDIS ;YES, GO TYPE DASHES
LDB T1,[LLFRK] ;GET THE FORK OWNINT IT
CALL FRKJOB ;FIND WHICH JOB HAS THAT FORK
RET ;FAILED
JRST DECSP2 ;OK, GO OUTPUT JOB NUMBER
XXLPRG: LDB T1,[LLSDE] ;SEE IF THIS IS A DISASSOCIATED BLOCK
JUMPN T1,CPOPJ ;IF SO, TYPE NOTHING
LDB T1,[LLFRK] ;GET THE FORK WHICH OWNS IT
CALL FRKJOB ;FIND OUT THE JOB NUMBER
RET ;FAILED
MOVSI T1,(T1) ;PUT INTO LEFT HALF
IORI T1,.JOBPN ;INDEX
GETAB ;READ PROGRAM NAME
ERJMP CPOPJ ;FAILED
JRST SIXOUT ;GO OUTPUT IT
XXLBYC: LDB T1,[LLBPCT] ;GET THE CURRENT BYTE COUNT
JRST DECSP6 ;OUTPUT IT
XXLKID: LDB T1,[LLLNK] ;GET THIS LINK ID
JRST OCTSP6 ;OUTPUT IT AND RETURN
XXLKIR: LDB T1,[LLHLK] ;GET LINK ID ON REMOTE HOST
JRST OCTSP6 ;OUTPUT IT AND RETURN
XXLSEG: LDB T1,[LLDSN] ;GET TRANSMIT COUNTER
CALL OCTSP4 ;OUTPUT IT
LDB T1,[LLIDN] ;GET RECEIVE COUNTER
JRST OCTSP6 ;OUTPUT AND RETURN
XXLOBJ: LDB T2,[LLFOB] ;GET FLAG DISTINGUSHING DCN FROM A SRV
LDB T1,[LLSOB] ;GET OBJECT CODE ASSUMING THIS IS A SRV
SKIPN T2 ;IS THIS ACTUALLY A DCN?
LDB T1,[LLFNM] ;YES, GET REMOTE OBJECT
MOVSI T2,-OBJNUM ;GET READY FOR SEARCH
HLRZ T3,OBJTAB(T2) ;GET NEXT OBJECT NUMBER
CAME T1,T3 ;FOUND IT?
AOBJN T2,.-2 ;NO, CONTINUE LOOKING
JUMPGE T2,DECOUT ;IF NOT FOUND, OUTPUT IN DECIMAL
MOVE T1,OBJTAB(T2) ;GET POINTER TO NAME
STR$ (T1) ;TYPE IT
RET ;DONE
;TABLE OF OBJECT NAMES:
DEFINE NT(CODE,TEXT),<
XWD <CODE>,[ASCIZ/TEXT/] ;;CODE AND NAME
>
OBJTAB: NT 0,TASK
NT 1,FAL1
NT 2,URDS
NT 3,ATS
NT 4,CTS
NT 5,TCL1
NT 6,OSI
NT 7,NRM
NT 10,3270
NT 11,2780
NT 12,3790
NT 13,TPS
NT 17,TCL
NT 20,TLK
NT 21,FAL
NT 22,RTL
NT 23,NCU
NT 26,MAIL
NT 27,NVT
NT 30,TCON
NT 31,LOOP
NT 32,EVENT
NT 34,FTS
NT ^D47,POSI
NT ^D63,DTR
NT ^D65,TOPOL
NT ^D123,PMR
NT ^D201,MS
OBJNUM==.-OBJTAB ;NUMBER OF ENTRIES
XXLKTP: MOVE T1,<PW(LLFLG)>(J) ;GET WORD CONTAINING FLAGS
TXNE T1,<PM(LLFOB)> ;IS THIS A SRV OR A DCN?
TDZA T2,T2 ;A SRV, MAYBE
MOVEI T2,1 ;A DCN, MAYBE
TXNE T1,<PM(LLINT)> ;IS THIS REALLY INTERNAL?
MOVEI T2,2 ;YES, GET THAT OFFSET
STR$ [ASCII/SRV /
ASCII/DCN /
ASCII/Int /](T2) ;OUTPUT PROPER NAME
CHI$ "(" ;TYPE OPENING PARENTHESIS
LDB T1,[LLBSZ] ;GET BYTE SIZE
CALL DECOUT ;OUTPUT BYTE SIZE
CHI$ ")" ;FINISH THE PARANTHESIS
RET ;DONE
XXLHST: LDB T3,[LLHSN] ;GET THE REMOTE NODE NUMBER
JUMPE T3,NOREM ;IF NONE, LOCAL
MOVEI T1,16 ;MAGIC NODE JSYS FUNCTION
MOVEI T2,T3 ;ADDRESS OF ARG BLOCK
HRROI T4,TEMP ;BP TO NODE NAME
NODE
ERJMP CPOPJ
SKIPE TEMP ;IF NONE, LOCAL
JRST TELHST
NOREM: STR$ LCLNOD ;OUTPUT OUR OWN NODE
RET ;DONE
XXLUSR: LDB T1,[LLSDE] ;SEE IF LL BLOCK IS DISACCIATED
JUMPN T1,CPOPJ ;IF SO, TYPE NOTHING
LDB T1,[LLFRK] ;GET FORK OWNING THE LINK
CALL FRKJOB ;CONVERT TO JOB NUMBER
RET ;CAN'T DO IT
JOBUSR: HRROI T2,T4 ;WANT ONE WORD RETURNED IN T4
MOVEI T3,.JIUNO ;JOB'S USER NUMBER
GETJI ;READ IT
ERJMP CPOPJ ;CAN'T
MOVE T1,T4 ;MOVE TO RIGHT AC
MOVEI T2,3 ;WANT THREE WORDS
JRST USROUT ;GO OUTPUT IT
XXLTSK: LDB T1,[LLTSK] ;GET POINTER TO TASK NAME
JUMPE T1,CPOPJ ;RETURN IF NULL
TLNE T1,-1 ;BETTER NOT BE OUT OF SECTION
RET ;YES, CAN'T GET IT
HRLI T1,^D20 ;ASK FOR SOME WORDS
MOVEI T2,TEMP ;POINT TO STORAGE
PEEK ;READ TEXT
ERJMP CPOPJ ;NO PRIVILEGES
TELHST: SETZM TEMP+^D20 ;MAKE SURE TEXT ENDS
MOVX T1,177B13 ;GET MASK FOR SECOND CHARACTER IN WORD
TXNE F,FR.MOR ;ANY MORE COLUMNS?
ANDCAM T1,TEMP+1 ;YES, CUT OFF TEXT AFTER SIX CHARS
STR$ TEMP ;OUTPUT NAME
RET ;DONE
XXFLOW: LDB T1,[LLBRP] ;GET BACK PRESSURE BIT
CHR$ [EXP " ","T"](T1) ;SAY IF TRANSMITS ARE BLOCKED
LDB T1,[LLBRL] ;GET OTHER BACK PRESSURE BIT
CHR$ [EXP " ","R"](T1) ;SAY IF RECEIVES ARE BLOCKED
SPACE ;SPACE OVER SOME
LDB T1,[LLMFC] ;GET TYPE OF FLOW CONTROL
CAILE T1,MAXFLW ;LEGAL VALUE?
SETO T1, ;NO, SAY UNKNOWN
STR$ @FLOWTB(T1) ;OUTPUT THE TYPE
JUMPE T1,CPOPJ ;IF NONE, ALL DONE
STR$ [ASCIZ/: /] ;TYPE MORE
LDB T1,[LLMSM] ;GET REMAINING MESSAGES TO SEND
JRST DECOUT ;OUTPUT AND RETURN
[ASCIZ/???/] ;UNKNOWN CODE
FLOWTB: [ASCIZ/None/] ;(0) NO FLOW CONTROL
[ASCIZ/Seg/] ;(1) CONTROL IS BY SEGMENT
[ASCIZ/Msg/] ;(2) CONTROL IS BY MESSAGES
MAXFLW==.-FLOWTB-1 ;HIGHEST KNOWN FLOW CONTROL CODE
XXLSTA: LDB T1,[LLSTA] ;GET STATE CODE
CAILE T1,LLSMAX ;GREATER THAN KNOWN STATE?
JRST OCTOUT ;YES, OUTPUT IN OCTAL
STR$ @LLSTAB(T1) ;NO, OUTPUT THE STATE
RET ;DONE
LLSTAB: [ASCIZ/Transient/] ;(0) NON-EXISTANT
[ASCIZ/CI wait/] ;(1) OBJECT IS LISTENING
[ASCIZ/CI sent/] ;(2) CONNECT-INITIALIZE SENT
[ASCIZ/CI read/] ;(3) CONNECT-INITIALIZE RECEIVED
[ASCIZ/Active/] ;(4) LINK IS ACTIVE
[ASCIZ/DI sent/] ;(5) DI SENT
[ASCIZ/DI queued/] ;(6) DI QUEUED
[ASCIZ/DI read/] ;(7) DI REVEIVED
[ASCIZ/CC sent/] ;(10) CC SENT
ABTCOD: [ASCIZ/Aborted/] ;(11) CONNECTION ABORTED
LLSMAX==.-LLSTAB-1 ;HIGHEST KNOWN STATE
XXLABT: LDB T1,[LLSTA] ;GET STATE CODE
CAIE T1,ABTCOD-LLSTAB ;IS IT CONNECTION BROKEN?
RET ;NO, TYPE NOTHING
LDB T1,[LLRSN] ;YES, GET REASON
MOVSI T2,-DINUM ;GET READY FOR SEARCH
HLRZ T3,DITAB(T2) ;GET NEXT POSSIBILITY
CAME T1,T3 ;IS THIS IT?
AOBJN T2,.-2 ;NO, KEEP SEARCHING
JUMPGE T2,DECOUT ;CAN'T FIND, GO GIVE NUMBER
HRLZ T1,DITAB(T2) ;GET ADDRESS OF STRING
HRRI T1,TEMP ;POINT TO STORAGE
BLT T1,TEMP+^D20 ;COPY THE STRING
TXNE F,FR.MOR ;MORE COLUMNS COMING?
SETZM TEMP+3 ;YES, CUT OFF OUTPUT
STR$ TEMP ;OUTPUT REASON
RET ;DONE
;TABLE OF DISCONNECT REASONS:
DEFINE NT(CODE,TEXT),<
XWD <CODE>,[ASCIZ/TEXT/] ;;CODE AND TEXT FOR ERRORS
>
DITAB: NT .DCX0,No special error
NT .DCX1,Resource allocation failure
NT .DCX2,Unknown destination node
NT .DCX3,Node shutting down
NT .DCX4,Unknown destination process
NT .DCX5,Invalid name field
NT .DCX11,User abort
NT .DCX32,Too many node connections
NT .DCX33,Too many process connections
NT .DCX34,Access not permitted
NT .DCX35,Logical link mismatch
NT .DCX36,Invalid account
NT .DCX37,Segment size too small
NT .DCX38,Process aborted
NT .DCX39,No path to destination node
NT .DCX40,Aborted due to data loss
NT .DCX41,Unknown destination process
NT .DCX42,Disconnect confirmation
NT .DCX43,Image data field too long
DINUM==.-DITAB ;SIZE OF TABLE
SUBTTL DISPLAY FOR ARPANET STATUS
;THIS DISPLAY MODE IS SET BY THE "ANH" COMMAND. THE STATUS OF ALL
;ARPANET SITES IS GIVEN. THIS DOES NOT NEED THE MONRD% JSYS.
DPYARH: MOVX T1,.GTHSZ ;WANT TO READ NUMBER OF HOSTS
GTHST% ;READ IT
ERJMP NOARPA ;FAILED, GO SEE WHY
SKIPN J,T3 ;PUT NUMBER OF HOSTS IN RIGHT AC
RET ;NO HOSTS, RETURN
MOVEI T1,TP.ANH ;THIS IS DISPLAY FOR HOST STATUS
CALL HDRSET ;SET UP HEADERS
TXO F,FR.EAT ;REMEMBER TO EAT OUTPUT LATER
APALOP: CALL FULL ;SEE IF SCREEN IS FULL YET
RET ;YES, DONE
MOVX T1,.GTHHI ;GET FUNCTION
MOVEI T3,(J) ;AND HOST INDEX
GTHST% ;READ HOST NUMBER AND STATUS
ERJMP APALPL ;FAILED
TXNE F,FR.AAH ;WANT TO ONLY SHOW ACTIVE (UP) HOSTS?
TXNE T4,HS%UP ;YES, CHECK IF HOST IS UP
TXNN T4,HS%VAL ;MAKE SURE STATUS IS VALID ALSO
JRST APALPL ;NOT UP OR NOT VALID, SKIP ON
DMOVEM T3,APANUM ;WANT TO SHOW IT, SAVE NUMBER AND STATUS
CALL DOCOLS ;SHOW THIS HOST
APALPL: AOBJN J,APALOP ;LOOP UNTIL LOOKED AT THEM ALL
RET ;DONE
NOARPA: MOVEI T1,.FHSLF ;GET READY
GETER ;READ ERROR REASON
HRRZ T1,T2 ;GET ERROR CODE
CAIE T1,ILINS2 ;IS THE JSYS UNDEFINED?
JRST LOSE ;NO, SOME OTHER ERROR
STR$ [ASCIZ/
? No ARPANET code exists in this monitor
/] ;YES, SAY WHAT'S WRONG
RET ;AND RETURN
;ROUTINES TO TYPE DATA ABOUT HOSTS:
XXAHST: MOVE T1,APANUM ;GET HOST NUMBER
JRST OCTOUT ;OUTPUT IT
XXANAM: MOVEI T1,.GTHNS ;WANT TO GET NAME
HRROI T2,TEMP ;POINT TO STORAGE
MOVE T3,APANUM ;GET HOST NUMBER
GTHST% ;READ THE NAME STRING
ERJMP CPOPJ ;NONE EXISTS
TXNE F,FR.MOR ;ANY MORE COLUMNS?
SETZM TEMP+3 ;YES, THEN RESTRICT THE NAME
STR$ TEMP ;OUTPUT THE NAME
RET ;DONE
XXATYP: LDB T1,[POINTR APASTS,HS%STY] ;GET TYPE CODE
CAILE T1,APATPX ;HIGHER THAN WE KNOW?
JRST OCTTEL ;YES, GIVE THE NUMBER
STR$ @APATPT(T1) ;NO, TYPE THE SYSTEM
MOVE T1,APASTS ;GET STATUS AGAIN
TXNN T1,HS%SRV ;IS THIS A USER?
STR$ [ASCIZ/ (user)/] ;YES, SAY SO
RET ;DONE
APATPT: [ASCIZ /other/] ;(0)
[ASCIZ /TENEX/] ;(1)
[ASCIZ /ITS/] ;(2)
[ASCIZ /TOPS-10/] ;(3)
[ASCIZ /TIP/] ;(4)
[ASCIZ /MTIP/] ;(5)
[ASCIZ /ELF/] ;(6)
[ASCIZ /ANTS/] ;(7)
[ASCIZ /MULTICS/] ;(10)
[ASCIZ /TOPS-20/] ;(11)
[ASCIZ /UNIX/] ;(12)
APATPX==.-APATPT-1 ;HIGHEST KNOWN SYSTEM TYPE
XXASTS: MOVE T1,APASTS ;GET THE STATUS OF THIS HOST
TXNE T1,HS%UP ;IS HOST UP?
STR$ [ASCIZ/Up/] ;YES, SAY SO
TXNE T1,HS%UP ;WELL?
RET ;YES, DONE
STR$ [ASCIZ/Down, /] ;SAY IT IS DOWN
LDB T1,[POINTR APASTS,HS%RSN] ;GET REASON FOR BEING DOWN
STR$ @RSNTAB(T1) ;OUTPUT REASON
LDB T1,[POINTR APASTS,<HS%DAY!HS%HR!HS%MIN>] ;GET TIME
JUMPE T1,CPOPJ ;DONE IF UNKNOWN
CAIE T1,<.RTJST(-1,<HS%DAY!HS%HR!HS%MIN>)> ;"-1" FORM OF UNKNOWN?
CAIN T1,<.RTJST(-1,<HS%DAY!HS%HR!HS%MIN>)>-1 ;OR "-2" FORM?
RET ;YES, DONE
STR$ [ASCIZ/, up /] ;HAVE REAL TIME, START OUTPUT
LDB T1,[POINTR APASTS,HS%DAY] ;GET DAY OF WEEK
STR$ DAYTAB(T1) ;TYPE IT
LDB T1,[POINTR APASTS,HS%HR] ;GET HOUR
CALL DECOUT ;OUTPUT IT
CHI$ ":" ;THEN THE COLON
LDB T1,[POINTR APASTS,HS%MIN] ;GET MINUTE
IMULI T1,5 ;FIVE MINUTE EXPANSION
JRST DECOUT ;OUTPUT AND RETURN
RSNTAB: [ASCIZ/net err/] ;(0) REASONS WHY HOST IS DOWN
[ASCIZ/sys dwn/] ;(1)
[ASCIZ/frn NCP/] ;(2)
[ASCIZ/nosuch/] ;(3)
[ASCIZ/NCP ini/] ;(4)
[ASCIZ/PM/] ;(5)
[ASCIZ/hdw wrk/] ;(6)
[ASCIZ/sfw wrk/] ;(7)
[ASCIZ/restart/] ;(8)
[ASCIZ/power/] ;(9)
[ASCIZ/bpt/] ;(10)
[ASCIZ/hdw err/] ;(11)
[ASCIZ/sched/] ;(12)
[ASCIZ/#13/] ;(13)
[ASCIZ/#14/] ;(14)
[ASCIZ/unknown/] ;(15)
DAYTAB: ASCII /Mon / ;(0) MONDAY
ASCII /Tue / ;(1) TUESDAY
ASCII /Wed / ;(2) WEDNESDAY
ASCII /Thu / ;(3) THURSDAY
ASCII /Fri / ;(4) FRIDAY
ASCII /Sat / ;(5) SATURDAY
ASCII /Sun / ;(6) SUNDAY
SUBTTL DISPLAY ROUTINE TO SHOW ARPANET CONNECTIONS
;ROUTINE TO TYPE OUT ALL OF THE ARPANET CONNECTIONS IN USE ON THIS
;SYSTEM. THIS IS THE "ANC" COMMAND.
DPYARC: MOVEI T1,TP.ANC ;GET CODE FOR ARPANET CONNECTION DISPLAY
CALL HDRSET ;AND SET UP HEADERS FOR IT
TXO F,FR.EAT ;REMEMBER TO DO EATING LATER
MOVEI T1,.GTNSZ ;GET FUNCTION
GTNCP% ;READ NUMBER OF NETWORK CONNECTIONS
ERJMP NOARPA ;FAILED, COMPLAIN
SKIPN J,T2 ;COPY TO GOOD AC
RET ;NONE, RETURN
ARPCLP: CALL FULL ;SEE IF SCREEN IS OVERFLOWED YET
RET ;YES, DONE
MOVX T1,.GTNIX ;GET FUNCTION TO RETURN DATA
MOVEI T2,(J) ;USES CONNECTION INDEX
MOVEI T3,ABLK ;POINT TO BLOCK
MOVSI T4,-<.NCSTS+1> ;GET NUMBER OF WORDS
GTNCP% ;READ THE STATUS
ERJMP ARPCLL ;FAILED
MOVE T1,ABLK+.NCFSM ;GET THE STATE OF THE CONNECTION
CAIE T1,DEADCD ;IS IT DEAD?
CAIN T1,FREECD ;OR FREE?
JRST ARPCLL ;YES, DON'T SHOW IT
CALL DOCOLS ;SHOW DATA ON THIS CONNECTION
ARPCLL: AOBJN J,ARPCLP ;LOOP OVER ALL OF THEM
RET ;DONE
;ROUTINES TO TYPE VARIOUS DATA ABOUT ARPANET CONNECTIONS:
XXACFH: MOVX T1,.GTHNS ;WANT TO GET HOST STRING
HRROI T2,TEMP ;POINT TO STORAGE
MOVE T3,ABLK+.NCFHS ;GET HOST NUMBER
GTHST% ;READ HOST NAME
ERJMP ACFHNU ;FAILED, GO GIVE NUMBER
TXNE F,FR.MOR ;LAST COLUMN?
SETZM TEMP+3 ;NO, THEN CUT OFF OUTPUT
STR$ TEMP ;OUTPUT NAME
RET ;DONE
ACFHNU: MOVE T1,ABLK+.NCFHS ;GET NUMBER
JRST OCTTEL ;OUTPUT NUMBER
XXACLS: SKIPA T1,ABLK+.NCLSK ;GET LOCAL SOCKET NUMBER
XXACFS: MOVE T1,ABLK+.NCFSK ;OR FOREIGN SOCKET NUMBER
JRST OCTOUT ;OUTPUT IT
XXACVT: MOVE T1,ABLK+.NCNVT ;GET VIRTUAL TERMINAL NUMBER
CAME T1,[-1] ;REALLY ONE HERE?
JRST OCTSP3 ;YES, SAY WHICH ONE IT IS
STR$ [ASCIZ/---/] ;NO, TYPE DASHES
RET ;DONE
XXACBT: MOVE T1,ABLK+.NCBTC ;GET NUMBER OF BITS TRANSMITTED OR RECEIVED
JRST DECOUT ;TYPE AND RETURN
XXABTA: SKIPA T1,ABLK+.NCBAL ;GET BIT ALLOCATION
XXAMSA: MOVE T1,ABLK+.NCMSG ;OR MESSAGE ALLOCATION
JRST DECOUT ;OUTPUT IT
XXAPRS: MOVE T4,[POINT 4,ABLK+.NCSTS,19] ;POINT TO PREVIOUS STATES
APRSLP: ILDB T1,T4 ;GET NEXT STATE
CALL APASTE ;OUTPUT IT
TLNN T4,770000 ;FINISHED OFF WORD YET?
RET ;YES, RETURN
STR$ [ASCIZ/, /] ;NO, SPACE OVER SOME
JRST APRSLP ;AND CONTINUE
XXASTE: MOVE T1,ABLK+.NCFSM ;GET THE STATE OF THE CONNECTION
APASTE: SKIPL T1 ;MAKE SURE IT IS REASONABLE
CAILE T1,APASTM ;SO WE CAN OUTPUT IT
JRST OCTOUT ;NO, THEN GIVE IN OCTAL
STR$ APASTT(T1) ;TYPE THE STATE CODE
RET ;DONE
;TABLE OF CONNECTIONS STATES:
DEADCD==0 ;STATE OF A DEAD CONNECTION
FREECD==16 ;STATE OF A FREE CONNECTION
APASTT: ASCII /DEAD/ ;(0) DEAD
ASCII /CLZD/ ;(1) CLOSED
ASCII /PNDG/ ;(2) PENDING
ASCII /LSNG/ ;(3) LISTENING
ASCII /RFCR/ ;(4) RFC RECEIVED
ASCII /CLW1/ ;(5) CLOSE WAIT SUB1
ASCII /RFCS/ ;(6) RFC SENT
ASCII /OPND/ ;(7) OPENED
ASCII /CLSW/ ;(10) CLOSE WAIT
ASCII /DATW/ ;(11) FINAL DATA WAIT
ASCII /RFN1/ ;(12) RFN1 FINAL WAIT
ASCII /CLZW/ ;(13) PROGRAM CLOSE WAIT
ASCII /RFN2/ ;(14) RFN2 SUB2 WAIT
ASCII /NUSE/ ;(15) NOT IN USE
ASCII /FREE/ ;(16) FREE
APASTM==.-APASTT-1 ;HIGHEST LEGAL STATE
SUBTTL ROUTINE TO GIVE HELP MESSAGE
;THIS MODE IS ENTERED BY THE "H" COMMAND. THERE ARE SEVERAL
;SUB-DISPLAYS, SUCH AS HELP FILE TYPEOUT, COLUMN TYPEOUT. THE NORMAL
;HELP DISPLAY SIMPLY TYPES OUT THE HELP FILE FOR SYSDPY.
DPYHLP: SETOM HDRTYP ;CLEAR ANY HEADER STUFF
TAB$ ;SET DEFAULT TABS
SKIPE T1,HLPDSP ;ANY SPECIAL HELP DISPLAY?
JRST (T1) ;YES, GO DO IT
CALL SETEAT ;GO SET UP HOW MANY LINES TO EAT
SKIPE T1,HLPJFN ;HAVE HELP FILE OPEN YET?
JRST HLPTYP ;YES, GO TYPE IT OUT
MOVX T1,GJ%SHT+GJ%OLD ;GET READY
HRROI T2,[ASCIZ/HLP:SYSDPY.HLP/] ;GET STRING
GTJFN ;OPEN THE HELP FILE
ERJMP LOSE ;FAILED, GO EXPLAIN THINGS
HRRZM T1,HLPJFN ;REMEMBER THE JFN
MOVX T2,OF%RD+7B5 ;GET SET TO OPEN THE FILE
OPENF ;OPEN IT
ERJMP [MOVE T1,HLPJFN ;FAILED, GET JFN
SETZM HLPJFN ;CLEAR IT
RLJFN ;RELEASE IT
ERJMP LOSE ;FAILED
JRST LOSE] ;SUCCEEDED, GO COMPLAIN
HLPTYP: SETZ T2, ;WANT TO BE AT FRONT OF FILE
SFPTR ;SET US THERE
ERJMP LOSE ;FAILED
HLPSCN: BIN ;READ NEXT CHARACTER
ERJMP HLPDON ;FAILED, GO SEE WHY
CAIE T2,15 ;CARRIAGE RETURN?
CAIN T2,12 ;OR LINE FEED?
JRST HLPSCN ;YES, IGNORE THEM
BKJFN ;PUT BACK THE CHARACTER
ERJMP LOSE ;FAILED
HLPLOP: CALL FULL ;OVERFLOWED THE SCREEN?
RET ;YES, RETURN NOW
MOVE T1,HLPJFN ;GET INPUT JFN
MOVE T2,[POINT 7,TEMP] ;GET POINTER TO BUFFER
MOVNI T3,TMPSIZ*5-5 ;GET NUMBER OF BYTES TO READ
SIN ;READ THEM
ERJMP HLPDON ;FAILED, GO SEE WHY
IDPB T3,T2 ;END STRING WITH A NULL
STR$ TEMP ;OUTPUT THIS PART
JRST HLPLOP ;LOOP UNTIL END OF FILE REACHED
HLPDON: SETZ T1, ;GET A NULL
IDPB T1,T2 ;STORE IT TO MAKE ASCIZ STRING
STR$ TEMP ;OUTPUT REMAINING PART OF TEXT
MOVEI T1,.FHSLF ;GET READY
GETER ;FIND OUT WHY WE STOPPED
ANDI T2,-1 ;KEEP ONLY THE ERROR CODE
CAIE T2,IOX4 ;END OF FILE?
JRST LOSE ;NO, GO COMPLAIN
RET ;DONE
SUBTTL SUBROUTINE TO TYPE OUT COLUMN NAMES
;CALLED AS PART OF THE HELP COMMAND, TO CREATE A LIST OF THE COLUMN
;NAMES, TELLING WHICH ONES ARE BEING SHOWN. THE OUTPUT IS ORDERED
;SO HE CAN TELL WHICH DISPLAYS THE COLUMNS ARE FOR.
HLPCOL: TAB$ [$TABS <15,40>] ;SET NICE TAB STOPS
TXNN F,FR.CMP ;SUPPRESS IF COMPRESSING
STR$ [ASCIZ/Display Displayed columns Suppressed columns
/] ;TYPE SOME
CALL SETEAT ;SET UP TO EAT LINES
SETOM LSTTYP ;CLEAR LAST TYPE SEEN
MOVE J,COLHLC ;GET AOBJN POINTER TO DISPLAY TYPES
HLPCLL: AOBJP J,CPOPJ ;RETURN IF DID ALL DISPLAY TYPES
HRRZM J,COLTYP ;REMEMBER THIS COLUMN TYPE
TXOE F,FR.NDC ;ANY PREVIOUS TYPES OUTPUT?
CRLF ;YES, SEPARATE FROM THEM
SETZM COLDIS ;INITIALIZE INDEX INTO DISPLAYED COLUMNS
SETZM COLSUP ;AND INDEX INTO SUPPRESSED COLUMNS
TYPCNX: SETZ T4, ;CLEAR RESULT AC
CALL FNDDIS ;FIND THE NEXT DISPLAYED COLUMN
MOVE T4,T1 ;REMEMBER THE TEXT ADDRESS
CALL FNDSUP ;THEN FIND THE NEXT SUPPRESSED COLUMN
HRL T4,T1 ;SAVE THAT ADDRESS TOO
JUMPE T4,HLPCLL ;IF NO MORE COLUMNS, DO NEXT TYPE
SKIPLE @DPYTAB+$DPEAT ;STILL HAVE LINES TO EAT?
JRST TYPCNC ;YES, JUST DO A CRLF
MOVE T2,COLTYP ;GET CURRENT COLUMN TYPE
HLRZ T3,DISTAB(T2) ;GET NAME OF DISPLAY
CAME T2,LSTTYP ;SAME AS PREVIOUS ONE?
STR$ (T3) ;NO, SAY WHICH DISPLAY THIS IS
MOVEM T2,LSTTYP ;AND REMEMBER THE NEW TYPE
TAB ;SPACE OVER
TRNE T4,-1 ;ANY DISPLAYED COLUMN?
STR$ (T4) ;YES, OUTPUT IT
TAB ;THEN TAB AGAIN
TLNE T4,-1 ;ANY SUPPRESSED COLUMN?
STR$ (T1) ;YES, OUTPUT IT
TYPCNC: CRLF ;END IN A CRLF
JRST TYPCNX ;LOOP OVER SOME MORE COLUMNS
;SUBROUTINES TO SEARCH FOR ANOTHER DISPLAYED COLUMN OR SUPPRESSED
;COLUMN. SKIP RETURNS IF NOT FOUND, NON-SKIP WITH TEXT OF COLUMN IN
;T1 IF FOUND.
FNDDIS: MOVE T1,COLDIS ;GET NEXT POSSIBLE COLUMN
SKIPN T2,COLDSP(T1) ;ANY MORE DISPLAYED COLUMNS?
RETSKP ;NOT FOUND, SKIP RETURN
AOS COLDIS ;INCREMENT COUNTER
MOVE T3,CL.TYP(T2) ;GET THE TYPE OF COLUMN
CAME T3,COLTYP ;THE ONE CURRENTLY LOOKING FOR?
JRST FNDDIS ;NO, LOOP FOR ANOTHER ONE
MOVSI T1,-COLNUM ;GET READY FOR SEARCH
FNDDIL: HRRZ T3,COLTAB+1(T1) ;FIND ADDRESS FOR NEXT POSSIBLE COLUMN
CAME T2,T3 ;FOUND THIS ONE?
AOBJN T1,FNDDIL ;NO, KEEP GOING
JUMPGE T1,FNDDIS ;SHOULD NEVER FAIL, BUT ...
HAVSUP: HLRZ T1,COLTAB+1(T1) ;GET THE STRING FOR THIS COLUMN
RET ;RETURN IT
FNDSUP: MOVE T1,COLSUP ;GET NEXT POSSIBLE INDEX
CAIL T1,COLNUM ;ALL DONE?
RETSKP ;YES, SKIP RETURN
AOS COLSUP ;INCREMENT COUNTER
HRRZ T2,COLTAB+1(T1) ;GET ADDRESS OF DATA FOR COLUMN
MOVE T3,CL.TYP(T2) ;THEN GET TYPE OF COLUMN
CAME T3,COLTYP ;THE ONE WE ARE INTERESTED IN?
JRST FNDSUP ;NO, KEEP LOOKING
SETZ T3, ;GET READY FOR A LOOP
FNDSUL: SKIPN COLDSP(T3) ;RAN OUT OF COLUMNS?
JRST HAVSUP ;YES, THIS IS A SUPPRESSED COLUMN
CAME T2,COLDSP(T3) ;FOUND THE COLUMN?
AOJA T3,FNDSUL ;NO, KEEP SEARCHING
JRST FNDSUP ;YES, LOOK AT NEXT COLUMN
SUBTTL INFORMATION LINE ROUTINE
;IF SELECTED BY THE "IN" COMMAND, THIS ROUTINE TYPES AS THE LAST LINE
;OF THE DISPLAY A SIMPLE STATUS LINE CONTAINING USEFUL INFORMATION.
INFO: MOVE T1,@DPYTAB+$DPLEN ;GET TERMINAL LENGTH
HRLOI T1,-1(T1) ;SET UP FOR TWO LINES AT BOTTOM
MOVEI T2,-1 ;WANT ALL COLUMNS
SIZ$ T1 ;TELL DPY WHERE WINDOW IS
CRLF ;START WITH A CRLF
HRROI T1,TEMP ;POINT TO TEMPORARY DATA
SETO T2, ;WANT CURRENT TIME
MOVX T3,OT%SCL!OT%NSC!2B29 ;GET FLAGS
ODTIM ;STORE THE TIME TEXT
STR$ TEMP ;THEN OUTPUT IT
MOVEI T1,.DWNTI ;WANT TO READ DOWNTIME
GETAB ;READ IT
SETZ T1, ;FAILED, ASSUME NONE
JUMPLE T1,DWNNON ;PROCEED IF NO DOWNTIME
SUB T1,NTIME ;COMPUTE TIME UNTIL SYSTEM DOWN
JUMPLE T1,DWNTEL ;SKIP ON IF DOWNTIME ALREADY PASSED
ADDI T1,<1B17/^D<60*24>>-1 ;ROUND UP TO NEXT HIGHER MINUTE
MULI T1,^D<60*24> ;CONVERT FROM UNIVERSAL TIME
ASHC T1,^D17 ;TO MINUTES UNTIL SYSTEM DOWN
CAILE T1,DWNTIM ;TIME TO WARN USER ABOUT SYSTEM GOING DOWN?
JRST DWNNON ;NOPE, SKIP OUTPUT
;YES, PROCEED TO TYPE TIME
DWNTEL: SKIPG T1 ;SYSTEM ALREADY DOWN?
STR$ [ASCIZ/, System down/] ;YES, SAY SO
JUMPLE T1,DWNNON ;SKIP ON IF NO TIME TO OUTPUT
STR$ [ASCIZ/, Down in /] ;MORE TIME LEFT, TYPE THIS
CALL DECOUT ;THEN MINUTES LEFT
STR$ [ASCIZ/ min/] ;FINISH TEXT
DWNNON: STR$ [ASCIZ/, Load av /] ;START LOAD AVERAGE
MOVE T1,[14,,.SYSTA] ;GET SYSTAT TABLE ENTRY
GETAB ;READ IT
SETZ T1, ;FAILED, MAKE ZERO
FMPRI T1,(10.0) ;CONVERT TO MULTIPLE OF TEN
FIXR T1,T1 ;THEN CONVERT TO INTEGER
MOVEI T4,DECOUT ;NORMAL DECIMAL OUTPUT ROUTINE
CALL FIXOUT ;OUTPUT IT
STR$ [ASCIZ/, Sleep /] ;SPACE OVER
CALL GETSLP ;FIND OUT THE SLEEP TIME
ADDI T1,^D500 ;ROUND UP
IDIVI T1,^D1000 ;TURN INTO SECONDS
CALL DECOUT ;TYPE IT
STR$ [ASCIZ/ sec, Page /] ;MORE STUFF
MOVE T1,PAGE ;GET PAGE NUMBER
AOJA T1,DECOUT ;ADD ONE AND GO TYPE IT
SUBTTL FORK TERMINATION INTERRUPT HANDLING
;HERE WHEN WE ARE WAITING FOR AN INFERIOR TO TERMINATE, TO BREAK
;OUT OF THE SLEEP WE WERE DOING FOR IT.
FRKINT: PUSH P,T1 ;SAVE AN AC
MOVEI T1,PSHINT ;GET PC TO GO TO
SKIPN FRKFLG ;IN THE SLEEP?
MOVEM T1,CHNPC1 ;YES, CHANGE THE PC
MOVEI T1,1 ;GET POSITIVE NUMBER
MOVEM T1,FRKFLG ;STOP THE NEXT SLEEP
POP P,T1 ;RESTORE THE AC
DEBRK ;RETURN WHERE INTERRUPTED
SUBTTL CHARACTER INTERRUPT HANDLING
;HERE TO HANDLE AN INTERRUPT DUE TO CHARACTER TYPE IN. THE
;CHARACTER IS STORED IN ONE OF SEVERAL BUFFERS, AND WHEN A LINE FEED
;IS SEEN THE BUFFER IS MADE AVAILABLE TO THE COMMAND PROCESSOR.
TTYINT: PUSH P,T1 ;SAVE AN AC
PUSH P,T2 ;AND ANOTHER
CHRCHK: MOVEI T1,.PRIIN ;GET READY
SIBE ;IS INPUT BUFFER NONEMPTY?
JRST CHRGET ;YES, GO HANDLE A CHAR
POP P,T2 ;NO, RESTORE ACS
POP P,T1 ;BOTH
DEBRK ;AND DISMISS THE INTERRUPT
CHRGET: PUSH P,[CHRCHK] ;SET TO CHECK ANOTHER CHAR WHEN DONE
PBIN ;GET THE CHARACTER
SKIPL @INTBUF ;SEE IF HAVE NOPLACE TO PUT THE CHAR
CAIN T1,33 ;OR SEE IF IT IS AN ALTMODE
JRST CHRALT ;YES, RING BELL
CAIN T1,"U"-100 ;CONTROL-U?
JRST CHRINI ;YES, GO REINITIALIZE
CAIN T1,177 ;RUBOUT?
JRST CHRRUB ;YES, GO UNDO A CHAR
CAIN T1,12 ;LINE FEED?
JRST CHRLIN ;YES, HAVE A LINE
AOS T2,INTCNT ;ADD 1 TO INPUT CHARS
CAILE T2,BUFLEN*5-1 ;ROOM FOR NEW CHAR?
JRST CHRFUL ;NO, COMPLAIN
IDPB T1,INTPTR ;PUT IT IN THE BUFFER
CAIN T2,1 ;FIRST CHARACTER ON THIS LINE?
CAIE T1," " ;AND IT IS A SPACE?
RET ;NO, JUST RETURN
MOVEI T1,"S" ;YES, GET SCROLL COMMAND LETTER
DPB T1,INTPTR ;REPLACE SPACE WITH IT
MOVEI T1,12 ;GET A LINE FEED
JRST CHRLIN ;AND PRETEND IT WAS TYPED IN
;HERE ON AN ALTMODE. WE DON'T DO ANY RECOGNITION, SO WARN THE
;USER BY BEEPING AT HIM.
CHRALT: MOVEI T1,7 ;GET A BELL CHAR
PBOUT ;OUTPUT IT
RET ;RETURN
;HERE ON A RUBOUT. WE REMOVE THE LATEST CHARACTER FROM THE
;INPUT BUFFER. WE BEEP AT HIM IF THERE ARE NO MORE CHARS.
CHRRUB: SKIPG INTCNT ;ANY CHARS STORED?
JRST CHRALT ;NO, GO BEEP AT HIM
SOS INTCNT ;YES, DECREMENT COUNT
SETO T1, ;SET COUNT OF -1
ADJBP T1,INTPTR ;BACK UP BYTE POINTER BY A CHAR
MOVEM T1,INTPTR ;AND STORE BACK
RET ;RETURN
;HERE ON A CONTROL-U. WE DELETE ALL INPUT WE HAVE ACCUMULATED
;SO FAR. THIS ROUTINE IS ALSO CALLED TO INITIALIZE THE INPUT BUFFER.
CHRINI: MOVE T1,@INTBUF ;GET BUFFER WE ARE USING
HRLI T1,(POINT 7,) ;MAKE A POINTER TO IT
MOVEM T1,INTPTR ;SAVE POINTER
SETZM INTCNT ;CLEAR COUNT OF SAVED CHARS
RET ;RETURN
;HERE WHEN HE HAS TYPED TOO MANY CHARACTERS, AND OUR BUFFER HAS
;FILLED UP. WE WIPE OUT THE BUFFER AND BEEP AT HIM.
CHRFUL: MOVEI T1,7 ;GET A BELL
PBOUT ;OUTPUT IT
JRST CHRINI ;GO INITIALIZE AGAIN
;HERE WHEN A LINE FEED HAS BEEN TYPED. WE MAKE THIS BUFFER AVAILABLE
;TO THE PROGRAM, ADVANCE TO THE NEXT BUFFER, AND GET THE MAIN CODE OUT
;OF THE DISMS IF IT WAS IN IT.
CHRLIN: IDPB T1,INTPTR ;FIRST STORE THE LINE FEED
MOVSI T1,(1B0) ;GET SIGN BIT
IORM T1,@INTBUF ;MAKE BUFFER AVAILABLE TO MAIN CODE
AOS T1,INTBUF ;ADVANCE TO NEXT BUFFER
CAILE T1,BUFFS+BUFNUM-1 ;WENT OFF OF END?
MOVEI T1,BUFFS ;YES, RESET TO FIRST ONE
MOVEM T1,INTBUF ;SAVE POINTER
CALL CHRINI ;INITIALIZE POINTER AND COUNTER
MOVEI T1,SLPINT ;GET PC TO GO TO
SKIPN TTYFLG ;IN THE SLEEP?
MOVEM T1,CHNPC1 ;YES, STOP IT
MOVEI T1,1 ;GET POSITIVE
MOVEM T1,TTYFLG ;STOP THE NEXT SLEEP
RET ;RETURN
SUBTTL ROUTINE TO INITIALIZE TTY BUFFERS
;CALLED AT START OF PROGRAM TO BUILD ALL THE BUFFERS. THEY ARE
;INITIALLY SET SO THEY ARE AVAILBLE TO THE INTERRUPT CODE, AND NOT
;TO THE MAIN CODE. THE POINTERS TO THE CURRENT BUFFERS ARE
;ALSO INITIALIZED.
BUFINI: MOVEI T1,BUFFS ;GET ADDRESS OF FIRST BUFFER HEADER
MOVEM T1,INTBUF ;SET AS INTERRUPT CODE'S CURRENT BUFFER
MOVEM T1,RUNBUF ;AND AS COMMAND CODE'S CURRENT BUFFER
MOVEI T1,BUFNUM-1 ;GET NUMBER OF BUFFERS TO INITIALIZE
MOVEI T2,BUFFER ;AND ADDRESS OF WHERE BUFFERS POINT
MOVEM T2,BUFFS(T1) ;POINT NEXT BUFFER AT ITS LOCATION
ADDI T2,BUFLEN ;MOVE TO NEXT ONE
SOJGE T1,.-2 ;LOOP OVER ALL BUFFER HEADERS
PJRST CHRINI ;THEN GO INITIALIZE INTERRUPT DATA
SUBTTL ROUTINE TO DO SPECIAL ACTIONS AT STARTUP
;CALLED RIGHT AFTER PROGRAM IS STARTED, TO SEE IF ANY SPECIAL ACTIONS
;ARE TO BE PERFORMED. IF SO, WE SET UP TO DO THEM. ARGUMENTS ARE
;OBTAINED FROM THE PRARG BLOCK OF THIS PROCESS.
GETARG: SETO T1, ;GET READY
HRROI T2,T4 ;TO READ OUR CONTROLLING JOB
MOVEI T3,.JICPJ ;GET OFFSET
GETJI ;READ IT
ERJMP DIE ;FAILED
JUMPE T4,ARGINS ;IF CONTROLLED BY JOB ZERO, GO INSERT JSYS
MOVE T1,[.PRARD,,.FHSLF] ;GET FUNCTION
MOVEI T2,TEMP ;POINT TO STORAGE
MOVEI T3,1 ;WANT ONLY ONE WORD
PRARG ;READ PRARG BLOCK
ERJMP DIE ;FAILED, COMPLAIN
JUMPLE T3,CPOPJ ;RETURN OK IF NO WORDS READ
SKIPN TEMP ;ANY SPECIAL ACTIONS DESIRED?
RET ;NO, RETURN
MOVE T1,[.PRAST,,.FHSLF] ;GET FUNCTION
MOVEI T2,T4 ;POINT TO AC
MOVEI T3,1 ;ONE ARGUMENT
SETZ T4, ;WANT TO CLEAR THE BLOCK
PRARG ;CLEAR IT
ERJMP DIE ;FAILED
SKIPL T1,TEMP ;GET THE FUNCTION CODE
CAILE T1,ARGMAX ;AND VERIFY ITS VALIDITY
JRST ARGBAD ;IT'S BAD, GO COMPLAIN
PJRST @ARGTAB-1(T1) ;DISPATCH TO ROUTINE
ARGTAB: EXP ARGINS ;(1) JUST INSERT THE MONRD% JSYS
ARGMAX==.-ARGTAB ;HIGHEST LEGAL FUNCTION
ARGINS: TXO F,FR.INS ;SET FLAG SAYING INSERT JSYS ONLY
CALL JSYTST ;GO INSERT THE JSYS IF NECESSARY
HALTF ;QUIT
JRST .-1 ;AND STAY THAT WAY
ARGBAD: HRROI T1,[ASCIZ/
? Illegal function code given in PRARG block
/] ;GET STRING
PSOUT ;TYPE IT
HALTF ;STOP
JRST .-1 ;FOREVER
SUBTTL SUBROUTINE TO SET UP TO READ INITIAL INDIRECT FILE
;HERE TO FIND THE SYSDPY.INI FILE IF IT EXISTS, AND SET IT UP
;SO THAT COMMANDS WILL BE READ FIRST FROM THAT FILE.
TAKINI: HRROI T1,TEMP ;POINT AT BUFFER
HRROI T2,[ASCIZ/PS:</] ;GET READY
SETZ T3, ;TO START STRING
SOUT ;STORE IT
MOVE T2,MYUSER ;GET MY USER NUMBER
DIRST ;CONVERT IT TO STRING
ERJMP DIE ;SHOULDN'T FAIL
HRROI T2,[ASCIZ/>SYSDPY.INI/] ;GET REST OF STRING
SOUT ;BUILD REST OF FILE SPEC
MOVX T1,GJ%SHT+GJ%OLD+GJ%ACC ;SET UP
HRROI T2,TEMP ;POINT AT FILE SPEC
GTJFN ;TRY TO FIND THE FILE
ERJMP NOINIG ;FAILED, GO SEE WHY
MOVX T2,7B5+OF%RD ;WANT TO READ THE FILE
OPENF ;DO THE OPEN
ERJMP DIE ;FAILED, GO COMPLAIN
HRRZM T1,TAKJFN ;SAVE THE JFN AWAY
SETZ T1, ;USE DEFAULT LABEL
CALL TAKFIL ;GO SET UP TO READ COMMANDS FROM IT
JFCL ;DON'T CARE IF IT FAILS
RET ;RETURN
;HERE IF FAILED TO FIND THE FILE:
NOINIG: MOVSI T2,-NOFNUM ;GET READY FOR SEARCH
CAME T1,NOFTAB(T2) ;FOUND THE ERROR?
AOBJN T2,.-1 ;NO, KEEP SEARCHING
JUMPGE T2,DIE ;IF NOT FOUND, GIVE ERROR
RET ;OTHERWISE ITS OK
NOFTAB: EXP GJFX16,GJFX17,GJFX18,GJFX19
EXP GJFX20,GJFX24,GJFX32
NOFNUM==.-NOFTAB ;NUMBER OF ERRORS IN TABLE
;HERE TO PUSH A LEVEL OF INDIRECT COMMANDS. WE SAVE THE CURRENT
;FILE POINTER, SAVED CHARACTER AND RESCAN FLAG, AND SET UP TO READ
;THE COMMAND FILE AGAIN. SKIP RETURN IF SUCCESSFUL.
TAKPSH: MOVE T4,TAKLVL ;GET THE CURRENT LEVEL
CAIL T4,TAKMAX ;CAN WE GO ANOTHER LEVEL DEEPER?
RET ;NO, ERROR RETURN
MOVE T1,TAKJFN ;GET INDIRECT FILE JFN
SKIPE T2,T4 ;AT TTY INPUT LEVEL?
RFPTR ;NO, READ THE CURRENT FILE POSITION
ERJMP CPOPJ ;FAILED, ERROR RETURN
MOVEM T2,TAKPTR(T4) ;SAVE THE OLD FILE POSITION
SETZ T2, ;GET SET
SFPTR ;SET INPUT TO BEGINNING OF FILE
ERJMP CPOPJ ;FAILED
HRRZ T1,SAVCHR ;GET THE SAVED CHARACTER
TXNE F,FR.RSN ;IS THE RESCAN FLAG SET?
TLO T1,-1 ;YES, REMEMBER THAT
MOVEM T1,TAKSVC(T4) ;SAVE THEM
TXZ F,FR.RSN ;CLEAR THE RESCAN FLAG
AOS TAKLVL ;INCREMENT DEPTH COUNTER
RETSKP ;GOOD RETURN
;HERE TO POP UP A LEVEL OF INDIRECT COMMANDS. WE HAVE TO RESTORE THE
;CURRENT FILE POSITION, THE SAVED CHARACTER, AND THE RESCAN FLAG.
TAKPOP: SOS T4,TAKLVL ;DECREMENT THE DEPTH COUNTER
MOVE T1,TAKJFN ;GET THE JFN OF THE TAKE FILE
MOVE T2,TAKPTR(T4) ;AND THE OLD FILE POINTER
SKIPE T4 ;RETURNING TO TTY COMMANDS?
SFPTR ;NO, THEN SET THE FILE POINTER
ERJMP DIE ;FAILED, GO LOSE
SKIPL T1,TAKSVC(T4) ;GET SAVED CHAR AND SEE IF WE SHOULD RESCAN
TXZA F,FR.RSN ;NO, CLEAR FLAG
TXO F,FR.RSN ;YES, SET IT
HRRZM T1,SAVCHR ;RESTORE THE CHARACTER
RET ;DONE
SUBTTL COMMAND PROCESSOR
;HERE WHEN A LINE OF INPUT HAS BEEN READ IN, TO HANDLE THE COMMANDS.
;COMMANDS ARE SINGLE LETTERS, FOLLOWED BY ARGUMENTS WHICH MAY BE
;OMITTED.
RUNCMD: TXZ F,FR.RSN ;NO CHARACTERS TO BE REREAD
SKIPL T1,@RUNBUF ;SEE IF A BUFFER IS READY TO READ
TDZA T1,T1 ;NO, CLEAR AC
HRLI T1,(POINT 7,) ;YES, MAKE A BYTE POINTER TO IT
MOVEM T1,RUNPTR ;SAVE THE BYTE POINTER
SKIPN TAKLVL ;DO COMMANDS IF READING FROM FILE
JUMPE T1,CPOPJ ;OR IF TTY LINE IS READY
NXTCMD: TXZ F,FR.NEG ;RESET NEGATE FLAG FOR NEW COMMAND
NXTCNG: CALL EATSPS ;EAT ANY LEADING SPACES
GETCHR ;THEN READ NEXT CHARACTER
CAIN C,12 ;IS THIS THE LINE FEED?
JRST RUNFIN ;YES, COMMAND LINE IS DONE
MOVSI T1,-CMDNUM ;NO, GET READY FOR LOOP
CMDSRC: HLRZ T2,CMDTAB(T1) ;GET NEXT COMMAND
CAME T2,C ;MATCH OUR LETTER?
AOBJN T1,CMDSRC ;NO, KEEP SEARCHING
JUMPL T1,CMDHAV ;GO IF FOUND IT
RESCAN ;PUT BACK THE CHARACTER
CALL JOBIN ;LOOK FOR A JOB NUMBER
JUMPGE T2,RUNBAD ;IF NOT THERE, THEN BAD COMMAND
SKIPA T2,[CMDJOB] ;SET UP ROUTINE TO CALL
CMDHAV: HRRZ T2,CMDTAB(T1) ;GET ADDRESS
CALL (T2) ;CALL ROUTINE FOR COMMAND
JRST RUNBAD ;IF BAD, GO TYPE BELL
JRST NXTCMD ;LOOK FOR NEXT COMMAND
JRST NXTCNG ;FOR "N" COMMAND, GO BACK DIFFERENTLY
;HERE WHEN DONE WITH A COMMAND. IF WE WERE READING FROM AN
;INDIRECT COMMAND, WE POP UP TO THE NEXT HIGHER COMMAND LEVEL. IF
;WE WERE READING FROM THE TTY, WE HAVE TO ADVANCE THE BUFFER.
RUNBAD: CALL CHRALT ;BAD INPUT, RING THE BELL
RUNFIN: MOVE T1,NTIME ;GET CURRENT TIME
MOVEM T1,SLWTIM ;RESET SLOWDOWN TIMER
SKIPE TAKLVL ;WERE WE READING FROM A COMMAND FILE?
JRST TAKCDN ;YES, GO POP UP A LEVEL
HRRZS @RUNBUF ;MAKE BUFFER AVAILABLE TO INTERRUPT CODE
AOS T1,RUNBUF ;ADVANCE TO NEXT BUFFER
CAILE T1,BUFFS+BUFNUM-1 ;WENT OFF OF END?
MOVEI T1,BUFFS ;YES, RESET TO TOP
MOVEM T1,RUNBUF ;SAVE NEW POINTER
JRST RUNCMD ;SEE IF ANOTHER COMMAND IS READY
TAKCDN: CALL TAKPOP ;POP BACK TO OLD LEVEL
SKIPE RUNPTR ;WERE WE READING TTY COMMANDS?
JRST NXTCMD ;YES, GO CONTINUE DOING THAT
JRST RUNCMD ;NO, THEN SEE IF HAVE ANY NOW
;COMMAND TABLE. CHARACTERS ARE IN LEFT HALF, ADDRESSES OF ROUTINES
;ARE IN RIGHT HALF.
CMDTAB: XWD ",",CPOPJ1 ;COMMA, GOOD RETURN
XWD "T",CMDT ;SHOW TITLES OR DO TTY DISPLAY
XWD "G",CMDGET ;GET COMMANDS FROM SPECIFIED OPTION
XWD "C",CMDCOL ;COLUMN FORMAT COMMAND
XWD "A",CMDA ;ADVANCE, ACTIVE, ARPANET COMMANDS
XWD "K",CMDK ;KILL OFF A JOB OR THE EXEC
XWD "B",CMDBLK ;SET NUMBER OF BLANKS BETWEEN COLUMNS
XWD "U",CMDUSR ;SHOW JOBS OF GIVEN USER
XWD "R",CMDREF ;REFRESH COMMAND
XWD "W",CMDSLP ;WAIT TIME COMMAND
XWD "L",CMDLIN ;SET NUMBER OF LINES OF OVERLAP
XWD "E",CMDE ;EXIT OR DO ENQ/DEQ STATUS
XWD "I",CMDI ;SET IDLE TIME OR SHOW IPCF DATA
XWD "N",CMDNEG ;NEGATE NEXT COMMAND
XWD "O",CMDOPR ;OPERATOR JOBS
XWD "D",CMDD ;DO DEFAULTS OR DECNET STATUS
XWD "H",CMDHLP ;HELP COMMAND
XWD "M",CMDMON ;DO MONITOR STATUS DISPLAY
XWD "J",CMDONE ;DO ALL JOBS DISPLAY
XWD "P",CMDP ;PUSH OR SHOW PARTICULAR PROGRAM
XWD "S",CMDS ;SKIP NUMBER OF JFNS OR FORKS
XWD "Q",CMDQUE ;SHOW THE QUEUES
CMDNUM==.-CMDTAB ;NUMBER OF COMMANDS
;ROUTINES TO HANDLE EACH COMMAND:
CMDT: GETCHR ;READ NEXT CHARACTER
CAIN C,"T" ;WANTS TTY DISPLAY?
JRST SETTTY ;YES, GO SET IT UP
RESCAN ;NO, RESTORE THE CHAR
TXNN F,FR.NEG ;WANT TO SHOW TITLE LINES?
TXZA F,FR.CMP ;NO, CLEAR FLAG
TXO F,FR.CMP ;YES, SET FLAG
SETOM HDRTYP ;CLEAR ANY KNOWN HEADER
RETSKP ;GOOD RETURN
CMDI: GETCHR ;GET NEXT CHARACTER
CAIN C,"N" ;IS IT AN I?
JRST SHWINF ;YES, GO DO INFORMATION COMMAND
CAIE C,"P" ;IS IT A P?
JRST SHWIDL ;NO, GO DO IDLE COMMAND
MOVEI R,DPYIPC ;SET UP TO SHOW IPCF STUFF
NEWDPY: SETZM PAGE ;RESET TO FIRST PAGE
TXZ F,FR.END ;ACT LIKE MORE PAGES TO GO
CALL PAGSET ;RESET SCROLLING TIMER
SKIPN T1,HLPJFN ;ANY HELP FILE OPEN?
RETSKP ;NO, ALL DONE
CLOSF ;YES, CLOSE THE FILE
ERJMP .+1 ;IGNORE ERROR
SETZM HLPJFN ;CLEAR THE JFN
RETSKP ;DONE
SHWIDL: RESCAN ;REREAD THE CHARACTER
TXNN F,FR.NEG ;WANT OPPOSITE ACTION?
TDZA T1,T1 ;NO, CLEAR FOR DEFAULT CHECK
MOVEI T1,1 ;YES, SET FOR OTHER CHECK
MOVEM T1,MAXIDF ;SAVE THE FLAG
CALL DECINZ ;READ NUMBER OF MINUTES
SKIPL T2 ;NO ARGUMENT GIVEN?
MOVX T1,DFTIDL ;YES, THEN GET DEFAULT
MOVEM T1,MAXIDL ;SET VALUE
RETSKP ;GOOD RETURN
SHWINF: TXNN F,FR.NEG ;WANTS TO SHUT OFF INFORMATION LINE?
TXOA F,FR.INF ;NO, SAY TO DO IT
TXZ F,FR.INF ;YES, SHUT IT OFF
RETSKP ;GOOD RETURN
CMDSLP:
IFE DECSW,<
TXZ F,FR.NOS ;ALLOW SLOWING DOWN UNTIL KNOW OTHERWISE
>
CALL DECINZ ;READ NUMBER OF SECONDS TO WAIT
IMULI T1,^D1000 ;CONVERT TO MILLISECONDS
SKIPN T2 ;WAS ANY NUMBER TYPED AT ALL?
MOVEI T1,DFTSLP ;NO, THEN SUPPLY THE DEFAULT
IFN DECSW,<
CAIG T1,^D1000 ;LESS THAN 1 SECONDS?
MOVEI T1,^D1000 ;YES, SLEEP FOR 1 INSTEAD
>
MOVEM T1,SLPTIM ;SAVE NEW SLEEP TIME
CAIE C,"!" ;WANT THE RATE TO BE CONSTANT?
RETSKP ;NO, ALL DONE
GETCHR ;YES, EAT THE EXCLAIMATION MARK
IFE DECSW,<
SKIPN TAKLVL ;DON'T ACCEPT FEATURE FROM TAKE FILES
TXO F,FR.NOS ;REMEMBER TO NOT SLOW DOWN
>
RETSKP ;RETURN
CMDLIN: CALL DECIN ;READ FOLLOWING NUMBER
SKIPL T2 ;ANY NUMBER TYPED?
MOVX T1,DFTLAP ;NO, SET UP DEFAULT OVERLAP
MOVEM T1,OVRLAP ;SET THE NEW OVERLAP
RETSKP ;GOOD RETURN
CMDE: GETCHR ;READ NEXT CHARACTER
CAIN C,"Q" ;WANT ENQ/DEQ STATUS?
JRST SETENQ ;YES, GO SET UP FOR THAT
CAIN C,"N" ;WANT TO ENABLE PRIVILEGES?
JRST ENABLE ;YES, GO DO IT
RESCAN ;REREAD THE CHARACTER
TTY$ $TTCLR ;CLEAR SCREEN AND HOME UP
HALTF ;EXIT NICELY
TXO F,FR.REF!FR.RFC ;SET TO REFRESH SCREEN
RETSKP ;AND SKIP RETURN
ENABLE: GETCHR ;READ NEXT CHARACTER
CAIE C,"!" ;BETTER BE EXCLAIMATION MARK
RET ;NO, ERROR
MOVEI T1,.FHSLF ;GET READY
RPCAP ;READ MY PRIVILEGES
TRNN T2,SC%WHL!SC%OPR ;CAN I DO PRIVILEGED STUFF?
RET ;NO, ERROR
MOVE T3,T2 ;YES, COPY THE PRIVILEGES OVER
EPCAP ;TURN ON ALL OUR PRIVILEGES
ERJMP CPOPJ ;FAILED SOMEHOW
TXNE F,FR.JSY ;COULD WE DO THE JSYS BEFORE?
RETSKP ;YES, GOOD RETURN
TTY$ $TTCLR ;ERASE THE SCREEN SO ERRORS CAN BE SEEN
CALL JSYTST ;TRY TO INSERT THE JSYS NOW
TXO F,FR.REF!FR.RFC ;REMEMBER TO REFRESH THE SCREEN
RETSKP ;GOOD RETURN
SETARP: GETCHR ;GET NEXT CHARACTER
SETZ T1, ;CLEAR IN CASE NO MATCH
CAIN C,"H" ;WANT HOSTS?
MOVEI T1,DPYARH ;YES
CAIN C,"C" ;WANTS CONNECTIONS?
MOVEI T1,DPYARC ;YES
JUMPE T1,CPOPJ ;FAIL IF NOT EITHER OF THEM
MOVE R,T1 ;SET UP DISPATCH
JRST NEWDPY ;GO FINISH
SETDEC: MOVEI R,DPYDEC ;SET TO DO DECNET DISPLAY
TXZA F,FR.ACT ;ALL LINKS TOO
SETENQ: MOVEI R,DPYENQ ;DO ENQ/DEQ DISPLAY
JRST NEWDPY ;GO FINISH
SETTTY: MOVEI R,DPYTTY ;DO THE TTY DISPLAY
TXZA F,FR.TAC ;SHOW ALL TERMINALS
SETSTR: MOVEI R,DPYDSK ;OR STRUCTURE DISPLAY
JRST NEWDPY ;GO SET IT UP
SETRES: SKIPA R,[DPYRES] ;DO RESOURCES DISPLAY
SETDEV: MOVEI R,DPYDEV ;DO DEVICE DISPLAY
JRST NEWDPY ;FINISH
CMDNEG: TXO F,FR.NEG ;SET THE NEGATE FLAG FOR NEXT COMMAND
AOS (P) ;DOUBLE SKIP RETURN
RETSKP ;DONE
CMDOPR: TXNE F,FR.NEG ;WANT OPERATOR JOBS SHOWN?
TXZA F,FR.OPR ;NO, CLEAR BIT
TXO F,FR.OPR ;YES, SET BIT
JRST NEWDPY ;RESET SCREEN
;COMMAND TO GET COMMANDS FROM THE INDIRECT FILE. COMMANDS ARE
;GOTTEN FROM THE STATEMENTS FOLLOWING THE SPECIFIED LABEL.
CMDGET: SKIPN TAKJFN ;SEE IF OUR COMMAND FILE IS OPEN
RET ;NO, THEN GIVE AN ERROR
CALL SIXIN ;GET WHAT LABEL TO LOOK FOR
TAKFIL: SKIPN T1 ;WAS THERE ONE?
MOVX T1,DFTLBL ;NO, USE THE DEFAULT
MOVEM T1,TAKLBL ;SAVE THE LABEL
CALL TAKPSH ;NEST TO NEXT LEVEL OF INDIRECTION
RET ;FAILED
LBLSRC: TXO F,FR.NOC ;DON'T CONVERT THE LABEL CHAR TO LF
GETCHR ;READ NEXT CHARACTER
CAIN C,12 ;END OF THE FILE?
JRST [TXZ F,FR.NOC ;YES, CLEAR SPECIAL FLAG
JRST TAKPOP] ;RETURN TO PREVIOUS LEVEL WITH ERROR
CAIE C,LBLCHR ;FOUND THE LABEL CHARACTER?
JRST LBLSRC ;NO, KEEP SEARCHING
CALL SIXIN ;READ THE LABEL NAME
CAME T1,TAKLBL ;THE ONE WE ARE LOOKING FOR?
JRST LBLSRC ;NO, LOOK FOR ANOTHER LABEL
TXZ F,FR.NOC ;CLEAR SPECIAL FLAG
RETSKP ;YES, RETURN TO GET COMMANDS FROM IT
;COMMAND TO KILL THE EXEC WE HAD PUSHED INTO, OR SOME JOB NUMBER. IF
;KILLING A JOB, THE COMMAND MUST END IN A "!" TO PREVENT ACCIDENTS.
CMDK: GETCHR ;READ NEXT CHARACTER
CAIE C,"E" ;WANTS THE EXEC TO DISAPPEAR?
JRST KILJOB ;NO, GO SEE ABOUT A JOB
SKIPN T1,HANDLE ;GET FORK HANDLE IF ANY
RETSKP ;NONE, SUCCEED
KFORK ;TRASH THE POOR EXEC
ERJMP CPOPJ ;FAILED
SETZM HANDLE ;OK, IT IS NO LONGER HERE
RETSKP ;GOOD RETURN
KILJOB: RESCAN ;RESTORE CHARACTER
CALL JOBIN ;READ JOB NUMBER IF ANY
MOVE T4,C ;REMEMBER IF TYPED "." OR NOT
GETCHR ;THEN GET TERMINATING CHAR
CAIE C,"!" ;COMMAND PROPERLY TYPED?
RET ;NO, ERROR
CAIN T4,"." ;WANT TO KILL MYSELF?
JRST KILSLF ;YES, DO DO IT
JUMPL T2,KILHVJ ;JUMP ON IF SUPPLIED A JOB NUMBER
CAIE R,DPYONE ;WANTS DEFAULT, LOOKING AT A JOB?
RET ;NO, THEN FAIL
MOVE T1,THEJOB ;YES, GET THE JOB NUMBER
KILHVJ: JUMPLE T1,CPOPJ ;CAN'T LOG OUT JOB 0
CAME T1,MYJOB ;MY OWN JOB?
CAMLE T1,HGHJOB ;OR ILLEGAL JOB?
RET ;YES, ERROR
LGOUT ;TRY TO LOG JOB OUT
ERJMP CPOPJ ;FAILED
RETSKP ;GOOD RETURN
KILSLF: TTY$ $TTCLR ;FIRST CLEAR THE SCREEN
SETO T1, ;WANT TO KILL THIS JOB
LGOUT ;GO AWAY
ERJMP .+1 ;FAILED
TXO F,FR.REF!FR.RFC ;SCREEN NEEDS REFRESHING NOW
RET ;AND ERROR RETURN
;HERE TO SELECT WHAT PART OF THE QUEUES ARE TO BE SHOWN.
CMDQUE: SETZB T3,T4 ;INITIALIZE FLAGS
CMDQLP: GETCHR ;READ NEXT CHARACTER
MOVSI T1,-QUENUM ;GET READY FOR SEARCH
HLRZ T2,QUETAB(T1) ;GET NEXT LETTER
CAME T2,C ;MATCH?
AOBJN T1,.-2 ;NO, KEEP SEARCHING
JUMPGE T1,CMDQDN ;JUMP IF NO MATCH
HRRZ T1,QUETAB(T1) ;GET ADDRESS OF INSTRUCTION
XCT (T1) ;SET SOME BITS
JRST CMDQLP ;LOOP FOR NEXT LETTER
CMDQDN: CAIL C,"A" ;SEE IF TERMINATED ON A LETTER
CAILE C,"Z" ;WELL?
SKIPA ;NO
RET ;YES, ERROR RETURN
RESCAN ;PUT BACK THE CHARACTER
SKIPN T4 ;SPECIFIED ANY QUEUES?
TXO T4,LIQALL ;NO, THEN DO ALL AS DEFAULT
MOVEM T4,QSRFL1 ;SET THE FLAG BITS
MOVEM T3,QSRFL2 ;IN BOTH LOCATIONS
MOVEI R,DPYQUE ;SET UP TO SHOW THE QUEUES
JRST NEWDPY ;GO FINISH
QUETAB: XWD "A",[TXO T4,LIQALL] ;ALL QUEUES
XWD "O",[TXO T4,LIQOUT] ;OUTPUT QUEUES
XWD "B",[TXO T4,LIQBAT] ;BATCH QUEUE
XWD "L",[TXO T4,LIQLPT] ;LINE PRINTER QUEUE
XWD "M",[TXO T4,LIQMNT] ;MOUNT REQUESTS
XWD "R",[TXO T4,LIQRET] ;RETRIEVAL REQUESTS
XWD "F",[TXO T3,LS.FST] ;WANTS FAST LISTING
XWD "D",[TXO T3,LS.ALL] ;WANTS DETAILED LISTING
QUENUM==.-QUETAB ;NUMBER OF COMMANDS
CMDREF: GETCHR ;READ FOLLOWING CHAR
CAIN C,"E" ;WANTS TO SEE AVAILABLE RESOURCES?
JRST SETRES ;YES
CAIN C,"P" ;WANTS TO SET RUN TIME SUPRESS LIMIT?
JRST SETRTS ;YES
RESCAN ;NO, PUT BACK THE CHAR
CALL DECINZ ;INPUT A NUMBER
SKIPN T1 ;NONZERO VALUE GIVEN?
MOVX T1,DFTREF ;NO, THEN GET DEFAULT
SKIPL T2 ;WAS ONE INPUT?
TXOA F,FR.REF ;NO, THEN SET UP REFRESH
MOVEM T1,REFTIM ;YES, SAVE THE NUMBER
CPOPJ1: AOS (P) ;SET FOR SKIP RETURN
RET ;RETURN
SETRTS: TXNN F,FR.NEG ;INVERSE SENCE?
TDZA T1,T1 ;NO, CLEAR FOR DEFAULT CHECK
MOVEI T1,1 ;YES, SET FOR OTHER CHECK
MOVEM T1,MAXRPF ;SAVE THE FLAG
CALL DECINZ ;GET THE NUMBER OF '100THs OF PERCENTS TO
SKIPL T2 ; SUPPRESS, AND SEE IF TO TAKE DEFAULT
MOVX T1,DFTRPL ;GET THE DEFAULT
MOVEM T1,MAXRPT ;SET THE TIME
RETSKP ;RETURN
CMDJOB: CAMLE T1,HGHJOB ;IS IT TOO LARGE?
RET ;NO, ERROR
MOVE T4,T1 ;SAVE A COPY
CAIE C,"-" ;FOLLOWED BY A DASH?
JRST CMDRAN ;NO, GO DO ONE JOB
MOVE T4,T1 ;YES, SAVE THIS ONE
GETCHR ;GOBBLE THE DASH
CALL JOBIN ;INPUT ANOTHER JOB NUMBER
JUMPGE T2,CPOPJ ;ERROR IF NONE THERE
CAMLE T1,HGHJOB ;SEE IF LEGAL AGAIN
RET ;NO, ERROR
CMDRAN: CAMGE T1,T4 ;SEE IF ORDER IS RIGHT
EXCH T1,T4 ;NO, SWITCH THEM THEN
SUB T1,T4 ;GET NUMBER OF JOBS DIFFERENCE
SUBI T4,1 ;BACK OFF A JOB
ADJBP T4,[POINT 1,BITS,0] ;GET A BYTE POINTER
TXNN F,FR.NEG ;ADDING JOBS?
TDZA T2,T2 ;YES, CLEAR AC
MOVEI T2,1 ;NO, SET AC NONZERO
IDPB T2,T4 ;DEPOSIT THE BIT
SOJGE T1,.-1 ;LOOP OVER REQUIRED NUMBER OF JOBS
RETSKP ;GOOD RETURN
CMDD: GETCHR ;GET THE NEXT CHARACTER
CAIN C,"N" ;WANTS TO SHOW DECNET STATUS?
JRST SETDEC ;YES, GO DO IT
CAIN C,"V" ;WANTS TO SHOW DEVICES
JRST SETDEV ;YES, GO DO IT
RESCAN ;NO, RESTORE THE CHAR
CALL DEFALT ;CALL ROUTINE TO DEFAULT EVERYTHING
RETSKP ;GOOD RETURN
;COMMAND TO SHOW OR REMOVE HELP DISPLAY. WE TRY TO PRESERVE THE STATE
;OF THE PREVIOUS DISPLAY, SO THAT GETTING HELP DOESN'T RIP YOU OFF.
CMDHLP: TXNE F,FR.NEG ;WANT TO SEE HELP TEXT?
JRST HLPNO ;NO, GO REMOVE IT
GETCHR ;READ NEXT CHAR
CAIE C,"C" ;WANTS HELP ON COLUMN COMMANDS?
JRST HLPNRM ;NO, GO DO NORMAL HELP
CALL DISNAM ;READ IN THE NAME OF THE DISPLAY
RET ;BAD INPUT
SUB T4,[1,,DISTAB+1] ;MAKE AOBJN POINTER OVER TYPES
MOVEM T4,COLHLC ;AND SAVE IT
MOVEI T1,HLPCOL ;GET SPECIAL HELP ROUTINE
MOVEM T1,HLPDSP ;REMEMBER IT
JRST HLPNRD ;AND FINISH UP
HLPNRM: RESCAN ;PUT BACK THE NEXT CHARACTER
SETZM HLPDSP ;SET NO SPECIAL HELP ROUTINE
HLPNRD: TXZ F,FR.END ;ACT LIKE MORE PAGES COMING
SETZ T1, ;GET A ZERO
EXCH T1,PAGE ;GET OLD PAGE COUNTER AND CLEAR IT
TLNE R,-1 ;ALREADY SET UP FOR HELP?
RETSKP ;YES, GOOD RETURN
MOVSI R,(R) ;NO, SAVE CURRENT ROUTINE
HRRI R,DPYHLP ;SET UP HELP MODE
MOVEM T1,OLDPAG ;SAVE IT FOR LATER RESTORATION
RETSKP ;AND SKIP RETURN
HLPNO: TLNN R,-1 ;WERE WE IN THE HELP DISPLAY?
RET ;NO, ERROR
HLRZ R,R ;YES, RESTORE OLD DISPLAY
MOVE T1,OLDPAG ;GET OLD PAGE VALUE
MOVEM T1,PAGE ;AND RESTORE IT
RETSKP ;GOOD RETURN
;COMMAND TO SET THE NUMBER OF BLANK SPACES BETWEEN COLUMNS IN A DISPLAY.
CMDBLK: CALL DISNAM ;READ IN A DISPLAY NAME
RET ;ERROR
GETCHR ;READ NEXT CHAR
CAIE C,"/" ;SECOND ARGUMENT FOLLOWING?
JRST DEFBLK ;NO, WANTS DEFAULT SEPARATION USED
CALL DECIN ;READ SEPARATION
CAIG T1,MAXSEP ;MAKE SURE NOT TOO LARGE
JUMPG T1,DEFBLL ;AND MAKE SURE POSITIVE
RET ;NO, ERROR
DEFBLK: RESCAN ;REREAD THE CHAR
SETZ T1, ;INDICATE TO USE DEFAULTS
DEFBLL: SKIPN T2,T1 ;GET SPECIFIED SEPARATION
HRRZ T2,(T4) ;WANTS DEFAULT, GET IT
MOVEM T2,COLSEP-DISTAB(T4) ;STORE NEW SEPARATION
AOBJN T4,DEFBLL ;LOOP FOR NECESSARY DISPLAYS
SETOM HDRTYP ;INVALIDATE ANY OLD HEADER
RETSKP ;GOOD RETURN
;USEFUL SUBROUTINE TO READ IN A DISPLAY NAME, AND RETURN AN AOBJN
;POINTER IN T4 WHICH POINTS TO THE SELECTED COLUMNS. SKIP RETURN
;IF SUCCESSFUL.
DISNAM: CALL CPYTXT ;COPY THE NAME OF THE DISPLAY
JUMPN T1,CPOPJ ;ERROR IF BUFFER OVERFLOWED
MOVE T4,[-DISNUM,,DISTAB+1] ;ASSUME WANT ALL COLUMNS SET
JUMPE T1,CPOPJ1 ;RETURN IF CORRECT
MOVEI T1,DISTAB ;GET ADDRESS OF THE TABLE
HRROI T2,TXTBUF ;AND POINTER TO USER'S STRING
TBLUK ;SEARCH FOR DISPLAY NAME
TXNN T2,TL%ABR+TL%EXM ;FIND A MATCH?
RET ;NO, FAIL
HRRO T4,T1 ;MAKE AOBJN POINTER TO PARTICULAR COLUMN
RETSKP ;AND GIVE GOOD RETURN
CMDONE: GETCHR ;GET FOLLOWING CHAR
CAIN C,"T" ;WANTS TO SPECIFY A TERMINAL?
JRST ONETTY ;YES, GO DO THAT
RESCAN ;NO, REREAD THE CHAR
CALL JOBINZ ;READ JOB NUMBER IF THERE
JUMPGE T2,CMDALL ;IF NONE, DO ALL JOBS
CAMLE T1,HGHJOB ;SEE IF LEGAL JOB NUMBER
RET ;NO, ERROR RETURN
MOVEM T1,THEJOB ;YES, SAVE NUMBER
SETZM THETTY ;AND CLEAR TERMINAL TO SHOW
MOVEI R,DPYONE ;GET ROUTINE TO DO
JRST NEWDPY ;GO FINISH
ONETTY: CALL OCTIN ;READ THE TTY NUMBER
JUMPGE T2,CPOPJ ;MUST HAVE ONE SPECIFIED
CAMLE T1,HGHTTY ;MAKE SURE IT IS LEGAL
RET ;NO, ERROR
ADDI T1,.TTDES ;TURN INTO TERMINAL DESIGNATOR
MOVEM T1,THETTY ;THEN SAVE IT
MOVEI R,DPYONE ;GET ROUTINE TO DO
JRST NEWDPY ;AND FINISH
CMDMON: SKIPA R,[DPYMON] ;SET UP ROUTINE
CMDALL: MOVEI R,DPYALL ;OR OTHER ROUTINE
JRST NEWDPY ;GO FINISH
CMDS: GETCHR ;READ FOLLOWING CHAR
MOVSI T1,-SDPNUM ;GET READY FOR SEARCH
HLRZ T2,CMDSDP(T1) ;GRAB NEXT COMMAND LETTER
CAME C,T2 ;FOUND MATCH?
AOBJN T1,.-2 ;NO, KEEP LOOKING
HRRZ T1,CMDSDP(T1) ;GET DISPATCH ADDRESS
JRST (T1) ;GO TO IT
CMDSDP: XWD "T",SETSTR ;SET UP STRUCTURE DISPLAY
XWD "J",CMDSKJ ;SKIP SOME JFNS
XWD "F",CMDSKF ;SKIP SOME FORKS
XWD "B",SETBIA ;SET BIAS CONTROL KNOB
XWD "+",SCRREL ;SCROLL AHEAD SOME PAGES
XWD "-",SCRREL ;SCROLL BACKWARDS SOME PAGES
XWD "I",SCRINT ;SET SCROLLING INTERVAL
XWD -1,SCRPHY ;IF NO MATCH, SCROLL TO PARTICULAR PAGE
SDPNUM==.-CMDSDP-1 ;NUMBER OF REAL COMMANDS
CMDSKF: CALL DECINZ ;READ ARGUMENT
MOVEM T1,SKPFRK ;SAVE NUMBER OF FORKS TO SKIP
RETSKP ;SKIP RETURN
CMDSKJ: CALL DECINZ ;READ ARGUMENT
MOVEM T1,SKPJFN ;SAVE NUMBER OF JFNS TO SKIP
RETSKP ;SKIP RETURN
SETBIA: CALL DECIN ;READ THE FOLLOWING NUMBER
JUMPGE T2,CPOPJ ;IF TYPED NONE, ERROR
GETCHR ;GET THE NEXT CHARACTER
CAIE C,"!" ;MUST BE EXCLAIMATION POINT
RET ;NO, ERROR
MOVE T4,T1 ;MOVE VALUE TO RIGHT AC
MOVEI T1,.SKSBC ;FUNCTION TO SET BIAS KNOB
MOVEI T2,T3 ;ADDRESS OF BLOCK
MOVEI T3,2 ;TWO ARGUMENTS
SKED% ;SET IT
ERJMP CPOPJ ;FAILED, GIVE ERROR
RETSKP ;GOOD RETURN
;HERE FOR THOSE VARIATIONS OF THE "S" COMMAND WHICH AFFECT SCROLLING.
;THE CURRENT SCREEN PAGE NUMBER CAN BE SET TO A PARTICULAR VALUE,
;OR CHANGED RELATIVE TO THE CURRENT PAGE.
SCRPHY: RESCAN ;REREAD LAST CHAR
CALL DECIN ;THEN GET PAGE NUMBER
SUBI T1,1 ;COMPENSATE FOR PAGE NUMBERING
JUMPL T2,SCRSAV ;IF ONE GIVEN, SET TO THAT PAGE
CALL PAGDO ;OTHERWISE JUST ADVANCE TO NEXT SCREEN
RETSKP ;GOOD RETURN
SCRREL: MOVE T4,C ;SAVE WHICH COMMAND THIS IS
CALL DECIN ;READ FOLLOWING NUMBER
SKIPL T2 ;WAS ONE TYPED?
MOVEI T1,1 ;NO, THEN DEFAULT TO ONE
CAIN T4,"-" ;WANTS TO BACK UP?
MOVN T1,T1 ;YES, NEGATE THE NUMBER
ADD T1,PAGE ;ADD CURRENT PAGE NUMBER IN
SCRSAV: SKIPGE T1 ;TRYING TO GO NEGATIVE?
SETZ T1, ;YES, TAME IT
MOVEM T1,PAGE ;SET NEW PAGE NUMBER
TXZ F,FR.END ;ACT LIKE MORE PAGES TO GO
CALL PAGSET ;RESET SCROLLING INTERVAL
RETSKP ;GOOD RETURN
SCRINT: CALL DECIN ;GET INTERVAL FOR SCROLLING
MOVEM T1,PAGINT ;SAVE IT
CALL PAGSET ;RESET PAGING TIMER
RETSKP ;GOOD RETURN
;COMMAND TO ADVANCE THE SINGLE-JOB DISPLAY TO THE NEXT SUITABLE
;JOB NUMBER. THESE ARE THE JOBS SHOWN ON THE NORMAL DISPLAY.
;ALSO USED TO DETERMINE WHETHER OR NOT TO SHOW ACTIVE LOGICAL
;LINK NODES.
CMDA: GETCHR ;READ NEXT CHARACTER
CAIN C,"N" ;WANTS TO SEE ARPANET STATUS?
JRST SETARP ;YES, GO DO THAT
RESCAN ;NO, PUT BACK CHARACTER
CAIE R,DPYONE ;CURRENTLY DOING ONE-JOB DISPLAY?
JRST CMDACT ;NO, GO CHECK FOR OTHER DISPLAYS
MOVE J,THEJOB ;GET THE JOB WE WERE SHOWING
ADVSRC: ADDI J,1 ;MOVE TO NEXT JOB
CAMLE J,HGHJOB ;OFF OF END?
SETZ J, ;YES, START OVER
CAMN J,THEJOB ;WENT ALL THE WAY AROUND?
JRST NEWDPY ;YES, STAY WITH THIS JOB
CALL GETDAT ;READ INFORMATION ON THIS JOB
JRST ADVSRC ;NO SUCH JOB, CONTINUE LOOKING
CALL SUPPRS ;WANT TO SEE THIS JOB?
JRST ADVSRC ;NO, LOOK AT NEXT ONE
MOVEM J,THEJOB ;YES, SET NEW JOB TO WATCH
JRST NEWDPY ;RESET PAGING AND RETURN
CMDACT: SETZ T1, ;CLEAR
CAIN R,DPYDEC ;DECNET DISPLAY?
MOVX T1,FR.ACT ;YES, GET FLAG
CAIN R,DPYTTY ;TERMINAL DISPLAY?
MOVX T1,FR.TAC ;YES, GET DIFFERENT FLAG
CAIN R,DPYARH ;ARPANET HOST DISPLAY?
MOVX T1,FR.AAH ;YES, OTHER FLAG
JUMPE T1,CPOPJ ;FAIL IF NOT THEM
TXNN F,FR.NEG ;WANT TO SEE ACTIVE STUFF ONLY?
TDOA F,T1 ;YES, SET THE FLAG
TDZ F,T1 ;NO, CLEAR THE FLAG
RETSKP ;GOOD RETURN
;COMMAND TO SPECIFY USER NAMES WHICH ARE TO BE SHOWN.
CMDUSR: CALL CPYTXT ;COPY POSSIBLE USER NAME
JUMPN T1,CPOPJ ;IF OVERFLOWED, GIVE ERROR
JUMPN T1,CMDUSL ;PROCEED IF SUPPLIED A NAME
TXNN F,FR.NEG ;NEGATING USERS?
CAIN C,"/" ;OR EXPLICITLY SPECIFYING NULL NAMES?
JRST CMDUSL ;YES, PROCEED
SETZM USRLST ;NO ARGUMENTS AT ALL, CLEAR LIST
RETSKP ;AND SKIP RETURN
CMDUSL: MOVEI T1,USERS ;GET STORAGE ADDRESS READY
SKIPN USRLST ;ALREADY HAVE SOME NAMES STORED?
MOVEM T1,USRFRE ;NO, THEN INITIALIZE FIRST FREE LOCATION
SUBI T2,TXTBUF-1 ;COMPUTE WORDS USED FOR NEW STRING
ADD T2,USRFRE ;THEN COMPUTE NEW FIRST FREE ADDRESS
CAIL T2,USERS+USRSIZ ;ABOUT TO OVERFLOW STORAGE AREA?
RET ;YES, FAIL RETURN
MOVE T1,USRFRE ;GET ADDRESS TO COPY INTO
HRLI T1,TXTBUF-1 ;AND LOCATION TO COPY FROM (MINUS ONE)
BLT T1,(T2) ;COPY STRING INTO STORAGE AREA
EXCH T2,USRFRE ;SET NEW FIRST FREE LOCATION AND GET OLD ONE
EXCH T2,USRLST ;POINT HEADER AT NEW ENTRY AND GET OLD ONE
TXNE F,FR.NEG ;WANT TO NOT SEE THIS NAME?
TLO T2,-1 ;YES, FLAG IT AS UNDESIRED
MOVEM T2,@USRLST ;STORE FLAG AND POINTER INTO STORAGE
CAIE C,"/" ;MORE NAMES COMING?
JRST NEWDPY ;NO, RESET PAGING AND RETURN
GETCHR ;YES, EAT THE SLASH
CALL CPYTXT ;READ THE NEXT NAME
JUMPN T1,CPOPJ ;FAIL IF OVERFLOWED
JRST CMDUSL ;GO PROCESS IT
;HERE TO EITHER REMOVE A COLUMN OF OUTPUT, OR TO ADD A COLUMN OF
;OUTPUT TO THE END OF THE DISPLAY.
CMDCOL: CALL CPYTXT ;COPY THE COLUMN NAME
RET ;HAS TO BE ONE
MOVEI T1,COLTAB ;GET ADDRESS OF COLUMN NAME TABLE
HRROI T2,TXTBUF ;AND POINTER TO USER'S STRING
TBLUK ;SEARCH FOR THE NAME
TXNN T2,TL%ABR+TL%EXM ;FIND A MATCH?
RET ;NO, ERROR
HRRZ T1,(T1) ;GET ADDRESS OF COLUMN DATA
AOS (P) ;GOOD RETURN NOW
TXNE F,FR.NEG ;WANT TO ADD THIS ENTRY?
JRST COLREM ;NO, GO REMOVE IT
MOVE T3,T1 ;SAVE COLUMN
MOVEI T1,-1 ;GET A LARGE NUMBER
GETCHR ;GET THE NEXT CHARACTER
CAIE C,"/" ;SECOND ARGUMENT COMING?
RESCAN ;NO, PUT BACK THE CHAR
CAIN C,"/" ;WELL?
CALL DECIN ;YES, READ THE ARGUMENT
MOVE T2,T1 ;PUT NUMBER IN RIGHT AC
MOVE T1,T3 ;AND COLUMN ADDRESS IN RIGHT AC
JRST COLADD ;GO ADD AT DESIRED COLUMN NUMBER
;HERE TO REMOVE A COLUMN FROM THE DISPLAY. ENTRY TO REMOVE IS IN
;AC T1, WHICH IS NOT CHANGED.
COLREM: SETOM HDRTYP ;HEADER ISN'T VALID ANYMORE
SETZ T2, ;SET UP FOR LOOP
COLREL: SKIPN T3,COLDSP(T2) ;RAN OUT OF COLUMNS?
RET ;YES, IT WAN'T THERE TO REMOVE
CAME T1,T3 ;IS THIS THE ONE TO REMOVE?
AOJA T2,COLREL ;NO, KEEP SEARCHING
COLRLL: MOVE T3,COLDSP+1(T2) ;GET NEXT WORD
MOVEM T3,COLDSP(T2) ;MOVE IT UP OVER OLD ONE
JUMPE T3,CPOPJ ;DONE WHEN MOVED THE NULL WORD
AOJA T2,COLRLL ;LOOP UNTIL DONE
;HERE TO ADD A COLUMN TO THE DISPLAY. ENTRY TO BE ADDED IS IN T1,
;AND COLUMN NUMBER TO INSERT IT AT IS IN T2.
COLADD: MOVEM T2,TEMP ;SAVE AWAY THE COLUMN NUMBER
CALL COLREM ;FIRST REMOVE THE ENTRY
MOVE T2,CL.TYP(T1) ;GET THE TYPE OF COLUMN THIS IS
SETZ T3, ;INITIALIZE INDEX
COLADS: SKIPN T4,COLDSP(T3) ;GET NEXT COLUMN
JRST COLADF ;NO MORE, INSERT AT END THEN
CAMN T2,CL.TYP(T4) ;WRONG COLUMN TYPE?
SOSLE TEMP ;OR NOT TO SPECIFIED COLUMN NUMBER?
AOJA T3,COLADS ;YES, KEEP SEARCHING
COLADF: EXCH T1,COLDSP(T3) ;PUT NEW ENTRY HERE AND GET OLD ENTRY
SKIPE T1 ;REACHED THE END?
AOJA T3,COLADF ;NO, KEEP SWITCHING THEM
SETZM COLDSP+1(T3) ;MAKE SURE NEXT ENTRY IS ZERO
RET ;DONE
CMDP: GETCHR ;READ THE NEXT CHARACTER
CAIE C,"R" ;COMMAND TO SHOW A PROGRAM?
JRST DOPUSH ;NO, GO PUSH TO ANOTHER EXEC
MOVEI T1,TXTBUF ;POINT TO STANDARD STORAGE AREA
MOVEI T2,^D13 ;GET COUNT FOR WORST CASE WILDCARDING
CALL CPYTX1 ;READ IN PROGRAM NAME
JUMPN T1,CPOPJ ;FAILED IF OVERFLOWED
JUMPN T1,PRGHAV ;SKIP ONWARD IF HAVE A NAME
TXNN F,FR.NEG ;NEGATING PROGRAMS?
CAIN C,"/" ;OR EXPLICITLY SPECIFYING BLANK NAME?
JRST PRGHAV ;YES, PROCEED
SETZM PRGNUM ;NOPE, CLEAR LIST OF PROGRAM NAMES
JRST NEWDPY ;AND RESET SCREEN
PRGHAV: MOVE T1,PRGNUM ;GET NUMBER OF PROGRAM NAMES STORED
CAILE T1,PRGMAX ;OVERFLOWED?
RET ;YES, ERROR RETURN
AOS T1,PRGNUM ;INCREMENT NUMBER OF PROGRAM NAMES
IMULI T1,3 ;GET OFFSET AGAIN
DMOVE T2,TXTBUF ;GET FIRST TWO WORDS FROM BUFFER
MOVE T4,TXTBUF+2 ;AND THIRD WORD
TXNE F,FR.NEG ;WANTS TO SUPPRESS THE PROGRAM NAME?
IORI T2,1 ;YES, FLAG LOW ORDER BIT IN FIRST WORD
DMOVEM T2,PRGWLD-3(T1) ;STORE FIRST TWO WORDS INTO TABLE
MOVEM T4,PRGWLD-1(T1) ;AND THIRD WORD ALSO
CAIE C,"/" ;ANOTHER PROGRAM NAME COMING?
JRST NEWDPY ;NO, GO RESET SCREEN AND RETURN
GETCHR ;YES, EAT THE SLASH
MOVEI T1,TXTBUF ;POINT TO STANDARD STORAGE AREA
MOVEI T2,^D13 ;GET COUNT FOR WORST CASE WILDCARDING
CALL CPYTX1 ;READ IN ANOTHER PROGRAM NAME
JUMPN T1,CPOPJ ;FAILED IF OVERFLOWED
JRST PRGHAV ;AND GO BACK TO LOOP
;COMMAND TO DO A PUSH TO A NEW EXEC. WHILE THE EXEC IS RUNNING,
;WE STILL COMPUTE THE CPU PERCENTAGES AND IDLE TIME. WHEN THE EXEC
;TERMINATES, WE REFRESH THE SCREEN AND RETURN. IF AN EXEC HAD
;PREVIOUSLY BEEN USED, WE JUST CONTINUE IT.
DOPUSH: RESCAN ;RESTORE UNWANTED CHARACTER
MOVEI T1,.FHSLF ;GET READY
MOVX T2,1B<TTYCHN> ;TO DISABLE TERMINAL INTERRUPT
DIC ;DO IT
CALL ECHOON ;TURN ON ECHOING NOW
SKIPE T1,HANDLE ;ALREADY HAVE AN EXEC AROUND?
JRST PSHCON ;YES, JUST CONTINUE IT
SETZ T4, ;REMEMBER NO JFN AND NO FORK YET
MOVX T1,CR%CAP ;GET READY TO CREATE ONE
CFORK ;MAKE AN INFERIOR FORK
ERJMP PSHFAI ;FAILED
HRLZ T4,T1 ;REMEMBER THE FORK HANDLE
MOVX T1,GJ%OLD+GJ%SHT ;GET FLAGS
HRROI T2,[ASCIZ/SYSTEM:EXEC.EXE/] ;AND FILE SPEC
GTJFN ;GET A JFN ON THE FILE
ERJMP PSHFAI ;FAILED
IORB T1,T4 ;COMBINE JFN AND HANDLE
GET ;READ EXEC INTO FORK
ERJMP PSHFAI ;FAILED
TRZ T4,-1 ;THE JFN NOW BELONGS TO THE INFERIOR
TTY$ $TTCLR ;CLEAR SCREEN AND HOME UP
TXO F,FR.REF!FR.RFC ;REMEMBER TO REFRESH SCREEN LATER
HLRZ T1,T4 ;GET HANDLE BACK
SETZ T2, ;NORMAL START ADDRESS
SFRKV ;START THE FORK
ERJMP PSHFAI ;FAILED
HLRZM T4,HANDLE ;OK, REMEMBER HANDLE FOR NEXT PUSH
JRST PSHCHK ;JOIN MAIN LOOP
PSHCON: TTY$ $TTCLR ;CLEAR SCREEN AND HOME UP
TXO F,FR.REF!FR.RFC ;REMEMBER TO REFRESH SCREEN LATER
TXO T1,SF%CON ;SET FLAG TO SAY CONTINUE FORK
SFORK ;CONTINUE IT
ERJMP PSHFIN ;FAILED, GIVE ERROR
JRST PSHCHK ;OK, GO TO MAIN LOOP
;NOW WAIT FOR THE EXEC TO FINISH UP:
PSHCHK: SETOM FRKFLG ;SAY NOT YET IN SLEEP
MOVEI T1,.FHSLF ;GET HANDLE
MOVX T2,1B<.ICIFT> ;THEN CHANNEL
AIC ;ACTIVATE FORK TERMINATION CHANNEL
PSHLOP: MOVEI T1,PSHSLP ;GET SLEEP TIME
AOSN FRKFLG ;SET FLAG AND CHECK IT
DISMS ;WAIT A LITTLE BIT IF NECESSARY
PSHINT: SETOM FRKFLG ;NO LONGER SLEEPING
GTAD ;READ TIME AND DATE
MOVEM T1,NTIME ;SAVE IT
CALL CPUCMP ;COMPUTE NEW CPU DATA
CALL CHKDRM ;AND COMPUTE NEW DORMANCY DATA
MOVE T1,HANDLE ;GET HANDLE
RFSTS ;GET STATUS
LDB T1,[POINT 17,T1,17] ;GET STATUS CODE
CAIN T1,.RFHLT ;DID IT HALT?
JRST PSHFIS ;YES, DONE
CAIE T1,.RFFPT ;FORCED HALT?
JRST PSHLOP ;NO, BACK TO LOOP
HRROI T1,[ASCIZ/
? EXEC terminated abnormally at PC /] ;GET STRING
PSOUT ;TYPE IT
MOVEI T1,.PRIOU ;TO TERMINAL
ANDI T2,-1 ;TRASH BITS
MOVEI T3,^D8 ;OCTAL
NOUT ;SAY WHAT THE PC IS
JFCL ;IGNORE ERROR
HRROI T2,[ASCIZ/ - /] ;GET STRING
SETZ T3, ;TERMINATE ON NULL
SOUT ;TYPE SEPARATOR
HRLO T2,HANDLE ;GET HANDLE, LAST ERROR
ERSTR ;SAY WHY THE EXEC DIED
JFCL ;CAN'T KNOW
JFCL ;EITHER ERROR
HRROI T2,[ASCIZ/
/] ;GET FINAL CRLF
SOUT ;TYPE IT
DOBE ;WAIT UNTIL DONE
MOVEI T1,^D5000 ;GET TIME
DISMS ;WAIT UNTIL HE CAN SEE IT
JRST PSHFIS ;AND RETURN
;HERE TO TERMINATE THE PUSH IF WE COULD NOT START IT UP:
PSHFAI: HRRZ T1,T4 ;GET POSSIBLE JFN WE CREATED
SKIPE T1 ;WAS THERE ONE?
RLJFN ;YES, RELEASE IT
ERJMP .+1 ;IGNORE ERROR
HLRZ T1,T4 ;GET POSSIBLE FORK HANDLE
SKIPE T1 ;WAS THERE ONE?
KFORK ;YES, RELEASE IT
ERJMP .+1 ;IGNORE FAILURE
JRST PSHFIN ;GO FINISH UP NOW
;HERE TO FINISH A PUSH WHEN THE EXEC HAS TERMINATED:
PSHFIS: AOS (P) ;SKIP RETURN
PSHFIN: MOVEI T1,.FHSLF ;MY FORK
MOVX T2,1B<.ICIFT> ;CHANNEL FOR TERMINATION
DIC ;DISABLE INTERRUPT
MOVE T1,MYNAME ;GET MY NAME
SETNM ;CHANGE BACK TO IT
CALL ECHOOF ;TURN ECHOING OFF AGAIN
MOVEI T1,.FHSLF ;GET READY
MOVX T2,1B<TTYCHN> ;TO REACTIVATE TERMINAL INTERRUPT
AIC ;DO IT
IIC ;CAUSE ONE IN CASE OF TYPE-AHEAD
RET ;RETURN
SUBTTL SIMPLE INPUT ROUTINES
;OCTAL AND DECIMAL NUMBER INPUT ROUTINES. AC T2 IS NEGATIVE IF A
;NUMBER WAS FOUND, NONNEGATIVE OTHERWISE. AC T1 WILL BE ZERO IF
;NO NUMBER WAS FOUND. AC T3 IS UNCHANGED.
DECINZ: CALL EATSPS ;READ SPACES FIRST
DECIN: SETZB T1,T2 ;CLEAR AC'S
NUMINL: GETCHR ;READ NEXT CHARACTER
CAIL C,"0" ;VALID DIGIT?
CAILE C,"9" ;WELL?
JRST NUMHAV ;NO, GO FINISH UP
TLOE T2,400000 ;YES, SET FLAG TO SAY FOUND A NUMBER
IMULI T1,^D10 ;MAKE ROOM FOR NEXT DIGIT
ADDI T1,-"0"(C) ;ADD NEW DIGIT IN
JRST NUMINL ;LOOP OVER WHOLE NUMBER
NUMHAV: SKIPGE T1 ;SEE IF OVERFLOWED?
MOVX T1,.INFIN ;YES, THEN GET POSITIVE INFINITY
JRST REREAD ;GO REREAD LAST CHAR
OCTIN: SETZB T1,T2 ;CLEAR AC'S
OCTINL: GETCHR ;READ NEXT CHAR
CAIL C,"0" ;OCTAL DIGIT?
CAILE C,"7" ;WELL?
JRST NUMHAV ;NO, GO FINISH UP
TLOE T2,400000 ;SET FLAG SAYING HAVE NUMBER
LSH T1,3 ;SHIFT OVER A DIGIT
IORI T1,-"0"(C) ;ADD IN NEW ONE
JRST OCTINL ;LOOP
;ROUTINE TO INPUT A JOB NUMBER, WHICH COULD BE MY OWN DUE TO A PERIOD.
;RETURNS SAME AS DECINZ OR DECIN.
JOBINZ: CALL EATSPS ;EAT LEADING SPACES
JOBIN: CALL DECIN ;LOOK FOR A NUMBER
JUMPL T2,CPOPJ ;RETURN IF GOT ONE
CAIE C,"." ;NO, THEN SEE IF A PERIOD IS THERE
RET ;NO, RETURN
GETCHR ;YES, EAT THE PERIOD
MOVE T1,MYJOB ;GET MY JOB NUMBER
SETO T2, ;SAY WE HAVE A NUMBER
RET ;RETURN
;SIXBIT INPUT ROUTINE. ALPHANUMERICS ARE ALLOWED ONLY. RETURNS
;QUANTITY IN AC T1.
SIXIN: SETZ T1, ;CLEAR RESULT
MOVE T2,[POINT 6,T1] ;AND SET UP BYTE POINTER
SIXINL: GETCHR ;READ NEXT CHARACTER
CAIL C,"0" ;POSSIBLY ALPHANUMERIC?
CAILE C,"Z" ;WELL?
JRST REREAD ;NO, RESCAN THE CHAR AND RETURN
CAILE C,"9" ;WELL?
CAIL C,"A" ;IS IT?
SKIPA ;YES
JRST REREAD ;NO, RESCAN IT AND RETURN
TRNE T1,77 ;ROOM FOR ANOTHER CHARACTER?
JRST SIXINL ;NO, IGNORE THIS ONE
SUBI C," " ;CONVERT FROM ASCII TO SIXBIT
IDPB C,T2 ;STORE THE CHARACTER
JRST SIXINL ;AND LOOP
;ROUTINE TO SKIP OVER SPACES AND TABS:
EATSPS: GETCHR ;GET NEXT CHARACTER
CAIE C," " ;A SPACE?
CAIN C," " ;OR TAB?
JRST EATSPS ;YES, KEEP EATING
REREAD: RESCAN ;NO, SET TO RESCAN THIS CHAR
RET ;AND RETURN
SUBTTL SUBROUTINE TO READ COMMAND CHARACTERS
;CHARACTER INPUT ROUTINE. CHARACTERS ARE READ EITHER FROM AN
;INDIRECT FILE, OR FROM THE INPUT BUFFERS. THIS ROUTINE PROVIDES
;FOR THE RESCANNING OF A SINGLE CHARACTER. CHAR READ IS RETURNED
;IN AC C.
RUNCHR: MOVE C,SAVCHR ;GET OLD CHARACTER
TXZE F,FR.RSN ;WANT A NEW CHARACTER INSTEAD?
RET ;NO, RETURN THIS ONE
SKIPE TAKLVL ;READING FROM AN INDIRECT FILE?
JRST TAKCHR ;YES, HANDLE SPECIAL
ILDB C,RUNPTR ;NO, GET NEW CHAR FROM OUR BUFFER
CHRHAV: CAIN C,15 ;CARRIAGE RETURN?
JRST RUNCHR ;YES, IGNORE IT
JUMPE C,RUNCHR ;ALSO EAT NULLS
CAIL C,"A"+40 ;IS THIS A LOWER CASE CHAR?
CAILE C,"Z"+40 ;WELL?
SKIPA ;NO
SUBI C,40 ;YES, CONVERT TO UPPER CASE
MOVEM C,SAVCHR ;REMEMBER IN CASE HAVE TO REREAD IT
CAIN C,12 ;HAVE A LINE FEED?
RESCAN ;YES, MAKE SURE IT STAYS AROUND
RET ;RETURN
TAKCHR: PUSH P,T1 ;SAVE SOME AC'S
PUSH P,T2 ;THAT WE NEED
MOVE T1,TAKJFN ;GET JFN
BIN ;READ THE NEXT CHARACTER
ERJMP TAKERR ;FAILED, GO ANALYSE
CAIN T2,12 ;FOUND A LINE FEED IN FILE?
MOVEI T2," " ;YES, MAKE IT A SPACE
TXNN F,FR.NOC ;SEE IF WE SHOULD CONVERT THE CHAR
CAIE T2,LBLCHR ;IS THIS THE START OF A LABEL?
SKIPA C,T2 ;NO, MOVE CHAR TO RIGHT AC
TAKDON: MOVEI C,12 ;GET A LINEFEED TO SAY WE'RE DONE
POP P,T2 ;RESTORE AC'S
POP P,T1 ;THAT WERE USED
JRST CHRHAV ;GO FINISH CHARACTER HANDLING
TAKERR: MOVEI T1,.FHSLF ;GET SET
GETER ;FIND OUT WHY WE LOST
ANDI T2,-1 ;KEEP ONLY THE ERROR REASON
CAIN T2,IOX4 ;END OF FILE?
JRST TAKDON ;YES, GO RETURN A LINE FEED
JRST DIE ;NO, THEN LOSE
SUBTTL ROUTINE TO SET UP ALL DEFAULT PARAMETERS
;THIS ROUTINE IS CALLED AT SYSTEM STARTUP, OR BY THE "D" COMMAND.
;ALL THE PARAMETERS ARE SET TO THEIR INITIAL VALUE.
DEFALT: TXZ F,FR.TAC!FR.OPR!FR.CMP!FR.ACT!FR.AAH!FR.INF
IFE DECSW,<
TXZ F,FR.NOS
>
SETZM SKPFRK ;CLEAR NUMBER OF FORKS TO SKIP
SETZM SKPJFN ;AND NUMBER OF JFNS TO SKIP
SETZM USRLST ;CLEAR LIST OF USERS TO SHOW
MOVE T1,NTIME ;GET CURRENT TIME
MOVEM T1,SLWTIM ;AND RESET THE SLOWDOWN TIMER
MOVX T1,LIQALL ;GET FLAGS FOR ALL QUEUES
MOVEM T1,QSRFL1 ;SET THEM
SETZM QSRFL2 ;CLEAR OTHER QUEUE FLAGS
MOVX T1,DFTPAG ;GET DEFAULT PAGE INTERVAL
MOVEM T1,PAGINT ;SET IT
CALL PAGSET ;AND RECOMPUTE SCROLLING TIME
MOVX T1,DFTLAP ;GET DEFAULT LINES TO OVERLAP
MOVEM T1,OVRLAP ;SET IT
MOVX T1,DFTSLP ;GET DEFAULT SLEEP TIME
MOVEM T1,SLPTIM ;SET IT
MOVX T1,DFTREF ;GET DEFAULT TIME BETWEEN REFRESHES
MOVEM T1,REFTIM ;SET IT
MOVX T1,DFTIDL ;GET DEFAULT IDLE TIME
MOVEM T1,MAXIDL ;AND SET IT
MOVX T1,DFTRPL ;GET DEFAULT RUNTIME PERCENT CUTOFF
MOVEM T1,MAXRPT ;SET IT
SETZM MAXIDF ;SET FLAG TO NORMAL CHECK
SETZM PRGNUM ;CLEAR ANY PROGRAM NAMES STORED
MOVE T1,[BITS,,BITS+1] ;GET READY
SETZM BITS ;CLEAR FIRST WORD OF BITS
BLT T1,BITS+<MAXJOB/^D36> ;THEN THE REST
JRST COLINI ;THEN GO INITIALIZE THE COLUMNS
SUBTTL SUBROUTINE TO SET UP HEADER AND TAB STOPS
;CALLED WITH THE HEADER TYPE IN T1, TO BUILD THE HEADER STRING AND
;SET THE PROPER TAB STOPS FOR FOLLOWING OUTPUT. STRING IS STORED
;IN LOCATION HDRTXT. IF FR.NDC IS SET, WE MAKE THE TITLE HAVE A CRLF
;FIRST, TO SEPARATE US FROM THE PREVIOUS OUTPUT.
HDRSET: TXZ F,FR.HDR ;CLEAR THE HEADER FLAG
CAMN T1,HDRTYP ;SEE IF ALREADY SET PROPER HEADER AND TABS
RET ;YES, JUST RETURN
MOVEM T1,HDRTYP ;NO, REMEMBER WHAT WE ARE BUILDING
MOVE T2,[COLTBS,,COLTBS+1] ;GET READY
SETZM COLTBS ;TO CLEAR TAB STOP WORDS
BLT T2,COLTBS+3 ;DO IT
MOVE T2,[POINT 7,HDRTXT] ;GET POINTER TO HEADER STORAGE
MOVEM T2,HDRPTR ;SAVE IT
MOVEI T2,12 ;GET CRLF READY
TXNE F,FR.NDC ;WANT A PRELIMINARY CRLF?
IDPB T2,HDRPTR ;YES, START STRING WITH ONE THEN
SETO T2, ;INITIALIZE COLUMN COUNTER
SETZM HDRPOS ;INITIALIZE COLUMN POSITION
HDRLOP: ADDI T2,1 ;MOVE TO NEXT HEADER
SKIPN T3,COLDSP(T2) ;ANY MORE COLUMNS TO LOOK AT?
JRST HDRDON ;NO, GO FINISH UP
HRRZ T4,CL.TYP(T3) ;GET TYPE
CAME T1,T4 ;THE TYPE WE WANT?
JRST HDRLOP ;NO, LOOK SOME MORE
MOVE T4,CL.SIZ(T3) ;GET WIDTH OF THIS COLUMN
ADD T4,COLSEP(T1) ;ADD IN SEPARATION BETWEEN COLUMNS
ADDB T4,HDRPOS ;ADD INTO TOTAL WIDTH SO FAR
CAIL T4,^D36*4-1 ;CHECK TO SEE IF TOO LARGE
SETZ T4, ;YES, MAKE NICER
ADJBP T4,[POINT 1,COLTBS,0] ;MAKE PROPER BYTE POINTER
MOVEM T4,TEMP ;SAVE AWAY
MOVEI T4,1 ;GET A BIT
DPB T4,TEMP ;SET THE TAB STOP
TXNE F,FR.CMP ;COMPRESSING HEADERS?
JRST HDRLOP ;YES, JUST GO TO NEXT COLUMN
MOVEI T4,11 ;GET A TAB
TXOE F,FR.HDR ;FIRST COLUMN?
IDPB T4,HDRPTR ;NO, THEN SEPARATE THE COLUMNS
ADDI T3,CL.TXT ;POINT TO THE TEXT STRING
CALL HDRSTR ;STORE IT AWAY
JRST HDRLOP ;AND LOOP
;HERE WHEN DONE PROCESSING ALL COLUMNS, TO FINISH UP.
HDRDON: MOVEI T3,[BYTE (7)12,12] ;GET A COUPLE OF END OF LINES
TXNN F,FR.CMP ;COMPRESSING OUTPUT?
CALL HDRSTR ;NO, STORE THESE
SETZ T1, ;GET A NULL
IDPB T1,HDRPTR ;MAKE STORED STRING ASCIZ
TAB$ COLTBS ;SET THE PROPER TAB STOPS
TXZ F,FR.HDR ;CLEAR THE HEADER BIT AGAIN
RET ;DONE
;LOCAL SUBROUTINE TO STORE AN ASCIZ STRING AWAY AS PART OF THE HEADER.
;ADDRESS OF STRING IS IN T3.
HDRSTR: HRLI T3,(POINT 7,) ;MAKE A BYTE POINTER
HDRSTL: ILDB T4,T3 ;GET NEXT CHARACTER
JUMPE T4,CPOPJ ;DONE WHEN GET A NULL
IDPB T4,HDRPTR ;STORE THIS CHAR
JRST HDRSTL ;LOOP FOR NEXT CHAR
SUBTTL SUBROUTINE TO OUTPUT ALL COLUMNS OF A LINE
;CALLED TO LOOP OVER ALL COLUMNS FOR THE CURRENT OUTPUT, CALLING
;THE VARIOUS SUBROUTINES TO OUTPUT THINGS. IT IS ASSUMED THAT
;THE HDRSET ROUTINE WAS PREVIOUSLY CALLED. RETURNS WHEN ALL
;COLUMNS HAVE BEEN PRINTED. CRLF IS TYPED WHEN THE LINE IS DONE.
DOCOLS: CALL HEADER ;TYPE HEADER IF NECESSARY
TXZE F,FR.EAT ;EATING NEEDED?
CALL SETEAT ;YES, GO SET IT UP
SKIPLE @DPYTAB+$DPEAT ;STILL EATING LINES?
JRST DOCRLF ;YES, DON'T DO ANY WORK YET THEN
SETOM NXTCOL ;INITIALIZE NEXT COLUMN FOR LOOP
DOCOLL: MOVE T1,NXTCOL ;GET THE OLD NEXT COLUMN
MOVEM T1,CURCOL ;SET AS THE CURRENT COLUMN
DOCOLF: AOS T1,NXTCOL ;GET NEXT COLUMN
SKIPN T1,COLDSP(T1) ;OUT OF COLUMNS?
JRST COLNOM ;YES, GO CLEAR FLAG
HRRZ T2,CL.TYP(T1) ;GET THE TYPE OF COLUMN
CAME T2,HDRTYP ;SAME TYPE AS THE HEADER IS SET UP FOR?
JRST DOCOLF ;NO, KEEP SEARCHING
TXOA F,FR.MOR ;THERE ARE MORE COLUMNS
COLNOM: TXZ F,FR.MOR ;NO MORE COLUMNS COMING
SKIPGE T1,CURCOL ;GET CURRENT COLUMN TO SHOW
JRST CHKMOR ;ISN'T ONE, GO LOOK SOME MORE
MOVE T1,COLDSP(T1) ;GET ADDRESS OF DATA BLOCK
CALL @CL.DSP(T1) ;PRINT DATA FOR THIS COLUMN
TAB ;APPEND A TAB AFTER THE COLUMN
CHKMOR: TXNN F,FR.MOR ;ANY MORE COLUMNS COMING?
JRST DOCRLF ;NO, END LINE WITH A CRLF
JRST DOCOLL ;YES, GO DO NEXT COLUMN
SUBTTL SUBROUTINES TO CONTROL SCREEN HANDLING
;CALLED AFTER A SCREEN HAS BEEN OUTPUT, TO SEE IF THE NEXT SCREEN
;SHOULD BE SCROLLED OR NOT, AND TO DO IT IF NECESSARY. CALL AT
;PAGSET TO JUST SET UP THE NEXT SCROLLING TIME.
PAGCHK: MOVE T1,NTIME ;GET CURRENT TIME
CAMGE T1,PAGTIM ;TIME TO SCROLL?
RET ;NO
TLNE R,-1 ;IN HELP DISPLAY?
JRST PAGSET ;YES, DELAY SCROLLING
PAGDO: TXZN F,FR.END ;DID PREVIOUS SCREEN END THE DISPLAY?
AOSA PAGE ;NO, MOVE TO NEXT PAGE
SETZM PAGE ;YES, RESET TO FIRST PAGE
PAGSET: MOVE T1,PAGINT ;GET INTERVAL BETWEEN SCROLLS
MUL T1,[1,,0] ;CONVERT FROM SECONDS
DIVI T1,^D<60*60*24> ;TO UNIVERSAL TIME
ADD T1,NTIME ;COMPUTE TIME FROM NOW
SKIPN PAGINT ;ANY INTERVAL AT ALL?
MOVX T1,.INFIN ;NOPE, SET SO WILL NEVER SCROLL
MOVEM T1,PAGTIM ;REMEMBER TIME OF NEXT SCROLLING
RET ;DONE
;SUBROUTINE TO SET UP THE WINDOW FOR THE MAIN OUTPUT DISPLAY. IF
;NO INFORMATION LINE IS TYPED, THE WINDOW IS THE WHOLE DISPLAY.
;IF A LINE IS TO BE TYPED, THE DISPLAY IS TWO LINES LESS.
WINSET: TLNN R,-1 ;SHOWING HELP DISPLAY?
TXNE F,FR.INF ;OR WANTS INFORMATION LINE?
JRST WINSEY ;YES, DO GO SPECIAL WINDOW
SIZ$ ;NO, RESET BACK TO WHOLE SCREEN
RET ;DONE
WINSEY: MOVE T1,@DPYTAB+$DPLEN ;GET TERMINAL LENGTH
SUBI T1,2 ;WANT ALL LINES EXCEPT LAST TWO
MOVEI T2,-1 ;WANT ALL COLUMNS
SIZ$ T1 ;SET WINDOW
RET ;DONE
SUBTTL SUBROUTINE TO RETURN SLEEP TIME
;CALLED TO COMPUTE THE SLEEP INTERVAL, TAKING INTO ACCOUNT THE
;SLOWING DOWN OF THE INTERVAL DUE TO INACTIVITY. RETURNS SLEEP
;TIME IN MILLISECONDS IN T1.
GETSLP:
IFE DECSW,<
TXNE F,FR.NOS ;ALLOWED TO SLOW DOWN DISPLAY?
JRST NRMSLP ;NOPE, THEN USE SPECIFIED SLEEP TIME
>
MOVE T1,NTIME ;GET CURRENT TIME
SUB T1,SLWTIM ;FIND INTERVAL SINCE LAST COMMAND
MUL T1,[^D<60*60*24*1000>] ;CONVERT FROM UNIVERSAL TIME
ASHC T1,^D17 ;INTO MILLISECONDS
SUBI T1,SLWGRC ;SUBTRACT GRACE TIME
JUMPLE T1,NRMSLP ;IF NOT YET TIME TO SLOW, USE SPECIFIED SLEEP
IDIVI T1,SLWFAC ;CONVERT FROM ELAPSED TIME TO SLOWING TIME
CAILE T1,MAXSLP ;LARGER THAN MAXIMUM SLOWING?
MOVEI T1,MAXSLP ;YES, REDUCE TO MAXIMUM
CAMGE T1,SLPTIM ;LARGER THAN HIS SPECIFIED TIME?
NRMSLP: MOVE T1,SLPTIM ;NO, USE SPECIFIED TIME
RET ;DONE
SUBTTL SUBROUTINE TO SET UP INITIAL COLUMNS
;HERE TO BUILD THE LIST OF DEFAULT COLUMNS FOR OUTPUT. THE
;ORDER OF COLUMNS DEPENDS ON THE VALUE DEFINED FOR THAT COLUMN
;IN THE COLS MACRO. LOWER NUMBERED COLUMNS WILL APPEAR BEFORE
;HIGHER NUMBERED COLUMNS. COLUMNS WITH A ZERO NUMBER WILL NOT
;BE INSERTED AT ALL.
COLINI: SETOM HDRTYP ;HEADER IS UNKNOWN AFTER THIS
MOVEI T1,DISNUM ;GET READY FOR LOOP
HRRZ T2,DISTAB(T1) ;GET DEFAULT SEPARATION BETWEEN COLUMNS
MOVEM T2,COLSEP(T1) ;INITIALIZE VALUE FOR THIS DISPLAY
SOJG T1,.-2 ;LOOP OVER ALL DISPLAYS
SETZM COLDSP ;CLEAR OUR CURRENT COLUMNS
SETZM ORDVAL ;INITIALIZE LOOP
COLINL: AOS T1,ORDVAL ;MOVE TO NEXT VALUE
MOVEM T1,ORDMIN ;SET AS THE MINIMUM ALLOWABLE VALUE
HRLOI T1,377777 ;GET INFINITY
MOVEM T1,ORDVAL ;SET AS INITIAL VALUE
SETZM ORDHAV ;CLEAR COLUMN WHICH IS PICKED
MOVEI T1,COLNUM+2 ;GET HIGHEST COLUMN+1
MOVEM T1,ORDIDX ;INITIALIZE INDEX
COLINS: SOSG T1,ORDIDX ;GET NEXT POSSIBLE COLUMN
JRST COLINH ;NO MORE, GO PROCESS SELECTED COLUMN
HRRZ T1,COLTAB(T1) ;GET ADDRESS OF THIS COLUMN
MOVE T2,CL.VAL(T1) ;THEN GET THE VALUE FOR THIS COLUMN
CAML T2,ORDMIN ;AT LEAST AS LARGE AS OUR MINIMUM?
CAML T2,ORDVAL ;AND LESS THAN PREVIOUS SMALLEST?
JRST COLINS ;NO, KEEP LOOKING
MOVEM T2,ORDVAL ;YES, SAVE THIS VALUE
MOVEM T1,ORDHAV ;AND THE ADDRESS
JRST COLINS ;LOOK FOR A BETTER COLUMN
COLINH: SKIPN T1,ORDHAV ;SEE IF FOUND A COLUMN
RET ;NO, ALL COLUMNS ARE DONE
MOVEI T2,-1 ;INDICATE COLUMN GOES AT END
CALL COLADD ;ADD THIS COLUMN TO ONES BEING SHOWN
JRST COLINL ;LOOP AGAIN
SUBTTL SUBROUTINE TO INITIALIZE RUNTIME TABLES
;HERE AT START OF PROGRAM, TO SET THE INITIAL RUNTIME VARIABLES
;FOR ALL THE JOBS.
TBLINI: MOVEI I,CPUAVG-1 ;SET INITIAL VALUE
GTAD ;READ TIME OF DAY
MOVEM T1,OTIME ;SET OLD TIME OF DAY
MOVEM T1,NTIME ;AND NEW TIME OF DAY
MOVEI T2,CPUAVG-1 ;GET READY FOR LOOP
MOVEM T1,TIMES(T2) ;SAVE TIMES THAT TABLES WERE MADE
SOJGE T2,.-1 ;LOOP OVER ALL TABLES
MOVNM T1,TIMRUN ;SAVE NEGATIVE TIME IN TIME TABLE
MOVE T1,[TIMRUN,,TIMRUN+1] ;GET SET
BLT T1,TIMRUN+MAXJOB-1 ;STORE TIMES IN ALL WORDS
MOVE T1,[BITS,,BITS+1] ;GET READY
SETZM BITS ;CLEAR FIRST WORD OF BITS
BLT T1,BITS+<MAXJOB/^D36> ;AND THE REST ALSO
MOVE J,HGHJOB ;START WITH HIGHEST JOB
TBLINL: MOVSI T1,(J) ;GET READY
IORI T1,.JOBRT ;TO READ JOB'S RUN TIME
GETAB ;READ IT
ERJMP DIE ;FAILED
SKIPGE T1 ;JOB EXIST?
SETZ T1, ;NO, THEN SET RUNTIME TO ZERO
MOVEM T1,CURRUN(J) ;SAVE AS CURRENT RUNTIME
MOVEI T2,CPUAVG-1 ;GET READY
MOVEM T1,@OLDRUN(T2) ;SAVE IN OTHER TABLES ALSO
SOJGE T2,.-1 ;LOOP OVER THEM ALL
SOJGE J,TBLINL ;LOOP OVER ALL JOBS
RET ;RETURN
SUBTTL SUBROUTINE TO RECALCULATE PERCENTAGES OF CPU TIME
;HERE TO TAKE THE TABLES OF RUNTIM AND ORUNTM, AND TO COMPUTE THE
;PERCENTAGE OF ALL JOB'S CPU TIME, AND STORE THEM BACK INTO THE
;TABLE RUNDIF. CALLED OCCASSIONALLY.
CPUCMP: MOVE T1,NTIME ;GET CURRENT TIME
SUB T1,OTIME ;SEE HOW LONG SINCE LAST CALCULATION
CAIGE T1,<<CPUINT_^D18>/^D<24*60*60>> ;TIME TO GET NEW DATA?
RET ;NO, JUST RETURN
SOJGE I,CPUCMI ;DECREMENT TO NEXT TABLE
MOVEI I,CPUAVG-1 ;TIME TO RESET TO TOP
TXO F,FR.CPR ;SET THAT THE DATA IS READY
CPUCMI: MOVE J,HGHJOB ;GET HIGHEST POSSIBLE JOB
CPUCML: MOVE T1,CURRUN(J) ;GET LATEST RUNTIME OF JOB
SUB T1,@OLDRUN(I) ;SUBTRACT RUNTIME FROM BEFORE
SKIPGE T1 ;IS IT REASONABLE?
SETZ T1, ;NO, CLEAR IT
MOVEM T1,RUNDIF(J) ;SAVE FOR OUTPUT LATER
SOJGE J,CPUCML ;LOOP OVER ALL JOBS
HRRZ T1,OLDRUN(I) ;GET ADDRESS OF PROPER TABLE
HRLI T1,CURRUN ;AND ADDRESS OF CURRENT RUNTIMES
MOVE T2,T1 ;COPY ADDRESS
BLT T1,MAXJOB-1(T2) ;SET NEW RUNTIMES FOR TABLE
MOVE T1,NTIME ;GET CURRENT TIME AGAIN
MOVEM T1,OTIME ;SAVE AS OLD TIME
MOVE T2,TIMES(I) ;GET TIME THAT CURRENT DATA WAS MADE
MOVEM T1,TIMES(I) ;SET CURRENT TIME FOR NEW DATA
SUB T1,T2 ;GET DIFFERENCE IN TIMES
MUL T1,[^D<1000*60*60*24>] ;CONVERT TO MILLISECONDS
ASHC T1,^D17 ;FROM UNIVERSAL FORMAT
MOVEM T1,TIMDIF ;SAVE DIFFERENCE
RET ;RETURN
SUBTTL ROUTINE TO UPDATE IDLE TIMES FOR ALL JOBS
;ROUTINE TO UPDATE THE IDLE TIMES FOR ALL JOBS.
;CALL AT UPDORM IF UPDATING A SINGLE JOB.
CHKDRM: MOVE J,HGHJOB ;GET HIGHEST JOB
CHKDRL: MOVSI T1,(J) ;GET INDEX READY
IORI T1,.JOBRT ;AND RUNTIME TABLE
GETAB ;READ VALUE
ERJMP DIE ;FAILED
CALL UPDORM ;UPDATE DORMANCY FOR JOB
MOVEM T1,IDLE(J) ;SAVE THE RESULT
SOJGE J,CHKDRL ;LOOP OVER ALL JOBS
RET ;DONE
;HERE TO CHECK THE IDLE TIME OF A SINGLE JOB:
UPDORM: JUMPL T1,NOTJOB ;IF NOT A JOB, CLEAR STUFF
CAMN T1,CURRUN(J) ;SAME RUNTIME AS LAST TIME?
JRST GETIDL ;YES, SKIP ONWARD
MOVEM T1,CURRUN(J) ;NO, SAVE NEW RUNTIME
MOVE T1,NTIME ;GET CURRENT TIME
MOVEM T1,TIMRUN(J) ;AND SAVE AS TIME RUNTIME CHANGED
SETZ T1, ;IDLE TIME IS NOW ZERO
RET ;RETURN
GETIDL: MOVE T1,NTIME ;GET CURRENT TIME
MOVM T2,TIMRUN(J) ;AND ABSOLUTE VALUE OF TIME JOB LAST RAN
SUB T1,T2 ;GET THE DIFFERENCE
SKIPGE T1 ;SEE IF NEGATIVE
SETZ T1, ;YES??? THEN SET TO ZERO
MULI T1,^D<60*24> ;CONVERT UNIVERSAL TIME TO MINUTES
ASHC T1,^D17 ;BY MULTIPLYING BY CORRECT CONSTANT
RET ;AND RETURN
;HERE WHEN THE JOB IS NONEXISTANT, TO CLEAR THE TABLES FOR IT.
NOTJOB: SETZM CURRUN(J) ;CLEAR CURRENT RUNTIME
MOVEI T1,CPUAVG-1 ;GET SET FOR LOOP
SETZM @OLDRUN(T1) ;CLEAR ALL RUNTIME TABLES
SOJGE T1,.-1 ;KEEP LOOPING UNTIL DONE
MOVE T1,NTIME ;GET CURRENT TIME
MOVEM T1,TIMRUN(J) ;AND SET IN TIME TABLE
SETZ T1, ;GET A ZERO
MOVE T2,J ;GET COPY OF JOB
ADJBP T2,[POINT 1,BITS,0] ;GET BYTE POINTER TO RIGHT BIT
DPB T1,T2 ;LET JOB BE SEEN LATER
RET ;THEN RETURN
SUBTTL ROUTINE TO RETURN STATE OF A JOB
;CALLED WITH JOB NUMBER IN J, AND TERMINAL NUMBER IN T1, TO RETURN
;THE STATE OF A JOB AS AN ASCII STRING IN T1.
STATE: JUMPL T1,STATRN ;IF NOT ON A TERMINAL, ASSUME RUNNING
MOVSI T1,(T1) ;TERMINAL NUMBER IS INDEX
IORI T1,.TTYJO ;TABLE OF TERMINALS
GETAB ;READ DATA
ERJMP DIE ;FAILED
ANDI T1,-1 ;KEEP ONLY THE RIGHT HALF
CAIN T1,-1 ;IS ANY FORK IN JOB WAITING FOR TTY?
STATRN: SKIPA T1,[ASCIZ/ RUN/] ;NO, THEN STATE IS RUNNING
MOVE T1,[ASCIZ/ TI/] ;YES, THEN STATE IS TI
RET ;RETURN
SUBTTL ROUTINE TO TYPE STATUS OF A FORK
;CALLED WITH THE FORK STATUS WORD IN T1, TO TYPE OUT THE PROPER
;STATUS OF THE FORK.
FRKSTS: HLRZ T2,T1 ;GET CODE
ANDI T2,(RF%STS) ;KEEP ONLY THE CODE
CAILE T2,STSMAX ;LEGAL CODE?
IORI T2,-1 ;NO, SET TO UNKNOWN
TXNE T1,RF%FRZ ;WAS PROCESS FROZEN?
SKIPL STSTAB(T2) ;AND IN A STATE WHERE IT MAKES SENSE?
SKIPA ;NO
MOVEI T2,-2 ;YES, SAY WAS FROZEN
STR$ @STSTAB(T2) ;OUTPUT THE STATUS NOW
RET ;AND RETURN
STS 1,frozen
STS 1,unknown
STSTAB: STS 1,running
STS 1,IO wait
STS 0,halt
STS 0,error halt
STS 1,fork wait
STS 1,sleep
STS 0,JSYS trap
STS 0,addr break
STSMAX==.-STSTAB-1 ;HIGHEST KNOWN CODE
SUBTTL SUBROUTINE TO TYPE OUT THE RSCAN BUFFER
;CALLED TO TYPE THE RSCAN BUFFER FOR A JOB. THIS IS USUALLY THE
;LAST COMMAND PROCESSED WHICH RAN A PROGRAM.
TYPRSC: TXNN F,FR.JSY ;CAN WE DO THE MONRD% JSYS?
RET ;NO, TYPE NOTHING
STR$ [ASCIZ/RSCAN buffer: /] ;START THE OUTPUT
MOVE T1,['RSCNBP'] ;GET THE SYMBOL
CALL GETJS0 ;READ THE POINTER
JRST DOCRLF ;FAILED, JUST TYPE A CRLF
JUMPE T1,RSCNON ;NULL POINTER, SAY SO
MOVEI T2,^D20 ;ALLOW A LONG STRING
CALL TYPPTM ;TYPE IT OUT
JFCL ;DON'T CARE IT IT FAILS
JRST DOCRLF ;THEN FINISH WITH A CRLF
RSCNON: STR$ [ASCIZ/(none)
/] ;SAY THERE IS NONE
RET ;RETURN
SUBTTL SUBROUTINE TO TYPE OUT ASCIZ STRING FROM A JSB
;CALLED WITH AN ADDRESS INTO A JSB IN AC T1, TO READ AND OUTPUT THE
;ASCIZ STRING THAT THE POINTER IS POINTING TO. USED FOR OUTPUT OF
;FILE NAMES. SKIP RETURN IF SUCCESSFUL. CALL AT TYPPTM WITH LENGTH
;IN T2 IF STRING CAN BE LONGER THAN A NORMAL FILE SPEC.
TYPPTR: MOVEI T2,^D8 ;SET UP NORMAL SIZE LIMIT
TYPPTM: ANDI T1,-1 ;KEEP ONLY RIGHT HALF
JUMPE T1,CPOPJ1 ;IF NO POINTER, GOOD RETURN
SUB T1,JSVAR ;REMOVE JSB OFFSET
MOVEM T1,TXTPTR ;SAVE THE OFFSET
SETZM TXTCTR ;CLEAR COUNTER ALSO
SETZM TEMP(T2) ;CLEAR THE WORD AFTER THE MAXIMUM
MOVEM T2,TXTMAX ;SAVE THE MAXIMUM OFFSET
TYPPTL: MOVE T1,['JSVAR '] ;BASE ADDRESS OF WORD
AOS T2,TXTPTR ;INCREMENT TO NEXT WORD
CALL GETJSB ;READ THE WORD
RET ;FAILED
AOS T2,TXTCTR ;INCREMENT WORD COUNTER TOO
MOVEM T1,TEMP-1(T2) ;SAVE THIS WORD
CAML T2,TXTMAX ;MORE WORDS TO BE READ MAYBE?
JRST TYPPTT ;NO, GO TYPE RESULT
TXNE T1,177B34 ;SEE IF THIS WORD ENDS IN A NULL
TXNN T1,177B27 ;SOMPLACE IN THE WORD
JRST TYPPTT ;YES, TYPE RESULT
TXNE T1,177B20 ;KEEP LOOKING FOR A NULL
TXNN T1,177B13 ;WELL?
JRST TYPPTT ;FOUND IT, ALL DONE
TXNE T1,177B6 ;LAST CHECK
JRST TYPPTL ;WORD IS FULL, GET NEXT ONE
;NOW SEARCH THE STRING AND REPLACE ALL BAD CHARACTERS WITH NICE
;ONES SO THAT THE OUTPUT ISN'T MESSED UP BY STRANGE FILENAMES.
TYPPTT: MOVE T1,[POINT 7,TEMP] ;GET A BYTE POINTER
TYPPFL: ILDB T2,T1 ;GET NEXT CHARACTER
JUMPE T2,TYPPFO ;DONE WHEN HAVE A NULL
CAIL T2," " ;IS IT A CONTROL CHARACTER?
JRST TYPPFL ;NO, LEAVE IT ALONE
CAIE T2,15 ;CARRIAGE RETURN?
CAIN T2,12 ;OR LINE FEED?
SKIPA T2,[" "] ;YES, TURN THEM INTO HARMLESS SPACES
MOVEI T2,"?" ;OTHER CONTROL CHARS BECOME THIS
DPB T2,T1 ;STORE THE NEW CHARACTER
JRST TYPPFL ;LOOP UNTIL DONE
TYPPFO: STR$ TEMP ;OUTPUT THE STRING WE COLLECTED
RETSKP ;GOOD RETURN
SUBTTL ROUTINE TO OUTPUT AN ERROR STRING
;CALLED WITH AN ERROR CODE IN T1, TO CONVERT IT TO A STRING AND
;OUTPUT IT TO THE SCREEN. TO BE FAST, WE KEEP A TABLE OF THE MOST
;RECENT ERRORS WE KNOW ABOUT.
ERROUT: CAIN T1,LSTRX1 ;NO ERRORS ENCOUNTERED YET?
RET ;YES, TYPE NOTHING
TXNE F,FR.MOR ;ANY MORE COLUMNS?
JRST ERRJUS ;YES, JUST TYPE THE STRING
MOVEM T1,TEMP ;SAVE THE ERROR CODE
MOVEI T2,OCTSP6 ;ASSUME WANT OCTAL OUTPUT AT FIRST
CAIL T1,.ERBAS ;IN RANGE OF OUR TABLE?
CAILE T1,.ERBAS+MAXERR ;WELL?
JRST ERROCT ;NO, WE GUESSED RIGHT
SKIPN T1,ERRS-.ERBAS(T1) ;IS THERE A MNEMONIC THERE?
SKIPA T1,TEMP ;NO, RESTORE NUMBER
MOVEI T2,SIXRHT ;YES, GET ROUTINE FOR SIXBIT OUTPUT
ERROCT: CALL (T2) ;OUTPUT EITHER SIXBIT OR OCTAL
STR$ [ASCIZ/ - /] ;SPACE OVER SOME
MOVE T1,TEMP ;RESTORE CODE
ERRJUS: HRLZ T4,ERRCNT ;GET NUMBER OF ERRORS ALREADY STORED
JUMPE T4,NEWERR ;IF NONE, HAVE A NEW ERROR
MOVN T4,T4 ;TURN INTO AOBJN POINTER
MOVX T2,.INFIN ;INITIALIZE AGE FOR LOOP
ERRSRC: CAMN T1,ERRCOD(T4) ;IS THIS THE ERROR CODE WE WANT?
JRST HAVERR ;YES, JUST GO TYPE IT
CAMGE T2,ERRAGE(T4) ;IS THIS ERROR OLDER THAN PREVIOUS ONES?
JRST ERRSRN ;NO, GO TRY NEXT ERROR
MOVE T2,ERRAGE(T4) ;YES, GET ITS AGE
HRRZ T3,T4 ;AND REMEMBER WHICH ERROR THIS WAS
ERRSRN: AOBJN T4,ERRSRC ;LOOK AT ALL KNOWN ERRORS
CAIL T4,ERRNUM ;IS THE TABLE FULL?
SKIPA T4,T3 ;YES, THEN USE THE OLDEST SLOT
NEWERR: AOS ERRCNT ;INCREMENT NUMBER OF STORED ERRORS
MOVEM T1,ERRCOD(T4) ;REMEMBER THIS ERROR CODE FOR LATER
HRRZ T1,T4 ;GET READY
IMULI T1,ERRSIZ ;MAKE OFFSET INTO ERROR STRINGS
ADD T1,[POINT 7,ERRTAB] ;MAKE BYTE POINTER TO STORAGE
MOVE T2,ERRCOD(T4) ;GET ERROR CODE
HRLI T2,.FHSLF ;AND A VALID PROCESS HANDLE
MOVEI T3,ERRSIZ*5-1 ;SET UP MAXIMUM SIZE OF STRING
ERSTR ;CONVERT CODE TO STRING
JFCL ;FAILED
SKIPA T1,T4 ;FAILED, GET WHICH ENTRY WE FAILED ON
JRST HAVERR ;SUCCESSFUL, GO ON
IMULI T1,ERRSIZ ;MAKE OFFSET
SETZM ERRTAB(T1) ;ZERO THE STRING SINCE DON'T KNOW ERROR
;HERE WHEN WE HAVE FOUND THE ERROR CODE, TO TYPE THE STORED STRING:
HAVERR: AOS T1,ERRTOT ;INCREMENT AGE COUNTER
MOVEM T1,ERRAGE(T4) ;AND SET THIS ERROR AS BEING NEWEST
MOVE T1,T4 ;GET WHICH ENTRY THIS IS
IMULI T1,ERRSIZ ;MAKE OFFSET INTO THE BUFFER
SKIPN ERRTAB(T1) ;IS THIS AN UNKNOWN ERROR?
JRST UNKERR ;YES, GO SAY SO
PUSH P,ERRTAB+5(T1) ;SAVE A WORD OF THE STRING
TXNE F,FR.MOR ;ARE THERE MORE COLUMNS AFTER THIS ONE?
SETZM ERRTAB+5(T1) ;YES, RESTRICT SIZE OF MESSAGE
STR$ ERRTAB(T1) ;OUTPUT THE ERROR TEXT
POP P,ERRTAB+5(T1) ;RESTORE THE WORD OF THE TEXT
RET ;DONE
UNKERR: STR$ [ASCIZ/Unknown error /] ;SAY WE DON'T KNOW WHAT IT IS
TXNN F,FR.MOR ;MORE COLUMNS?
RET ;NO, THEN WE ALREADY GAVE THE NUMBER
MOVE T1,ERRCOD(T4) ;GET THE NUMBER
JRST OCTOUT ;OUTPUT IT
SUBTTL SUBROUTINE TO TYPE OUT A JSYS VALUE
;CALLED WITH AN MUUO IN AC T1, TO OUTPUT IT NICELY. IF IT IS A KNOWN
;JSYS, THE NAME WILL BE OUTPUT, OTHERWISE JUST JSYS NNN. IF IT
;IS A UUO, THE OPCODE WILL BE TYPED.
UUOOUT: HLRZ T2,T1 ;GET OPCODE AND STUFF
JUMPE T2,CPOPJ ;DONE IF NO INSTRUCTION
CAIE T2,(JSYS) ;IS THIS A JSYS?
JRST TYPUUO ;NO, TYPE OUT A UUO
CAMN T1,[MONRD%] ;IS IT OUR JSYS?
JRST OURJSY ;YES, TYPE SPECIAL
HRRZ T2,T1 ;GET THE JSYS NUMBER
CAIG T2,JSYSMX ;IS THIS A KNOWN JSYS?
SKIPN T1,JSTABL(T2) ;AND DOES IT HAVE A NAME?
SKIPA T1,T2 ;NO, HAVE TO OUTPUT AS JSYS NNN
JRST SIXOUT ;YES, GO OUTPUT IT
STR$ [ASCIZ/JSYS /] ;BEGIN OUTPUT
PJRST OCTOUT ;OUTPUT NUMBER
OURJSY: STR$ [ASCIZ/MONRD/] ;OUTPUT SPECIAL NAME
RET ;DONE
;HERE TO TYPE OUT A UUO. THIS IS NECESSARY FOR THOSE PROGRAMS WHICH
;RUN UNDER THE COMPATABILITY PACKAGE.
TYPUUO: LDB T2,[POINT 9,T1,8] ;GET OPCODE
CAIN T2,047 ;IS THIS A CALLI?
JRST TYPCAL ;YES, HANDLE SPECIAL
CAIN T2,051 ;IS THIS A TTCALL?
JRST TYPTTC ;YES, HANDLE SPECIAL
CAILE T2,100 ;A NORMAL UUO?
JRST TYPOPC ;NO, TYPE OUT THE OPCODE
MOVE T1,UUOTAB-40(T2) ;YES, GET NAME
PJRST SIXOUT ;OUTPUT AND RETURN
TYPCAL: STR$ [ASCIZ/CALLI /] ;TYPE START OF TEXT
TRNE T1,400000 ;IS THIS A NEGATIVE CALLI?
TDOA T1,[-1,,200000] ;YES, EXTEND IT AND CLEAR PHYSICAL BIT
TDZA T1,[-1,,200000] ;NO, CLEAR LEFT HALF AND PHYSICAL BIT
CHI$ "-" ;IF NEGATIVE CALLI, TYPE MINUS SIGN
MOVM T1,T1 ;GET POSITIVE NUMBER
PJRST OCTOUT ;THEN OUTPUT THE NUMBER
TYPTTC: LDB T2,[POINT 4,T1,12] ;GET TTCALL TYPE
MOVE T1,TTCTAB(T2) ;GET NAME
PJRST SIXOUT ;OUTPUT IT
TYPOPC: STR$ [ASCIZ/OPCODE /] ;TYPE OPCODE TEXT
MOVE T1,T2 ;GET OPCODE
PJRST OCTOUT ;OUTPUT IT
SUBTTL SIMPLE DATA OUTPUT ROUTINES
;HERE WITH A TERMINAL NUMBER IN AC T1, TO OUTPUT THE PROPER THING,
;ONE OF NUMBER, OR "DET", OR NUMBER FOLLOWED BY CONTROLLING JOB.
;ASSUMES JOB INFORMATION IS READ INTO AREA AT BLK.
TTYOUT: JUMPL T1,TTYDET ;JUMP IF HE IS DETACHED
MOVEI T2," " ;GET A SPACE
CAMN T1,CTYNUM ;IS THIS THE CTY?
MOVEI T2,"*" ;YES, GET AN ASTERISK INSTEAD
CHI$ (T2) ;OUTPUT SPACE OR STAR
CALL OCTOUT ;OUTPUT NUMBER
SKIPGE T1,BLK+.JICPJ ;CONTROLLED ON A PTY?
RET ;NO, ALL DONE
CHI$ "J" ;YES, OUTPUT LETTER TO INDICATE IT
JRST DECOUT ;THEN PRINT THE JOB NUMBER
TTYDET: STR$ [ASCIZ/ Det/] ;GET DETACHED STRING
RET ;AND RETURN
;HERE WITH A USER NUMBER IN T1, TO OUTPUT THE USER NAME. IF ZERO,
;THE USER IS NOT LOGGED IN. AC T2 HAS THE NUMBER OF WORDS TO
;RESTRICT THE OUTPUT TO IF MORE COLUMNS FOLLOW.
USROUT: MOVE T3,T2 ;SAVE CUTOFF AMOUNT
SKIPN T2,T1 ;MOVE NUMBER INTO RIGHT AC
JRST USRNLI ;SKIP ON IF NOT LOGGED IN
CAMN T1,OPRUSR ;IS THIS THE OPERATOR'S NUMBER?
JRST USRIOP ;YES, SKIP THE JSYS THEN
HRROI T1,TEMP ;POINT TO TEMPORARY STORAGE
DIRST ;CONVERT NUMBER TO STRING
RET ;IF ERROR, RETURN NOW
JUMPLE T3,USRFUL ;OUTPUT WHOLE THING IF GIVEN ZERO
CAIL T3,TMPSIZ ;MAKE SURE NOT GIVEN JUNK
JRST USRFUL ;YES, ALLOW ALL OUTPUT THEN
TXNE F,FR.MOR ;MORE COLUMNS TO COME?
SETZM TEMP(T3) ;YES, RESTRICT LENGTH OF OUTPUT
USRFUL: STR$ TEMP ;OUTPUT THE STRING
RET ;AND RETURN
USRNLI: STR$ [ASCIZ/Not logged in/] ;OUTPUT THIS STRING
RET ;THEN RETURN
USRIOP: STR$ [ASCIZ/OPERATOR/] ;GIVE OPERATOR
RET ;AND RETURN
;HERE TO OUTPUT A PERCENTAGE IN THE FORM NN.MM, WHERE T1 HAS NN,
; AND T2 HAS MM
CENOUT: MOVE T4,T2 ;SAVE FRACTIONAL PART
SKIPN T1 ;IS THERE A NUMBER THERE?
STR$ [ASCIZ/ /] ;NO, THEN TYPE SPACES
SKIPE T1 ;WELL?
CALL DECSP2 ;YES, OUTPUT IN A FIELD OF 3
CHI$ "." ;THEN OUTPUT A DOT
MOVE T1,T4 ;GET BACK FRACTIONAL PART
IDIVI T1,^D10 ;SPLIT INTO SEPARATE DIGITS
CHI$ "0"(T1) ;OUTPUT FIRST ONE
CHI$ "0"(T2) ;AND SECOND ONE
RET ;DONE
;HERE TO OUTPUT A HEADER LINE IF NECESSARY. THE TEXT HAD PREVIOUSLY BEEN
;STORED IN HDRTXT. THE HEADER HAS BEEN SET UP BY A PREVIOUS CALL TO
;THE HDRSET ROUTINE.
HEADER: TXON F,FR.HDR ;HAVE WE TYPED THE HEADER YET?
STR$ HDRTXT ;NO, DO SO NOW
TXO F,FR.NDC ;CRLF WILL BE NEEDED IN NEXT DISPLAY
RET ;DONE
SUBTTL SIMPLE OUTPUT SUBROUTINES
;THE FOLLOWING ROUTINES TAKE THEIR ARGUMENTS IN AC T1. THEY GIVE
;ALL THEIR OUTPUT TO THE DPY ROUTINES. THESE ROUTINES DO NOT USE
;JSYSES SO THAT THE PROGRAM CAN RUN AS FAST AS POSSIBLE.
TMHSPC: CAIGE T1,^D60 ;AY LEAST ONE HOUR?
STR$ [ASCIZ/ /] ;NO, SPACE OVER
TMHSPS: CAIGE T1,^D60 ;ONLY MINUTES TO OUTPUT?
JRST DECSP2 ;YES, GO DO IT
MOVEI T4,TIMTST ;GET READY
JRST TMHOUT ;JOIN OTHER CODE
TIMSPC: CAIGE T1,^D<60*60> ;AT LEAST ONE HOUR?
STR$ [ASCIZ/ /] ;NO, SPACE OVER
CAIGE T1,^D60 ;AT LEAST ONE MINUTE?
STR$ [ASCIZ/ /] ;NO, SPACE OVER MORE
;THEN FALL INTO TIME OUTPUT
TIMOUT: CAIGE T1,^D60 ;LESS THAN ONE MINUTE?
JRST DECSP2 ;YES, OUTPUT SIMPLY
MOVEI T4,TIMTST ;GET OUTPUT ROUTINE READY
IDIVI T1,^D<60*60> ;GET HOURS INTO T1 AND MINUTES IN T2
HRLI T4,(T2) ;SAVE MINUTES
CALL (T4) ;OUTPUT HOURS
HLRZ T1,T4 ;GET BACK MINUTES
TMHOUT: IDIVI T1,^D60 ;GET MINUTES IN T1 AND SECONDS IN T2
HRLI T4,(T2) ;SAVE SECONDS
CALL (T4) ;OUTPUT MINUTES
HLRZ T1,T4 ;GET BACK SECONDS
;AND FALL INTO OUTPUT ROUTINE
TIMYES: CHI$ ":" ;FIRST OUTPUT A COLON
IDIVI T1,^D10 ;SPLIT INTO TWO DIGITS
CHI$ "0"(T1) ;OUTPUT FIRST ONE
CHI$ "0"(T2) ;THEN SECOND ONE
RET ;AND RETURN
TIMTST: JUMPE T1,CPOPJ ;IF NOTHING THERE, RETURN
HRRI T4,TIMYES ;SOMETHING, SET UP OTHER ROUTINE
JRST DECSP2 ;AND GO INTO TWO DIGIT OUTPUT
DECSP6: CAIGE T1,^D100000 ;IS THIS A FIVE OR LESS DIGIT NUMBER?
SPACE ;YES, SPACE OVER
DECSP5: CAIGE T1,^D10000 ;IS THIS A FOUR OR LESS DIGIT NUMBER?
SPACE ;YES, SPACE OVER
DECSP4: CAIGE T1,^D1000 ;IS THIS A THREE OR LESS DIGIT NUMBER?
SPACE ;YES, TYPE A SPACE
DECSP3: CAIGE T1,^D100 ;IS THIS A TWO OR LESS DIGIT NUMBER?
SPACE ;YES, TYPE A SPACE
DECSP2: CAIGE T1,^D10 ;IS THIS ONE DIGIT NUMBER?
SPACE ;YES
JRST DECOUT ;JOIN DECOUT ROUTINE
OCTSP6: CAIGE T1,100000 ;FIVE OR LESS DIGITS?
SPACE ;YES, TYPE SPACE
OCTSP5: CAIGE T1,10000 ;FOUR OR LESS DIGITS?
SPACE ;YES, DO A SPACE
OCTSP4: CAIGE T1,1000 ;IS THIS A THREE OR LESS DIGIT NUMBER?
SPACE ;YES, TYPE A SPACE
OCTSP3: CAIGE T1,100 ;IS THIS TWO OR LESS DIGITS?
SPACE ;YES
OCTSP2: CAIGE T1,10 ;ONE DIGIT NUMBER?
SPACE ;YES
JRST OCTOUT ;JOIN OCTAL OUTPUT CODE
FIXOUT: IDIVI T1,^D10 ;SPLIT OFF TENTHS
EXCH T2,T4 ;GET ROUTINE TO CALL AND SAVE DIGIT
CALL (T2) ;OUTPUT THE INTEGRAL PART
CHI$ "." ;PRINT A DOT
CHI$ "0"(T4) ;THEN PRINT THE FRACTIONAL PART
RET ;DONE
INFOUT: TLC T1,377777 ;INVERT
TLCE T1,377777 ;ALL BITS LIT
JRST DECOUT ;NO, TYPE THE NUMBER
STR$ [ASCIZ/+Inf/] ;YES, SAY SO
RET ;DONE
OCTTEL: CHI$ "#" ;SAY THIS IS AN OCTAL NUMBER
OCTOUT: SKIPA T3,[^D8] ;SET UP FOR OCTAL
DECOUT: MOVEI T3,^D10 ;SET UP FOR DECIMAL
JUMPGE T1,NUMOUT ;OUTPUT IF NONNEGATIVE
CHI$ "-" ;TYPE MINUS SIGN
MOVM T1,T1 ;MAKE POSITIVE
NUMOUT: IDIVI T1,(T3) ;GET A DIGIT
JUMPE T1,NUMFIN ;IF ZERO, FINISH UP
HRLM T2,(P) ;SAVE THIS DIGIT
CALL NUMOUT ;LOOP
HLRZ T2,(P) ;DONE, GET BACK DIGIT
NUMFIN: CHI$ "0"(T2) ;OUTPUT IT
CPOPJ: RET ;AND RETURN
OCTFUL: MOVEI T3,^D12 ;GET A COUNT
OCTFLL: SETZ T2, ;ZERO AC
ROTC T1,3 ;GET NEXT CHAR
CHI$ "0"(T2) ;OUTPUT IT
SOJG T3,OCTFLL ;LOOP UNTIL DONE
RET ;DONE
;SUBROUTINE TO OUTPUT A VALUE AS A SYMBOL PLUS OFFSET.
SYMOUT: CALL CVTSYM ;CONVERT TO SYMBOL AND OFFSETS
MOVEM T2,TEMP ;SAVE OFFSET FOR AWHILE
JUMPE T1,SYMOUN ;IF NO SYMBOL, JUST OUTPUT OCTAL
CALL R50OUT ;OUTPUT RADIX50 NAME
SKIPN TEMP ;ANY OFFSET?
RET ;NO, DONE
CHI$ "+" ;YES, TYPE PLUS SIGN
SYMOUN: MOVE T1,TEMP ;GET BACK OCTAL
PJRST OCTOUT ;OUTPUT IT AND RETURN
R50OTT: SKIPA T3,[PBOUT] ;SET UP INSTRUCTION
R50OUT: MOVE T3,[CHI$ (T1)] ;OR OTHER ONE
TLZ T1,740000 ;CLEAR JUNK IN HIGH ORDER BITS
R50OUL: IDIVI T1,50 ;GET A DIGIT
JUMPE T1,R50FIN ;IF ZERO, HAVE ALL DIGITS
HRLM T2,(P) ;MORE, SAVE THIS ONE
CALL R50OUL ;LOOP
HLRZ T2,(P) ;GET BACK A DIGIT
R50FIN: SETZ T1, ;START WITH A NULL
CAIL T2,1 ;IN RANGE OF A DIGIT?
CAILE T2,12 ;WELL?
SKIPA ;NO
MOVEI T1,"0"-1(T2) ;YES, GET ASCII CHAR
CAIL T2,13 ;IN RANGE OF A LETTER?
CAILE T2,44 ;WELL?
SKIPA ;NO
MOVEI T1,"A"-13(T2) ;YES, GET ASCII CHAR
CAIN T2,45 ;PERIOD?
MOVEI T1,"." ;YES
CAIN T2,46 ;DOLLAR SIGN?
MOVEI T1,"$" ;YES
CAIN T2,47 ;PERCENT SIGN?
MOVEI T1,"%" ;YES
XCT T3 ;OUTPUT THE CHAR
RET ;DONE
FLTOUT: MOVE T2,T1 ;MOVE TO RIGHT AC
HRROI T1,TEMP ;POINT TO STORAGE
MOVX T3,FL%ONE+FL%PNT+FL%OVL+2B23+2B29 ;GET BITS
FLOUT ;OUTPUT NUMBER
ERJMP CPOPJ ;FAILED
STR$ TEMP ;TYPE IT
RET ;DONE
VEROUT: MOVE T4,T1 ;SAVE ADDRESS OF VERSION
MOVE T1,.NDVER(T4) ;GET VERSION
CALL OCTOUT ;OUTPUT IT
CHI$ "." ;TYPE A DOT
MOVE T1,.NDECO(T4) ;GET ECO NUMBER
CALL OCTOUT ;OUTPUT IT TOO
CHI$ "." ;ANOTHER DOT
MOVE T1,.NDCST(T4) ;GET CUSTOMER LEVEL
JRST OCTOUT ;FINISH WITH IT
PCOUT: MOVE T4,T1 ;SAVE RIGHT HALF OF PC
HLRZ T1,T1 ;AND GET LEFT HALF
ANDI T1,7777 ;KEEP ONLY SECTION NUMBER
SKIPN T1 ;NONZERO SECTION?
STR$ [ASCIZ/ /] ;NO, SPACE OVER SOME
SKIPE T1 ;WELL?
CALL OCTSP4 ;YES, OUTPUT IT
MOVS T1,T4 ;GET RIGHT HALF PC READY
;FALL INTO OUTPUT CODE
OCTSIX: MOVEI T3,6 ;GET A COUNT
OCTSIL: SETZ T2, ;CLEAR NEXT AC
ROTC T1,3 ;SHIFT NEXT DIGIT IN
CHI$ "0"(T2) ;OUTPUT IT
SOJG T3,OCTSIL ;LOOP OVER ALL DIGITS
RET ;DONE
SIXRHT: TRNE T1,77 ;RIGHT JUSTIFIED YET?
JRST SIXOUT ;YES, OUTPUT IT
LSH T1,-6 ;NO, SHIFT OVER
JUMPN T1,SIXRHT ;LOOP UNTIL DONE
SIXOUT: SKIPA T4,[CHI$ (T1)] ;GET INSTRUCTION TO TYPE TO DPY
SIXOTT: MOVE T4,[PBOUT] ;OR INSTRUCTION TO TYPE TO TTY
MOVE T2,T1 ;MOVE WORD TO BETTER AC
SIXOUL: JUMPE T2,CPOPJ ;DONE IF GET A NULL
SETZ T3, ;CLEAR NEXT AC
ROTC T2,6 ;SHIFT IN NEXT CHARACTER
MOVEI T1," "(T3) ;CONVERT IT TO ASCII
XCT T4 ;OUTPUT IT
JRST SIXOUL ;LOOP UNTIL DONE
DOCRLF: CRLF ;TYPE THE CRLF
RET ;RETURN
SUBTTL ROUTINES TO NOECHO AND ECHO THE TERMINAL
;ROUTINES TO TURN OFF OR ON ECHOING FOR THE TERMINAL.
ECHOON: SKIPA T3,[TXO T2,TT%ECO] ;GET INSTRUCTION
ECHOOF: MOVE T3,[TXZ T2,TT%ECO] ;OR OTHER ONE
MOVEI T1,.PRIIN ;PRIMARY INPUT
RFMOD ;READ STATUS OF TERMINAL
XCT T3 ;TURN ON OR OFF ECHO BIT
SFMOD ;SET TERMINAL TO NEW STATUS
RET ;RETURN
SUBTTL SUBROUTINE TO DO RESCANNING OF COMMAND LINE
;CALLED AT START OF PROGRAM, TO RESCAN THE INPUT BUFFER AND SEE
;IF WE WERE PROPERLY STARTED. IF SO, THE REST OF THE BUFFER IS
;LEFT AS THE FIRST INPUT TO BE READ BY THE PROGRAM.
CMDINI: MOVEI T1,.RSINI ;GET FUNCTION
RSCAN ;MAKE THE RESCAN BUFFER AVAILABLE
ERJMP DIE ;FAILED
MOVEM T1,TEMP ;SAVE NUMBER OF CHARS AVAILABLE
MOVE T2,[POINT 6,MYNAME] ;GET A POINTER READY
MOVEI T3,6 ;WANT TO READ SIX CHARACTERS
NAMCHK: SOJL T3,CPOPJ ;IF FINISHED WITH NAME, ALL DONE
ILDB T4,T2 ;READ NEXT CHARACTER OF NAME
JUMPE T4,CPOPJ ;DONE IF NO MORE TO NAME
SOSGE TEMP ;DECREMENT COUNT OF CHARS LEFT
RET ;NO MORE, THEN NO COMMANDS TO RESCAN
PBIN ;READ NEXT CHARACTER
CAIL T1,"A"+40 ;LOWER CASE?
CAILE T1,"Z"+40 ;WELL?
SKIPA ;NO
SUBI T1,40 ;YES, MAKE UPPER CASE
CAIN T1," "(T4) ;MATCH HIS TYPEIN?
JRST NAMCHK ;YES, CONTINUE LOOKING
LINEAT: SOSGE TEMP ;BAD COMMAND, DECREMENT COUNT
RET ;ALL OF LINE DONE, RETURN
PBIN ;READ NEXT CHAR
JRST LINEAT ;LOOP UNTIL DONE
SUBTTL SUBROUTINES TO HANDLE EATING OF LINES
;THIS ROUTINE IS CALLED AFTER THE MAIN HEADER OF A DISPLAY IS TYPED
;OUT, TO TELL DPY HOW MANY LINES OF FOLLOWING OUTPUT ARE TO BE
;THROWN AWAY. THIS IS DONE TO IMPLEMENT SCROLLING OF THE SCREEN VERY
;EASILY. NUMBER OF SCREENFULLS TO EAT IS IN LOCATION PAGE.
SETEAT: LOC$ T1 ;READ CURRENT OUTPUT POSITION
JUMPL T1,CPOPJ ;IF ALREADY OVERFLOWED, IGNORE IT
HLRZ T1,T1 ;GET LINE NUMBER FOR NEXT OUTPUT
MOVE T2,@DPYTAB+$DPLEN ;GET SIZE OF TERMINAL
TLNN R,-1 ;IN A HELP DISPLAY, OR ARE WE
TXNE F,FR.INF ;SHOWING INFORMATION LINE?
SUBI T2,2 ;YES, TWO LESS LINES LEFT IN DISPLAY
SUB T2,T1 ;COMPUTE LINES REMAINING
AOS T1,T2 ;ADJUST FOR ONE OFF EFFECT
SUB T1,OVRLAP ;DIDDLE BY AMOUNT OF DESIRED OVERLAP
IMUL T1,PAGE ;MULTIPLY BY PAGE NUMBER
SKIPGE T1 ;NEGATIVE?
SETZ T1, ;YES, RAISE TO ZERO
TLNE T1,-1 ;OVERFLOWED?
MOVEI T1,-1 ;YES, MAKE LARGEST VALUE
HRLI T1,$SEEAT ;SET UP FUNCTION CODE
SET$ T1 ;TELL DPY HOW MUCH TO IGNORE
RET ;DONE
;ROUTINE TO SEE IF THE SCREEN IS FULL. USED TO TERMINATE LISTING OF
;DATA WHEN IT WOULD NEVER SHOW TO THE SCREEN. SKIP RETURN IF SCREEN
;IS NOT YET FULL. USES AC T1.
FULL: LOC$ T1 ;READ CURRENT POSITION
JUMPGE T1,CPOPJ1 ;SKIP RETURN IF STILL MORE LINES LEFT
RET ;ALL FULL, ERROR RETURN
;ROUTINE TO SEE HOW MUCH ROOM IS LEFT ON THE CURRENT LINE. USED TO
;DETERMINE WHEN A CRLF IS NEEDED BEFORE FURTHER OUTPUT. COLUMNS LEFT
;IS RETURNED IN AC T1.
LEFT: LOC$ T1 ;READ CURRENT POSITION
ANDI T1,-1 ;ONLY KEEP THE COLUMN NUMBER
SUB T1,@DPYTAB+$DPWID ;SUBTRACT FROM SIZE OF LINE
MOVN T1,T1 ;GET POSITIVE NUMBER
RET ;DONE
SUBTTL ROUTINE WHICH CHECKS A PROGRAM NAME AGAINST A WILDCARD
;ROUTINE TO CHECK A JOB'S PROGRAM NAME AGAINST ONES SPECIFIED BY THE
;USER TO DECIDE IF THIS USER SHOULD BE SHOWN. CALLED WITH THE USER'S
;SIXBIT PROGRAM NAME IN T1. SKIP RETURN IF JOB IS SELECTED.
PRGCMP: SKIPN T4,PRGNUM ;ANY PROGRAM NAMES STORED?
RETSKP ;NO, THEN SHOW EVERYTHING
IMULI T4,3 ;THERE ARE THREE WORDS FOR EACH NAME
CALL SIXASC ;CONVERT THE SIXBIT NAME TO ASCIZ
HRROI T3,TEMP ;SET UP POINTER TO TEST NAME
PRCMPL: SUBI T4,3 ;BACK DOWN BY A PROGRAM NAME
JUMPL T4,PRGNOM ;IF NEGATIVE, NO MORE TO CHECK
MOVS T1,PRGWLD(T4) ;GET FIRST WORD OF NAME
CAIN T1,(ASCII/*/) ;SEE IF IT IS THE TOTAL MATCH WILDCARD
JRST PRGMAT ;YES, AUTOMATIC MATCH THEN
MOVEI T1,.WLSTR ;GET FUNCTION FOR JSYS
HRROI T2,PRGWLD(T4) ;POINT AT WILD STRING
WILD% ;COMPARE THE STRINGS
ERJMP CPOPJ1 ;FAILED, SHOW THE JOB
TXNE T1,WL%NOM ;FOUND A MATCH?
JRST PRCMPL ;NO, KEEP CHECKING
PRGMAT: SKIPA T1,PRGWLD(T4) ;GET CURRENT ENTRY WITH FLAG
PRGNOM: SETCM T1,PRGWLD ;OR ORIGINAL ENTRY
TXNN T1,1 ;WANTED TO SEE THIS PROGRAM?
AOS (P) ;YES, SKIP RETURN
RET ;NOPE
SUBTTL ROUTINE WHICH CHECKS USER NAME AGAINST LIST
;ROUTINE TO CHECK A USER NAME AGAINST A LIST OF WILDCARD USER NAMES,
;AND DECIDE WHETHER OR NOT THIS USER IS DESIRED. CALLED WITH THE
;USER NUMBER IN T1. SKIP RETURN IF THIS USER IS SELECTED.
USRCMP: SKIPN USRLST ;IS ANY LIST SET UP?
RETSKP ;NO, THEN SHOW ALL JOBS
MOVEI T4,USRLST ;SET UP POINTER TO TEST STRINGS
SKIPN T2,T1 ;MOVE USER NAME TO RIGHT AC
JRST NLICHK ;IF NOT LOGGED IN, GO TO SPECIAL ROUTINE
HRROI T1,TEMP ;POINT TO TEMPORARY STORAGE
DIRST ;CONVERT NUMBER INTO USER NAME STRING
ERJMP CPOPJ1 ;FAILED, THEN SHOW THE JOB
HRROI T3,TEMP ;POINT TO NAME STRING
USRCML: HRRZ T4,(T4) ;FOLLOW LINK TO NEXT NAME STRING
JUMPE T4,USRNOM ;IF NO MORE, GO RETURN RESULT
MOVS T1,1(T4) ;GET FIRST WORD OF NAME STRING
JUMPE T1,USRCML ;IF NO STRING, GO TO NEXT ONE
CAIN T1,(ASCII/*/) ;SEE IF THIS IS THE TOTAL WILDCARD
JRST USRMAT ;YES, AUTOMATIC MATCH THEN
MOVEI T1,.WLSTR ;MUST DO JSYS, GET FUNCTION CODE
HRROI T2,1(T4) ;GET POINTER TO THIS WILDCARD STRING
WILD% ;SEE IF THEY MATCH
ERJMP DIE ;FAILED
TXNE T1,WL%NOM ;IS NAME MATCHED BY THIS STRING?
JRST USRCML ;NO, KEEP SEARCHING
USRMAT: SKIPA T1,(T4) ;GET FLAG FROM MATCHING STRING
USRNOM: SETCM T1,USERS ;OR GET COMPLIMENT OF FIRST STRING
JUMPGE T1,CPOPJ1 ;SHOW JOB IF FLAG NOT SET
RET ;AND DON'T IF SET
;HERE IF USER BEING CHECKED IS NOT LOGGED IN:
NLICHK: HRRZ T4,(T4) ;FOLLOW LINK TO NEXT NAME STRING
JUMPE T4,USRNOM ;IF NO MORE, RETURN RESULT
SKIPN 1(T4) ;IS THE TEST STRING NULL?
JRST USRMAT ;YES, THEN HAVE A MATCH
JRST NLICHK ;NO, KEEP SEARCHING
SUBTTL SUBROUTINE TO COPY TEXT INTO SEPARATE BUFFER
;ROUTINE TO COPY TEXT FROM THE COMMAND BUFFER TO THE TXTBUF BUFFER.
;BUFFER MUST BE AT LEAST TXTLEN WORDS IN LENGTH. ALL TEXT IS COPIED
;UNTIL THE FIRST SPACE, TAB, SLASH, COMMA, OR LINE FEED. CALL IS:
;
; CALL CPYTXT ;COPY STRING
; (ERROR RETURN) ;FAILED
; (GOOD RETURN) ;SUCCEEDED
;
;ON ERROR RETURN, T1 = 0 IF NO TEXT WAS GIVEN, OR NONZERO IF THE
;TEXT BUFFER WAS OVERFLOWED. ON GOOD RETURN, T1 CONTAINS THE
;FIRST WORD OF THE BUFFER, AND T2 CONTAINS FIRST FREE WORD.
;CALL AT CPYTX1 IF SIZE AND ADDRESS IS NOT THE NORMAL ONE.
CPYTXT: MOVEI T2,TXTLEN*5-1 ;SET UP SIZE OF AREA
MOVEI T1,TXTBUF ;POINT TO NORMAL TEXT BUFFER
CPYTX1: HRLI T1,(POINT 7,) ;MAKE A BYTE POINTER
HRRZ T3,T1 ;REMEMBER ADDRESS OF BUFFER
SETZM (T3) ;AND CLEAR FIRST WORD
CPYTXL: GETCHR ;READ NEXT CHARACTER
CAIN C,"V"-100 ;QUOTING CHARACTER?
JRST [ GETCHR ;YES, GET FOLLOWING CHARACTER
JRST CPYTXY] ;AND USE IT AS IS
CAIN C,12 ;END OF LINE?
JRST CPYTXD ;YES, DONE
CAIE C," " ;SPACE?
CAIN C," " ;OR TAB?
JRST CPYTXD ;YES, DONE
CAIE C,"/" ;SLASH?
CAIN C,"," ;OR COMMA?
JRST CPYTXD ;YES, DONE
CPYTXY: IDPB C,T1 ;STORE THIS CHAR
SOJGE T2,CPYTXL ;IF MORE ROOM, GET ANOTHER CHAR
RET ;OTHERWISE RETURN ERROR
CPYTXD: RESCAN ;REREAD TERMINATING CHARACTER
SETZ T2, ;GET A NULL
IDPB T2,T1 ;MAKE THE STRING ASCIZ
MOVEI T2,1(T1) ;REMEMBER FIRST FREE WORD
SKIPE T1,(T3) ;ANY TEXT STORED?
AOS (P) ;YES, GOOD RETURN
RET ;DONE
SUBTTL SUBROUTINE TO CONVERT SIXBIT WORD INTO ASCIZ
;CALLED WITH A SIXBIT QUANTITY IN AC1, TO STORE IN LOCATION TEMP AND
;TEMP+1 THE ASCIZ TEXT FOR THAT WORD. USES ALL TEMP AC'S.
;ON RETURN, AC T1 IS READY TO APPEND MORE CHARACTERS TO THE STRING.
SIXASC: SETZM TEMP ;CLEAR WORDS FIRST
SETZM TEMP+1 ;TO GUARANTEE A NULL EXISTS
MOVE T2,T1 ;MOVE WORD TO BETTER AC
MOVE T1,[POINT 7,TEMP] ;GET READY
SIXASL: JUMPE T2,CPOPJ ;DONE IF WORD IS ZERO
SETZ T3, ;CLEAR NEXT AC
ROTC T2,6 ;GET NEXT CHARACTER
ADDI T3," " ;CONVERT TO ASCII
IDPB T3,T1 ;STORE AWAY
JRST SIXASL ;LOOP UNTIL DONE
SUBTTL SUBROUTINE TO CONVERT OCTAL VALUE TO SYMBOLS
;CALLED WITH AN OCTAL VALUE IN AC T1, TO OBTAIN THE RADIX50 SYMBOL
;AND OFFSET FOR THE VALUE. THIS REQUIRES PRIVILEGES TO WORK.
;TO SAVE TIME, WE FIRST TRY TO FIND THE SYMBOL IN OUR OWN LOCAL
;SYMBOL TABLE. RETURNS SYMBOL IN T1 AND OFFSET IN T2.
CVTSYM: HRLZ T4,MONSYC ;GET CURRENT COUNT OF SYMBOLS
JUMPE T4,SYMSNP ;IF NONE, GO SNOOP
MOVN T4,T4 ;GET READY FOR A SEARCH
CAME T1,MONSYV(T4) ;FOUND THE VALUE IN TABLE?
AOBJN T4,.-1 ;NO, KEEP LOOKING
JUMPGE T4,SYMSNP ;NOT IN TABLE, GO SNOOP IT
MOVE T1,MONSYS(T4) ;FOUND IT, GET THE SYMBOL NAME
MOVE T2,MONSYO(T4) ;AND THE OFFSET
RET ;DONE
SYMSNP: MOVEM T1,TEMP ;SAVE FOR AWHILE
CAIL T4,MAXSYM ;IS THE SYMBOL TABLE FULL?
JRST SYMLOS ;YES, JUST RETURN OCTAL
MOVEI T1,.SNPAD ;FUNCTION TO FIND A SYMBOL
MOVE T2,TEMP ;VALUE TO FIND
SETZ T3, ;GLOBAL SEARCH
SNOOP ;LOOK FOR IT
ERJMP SYMLOS ;FAILED, RETURN OCTAL
MOVE T1,T2 ;MOVE SYMBOL TO RIGHT AC
MOVE T2,T3 ;AND OFFSET
MOVEM T1,MONSYS(T4) ;STORE THE SYMBOL NAME
MOVEM T2,MONSYO(T4) ;AND THE OFFSET
MOVE T3,TEMP ;GET VALUE WE FOUND
MOVEM T3,MONSYV(T4) ;SAVE IT
AOS MONSYC ;INCREMENT NUMBER OF SYMBOLS IN TABLE
RET ;DONE
SYMLOS: SETZ T1, ;SAY NO SYMBOL KNOWN
MOVE T2,TEMP ;GET ORIGINAL VALUE
RET ;DONE
SUBTTL ERROR TYPEOUT
;HERE TO TYPE ERRORS. THE DIE ROUTINE STOPS PERMANENTLY.
;THE LOSE ROUTINE OUTPUTS THE ERROR MESSAGE TO DPY, AND DOESN'T
;STOP THE PROGRAM.
TOOMNY: HRROI T1,[ASCIZ/
? Tables too small for jobs on system, reassemble with larger MAXJOB
/] ;GET STRING
PSOUT ;OUTPUT IT
HALTF ;QUIT
JRST .-1 ;STAY THAT WAY
DIE: MOVEI T1,.PRIOU ;OUTPUT STRAIGHT TO TERMINAL
CALL GIVERR ;TYPE THE LAST ERROR
HALTF ;QUIT
JRST .-1 ;STAY THAT WAY
LOSE: HRROI T1,TEMP ;POINT TO BUFFER
CALL GIVERR ;STORE THE ERROR MESSAGE
STR$ TEMP ;OUTPUT IT
RET ;DONE
GIVERR: HRROI T2,[ASCIZ/
? /] ;GET START OF ERROR
SETZ T3, ;CLEAR
SOUT ;START STRING
HRLOI T2,.FHSLF ;LAST ERROR IN MY PROCESS
MOVEI T3,TMPSIZ*5-12 ;GET MAXIMUM NUMBER OF CHARS
ERSTR ;TYPE ERROR
JFCL ;IGNORE ERRORS
JFCL
HRROI T2,[ASCIZ/
/] ;GET A FINAL CRLF
SETZ T3, ;WHOLE STRING
SOUT ;OUTPUT IT
RET ;DONE
SUBTTL SUBROUTINE TO SEE IF MONRD% JSYS EXISTS
;THIS SUBROUTINE IS CALLED TO TRY OUT THE MONRD% JSYS TO SEE IF IT
;WORKS. IF IT DOES NOT, WE TRY TO PUT IT INTO THE RUNNING MONITOR.
;THEN WE TRY IT AGAIN. FLAG FR.JSY IS SET IF IT WORKS CORRECTLY.
;ALWAYS RETURNS RIGHT AFTER CALL.
JSYTST: MOVEI T1,.RDTST ;GET TEST FUNCTION
SETZ T2, ;CLEAR AC
MONRD% ;TRY THE JSYS OUT
ERJMP JSYINI ;FAILED, GO TRY TO PUT IT IN
CAIN T2,.TSTNY ;ABLE TO USE THE JSYS?
JRST SYMRED ;YES, GO COLLECT SYMBOLS
CAIN T2,.TSTNN ;TOLD WE AREN'T GOOD ENOUGH?
RET ;YES, RETURN GRACEFULLY
IERR Wrong value returned from test function of "MONRD%" JSYS
;HERE WHEN THE MONRD% JSYS FAILS, TRY TO INSERT IT:
JSYINI: CALL MKJSYS ;TRY TO IMPLEMENT THE JSYS NOW
RET ;FAILED, ERROR MESSAGE ALREADY GIVEN
MOVEI T1,.RDTST ;GET TEST FUNCTION AGAIN
SETZ T2, ;CLEAR OTHER AC
MONRD% ;TRY IT AGAIN NOW
ERJMP [IERR "MONRD%" JSYS not inserted (not enough free core)]
CAIE T2,.TSTNY ;GET THE PROPER NUMBER?
IERR "MONRD%" JSYS inserted but test function returns wrong value
SYMRED: MOVSI T4,-SYMCNT ;GET NUMBER OF SYMBOLS TO FIND OUT
SYMRDL: MOVEI T1,.RDSYM ;FUNCTION TO READ A SYMBOL VALUE
MOVE T2,SYMTAB(T4) ;GET SYMBOL TO FIND OUT
MONRD% ;GET THE VALUE
ERJMP NOMONS ;FAILED, GO SAY WHY
JUMPN T1,NOMONS ;ALSO FAILED
MOVEM T2,SYMVAL(T4) ;SAVE THE VALUE FOR LATER
AOBJN T4,SYMRDL ;LOOP OVER ALL SYMBOLS
TXO F,FR.JSY ;CAN USE JSYS NOW
RET ;RETURN
;HERE FOR ERRORS IN SNOOPING OR USING MONRD%. THESE ROUTINES ARE
;CALLED BY THE IERR AND SERR MACROS. AN ERROR MESSAGE IS TYPED, AND
;THEN WE SLEEP FOR A FEW SECONDS TO GIVE TIME FOR THE TEXT TO BE READ.
NOMONS: HRROI T1,[ASCIZ/
? "MONRD%" JSYS failed to find the value of /]
PSOUT ;START OFF ERROR MESSAGE
MOVE T1,SYMTAB(T4) ;GET THE SYMBOL NAME IN SIXBIT
CALL SIXOTT ;OUTPUT IT TO THE TERMINAL
HRROI T1,[ASCIZ/
/] ;GET A FINAL CRLF
JRST IERRTP ;AND FINISH THE OUTPUT
SERRTP: PSOUT ;OUTPUT STRING
MOVEI T1,.PRIOU ;PRIMARY OUTPUT
HRLOI T2,.FHSLF ;LAST ERROR IN MY FORK
SETZ T3, ;INFINITE OUTPUT
ERSTR ;DO IT
JFCL ;IGNORE ERRORS
JFCL
SKIPA ;SKIP
IERRTP: PSOUT ;OUTPUT THE ERROR MESSAGE
MOVEI T1,^D5000 ;GET A TIME
TXNN F,FR.INS ;JUST INSERTING JSYS?
DISMS ;NO, SLEEP SOME SO HE CAN READ ERROR
RET ;THEN RETURN
SUBTTL ROUTINE TO "IMPLEMENT" USEFUL JSYS FOR SYSDPY
;ROUTINE TO IMPLEMENT THE MONRD% JSYS BY SNOOPING. IT IS ONLY
;NECESSARY TO HAVE A PRIVILEGED USER DO THIS ONCE, THEREAFTER ANYONE
;CAN USE THE JSYS TO READ INFORMATION. SKIP RETURN IF SUCCESSFUL.
MKJSYS: MOVEI T1,.FHSLF ;GET READY
RPCAP ;READ MY CAPABILITIES
TXNN T3,SC%WHL!SC%OPR ;SEE IF I CAN SNOOP
RET ;NO, RETURN WITHOUT COMPLAINING
AOS T1,VIRGIN ;BUMP COUNT OF TIMES WE GOT HERE
CAIE T1,1 ;BETTER BE FIRST TIME
IERR Initialization code is runnable only once
HRROI T1,[ASCIZ/
Attempting to insert "MONRD%" JSYS by snooping.../]
TXNN F,FR.INS ;SKIP MESSAGE IF SPECIAL ENTRY
PSOUT ;SAY WE ARE DOING THE WORK
MOVEI T1,.SNPSY ;FUNCTION TO GET A SYMBOL
MOVE T2,[RADIX50 0,.SNOOP] ;GET SYMBOL WE WANT
MOVE T3,[RADIX50 0,JSYSA] ;PROGRAM NAME
SNOOP ;FIND ITS VALUE
SERR SNOOP failed to get .SNOOP value
MOVEM T2,SNPVAL ;SAVE THE VALUE
CALL GETSYM ;FIX UP ALL CODE WITH SYMBOLS
RET ;ERROR, MESSAGE ALREADY GIVEN
MOVEI T1,.SNPLC ;GET FUNCTION TO LOCK PAGES
MOVEI T2,1 ;ONE PAGE
MOVEI T3,SNPLOC/1000 ;PAGE NUMBER TO BE LOCKED
SNOOP ;DO IT
SERR SNOOP failed to lock page
IMULI T2,1000 ;TURN MONITOR PAGE INTO ADDRESS
MOVEM T2,MONADR ;SAVE IT
MOVEI T1,.SNPDB ;GET READY TO DEFINE A BREAKPOINT
MOVEI T2,0 ;BREAKPOINT NUMBER 0
MOVE T3,SNPVAL ;GET ADDRESS TO BE PATCHED
MOVSI T4,(<CALL>) ;GET INSTRUCTION TO CALL US BY
HRR T4,MONADR ;INSERT ADDRESS
SNOOP ;DEFINE THE BREAKPOINT
JRST [CALL SNPFIN ;FAILED, UNDO SNOOP
SERR SNOOP failed to define breakpoint]
MOVEI T1,.SNPIB ;FUNCTION TO PUT IN BREAKPOINT
SNOOP ;PUT IT IN
JRST [CALL SNPFIN ;FAILED, UNDO SNOOP
SERR SNOOP failed to insert breakpoint]
AOS (P) ;INSERTED PROPERLY, SET UP FOR SKIP
SNPFIN: MOVEI T1,.SNPUL ;FUNCTION TO UNDO EVERYTHING
SNOOP ;UNDO SNOOPING (AND INSTALL JSYS!!)
JFCL ;OH WELL
RET ;ALL DONE
SUBTTL SUBROUTINE TO FILL IN SYMBOL VALUES
;SUBROUTINE TO FILL IN THE VALUES OF ALL MONITOR SYMBOLS REFERENCED
;BY THE $$ MACRO. THIS IS DONE BY SCANNING THE SYMS TABLE, WHICH HAS
;BLOCKS OF DATA IN THE FOLLOWING FORMAT:
;
; WORD 0 THE ADDRESS WHERE THE SYMBOL VALUE IS NEEDED.
; WORD 1 THE SYMBOL NAME IN RADIX50.
; WORD 2 THE PROGRAM MODULE NAME IN RADIX50.
; WORD 3 ADDRESS TO SET NONZERO IF SYMBOL ISN'T FOUND.
;
;SKIP RETURN IF SUCCESSFULLY FOUND ALL SYMBOLS.
GETSYM: MOVSI J,-SYMNUM ;SET UP AOBJN LOOP OVER SYMBOL TABLE
GETSYL: SKIPN T2,SYMS+1(J) ;IS THIS A NEW SYMBOL TO FIND?
JRST GETSYX ;NO, LOOK AT NEXT ONE
MOVE T3,SYMS+2(J) ;GET PROGRAM NAME
MOVEI T1,.SNPSY ;FUNCTION TO LOOKUP A SYMBOL
SNOOP ;ASK MONITOR FOR VALUE
JRST UNKSYM ;FAILED, GO HANDLE IT
MOVE T1,SYMS+1(J) ;GET SYMBOL NAME AGAIN
MOVE T3,J ;COPY AOBJN POINTER FOR SEARCH
GETSIL: CAME T1,SYMS+1(T3) ;IS THIS SYMBOL THE DESIRED ONE?
JRST GETSIX ;NO, KEEP SEARCHING
MOVE T4,@SYMS(T3) ;YES, GET INSTRUCTION THERE
ADD T4,T2 ;ADD IN THE SYMBOL VALUE
TLNN T4,-1 ;IS LEFT HALF ZERO?
MOVEM T4,@SYMS(T3) ;YES, REPLACE WHOLE VALUE
TLNE T4,-1 ;IS IT NONZERO?
HRRM T4,@SYMS(T3) ;YES, ONLY REPLACE RIGHT HALF
SETZM SYMS+1(T3) ;DONE WITH THIS USE OF THIS SYMBOL
GETSIX: ADDI T3,3 ;MOVE TO NEXT FOUR-WORD BLOCK
AOBJN T3,GETSIL ;SEARCH ALL OF REST OF TABLE
GETSYX: ADDI J,3 ;MOVE TO NEXT SYMBOL BLOCK
AOBJN J,GETSYL ;CONTINUE SEARCH FOR MORE NEW SYMBOLS
RETSKP ;HAVE THEM ALL
;HERE IF WE FAILED TO FIND A SYMBOL VALUE, TO TYPE OUT THE NAME
;OF THE SYMBOL SO THAT THE PROBLEM CAN EASILY BE FIXED. IF THIS
;SYMBOL IS ALLOWED TO BE UNKNOWN, WE JUST REMEMBER THAT.
UNKSYM: SKIPE T1,SYMS+3(J) ;ARE WE ALLOWED TO NOT KNOW THIS SYMBOL?
JRST [SETOM (T1) ;YES, SET FLAG SAYING WE FAILED
JRST GETSYX] ;AND GO BACK TO THE LOOP
HRROI T1,[ASCIZ/
? SNOOP failed to find value of /] ;GET READY
PSOUT ;TYPE THE INITIAL STRING
MOVE T1,SYMS+1(J) ;GET THE SYMBOL
CALL R50OTT ;OUTPUT TO TERMINAL
SKIPN SYMS+2(J) ;ANY PROGRAM NAME?
JRST UNKSYF ;NO, SKIP ON
HRROI T1,[ASCIZ/ in module /] ;YES, SAY SO
PSOUT ;OUTPUT IT
MOVE T1,SYMS+2(J) ;GET PROGRAM NAME
CALL R50OTT ;OUTPUT THAT TOO
UNKSYF: HRROI T1,[ASCIZ/:
/] ;GET THE REST OF THE STRING
JRST SERRTP ;GO OUTPUT IT AND THE ERROR REASON
SUBTTL SNOOP CODE
;THE FOLLOWING INSTRUCTIONS ARE EXECUTED BY THE MONITOR TO IMPLEMENT
;A JSYS WHICH WILL READ ANOTHER JOB'S JSB OR PSB. THIS CODE IS
;SELF-RELOCATABLE. THIS IS CALLED FROM THE BEGINNING OF A SNOOP JSYS.
XLIST ;DUMP ANY LITERALS FIRST
LIT
LIST
SYMS: ;SYMBOLS GET DUMPED HERE
LOC SNPLOC ;ACTUAL CODE GOES IN HIGH CORE
SNOPCD: MOVSI P2,(<JRST (P1)>) ;PUT INSTRUCTION IN P2
JSP P1,P2 ;JUMP TO IT AND PUT PC INTO P1
SUBI P1,. ;RELOCATE THE CODE
JSP CX,$$(SAVT,APRSRV) ;SAVE AC'S SNOOP WANTS TO USE
NOINT ;DON'T ALLOW US TO BE STOPPED
MOVEI T1,$$(JSTAB,LDINIT) ;GET ADDRESS OF JSYS TABLE
HRRZ T1,JSYNUM(T1) ;GET INSTRUCTION FOR OUR JSYS
CAIN T1,$$(UJSYS,SCHED) ;ALREADY BEEN DIDDLED?
AOSE ONCE(P1) ;OR ALREADY ENTERED THIS CODE?
JRST INSDON(P1) ;YES, DO NOTHING
CALL $$(LGTAD,TIMER) ;GET CURRENT TIME
MOVEM T1,POKTIM(P1) ;SAVE IT
MOVE T1,$$(JOBNO,STG) ;GET MY JOB NUMBER
<HRL T1,(T1)>+$$(JOBDIR,STG) ;AND MY USER NUMBER
MOVEM T1,POKWHO(P1) ;SAVE IT
MOVEI T1,JSYLEN+1 ;GET NUMBER OF WORDS WANTED
CALL $$(ASGSWP,FREE) ;ALLOCATE FREE CORE
JRST INSDON(P1) ;CAN'T GET IT
AOS P2,T1 ;OK, SAVE ADDRESS OF WHERE JSYS BEGINS
HRLI T1,.MONRD(P1) ;GET ADDRESS OF CODE TO COPY
MOVEI T2,JSYLEN-1(T1) ;GET ADDRESS OF LAST LOC TO COPY TO
BLT T1,(T2) ;COPY CODE INTO FREE CORE
CALL $$(SWPMWE,PAGEM) ;WRITE ENABLE THE MONITOR
MOVEI T1,$$(JSTAB,LDINIT) ;GET ADDRESS OF START OF JSYS TABLE
HRRM P2,JSYNUM(T1) ;SETUP DISPATCH ADDRESS
CALL $$(SWPMWP,PAGEM) ;WRITE PROTECT MONITOR AGAIN
INSDON: OKINT ;ALLOW INTERRUPTS AGAIN
RET ;RETURN
ONCE: EXP -1 ;ONCE-ONLY FLAG
LIT ;DUMP LITERALS NOW
SUBTTL THE MONRD% JSYS
;THE FOLLOWING CODE IS THE JSYS INSTALLED INTO THE RUNNING MONITOR.
;ITS FUNCTION IS TO RETURN INFORMATION NEEDED BY THIS PROGRAM.
;THE CALL IS:
;
; MOVEI T1,FUNCTION ;GET FUNCTION CODE
; (ARGUMENTS IN T2-T4) ;AND POSSIBLE ARGUMENTS
; MONRD% ;DO THE JSYS
; ERJMP LOSE ;FAIL IF NOT IMPLEMENTED
; JUMPN T1,ERROR ;AC IS NONZERO IF FUNCTION FAILED
; ;DONE, ANY VALUE RETURNED IN T2
;FUNCTIONS AND CONSTANTS:
.RDTST==0 ;TEST FUNCTION
.RDSYM==1 ;READ SYMBOL FUNCTION
.RDJSB==2 ;READ FROM JSB
.RDPSB==3 ;READ FROM PSB
.RDSTS==4 ;READ FORK STATUS
.RDMAP==5 ;READ WORDS FROM FORK PAGE MAP
.RDFST==6 ;READ FKSTAT WORD
.RDPID==7 ;READ WORD FROM IPCF HEADER
.RDDLL==10 ;READ DECNET LOGICAL LINK DATA
.RDTTY==11 ;READ WORD FROM TERMINAL DATABASE
.RDTTS==12 ;READ TTSTAT WORD FOR TERMINAL
.RDWSP==13 ;READ FKWSP WORD
.RDRES==14 ;READ STATUS OF SYSTEM RESOURCES
.TSTNY==123456 ;VALUE RETURNED FROM TEST FUNCTION
.TSTNN==654321 ;VALUE RETURNED IF NOT ALLOWED TO DO IT
;THE ACTUAL JSYS CODE:
.MONRD: MOVSI P2,(<JRST (P1)>) ;SETUP RETURN INSTRUCTION
JSP P1,P2 ;PUT PC IN P1 AND RETURN
SUBI P1,. ;RELOCATE IT
NOINT ;DISALLOW INTERRUPTS
IFN FTPRIV,<
MOVE P2,$$(CAPENB,STG) ;GET HIS CAPABILITIES
TXNN P2,SC%WHL!SC%OPR ;ALLOWED TO DO THIS JSYS?
JUMPN T1,ERROR(P1) ;NO, ERROR UNLESS FUNCTION 0
>
SKIPL T1 ;SEE IF HAVE LEGAL FUNCTION
CAILE T1,.RDMAX ;WELL?
JRST ERROR(P1) ;NO, GO LOSE
ADD T1,P1 ;RELOCATE THE ADDRESS
CALL @MONRDT(T1) ;CALL THE SUBROUTINE
JRST ERROR(P1) ;FAILED
XCTU [MOVEM P2,2](P1) ;STORE RETURNED VALUE
TDZA T1,T1 ;CLEAR AC
ERROR: SETO T1, ;OR SET AC NONZERO
XCTU [MOVEM T1,1](P1) ;STORE SUCCESS FLAG
OKINT ;ALLOW INTERRUPTS AGAIN
JRST $$(MRETN,SCHED) ;RETURN FROM JSYS
MONRDT: IFIW TSTFNC(P1) ;TEST EXISTANCE OF JSYS
IFIW SYMFNC(P1) ;READ VALUE OF SYMBOL
IFIW JSBFNC(P1) ;READ WORD FROM JSB
IFIW PSBFNC(P1) ;READ WORD FROM PSB
IFIW STSFNC(P1) ;GET FORK STATUS
IFIW MAPFNC(P1) ;READ ACCESS OF CORE PAGE
IFIW FSTFNC(P1) ;RETURN FKSTAT WORD
IFIW IPCFNC(P1) ;RETURN WORD FROM PID HEADER
IFIW DLLFNC(P1) ;DUMP LL BLOCKS FOR DECNET
IFIW TTYFNC(P1) ;RETURN WORD FROM TERMINAL BLOCKS
IFIW TTSFNC(P1) ;RETURN THE TTSTAT WORD
IFIW WSPFNC(P1) ;RETURN FKWSP WORD
IFIW RESFNC(P1) ;RETURN RESOURCE INFORMATION
.RDMAX==.-MONRDT-1 ;HIGHEST LEGAL FUNCTION
POKTIM: EXP 0 ;TIME AT WHICH JSYS WAS INSTALLED
POKWHO: EXP 0 ;USER NUMBER AND JOB NUMBER WHICH DID IT
;TEST FUNCTION. USED TO SEE IF JSYS IS IMPLEMENTED. NO ARGUMENTS.
;RETURNS IN T2 THE NUMBER .TSTN?, IN T3 THE TIME THE JSYS WAS PUT IN,
;AND IN T4 THE USER NUMBER AND JOB NUMBER WHICH DID IT.
TSTFNC: DMOVE T1,POKTIM(P1) ;GET THE TIME AND WHO PUT IN JSYS
XCTU [DMOVEM T1,3](P1) ;STORE IN USER'S AC
MOVEI P2,.TSTNY ;GET TEST NUMBER TO BE RETURNED
IFN FTPRIV,<
MOVE T1,$$(CAPENB,STG) ;GET PRIVILEGES
TXNN T1,SC%WHL!SC%OPR ;ABLE TO DO THE OTHER FUNCTIONS?
MOVEI P2,.TSTNN ;NO, GET FAILURE CODE
>
SKP: AOS (P) ;SET UP FOR SKIP RETURN
RET: RET ;DO IT
;LOOKUP SYMBOL VALUE FUNCTION. T2 = SIXBIT OF SYMBOL TO LOOK UP.
;RETURNS VALUE IN T2.
SYMFNC: CALL SYMSR0(P1) ;LOOK FOR THE SYMBOL
RET ;FAILED
JRST SKP(P1) ;GOOD RETURN
;GET STATUS OF FORK FUNCTION. T2 = SYSTEM FORK NUMBER.
;RETURNS STATUS WORD (SAME AS .RFSTS) IN T2.
STSFNC: MOVE T1,T2 ;PUT FORK NUMBER IN RIGHT AC
MOVE FX,T2 ;AND IN OTHER AC
CALL CHKFRK(P1) ;SEE IF THE FORK IS THERE
RET ;NO, ERROR RETURN
CALL $$(MRFSTS,FORK) ;OK, READ FORK STATUS
OKSKED ;ALLOW SCHEDULING NOW
MOVE P2,T1 ;COPY STATUS
JRST SKP(P1) ;GOOD RETURN
;GET FKSTAT OR FKWSP WORD FOR FORK. T2 = SYSTEM FORK NUMBER. RETURNS
;WORD IN T2.
WSPFNC: SKIPA P2,WSPLOC(P1) ;GET ADDRESS OF WORKING SET TABLE
FSTFNC: MOVEI P2,$$(FKSTAT,STG) ;OR ADDRESS OF SCHEDULER TEST TABLE
SKIPL T2 ;VERIFY FORK NUMBER
CAIL T2,$$(NFKS,STG) ;SOME MORE
RET ;BAD
ADD P2,T2 ;ADD IN OFFSET INTO TABLE
MOVE P2,(P2) ;GET WORD
JRST SKP(P1) ;GOOD RETURN
WSPLOC: EXP $$(FKWSP,STG) ;ADDRESS OF WORKING SET TABLE
;GET WORD FROM TTACTL DATA FOR TERMINALS. T2 = SYMBOL IN BLOCK,
;T3 = OFFSET FROM SYMBOL, T4 = TERMINAL NUMBER. RETURNS WORD IN T2.
TTYFNC: MOVEI T1,$$(TTDDLN,TTYSRV) ;GET LENGTH OF TERMINAL BLOCKS
SUBI T1,1 ;BACK OFF ONE
CALL SYMSRC(P1) ;LOOK FOR THE SYMBOL
RET ;UNKNOWN SYMBOL
XCTU [SKIPL T1,4](P1) ;GET TERMINAL NUMBER
CAIL T1,$$(NLINES,STG) ;AND RANGE CHECK IT
RET ;OUT OF RANGE
<SKIPG T1,(T1)>+$$(TTACTL,STG) ;GET POINTER TO DATA BLOCK
RET ;NOT ASSIGNED
ADD P2,T1 ;ADD ADDRESS INTO OFFSET
MOVE P2,(P2) ;GET THE REQUIRED WORD
JRST SKP(P1) ;DONE
;GET THE WORD FROM TTSTAT FOR A TTY LINE. AC T2 HAS THE LINE NUMBER.
;RETURNS THE WORD IN T2.
TTSFNC: SKIPL T2 ;RANGE CHECK THE DATA
CAIL T2,$$(NLINES,STG) ;SOME MORE
RET ;ITS BAD
<MOVE P2,(T2)>+$$(TTSTAT,STG) ;GET THE WORD
JRST SKP(P1) ;GOOD RETURN
;GET WORD FROM JSB FUNCTION. T2 = SYMBOL IN JSB, T3 = OFFSET FROM SYMBOL,
;T4 = JOB NUMBER. RETURNS WORD FROM JSB IN AC T2.
;THE JSB AREA STARTS AT LOCATION JSB, AND EXTENDS UP TO THE PAGE PPMPG.
JSBFNC: MOVEI T1,$$(JSVARZ,POSTLD) ;GET LAST ADDRESS IN JSB
HRLI T1,$$(JSVAR,JOBDAT) ;AND PUT IN LOWEST JSB ADDRESS
CALL SYMSRC(P1) ;LOOK FOR THE SYMBOL
RET ;FAILED, RETURN
XCTU [SKIPL T1,4](P1) ;GET JOB AND SEE IF NONNEGATIVE
CAIL T1,$$(NJOBS,STG) ;AND SEE IF NOT TOO LARGE
RET ;NO, ERROR RETURN
NOSKED ;STOP SCHEDULING NOW
<SKIPGE 0(T1)>+$$(JOBRT,STG) ;IS THIS JOB NUMBER ASSIGNED?
JRST SKDRET(P1) ;NO, GO ERROR RETURN
<HRRZ T1,0(T1)>+$$(JOBPT,STG) ;GET TOP FORK OF THE JOB
<HRLZ T1,0(T1)>+$$(FKJOB,STG) ;THEN GET SPT INDEX OF JSB
MOVE T2,P2 ;GET ADDRESS
SUBI T2,$$(JSVAR,JOBDAT) ;SUBTRACT BASE ADDRESS
LSH T2,-^D9 ;GET PAGE NUMBER INTO JSB
HRR T1,T2 ;PUT THAT INTO T1
PUSH P,T1 ;SAVE PAGE IDENT FOR LATER
CALL $$(MRPACS,PAGEM) ;READ ACCESSIBILITY OF PAGE
JUMPE T1,JSBZER(P1) ;NO PAGE, GO RETURN ZERO
POP P,T1 ;PAGE IS THERE, RESTORE IDENT
MOVEI T2,$$(FPG1A,STG) ;GET ADDRESS OF TEMPORARY PAGE
CALL $$(SETMPG,PAGEM) ;MAP THE PAGE OF THE JSB
NOINT ;MATCH OKINT DONE BY CLRJSB
ANDI P2,777 ;ONLY KEEP OFFSET INTO PAGE NOW
<MOVE P2,0(P2)>+$$(FPG1A,STG) ;GET THE WORD FROM THE JSB
OKSKP: CALL $$(CLRJSB,FORK) ;UNMAP THE TEMPORARY PAGE
OKSKED ;CAN SCHEDULE AGAIN NOW
JRST SKP(P1) ;GOOD RETURN
JSBZER: OKSKED ;ALLOW SCHEDULING
POP P,T1 ;POP OFF AC
SETZ P2, ;MAKE A ZERO RESULT
JRST SKP(P1) ;GOOD RETURN
;READ WORD OF PSB FUNCTION. T2 = SYMBOL NAME, T3 = OFFSET FROM SYMBOL,
;T4 = SYSTEM FORK NUMBER. RETURNS WORD OF PSB IN T2.
;WE ONLY PROVIDE FOR THE READING OF THE TWO IMPORTANT PAGES.
PSBFNC: MOVEI T1,$$(PSBPGA,STG) ;GET LOWER BOUND ON SYMBOL
HRLI T1,1777(T1) ;CREATE UPPER BOUND
MOVS T1,T1 ;AND REVERSE TO MAKE CORRECT
CALL SYMSRC(P1) ;LOOK FOR HIS SYMBOL
RET ;NOT FOUND
XCTU [MOVE T1,4](P1) ;GET THE FORK NUMBER
CALL CHKFRK(P1) ;SEE IF FORK IS OK TO LOOK AT
RET ;NO, ERROR
CALL $$(SETLF3,FORK) ;FORK IS THERE, MAP THE PSB
OKSKED ;THEN ALLOW SCHEDULING
ADD P2,T1 ;RELOCATE WORD TO BE READ
MOVE P2,(P2) ;GET THE WORD
CALL $$(CLRJSB,FORK) ;UNMAP THE JSB OR PSB NOW
JRST SKP(P1) ;GOOD RETURN
;READ A WORD FROM THE HEADER BLOCK OF A PID. T2 = PID TO READ,
;T3 = OFFSET INTO HEADER. RETURNS WORD IN T2.
IPCFNC: SKIPL P2,T3 ;VALIDATE THE HEADER OFFSET
CAIL P2,$$(PIDHDS,STG) ;AND SAVE IN GOOD AC
RET ;BAD OFFSET
MOVE T1,T2 ;MOVE PID TO RIGHT AC
CALL $$(VALPID,IPCF) ;VALIDATE THE PID NUMBER
RET ;BAD, RETURN
ADD P2,T2 ;ADD ADDRESS OF HEADER TO OFFSET
MOVE P2,(P2) ;GET THE WORD
JRST SKP(P1) ;GOOD RETURN
;READ ACCESS OF A USER CORE PAGE. T2 = PAGE NUMBER TO BE EXAMINED,
;T3 = SYSTEM FORK NUMBER. RETURNS PAGE POINTER IN T2, IN THE FOLLOWING
;FORMAT:
;
; 0 THIS PAGE AND ALL FURTHER PAGES ARE NONEXISTANT
; 0,,N THIS PAGE NONEXISTANT, NEXT EXISTANT PAGE IS N
; 1XXXXX,,XXXXXX PRIVATE PAGE
; 2XXXXX,,FORK SHARED PAGE WITH GIVEN SYSTEM FORK INDEX
; 2XXXXX,,-OFN SHARED PAGE WITH GIVEN FILE OFN
; 3XXXXX,,FORK INDIRECT PAGE WITH GIVEN FORK INDEX
; 3XXXXX,,-OFN INDIRECT PAGE WITH GIVEN FILE OFN
MAPFNC: MOVE P2,T2 ;SAVE PAGE NUMBER IN SAFE PLACE
MOVE T1,T3 ;GET SYSTEM FORK NUMBER IN RIGHT AC
TDNN P2,[-1,,777000](P1) ;VALIDATE PAGE NUMBER
CALL CHKFRK(P1) ;AND VALIDATE FORK NUMBER
RET ;BAD, ERROR RETURN
<HLRZ T1,(T1)>+$$(FKPGS,STG) ;GET SPT INDEX OF PAGE TABLE
MOVEI T2,$$(FPG1A,STG) ;AND ADDRESS OF TEMP PAGE
CALL $$(SETMPG,PAGEM) ;MAP IN THE PAGE TABLE
NOINT ;MATCH OKINT DONE BY CLRJSB
<SKIPN T1,(P2)>+$$(FPG1A,STG) ;IS PAGE POINTER IN USE?
AOJA P2,MAPZER(P1) ;NO, GO HUNT FOR NEXT USED ONE
MOVE P2,T1 ;PUT POINTER IN SAFE PLACE
CALL $$(CLRJSB,FORK) ;REMOVE THE MAPPING
OKSKED ;ALLOW SCHEDULING NOW
TLNN P2,200000 ;IS THIS A DIRECT POINTER?
JRST SKP(P1) ;YES, RETURN IT AS IS
HRRZ T1,P2 ;GET SPT INDEX FROM POINTER
CAIL T1,$$(NOFN,STG) ;IS THIS AN OFN?
<SKIPA T1,(T1)>+$$(SPTH,STG) ;NO, GET PAGE'S ORIGIN
HRLZ T1,T1 ;YES, SET UP
HLRZ T2,T1 ;GET OFN IF ANY
SKIPE T2 ;IS THIS OFN,,PAGE OR 0,,FORK?
MOVN T1,T2 ;IS OFN, NEGATE IT
HRR P2,T1 ;REPLACE RIGHT HALF WITH OFN OR FORK
JRST SKP(P1) ;GOOD RETURN
MAPZER: TRZN P2,777000 ;WENT OFF END OF THE PAGE MAP?
<SKIPE (P2)>+$$(FPG1A,STG) ;OR FOUND A NONZERO ENTRY?
JRST OKSKP(P1) ;YES, DO UNMAP, OKSKED, AND SKIP RETURN
AOJA P2,MAPZER(P1) ;OTHERWISE KEEP SEARCHING
;FUNCTION TO DUMP OUT THE LL BLOCKS INTO CORE. T2 = <-LEN,,ADDR>
;OF BLOCK TO STORE DATA. RETURNS IN T2 SIZE OF EACH BLOCK IN LEFT
;HALF, AND NUMBER OF BLOCKS RETURNED IN RIGHT HALF.
OKDLL: BLOCK 1 ;NONZERO IF NOT ABLE TO DO THIS FUNCTION
.FAIL.==OKDLL ;DEFINE LOC IN CASE SYMBOLS AREN'T FOUND
DLLFNC: SKIPE OKDLL(P1) ;SEE IF WE CAN DO THIS STUFF
RET ;NO, RETURN
MOVE P3,T2 ;SAVE IOWD POINTER
SUB P3,[1,,1](P1) ;FIX UP POINTER
MOVSI P2,DLLNUM ;GET SIZE OF EACH BLOCK AND CLEAR COUNTER
CALL $$(LOKLL,NSPSRV) ;LOCK UP THE NETWORK STRUCTURE
MOVEI T1,DLLSUB(P1) ;GET CO-ROUTINE ADDRESS
SETO T2, ;WE WANT ALL LOGICAL LINK BLOCKS
CALL $$(OBJSRC,NSPSRV) ;CALL CO-ROUTINE TO PROCESS THEM
CALL $$(ULOKLL,NSPSRV) ;UNLOCK THE DATA STRUCTURE
JRST SKP(P1) ;GOOD RETURN
;SUBROUTINE CALLED FOR EACH LOGICAL LINK BLOCK. AC T1 HAS
;THE ADDRESS OF THE NEW LL BLOCK.
DLLSUB: JSP CX,$$(SAVT,APRSRV) ;HAVE TO SAVE ALL TEMPORARIES
MOVSI T2,-DLLNUM ;GET READY FOR A LOOP
HRR T2,P1 ;RELOCATE AOBJN POINTER
MOVSI T3,(<MOVEM T4,>) ;SET UP AN INSTRUCTION
DLLSTL: AOBJP P3,RET(P1) ;RETURN IF NO MORE ROOM
MOVE T4,T1 ;COPY ADDRESS OF LL BLOCK
ADD T4,DLLTAB(T2) ;ADD OFFSET DESIRED
MOVE T4,(T4) ;GET THE DATA
HRR T3,P3 ;POINT TO NEXT WORD
XCTU T3 ;STORE THE WORD
ERJMP RET(P1) ;FAILED
AOBJN T2,DLLSTL(P1) ;STORE ALL DESIRED WORDS
AOJA P2,RET(P1) ;COUNT BLOCKS STORED AND RETURN
;TABLE OF WORDS TO BE RETURNED BACK TO USER. THIS TABLE IS BUILT
;BY EXPANDING THE LLNUMS MACRO DEFINED EARLIER.
DEFINE LLLIST(ARGS),<
IRP ARGS,< ;;LOOP OVER ALL ARGS
DL.'ARGS==.-DLLTAB ;;ASSIGN OFFSET
EXP ARGS ;;MAKE OFFSET TABLE
>
>
DLLTAB: LLNUMS ;EXPAND THE MACRO
DLLNUM==.-DLLTAB ;NUMBER OF WORDS
.FAIL.==0 ;NO MORE SYMBOL FAILURES ALLOWED NOW
;FUNCTION TO RETURN VARIOUS SYSTEM RESOURCE INFORMATION IN THE MONITOR.
;CALLED WITH TYPE OF RESOURCE IN T2. RETURNS T2 = CURRENT VALUE,
;AND T3 = INITIAL VALUE.
RESFNC: TRNN T2,-1 ;WANTS A SUB FIELD OF RESIDENT SPACE?
JRST RESSUB(P1) ;NO, GO DO OTHER FIELDS
SUBI T2,1 ;DECREMENT OFFSET
TLNN T2,-1 ;SEE IF NONZERO LEFT HALF
CAIL T2,$$(RESQTL,STG) ;OR IF FUNCTION IS TOO BIG
RET ;YES, BAD
<MOVE P2,(T2)>+$$(RESQTB,FREE) ;GET INITIAL COUNT
<MOVE T2,(T2)>+$$(RESUTB,STG) ;AND CURRENT FREE COUNT
XCTU [MOVEM T2,3](P1) ;GIVE TO USER
JRST SKP(P1) ;AND RETURN FINAL RESULT TOO
RESSUB: HLRZ T2,T2 ;GET FIELD OFFSET
CAILE T2,MAXRES ;RANGE CHECK THE INDEX
RET ;BAD
ADD T2,P1 ;RELOCATE ADDRESS
SKIPGE P2,RESTB1(T2) ;GET VALUE OR POINTER
MOVE P2,(P2) ;WAS A POINTER, GET DATA
CAMN T2,P1 ;IS IT RESIDENT FREE SPACE?
JRST RESFTL(P1) ;YES, GO DO SPECIAL CASE
SKIPL T2,RESTB2(T2) ;HAVE TO COMPUTE CURRENT VALUE?
TLOA T2,(IFIW) ;YES, SET BIT FIRST
SKIPA T2,@T2 ;NO, JUST GET IT
CALL @T2 ;YES, COMPUTE DATA
XCTU [MOVEM T2,3](P1) ;GIVE TO USER
JRST SKP(P1) ;DONE
;CALCULATE TOTAL OF POOLS FOR THE CUMULATIVE OUTPUT FOR RES. FREE SPACE
RESFTL: MOVNI T2,$$(RESQTL,STG) ;GET THE NUMBER OF POOLS
HRLZS T2 ;MAKE AOBJN POINTER
SETZ T3, ;INIT THE COUNT
RESFT1: <MOVE T4,(T2)>+$$(RESQTB,STG) ;GET INITIAL VALUE
<SUB T4,(T2)>+$$(RESUTB,STG) ;CALC AMOUNT USED
ADD T3,T4 ;ADD IT IN
AOBJN T2,RESFT1(P1) ;MORE TO DO?
MOVE T2,P2 ;NO, GET THE INITIAL VALUE
SUB T2,T3 ;CALC WHAT'S LEFT
XCTU [MOVEM T2,3](P1) ;RETURN IT
JRST SKP(P1) ;DONE
RESTB1: EXP $$(NRESFB,STG) ;(0) NUMBER OF RESIDENT BLOCKS
EXP $$(SWFREL,STG) ;(1) AMOUNT OF SWAPABLE SPACE
EXP $$(ENQMXF,STG) ;(2) MAXIMUM ENQ USAGE
EXP $$(MAXBLK,STG) ;(3) MAXIMUM NETWORK STORAGE
EXP $$(NOFN,STG) ;(4) SIZE OF OFN TABLE
EXP $$(SSPT,STG) ;(5) SIZE OF SPT TABLE
IFIW $$(DRMTPG,STG) ;(6) NUMBER OF SWAPPING PAGES
IFIW $$(TOTRC,STG) ;(7) TOTAL USER CORE AVAILABLE
EXP $$(NFKS,STG) ;(10) NUMBER OF FORKS
MAXRES==.-RESTB1 ;HIGHEST VALUE
RESTB2: IFIW $$(RESFRE,STG) ;FREE RESIDENT BLOCKS
IFIW 2+$$(SWPFRE,STG) ;NONRESIDENT STORAGE
IFIW $$(ENQSPC,STG) ;ENQ SPACE LEFT
IFIW $$(BLKASG,STG) ;NETWORK SPACE ASSIGNED
IFIW $$(NOF,PAGEM) ;CURRENT OFNS ASSIGNED
IFIW $$(SPTC,PAGEM) ;CURRENT SPT SLOTS ASSIGNED
IFIW $$(DRMFRE,STG) ;FREE SWAPPING PAGES
IFIW $$(NRPLQ,STG) ;PAGES ON THE REPLACEABLE QUEUE
Z FRKCNT(P1) ;ROUTINE TO COUNT USED FORKS
;ROUTINE TO COMPUTE NUMBER OF USED FORKS ON THE SYSTEM.
FRKCNT: SETZ T2, ;START WITH ZERO
MOVNI T3,$$(NFKS,STG) ;GET NUMBER OF FORKS TOTAL
MOVSI T3,(T3) ;MAKE AOBJN POINTER
FRKCN1: <SKIPL (T3)>+$$(FKPT,STG) ;THIS FORK ASSIGNED?
ADDI T2,1 ;YES, COUNT IT
AOBJN T3,FRKCN1(P1) ;LOOP UNTIL LOOKED AT THEM ALL
RET ;DONE
;SUBROUTINE TO CHECK A SYSTEM WIDE FORK NUMBER, AND VERIFY THAT THE
;FORK IS LEGAL AND EXISTS. CALL:
;
; MOVE T1,FORK ;GET SYSTEM FORK NUMBER
; CALL CHKFRK(P1) ;VERIFY THAT IT IS THERE
; (ERROR) ;ILLEGAL FORK, OR NOT EXISTANT
; (GOOD RETURN) ;IS LEGAL, WE ARE NOSKED
;
;ON A SUCCESSFUL RETURN, WE ARE RUNNING NOSKED SO THE CALLER MUST
;DO AN OKSKED SOMETIME. DOES NOT CHANGE T1.
CHKFRK: SKIPL T1 ;SEE IF FORK NUMBER IS LEGAL
CAIL T1,$$(NFKS,STG) ;WELL?
RET ;NO, ERROR
NOSKED ;NO RACES NOW
HRRZ T2,.JBVER ;GET MONITOR VERSION
CAIGE T2,NWFKPT ;NEW STYLE SCHEDULAR CODE?
JRST CHKFRO(P1) ;NO, GO DO OLD WAY
<SKIPL 0(T1)>+$$(FKPT,STG) ;IS FORK ASSIGNED?
JRST SKP(P1) ;YES, GOOD RETURN
JRST SKDRET(P1) ;NO, GIVE ERROR RETURN
CHKFRO: <HLRZ T2,0(T1)>+$$(FKPT,STG) ;GET QUEUE FORK IS ON
CAIE T2,$$(WTLST,STG) ;IS FORK IN A WAIT?
CAIN T2,$$(GOLST,STG) ;OR RUNNABLE?
JRST SKP(P1) ;YES, SUCCESSFUL RETURN
SKDRET: OKSKED ;NO, THEN FORK IS NONEXISTANT
RET ;SO ERROR RETURN
;SUBROUTINE TO SEARCH FOR A MONITOR SYMBOL IN OUR LITTLE TABLE, AND
;RANGE CHECK IT AGAINST THE LIMITS OF THE PSB OR JSB. CALL:
;
; MOVE T1,[LOWADR,,HGHADR] ;GET BOUNDS ON THE ADDRESS
; MOVE T2,SYMBOL ;GET SIXBIT SYMBOL
; CALL SYMSRC(P1) ;LOOK FOR IT
; (ERROR) ;NOT FOUND, OR OUT OF LEGAL RANGE
; (GOOD RETURN) ;VALUE IN AC P2
;
;A SYMBOL NAME OF ZERO IMPLIES A VALUE OF ZERO, SO THAT THE OFFSET
;GIVEN IS THE ACTUAL ADDRESS WANTED. CALL AT SYMSR0 IF NO OFFSET
;IS TO BE USED, AND NO RANGE CHECKING IS WANTED.
SYMSR0: SETZ T1, ;NO BOUNDS CHECKING
SYMSRC: SKIPN P2,T2 ;ANY SYMBOL NAME SPECIFIED?
JRST SYMSRV(P1) ;NO, WANTS THE PARTICULAR VALUE
MOVSI T3,-SYMCNT ;GET NUMBER OF SYMBOLS TO LOOK AT
HRR T3,P1 ;RELOCATE THE ADDRESS
SYMLOP: CAME T2,SYMTAB(T3) ;FOUND THE SYMBOL YET?
AOBJN T3,SYMLOP(P1) ;NO, KEEP LOOKING
JUMPGE T3,RET(P1) ;NOT FOUND, ERROR
MOVE P2,SYMVAL(T3) ;OK, GET THE VALUE
SYMSRV: JUMPE T1,SKP(P1) ;IF NO BOUNDS CHECKING, ARE DONE
XCTU [ADD P2,3](P1) ;ADD IN OFFSET SPECIFIED BY USER
HLRZ T2,T1 ;GET LOWER BOUND
CAML P2,T2 ;ADDRESS LESS THAN LOWER BOUND?
CAILE P2,(T1) ;OR HIGHER THAN UPPER BOUND?
RET ;YES, ERROR
JRST SKP(P1) ;NO, THEN SKIP RETURN
;TABLE OF KNOWN SYMBOLS WE CAN BE TOLD TO USE:
DEFINE SS,< ;;DEFINE SYMBOLS WE WILL KNOW ABOUT
XX JSVAR,JOBDAT ;BEGINNING OF JOB STORAGE BLOCK
XX JSVARZ,POSTLD ;END OF JOB STORAGE BLOCK
XX RSCNBP ;POINTER TO JOB'S RSCAN BUFFER
XX MAXJFN ;HIGHEST JFN IN USE
XX FILSTS ;STATUS BITS FOR JFN
XX FILBYT ;BYTE POINTER INTO WINDOW
XX FILBYN ;BYTE NUMBER INTO FILE
XX FILDDN ;POINTER TO DEVICE STRING IN JFN BLOCK
XX FILDNM ;POINTER TO DIRECTORY STRING
XX FILNEN ;POINTER TO NAME AND EXTENSION STRINGS
XX FILVER ;GENERATION NUMBER
XX FILOFN ;OFN FOR THIS FILE
XX FILDEV ;DEVICE DISPATCH
XX DSKDTB,DISC ;ADDRESS FOR DISKS
XX SYSFK ;JOB FORK TO SYSTEM FORK TABLE
XX FKPTRS ;STRUCTURE OF FORKS
XX NUFKS ;NUMBER OF USER FORKS
XX FKCNT ;NUMBER OF FORKS IN THE JOB
XX MLJFN ;LENGTH OF EACH JFN BLOCK
XX PSVAR,JOBDAT ;BEGINNING OF PROCESS STORAGE BLOCK
XX PSVARZ,POSTLD ;END OF PROCESS STORAGE BLOCK
XX JOBNO ;JOB NUMBER FORK BELONGS TO
XX UPDL ;BEGINNING OF JSYS STACK
XX FKRT ;FORK RUN TIME
XX PPC ;PROCESS PC
XX KIMUU1 ;LAST USER UUO
XX CAPMSK ;POSSIBLE CAPABILITIES
XX CAPENB ;ENABLED CAPABILITIES
XX UTRPCT ;NUMBER OF PAGE TRAPS
XX LSTERR ;LAST ERROR IN FORK
XX INTDF ;NO INTERRUPTIONS COUNTER
XX TRAPPC ;THE PC OF THE LAST PAGE FAULT
XX TTFLG1,TTYSRV ;FLAGS
XX TTOCT,TTYSRV ;CHARACTERS IN OUTPUT BUFFER
XX TTICT,TTYSRV ;CHARACTERS IN INPUT BUFFER
XX TTLINK,TTYSRV ;LINES LINKED TO THIS TTY
XX TTFLGS,TTYSRV ;MORE FLAGS
XX RESQTL ;NUMBER OF RESIDENT FREE POOLS
>
DEFINE XX(SYMBOL,MODULE<STG>),<
EXP SIXBIT /SYMBOL/ ;SIXBIT NAME
>
XALL ;ALLOW LISTING
SYMTAB: SS
SYMCNT==.-SYMTAB ;NUMBER OF SYMBOLS
DEFINE XX(SYMBOL,MODULE<STG>),<
SYMBOL: Z $$(SYMBOL,MODULE) ;VALUE OF NAME
>
SYMVAL: SS
SALL ;RETURN TO NORMAL LISTING
LIT ;DUMP LITERALS
JSYLEN==.-.MONRD ;NUMBER OF WORDS FOR JSYS
IFG <.-SNPLOC-1000>,< ;MAKE SURE STILL ON ONE PAGE
PRINTX ? SNOOP code is larger than a page. Do not attempt to run program!
>
RELOC ;RETURN TO NORMAL CODE
SYMNUM==<.-SYMS>/4 ;NUMBER OF SYMBOLS TO FILL IN
SUBTTL MACRO TO DEFINE THE DISPLAY TYPES
;THE FOLLOWING MACRO DEFINES THE TYPES OF DISPLAYS WHICH CAN
;BE OUTPUT, AND WHICH HAVE DEFINABLE COLUMNS. (THUS THINGS LIKE
;THE QUEUE DISPLAY WON'T APPEAR HERE, SINCE NO COLUMNS CAN BE
;CHANGED). THE ARGUMENTS ARE:
;
; XX SEPARATION, TYPE, TEXT
;
;WHERE SEPARATION IS THE DEFAULT NUMBER OF BLANKS BETWEEN COLUMNS,
;TYPE IS THE MNEMONIC FOR THIS DISPLAY USED IN THE COLUMN MACRO LATER,
;AND TEXT IS THE NAME OF THIS COLUMN FOR TBLUK PURPOSES. THIS
;TABLE MUST BE IN ALPHABETICAL ORDER.
DEFINE TYPES,< ;;DEFINE THE TYPES
XX 3,ANH,ARPANET-HOSTS ;;HOSTS ON THE ARPANET
XX 3,ANC,ARPANET-LINKS ;;ARPANET CONNECTIONS
XX 2,DLL,DECNET-STATUS ;;DECNET DISPLAY
XX 4,DEV,DEVICES ;;SYSTEM DEVICES
XX 1,DSK,DISK-UNITS ;;UNITS IN THE SYSTEM
XX 3,EQL,ENQ-LOCKS ;;LOCKS FOR ENQ/DEQ
XX 3,EQQ,ENQ-QUEUES ;;QUEUES FOR THE LOCKS
XX 2,FIL,FILES ;;FILES OF A JOB
XX 2,FRK,FORKS ;;FORKS IN A JOB
XX 2,IPC,IPCF-STATUS ;;THE PIDS ON THE SYSTEM
XX 2,JOB,JOBS ;;ALL OF THE JOBS
XX 2,STR,STRUCTURES ;;DISK STRUCTURES
XX 2,TTY,TERMINALS ;;THE TERMINALS
>
DEFINE XX(SEP,TYPE,TEXT),<
TP.'TYPE==.-DISTAB ;;DEFINE HEADER CODE
XWD [ASCIZ/TEXT/],SEP ;;DUMP NAME AND SEPARATION
>
DISTAB: XWD DISNUM,DISNUM ;NUMBER OF ENTRIES
TYPES ;EXPAND THE TABLE
DISNUM==.-DISTAB-1 ;NUMBER OF ENTRIES
SUBTTL MACRO TO DEFINE THE COLUMNS
;THE FOLLOWING MACRO DEFINES THE COLUMNS WHICH CAN BE OUTPUT FOR
;A FORK. THE ARGUMENTS ARE:
;
; XX ORDER, TYPE, SIZE, ROUTINE, NAME, HEADER
;
;ORDER GIVES THE DEFAULT ORDERING OF THE COLUMNS.
;TYPE IS THE TYPE OF COLUMN THIS IS, WITHOUT THE "TP."
;SIZE IS THE NUMBER OF SPACES THIS COLUMN NEEDS IN WORST CASE.
;ROUTINE IS THE DISPATCH ADDRESS FOR THIS COLUMN, WITHOUT THE "XX"
;NAME IS THE KEYWORD NAME FOR THIS COLUMN.
;HEADER IS THE TEXT OUTPUT AS THE HEADER FOR THIS COLUMN.
DEFINE COLS,<
XX 0,DLL,15,LABT,ABORT-REASON,<Abort reason> ;;ABORT REASON
XX 0,JOB,15,ACCT,ACCOUNT,< Account> ;;ACCOUNT STRING
XX 30,DSK,6,ALIS,ALIAS,<Alias> ;;DISK ALIAS
XX 0,DLL,10,LBYC,BYTE-COUNT-IN-SEGMENT,<Byte count> ;;BYTES
XX 10,DSK,4,CHAN,CHANNEL,<Chan> ;;DISK CHANNEL
XX 60,EQL,15,LCOD,CODE-FOR-LOCK,<Lock code> ;;LOCK CODE
XX 0,JOB,7,CTIM,CONNECT-TIME,<Connect> ;;CONNECT TIME OF JOB
XX 15,DSK,4,CTRL,CONTROLLER,<Ctrl> ;;DISK CONTROLLER
XX 60,JOB,5,CPU,CPU-PERCENTAGE,< %CPU> ;;PERCENTAGE OF THE CPU
XX 10,DEV,6,DEVN,DEVICE,<Device> ;;DEVICE
XX 30,DEV,12,DEVC,DEVICE-DESIGNATOR,< Designator> ;;DESIGNATOR
XX 20,DEV,5,DEVJ,DEVICE-OWNER,<Owner> ;;OWNER OF DEVICE
XX 40,DEV,15,DEVU,DEVICE-USER,< User> ;;USER OF DEVICE
XX 0,JOB,20,CDIR,DIRECTORY,<Connected directory> ;;DIRECTORY
XX 90,DSK,25,USTS,DISK-STATUS,<Disk status> ;;STATUS
XX 20,EQQ,3,QJOB,ENQ-BLOCK-CREATOR,<Job> ;;JOB WHICH MADE BLOCK
XX 25,EQQ,6,QPRG,ENQ-PROGRAM,< Prog> ;;PROGRAM NAME
XX 30,EQQ,7,QFLG,ENQ-STATUS,<Status> ;;QUEUE BLOCK STATUS
XX 60,FIL,140,FILE,FILE-NAME,< File name> ;;FILE NAME OF JFN
XX 40,FIL,10,BYTE,FILE-POINTER,<Pointer> ;;CURRENT FILE POINTER
XX 50,FIL,14,FSTA,FILE-STATUS,<Status> ;;STATUS OF JFN
XX 30,IPC,10,PIDF,FLAGS-FOR-PID,<Flags> ;;FLAGS
XX 80,TTY,25,TFLG,FLAGS-FOR-TERMINAL,<Flags> ;;TERMINAL FLAGS
XX 0,DLL,11,FLOW,FLOW-STATUS,<Flow status> ;;FLOW CONTROL
XX 0,JOB,15,FHST,FOREIGN-HOST,<Foreign host> ;;ARPANET HOST
XX 15,ANC,11,ACFS,FOREIGN-SOCKET,<Foreign soc> ;;FOREIGN SOCKET
XX 10,FRK,3,FORK,FORK,<Frk> ;;THE FORK NUMBER
XX 0,FRK,5,FFLG,FORK-FLAGS,<Flags> ;;FORK FLAGS
XX 80,FRK,10,RUN,FORK-RUNTIME,< Runtime> ;;RUNTIME OF FORK
XX 50,FRK,10,STAT,FORK-STATUS,<Status> ;;THE STATUS OF THE FORK
XX 0,JOB,5,FKS,FORKS-IN-JOB,<Forks> ;;NUMBER OF FORKS
XX 30,EQL,10,LRES,FREE-LOCKS,<Free locks> ;;FREE LOCKS LEFT
XX 40,STR,6,STPG,FREE-PAGES,< Free> ;;NUMBER OF FREE PAGES
XX 20,ANH,15,ANAM,HOST-NAME,<Host name> ;;NAME OF HOST
XX 10,ANH,11,AHST,HOST-NUMBER,<Host number> ;;HOST NUMBER
XX 50,ANH,30,ASTS,HOST-STATUS,<Status> ;;HOST STATUS
XX 40,ANH,14,ATYP,HOST-TYPE,<System type> ;;TYPE OF HOST
XX 70,JOB,6,IDLE,IDLE-TIME,< Idle> ;;IDLE TIME
XX 30,FIL,3,INIF,INITIALIZING-FORK,<Frk> ;;FORK WHICH STARTED JFN
XX 40,TTY,3,TINC,INPUT-CHARACTERS,< In> ;;CHARS IN INPUT
XX 0,FRK,5,INTD,INTERRUPT-DEFER-COUNT,<INTDF> ;;INTERRUPT DEFER
XX 10,FIL,3,JFN,JFN,<JFN> ;;JFN OF FILE
XX 10,JOB,3,JOB,JOB,<Job> ;;JOB NUMBER
XX 40,FRK,9,CALL,LAST-CALL,<Last call> ;;THE LAST JSYS DONE
XX 0,FRK,25,LERR,LAST-ERROR,< Last error> ;;LAST ERROR IN FORK
XX 40,EQL,6,LLVL,LEVEL-OF-LOCK,<Level> ;;LOCK LEVEL
XX 0,DLL,4,LKFK,LINK-FORK-OWNER,<Fork> ;;FORK OWNER OF LINK
XX 0,DLL,7,LKID,LINK-ID,<Link ID> ;;LINK ID
XX 10,DLL,3,LKJB,LINK-JOB-OWNER,<Job> ;;OWNER OF LINK
XX 20,DLL,7,LPRG,LINK-PROGRAM,<Program> ;;PROGRAM NAME FOR LINK
XX 70,DLL,9,LSTA,LINK-STATE,<State> ;;STATE
XX 30,DLL,7,LKTP,LINK-TYPE,< Type> ;;TYPE OF I/O
XX 90,DLL,15,LUSR,LINK-USER,< User> ;;USER
XX 0,JOB,15,LINK,LINKED-TERMINALS,<Links to TTY> ;;TERMINAL LINKS
XX 10,ANC,11,ACLS,LOCAL-SOCKET,<Local soc> ;;SOCKET NUMBER
XX 10,EQL,4,LLCK,LOCK-NUMBER,<Lock> ;;ENQ LOCK NUMBER
XX 0,FRK,24,CORE,MAPPED-PAGES,<Mapped pages> ;;PAGE MAP
XX 0,FRK,10,MPC,MONITOR-PC,<Monitor PC> ;;THE MONITOR PC
XX 20,STR,5,STMC,MOUNT-COUNT,<Mount> ;;NUMBER OF MOUNTS
XX 0,ANC,9,ABTA,NCP-BIT-ALLOCATION,<Bit alloc> ;;ALLOCATION OF BITS
XX 30,ANC,10,ACBT,NCP-BITS-TRANSFERED,<Bits trans> ;;BITS SENT
XX 40,ANC,15,ACFH,NCP-FOREIGN-HOST,<Foreign host> ;;HOST
XX 0,ANC,9,AMSA,NCP-MESSAGE-ALLOC,<Msg alloc> ;;ALLOCATION OF MSGS
XX 20,ANC,3,ACVT,NCP-NVT,<NVT> ;;NETWORK VIRTUAL TERMINAL
XX 50,ANC,5,ASTE,NCP-STATE,<State> ;;STATE OF NCP CONNECTION
XX 50,DSK,4,LUNT,NUMBER-OF-PACK,<Pack> ;;PACK NUMBER
XX 10,TTY,3,TNUM,NUMBER-OF-TERMINAL,<TTY> ;;TERMINAL
XX 40,DLL,6,LOBJ,OBJECT-NAME,<Object> ;;OBJECT NAME
XX 20,FIL,7,OFN,OFN,< OFN> ;;THE OFNS OF THE FILE
XX 0,ANC,22,APRS,OLD-NSP-STATES,<Previous states> ;;OLD STATES
XX 30,STR,5,STOF,OPEN-FILE-COUNT,<Files> ;;NUMBER OF FILES OPEN
XX 50,TTY,3,TOUC,OUTPUT-CHARACTERS,<Out> ;;CHARS IN OUTPUT
XX 10,IPC,3,PIDJ,OWNER-OF-PID,<Job> ;;JOB WHICH OWNS PID
XX 20,TTY,3,TJOB,OWNER-OF-TERMINAL,<Job> ;;JOB OWNING TTY
XX 10,EQQ,4,QLCK,OWNING-LOCK,<Lock> ;;LOCK WHICH OWNS QUEUE
XX 0,IPC,7,RECC,PACKETS-TO-READ,<Packets> ;;NUMBER OF PACKETS
XX 0,FRK,12,TRPC,PAGE-TRAP-PC,<Page trap PC> ;;PC OF PAGE TRAPS
XX 60,FRK,6,TRAP,PAGE-TRAPS,<Ptraps> ;;NUMBER OF PAGE TRAPS
XX 30,FRK,10,UPC,PC,< User PC> ;;THE CURRENT USER PC
XX 20,IPC,13,PID,PID,< PID> ;;THE PID
XX 15,IPC,4,POWN,PID-FORK,<Fork> ;;FORK WHICH CREATED PID
XX 50,IPC,20,PNAM,PID-NAME,< Name> ;;NAME OF PID
XX 17,IPC,6,PPRG,PID-PROGRAM,< Prog> ;;PROGRAM RUNNING
XX 0,FRK,5,PRIV,PRIVILEGES,<Privs> ;;PRIVILEGES OF FORK
XX 30,JOB,7,PROG,PROGRAM,<Program> ;;PROGRAM NAME
XX 0,IPC,9,PQTA,QUOTAS,< Quotas> ;;SEND, RECEIVE QUOTAS
XX 0,DSK,12,RDER,READ-ERRORS,<Read errors> ;;NUMBER OF READ ERRORS
XX 70,DSK,8,READ,READS,< Reads> ;;DISK READS
XX 60,DLL,6,LHST,REMOTE-HOST-NAME,<Host> ;;REMOTE HOST
XX 0,DLL,9,LKIR,REMOTE-ID,<Remote ID> ;;REMOTE ID
XX 50,EQQ,10,QID,REQUEST-ID,<Request ID> ;;REQUEST ID
XX 50,JOB,9,JRUN,RUNTIME,< Runtime> ;;RUNTIME OF JOB
XX 0,JOB,5,JCLS,SCHEDULER-CLASS,<Class> ;;SCHEDULER CLASS
XX 0,FRK,16,SCHD,SCHEDULER-TEST,<Scheduler test> ;;FKSTAT WORD
XX 0,DSK,12,PSER,SEEK-ERRORS,<Seek errors> ;;NUMBER OF SEEK ERRORS
XX 60,DSK,8,SEEK,SEEKS,< Seeks> ;;DISK SEEKS
XX 45,STR,6,STSZ,SIZE-OF-STRUCTURE,< Size> ;;SIZE
XX 0,TTY,11,TSPD,SPEEDS,<Line speeds> ;;SPEED OF LINE
XX 40,JOB,5,JSTA,STATE,<State> ;;STATE JOB IS IN
XX 10,STR,9,STNM,STRUCTURE,<Structure> ;;STRUCTURE NAME
XX 50,STR,40,STST,STRUCTURE-STATUS,<Structure status> ;;STATUS
XX 20,FRK,3,SUP,SUPERIOR,<Sup> ;;THE SUPERIOR OF THE FORK
XX 0,DSK,8,SWAP,SWAPPING-SPACE,<Swapping> ;;SWAPPING SPACE
XX 40,IPC,10,SYSP,SYSTEM-PID,<System PID> ;;THE SYSTEM PID
XX 0,DLL,6,LTSK,TASK-NAME,<Task> ;;NAME OF TASK
XX 20,JOB,8,TERM,TERMINAL,<Terminal> ;;TERMINAL JOB IS ON
XX 50,EQL,13,LTIM,TIME-LOCK-OBTAINED,<Time locked> ;;TIME
XX 80,DLL,10,LSEG,TRANSMIT-RECEIVE-SEGMENT,<Trans Recv> ;COUNTERS
XX 70,TTY,15,TLNK,TTY-LINKS,<Links to TTY> ;;LINKS
XX 25,TTY,15,TUSR,TTY-USER,< User> ;;USER ON A TERMINAL
XX 0,DSK,4,TYPE,TYPE-OF-DISK,<Type> ;;TYPE OF DISK
XX 20,EQL,11,LTYP,TYPE-OF-LOCK,<Restriction> ;;TYPE OF ENQ LOCK
XX 30,TTY,9,TTYP,TYPE-OF-TERMINAL,<Type> ;;TERMINAL TYPE
XX 20,DSK,4,UNIT,UNIT,<Unit> ;;DISK UNIT
XX 80,JOB,15,USER,USER-NAME,< User> ;;USER NAME
XX 40,DSK,6,STR,VOLUME-ID,<Vol ID> ;;THE VOLUME NAME
XX 70,FRK,7,WSIZ,WORKING-SET-SIZE,<WS size> ;;WORKING SET SIZE
XX 0,DSK,12,WTER,WRITE-ERRORS,<Write errors> ;;WRITE ERRORS
XX 80,DSK,8,WRIT,WRITES,< Writes> ;;DISK WRITES
>
DEFINE XX(ORD,TYP,SIZE,DISP,NAME,HEAD),<
XWD [ASCIZ/NAME/],[ EXP TP.'TYP ;TYPE OF COLUMN
IFE <^D<ORD>>,< EXP 0> ;ORDERING DATA
IFN <^D<ORD>>,< XWD TP.'TYP,^D<ORD>>
EXP XX'DISP ;DISPATCH ADDRESS
EXP ^D<SIZE> ;WIDTH OF COLUMN
ASCIZ "HEAD"] ;HEADER TEXT
>
COLTAB: XWD COLNUM,COLNUM ;NUMBER OF ENTRIES
COLS ;EXPAND THE TABLE
COLNUM==.-COLTAB-1 ;NUMBER OF COLUMNS
SUBTTL DEFINITIONS OF THE STATISTICS
;TABLE OF ENTRIES TO BE TYPED. THE IMBEDDED XX MACRO HAS THE FOLLOWING
;ARGUMENTS:
;
; XX NAME,ROUTINE,INDEX
;
;WHERE NAME IS THE NAME OF THIS DATA (4 OR LESS LETTERS TO LOOK GOOD),
;ROUTINE IS THE CODE TO TYPE OUT THE DATA, AND INDEX IS THE INDEX INTO
;THE GETAB TABLE CONTAINING THE DATA.
DEFINE STATS,<
XX USED,DOPCT,32 ;;USED TIME AS PERCENTAGE
XX NRUN,DOAVG,13 ;;AVERAGE NUMBER OF RUNNABLE FORKS
XX DMRD,DODIF,4 ;;NUMBER OF DRUM READS
XX TTIN,DODIF,21 ;;NUMBER OF TERMINAL INPUT CHARACTERS
XX IDLE,DOPCT,0 ;;IDLE TIME AS PERCENTAGE
XX NBAL,DOAVG,12 ;;AVERAGE NUMBER OF FORKS IN BALANCE SET
XX DMWR,DODIF,5 ;;NUMBER OF DRUM WRITES
XX TTOU,DODIF,22 ;;NUMBER OF TERMINAL OUTPUT CHARACTERS
XX SWPW,DOPCT,1 ;;SWAP-WAIT TIME AS PERCENTAGE
XX BSWT,DOAVG,26 ;;AVERAGE NUMBER OF FORKS WAITING
XX DKRD,DODIF,6 ;;NUMBER OF DISK READS
XX WAKE,DODIF,10 ;;NUMBER OF PROCESS WAKEUPS
XX SKED,DOPCT,2 ;;SCHEDULAT OVERHEAD TIME AS PERCENTAGE
XX UPGS,DOAVG,37 ;;AVERAGE NUMBER OF PAGES IN BALANCE SET
XX DKWR,DODIF,7 ;;NUMBER OF DISK WRITES
XX TTCC,DODIF,11 ;;NUMBER OF TERMINAL INTERRUPTS
>
;NOW EXPAND THE TABLE PROPERLY:
DEFINE XX(NAME,ROUTINE,INDEX),<
XWD INDEX,[ASCIZ/NAME/]
>
XALL ;LET EXPANSION SHOW
STATTB: STATS ;GENERATE THE TABLE
STATNM==.-STATTB ;NUMBER OF ENTRIES
;NOW PRODUCE THE TABLE OF ROUTINES:
DEFINE XX(NAME,ROUTINE,INDEX),<
EXP ROUTINE ;CODE TO HANDLE NAME
>
STATCD: STATS ;GENERATE THE TABLE
SALL ;RETURN TO NORMAL LISTING
SUBTTL TABLE OF JSYSES AND UUOS
;THE FOLLOWING TABLE OF JSYSES IS PRODUCED BY EXPANDING THE
;MACRO DEFJS DEFINED IN UUOSYM. UNUSED JSYSES JUST STAY ZERO.
JSTABL: ;TABLE OF JSYS NAMES
IF1,< DEFINE DEFJS(NAME,NUMBER,FLAGS,EXTRA1,EXTRA2),<
JSYSMX==NUMBER ;;JUST FIND LAST DEFINED JSYS
>
JSLIST ;DO THE WORK
BLOCK JSYSMX+1 ;ALLOCATE SPACE FOR THE TABLE
>
IF2,< DEFINE DEFJS(NAME,NUMBER,FLAGS,EXTRA1,EXTRA2),<
XLIST ;;TURN OFF LISTING
IFG <NUMBER-JSYSMX>,<
BLOCK NUMBER-JSYSMX
> ;;LEAVE ROOM FOR GAPS
EXP SIXBIT/NAME/ ;;GENERATE THIS JSYS NAME
JSYSMX==NUMBER+1 ;;MOVE UP TO NEXT JSYS VALUE
LIST ;;RESUME LISTING
>
JSYSMX==0 ;INITIALIZE JSYS NUMBER
JSLIST ;GENERATE THE TABLE
>
UUOTAB: ;TABLE OF UUO NAMES
UU <CALL,INIT,UUO42,UUO43,UUO44,UUO45,UUO46,CALLI >
UU <OPEN,TTCALL,UUO52,UUO53,UUO54,RENAME,IN,OUT>
UU <SETSTS,STATO,GETSTS,STATZ,INBUF,OUTBUF,INPUT,OUTPUT>
UU <CLOSE,RELEAS,MTAPE,UGETF,USETI,USETO,LOOKUP,ENTER>
UU <UJEN>
TTCTAB: UU <INCHRW,OUTCHR,INCHRS,OUTSTR,INCHWL,INCHSL,GETLCH,SETLCH>
UU <RESCAN,CLRBFI,CLRBFO,SKPINC,SKPINL,TTCALL,TTCALL>
SUBTTL SYMBOLS TO BE SNOOPED FOR DISK STATISTICS
XALL ;LET EXPANSIONS SHOW
DEFINE XX(SYM,MOD<PHYSIO>),<
RADIX50 0,SYM ;;DEFINE RADIX50 VALUE OF SYMBOL
>
TBSUDB: USYMS ;TABLE OF SYMBOLS
NUMUDB==.-TBSUDB ;NUMBER OF SYMBOLS
DEFINE XX(SYM,MOD<PHYSIO>),<
RADIX50 0,MOD ;;PROGRAM NAME TO FIND SYMBOL IN
>
TBMUDB: USYMS ;TABLE OF PROGRAM NAMES
DEFINE XX(SYM,MOD<PHYSIO>),<
SYM: EXP 0 ;;DEFINE LOCATION FOR VALUE TO GO
>
TBVUDB: USYMS ;TABLE OF VALUES TO FILL IN
SALL ;RETURN TO NORMAL
SUBTTL ERROR CODE MNEMONICS
;THE FOLLOWING TABLE IS GENERATED BY EXPANDING THE .ERCOD MACRO
;IN MONSYM. IN PASS1, WE SIMPLY LOOK FOR THE HIGHEST ERROR CODE.
;IN PASS2, WE GENERATE THE TABLE.
IF1,<
DEFINE .ERR(NUMBER,NAME,TEXT),<
IFG <NUMBER-MAXERR>,<MAXERR==NUMBER>
>
MAXERR==0 ;START OFF HIGHEST ERROR NUMBER
.ERCOD ;EXPAND ERROR MACRO
ERRS: BLOCK MAXERR+1 ;LEAVE ROOM FOR THE ERRORS
>
IF2,<
DEFINE .ERR(NUMBER,NAME,TEXT),<
XLIST
RELOC ERRS+NUMBER
SIXBIT /NAME/
LIST
>
ERRS: .ERCOD ;GENERATE THE ERROR TABLE
RELOC ERRS+MAXERR+1 ;THEN RELOCATE TO PROPER PLACE
>
SUBTTL DATA STORAGE
LEVTAB: EXP CHNPC1 ;PLACE TO STORE PC
BLOCK 2 ;OTHER LEVELS UNUSED
CHTAB: XWD 1,TTYINT ;LEVEL 1, INTERRUPT ROUTINE
BLOCK .ICIFT-1 ;UNUSED CHANNELS
XWD 1,FRKINT ;LEVEL 1, INTERRUPT ROUTINE
BLOCK ^D36-.ICIFT ;OTHER CHANNELS UNUSED
;POINTERS TO THE RUNTIMES
XX==0 ;START OFF COUNTER AT ZERO
OLDRUN: REPEAT CPUAVG,<
Z RUNTIM+<XX*MAXJOB>(J)
XX==XX+1
>
;MESSAGE TO BE SENT TO QUASAR FOR QUEUE LISTING:
QSRMSG: XWD QSRLEN,.QOLIS ;TYPE OF FUNCTION AND LENGTH
XWD 0,'SYS' ;FLAGS AND 3 LETTER MNENOMIC
EXP 0 ;ACKNOWLEDGE WORD
QSRFL2: EXP 0 ;FLAGS FILLED IN LATER
EXP 1 ;ONE ARGUMENT BLOCK FOLLOWING
XWD 2,.LSQUE ;QUEUE BLOCK
QSRFL1: EXP 0 ;WHICH QUEUES TO LIST, FILLED IN LATER
QSRLEN==.-QSRMSG ;SIZE OF PACKET
;MESSAGE SENT TO SYSTEM INFO TO OBTAIN NAME OF A PID:
INFMSG: EXP .IPCIG ;FUNCTION TO RETURN NAME OF A PID
EXP 0 ;NO COPIES OF THE RESPONSE
INFDAT: EXP 0 ;FILLED IN LATER
PDL: BLOCK PDLSIZ ;STACK AREA
KWNJOB: BLOCK 1 ;JOB NUMBER A FORK BELONGS TO
LCLNOD: BLOCK 5 ;LOCAL NODE NAME
PCFLAG: BLOCK 1 ;THE PC FLAGS OF A FORK
PC: BLOCK 1 ;THE CURRENT PC OF A FORK
USERPC: BLOCK 1 ;THE USER MODE PC OF A FORK
HAVPC: BLOCK 1 ;SET IF PC STUFF IS AVAILABLE
HAVID: BLOCK 1 ;SET IF ID INFORMATION IS KNOWN
HAVALC: BLOCK 1 ;SET IF HAVE ALLOCATION INFO
STRALC: BLOCK 2 ;ALLOCATION INFORMATION
TTJBVL: BLOCK 1 ;TERMINAL TO JOB WORD IF NONNEGATIVE
JOBFRK: BLOCK 1 ;JOB FORK NUMBER WE ARE ON
FORK: BLOCK 1 ;SYSTEM FORK NUMBER WE ARE ON
THETTY: BLOCK 1 ;TERMINAL NUMBER DOING SINGLE DISPLAY ON
THEJOB: BLOCK 1 ;JOB NUMBER DOING SINGLE DISPLAY ON
TXTPTR: BLOCK 1 ;ADDRESS IN JSB OF ASCII TEXT
TXTMAX: BLOCK 1 ;MAXIMUM NUMBER OF WORDS IN STRING
TXTCTR: BLOCK 1 ;COUNTER INTO WHICH WORD OF TEXT WE ARE ON
JFNOFF: BLOCK 1 ;OFFSET INTO JSB OF A JFN BLOCK
JFN: BLOCK 1 ;JFN WE ARE TYPING OUT
TXTTMP: BLOCK 1 ;TEMPORARY WORD
SNPVAL: BLOCK 1 ;VALUE OF .SNOOP SYMBOL
MONADR: BLOCK 1 ;ADDRESS IN MONITOR OF SNOOP PAGE
TIMES: BLOCK CPUAVG ;TIMES DATA IN EACH TABLE WAS COMPUTED
RUNTIM: BLOCK MAXJOB*CPUAVG ;TABLE OF COLLECTED RUNTIMES
CURRUN: BLOCK MAXJOB ;CURRENT RUNTIMES OF THE JOBS
CLSTAB: BLOCK MAXJOB ;SCHEDULER CLASS EACH JOB IS IN
CLSNUM: BLOCK MAXCLS+1 ;NUMBER OF JOBS IN EACH CLASS
HANDLE: BLOCK 1 ;FORK HANDLE OF INFERIOR FORK
DEVUNT: BLOCK 1 ;JOB AND UNIT NUMBERS FOR A DEVICE
COLUMN: BLOCK 1 ;COLUMN COUNTER
REFLST: BLOCK 1 ;TIME OF LAST REFRESH
REFTIM: BLOCK 1 ;NUMBER OF MINUTES BETWEEN REFRESHES
SKPJFN: BLOCK 1 ;NUMBER OF JFNS TO BE SKIPPED
SKPFRK: BLOCK 1 ;NUMBER OF FORKS TO BE SKIPPED
CHNPC1: BLOCK 1 ;PC ON AN INTERRUPT
TTYFLG: BLOCK 1 ;USED TO STOP SLEEPS WHEN TTY COMMANDS TYPED
FRKFLG: BLOCK 1 ;USED TO STOP SLEEPS WHILE WAITING FOR EXEC
MAXRPF: BLOCK 1 ;FLAG FOR WHICH RUNTIME PERCENT CUTOFF IS USED
MAXRPT: BLOCK 1 ;MAXIMUM RUNTIME TO SUPPRESS FOR SHOWN JOBS
MAXIDL: BLOCK 1 ;MAXIMUM IDLE TIME FOR SHOWN JOBS
MAXIDF: BLOCK 1 ;FLAG FOR WHICH IDLE CUTOFF IS DONE
INTCNT: BLOCK 1 ;NUMBER OF CHARS IN INTERRUPT BUFFER
INTPTR: BLOCK 1 ;BYTE POINTER INTO BUFFER FOR INTERRUPT CODE
HLPJFN: BLOCK 1 ;JFN FOR HELP FILE
SBLK: BLOCK .MSRBT+1 ;ARGUMENT BLOCK FOR MSTR
STRUC: BLOCK 2 ;STRUCTURE NAME
ALIAS: BLOCK 2 ;ALIAS NAME
UDB: BLOCK UDBSIZ ;BLOCK FOR READING UDB INTO
CHAN: BLOCK 1 ;CHANNEL NUMBER UDB IS OF
CTRL: BLOCK 1 ;CONTROLLER NUMBER UDB IS OF
UNIT: BLOCK 1 ;UNIT NUMBER UDB IS OF
COLTYP: BLOCK 1 ;FOR HELP OUTPUT
COLDIS: BLOCK 1 ;FOR LOOPING THROUGH DISPLAYED COLUMNS
COLSUP: BLOCK 1 ;FOR LOOPING THROUGH SUPPRESSED COLUMNS
LSTTYP: BLOCK 1 ;LAST TYPE OF COLUMN TYPED OUT
HLPDSP: BLOCK 1 ;DISPATCH FOR SPECIAL HELP
COLHLC: BLOCK 1 ;AOBJN POINTER TO DISPLAYS TO GIVE HELP ON
PAGTIM: BLOCK 1 ;TIME AT WHICH NEXT SCROLLING IS DONE
PAGINT: BLOCK 1 ;AUTOMATIC SCROLLING INTERVAL
LNKNUM: BLOCK 1 ;NUMBER OF LOGICAL LINKS TO TYPE OUT
BEGTIM: BLOCK 1 ;UNIVERSAL TIME SYSTEM STARTED
INTBUF: BLOCK 1 ;BUFFER IN USE BY INTERRUPT CODE
RUNPTR: BLOCK 1 ;BYTE POINTER INTO BUFFER FOR RUNTIME CODE
SAVCHR: BLOCK 1 ;LAST CHARACTER READ OF A COMMAND
TAKJFN: BLOCK 1 ;JFN OF INDIRECT FILE
TAKLVL: BLOCK 1 ;DEPTH OF NESTED TAKE COMMANDS
TAKLBL: BLOCK 1 ;LABEL IN TAKE FILE WE'RE LOOKING FOR
TAKPTR: BLOCK TAKMAX+1 ;FILE POINTERS FOR EACH LEVEL OF TAKE FILES
TAKSVC: BLOCK TAKMAX+1 ;SAVED CHARACTERS AND RESCAN FLAG
RUNBUF: BLOCK 1 ;BUFFER IN USE BY RUNTIME CODE
BUFFS: BLOCK BUFNUM ;POINTERS TO TTY BUFFERS
BUFFER: BLOCK BUFNUM*BUFLEN ;BUFFER AREA FOR TTY INPUT
CTYNUM: BLOCK 1 ;TERMINAL NUMBER OF THE CTY
MYJOB: BLOCK 1 ;MY JOB NUMBER
MYUSER: BLOCK 1 ;MY USER NUMBER
MYNAME: BLOCK 1 ;MY PROGRAM NAME
OPRUSR: BLOCK 1 ;THE OPERATOR'S USER NUMBER
VIRGIN: BLOCK 1 ;COUNT OF TRIES TO GET MONITOR SYMBOLS
SLPTIM: BLOCK 1 ;TIME TO SLEEP BETWEEN UPDATES
HGHJOB: BLOCK 1 ;HIGHEST JOB SYSTEM HAS
HGHTTY: BLOCK 1 ;HIGHEST TERMINAL NUMBER SYSTEM HAS
TTYSTS: BLOCK 1 ;STATUS WORD OF A TERMINAL
LOKNUM: BLOCK 1 ;NUMBER OF CURRENT ENQ LOCK BEING DONE
ENQNUM: BLOCK 1 ;NUMBER OF CURRENT ENQ QUEUE BLOCK
LSTNUM: BLOCK 1 ;LAST LOCK NUMBER OUTPUT
PIDTAB: BLOCK PIDSIZ+1 ;STORAGE FOR PIDS OF A JOB
PIDJOB: BLOCK 1 ;JOB NUMBER READING PIDS OF
OLDJOB: BLOCK 1 ;PREVIOUS JOB WE PROCESSED
LOKTAB: BLOCK LCKMAX ;STORAGE FOR ENQ BLOCK POINTERS
BLK: BLOCK .JISTM+1 ;DATA FROM GETJI JSYS
TEMP: BLOCK TMPSIZ ;TEMPORARY STRING STORAGE
USERS: BLOCK USRSIZ ;LINKED LIST OF USERS TO SHOW
USRLST: BLOCK 1 ;ADDRESS OF FIRST USER TO SHOW
USRFRE: BLOCK 1 ;FIRST FREE WORD IN USERS ARRAY
BITS: BLOCK <MAXJOB/^D36>+1 ;BITS TO SUPPRESS SHOWING OF JOBS
NTIME: BLOCK 1 ;CURRENT UNIVERSAL FORMAT TIME
ACTTAB: BLOCK MAXTTY+1 ;TABLE OF ACTIVE TIMES FOR TERMINALS
IDLE: BLOCK MAXJOB ;NUMBER OF MINUTES OF IDLE TIME
ORUNTM: BLOCK MAXJOB ;OLD RUNTIMES OF JOBS
RUNDIF: BLOCK MAXJOB ;DIFFERENCE BETWEEN CURRENT AND OLD RUN TIME
CPUPER: BLOCK MAXJOB ;CALCULATED CPU PERCENTAGE
TIMDIF: BLOCK 1 ;TIME INTERVAL CPU TABLE USES
OTIME: BLOCK 1 ;TIME THAT OLD RUNTIMES WERE COMPUTED
TIMRUN: BLOCK MAXJOB ;TIMES THAT RUNTIMES CHANGED
OLDSTA: BLOCK STATNM ;OLD VALUES OF STATISTICS
OLDTIM: BLOCK 1 ;UPTIME THEY WERE COMPUTED
PAGE: BLOCK 1 ;PAGE NUMBER OF OUTPUT WE ARE ON
OLDPAG: BLOCK 1 ;SAVED VALUE OF PAGE WHILE SHOWING HELP
OVRLAP: BLOCK 1 ;NUMBER OF LINES OF OVERLAP WANTED
SLWTIM: BLOCK 1 ;TIMER FOR SLOWDOWN FEATURE
DEVNAM: BLOCK 2 ;DEVICE NAME BEING GRUNGED ON
NEWSTA: BLOCK STATNM ;NEW VALUES OF STATISTICS
NEWTIM: BLOCK 1 ;UPTIME THEY WERE COMPUTED
STADIF: BLOCK 1 ;DIFFERENCE BETWEEN OLDTIM AND NEWTIM
KBLK: BLOCK 10 ;BLOCK FOR CLASS SCHEDULER DATA
HDRTXT: BLOCK ^D50 ;TEXT OUTPUT AS HEADER
HDRPTR: BLOCK 1 ;BYTE POINTER INTO HEADER TEXT
HDRPOS: BLOCK 1 ;COLUMN POSITION WE ARE AT
HDRTYP: BLOCK 1 ;CURRENT TYPE OF HEADER
COLSEP: BLOCK DISNUM+1 ;SEPARATION TO USE BETWEEN COLUMNS
COLTBS: BLOCK 4 ;TAB STOPS FOR THIS OUTPUT
EATNUM: BLOCK 1 ;NUMBER OF LINES TO EAT
IDPGS: BLOCK 1 ;TOTAL PAGES IN USE BY A FORK
IDPAG: BLOCK 1 ;CURRENT PAGE OF FORK WE ARE LOOKING AT
IDNUM: BLOCK 1 ;NUMBER OF IDENTITIES IN TABLE
IDYNM: BLOCK 1 ;NUMBER OF IDENTITIES LEFT TO TYPE
TXTBUF: BLOCK TXTLEN ;STORAGE FOR CPYTXT ROUTINE
CURCOL: BLOCK 1 ;CURRENT COLUMN BEING OUTPUT
NXTCOL: BLOCK 1 ;NEXT COLUMN TO BE OUTPUT
COLDSP: BLOCK COLNUM+1 ;COLUMN OUTPUT DISPATCHES
ORDMIN: BLOCK 1 ;MINIMUM COLUMN NUMBER TO ALLOW
ORDVAL: BLOCK 1 ;CURRENT BEST VALUE FOR COLUMN
ORDHAV: BLOCK 1 ;WHICH COLUMN IS CURRENTLY BEST
ORDIDX: BLOCK 1 ;COUNTER THROUGH COLUMNS
QSRPID: BLOCK 1 ;PID OF QUASAR
MYPID: BLOCK 1 ;MY PID
INFPID: BLOCK 1 ;PID OF SYSTEM INFO
APANUM: BLOCK 1 ;ARPANET HOST NUMBER
APASTS: BLOCK 1 ;HOST STATUS. MUST FOLLOW APANUM!
PIDSYS: BLOCK PIDNUM ;TABLE OF SYSTEM PIDS
PRGWLD: BLOCK PRGMAX*3 ;STORAGE FOR PROGRAM NAMES TO SHOW
PRGNUM: BLOCK 1 ;NUMBER OF PROGRAM NAMES TO CHECK
MBLK: BLOCK 10 ;ARGUMENT BLOCK FOR IPCF JSYSES
ABLK: BLOCK .NCSTS+1 ;ARGUMENT BLOCK FOR ARPANET CONNECTIONS
MONSYV: BLOCK MAXSYM ;TABLE OF VALUES OF SYMBOLS
MONSYS: BLOCK MAXSYM ;TABLE OF SYMBOLS
MONSYO: BLOCK MAXSYM ;TABLE OF OFFSETS
MONSYC: BLOCK 1 ;NUMBER OF SYMBOLS IN TABLE
IDVALS: BLOCK 1000 ;TABLE OF IDENTITES OF FORK PAGES
IDCNTS: BLOCK 1000 ;NUMBER OF TIMES EACH IDENTITY WAS USED
RESDAT: BLOCK 2 ;DATA RETURNED ABOUT RESIDENT SPACE
ERRTOT: BLOCK 1 ;COUNTER FOR AGING ERROR CODES
ERRCNT: BLOCK 1 ;NUMBER OF ERROR CODES KNOWN
ERRCOD: BLOCK ERRNUM ;THE ERROR CODES WHICH ARE KNOWN
ERRAGE: BLOCK ERRNUM ;THE AGES OF EACH ERROR CODE
ERRTAB: BLOCK ERRNUM*ERRSIZ ;STRING STORAGE FOR THE ERRORS
END 3,,ENTRY ;ENTRY VECTOR