!++ ! FACILITY: SYSMON - Monitor the system ! ! ABSTRACT: ! This program displays working set info for each ! process and the image being run for each. It is ! interesting to note: which images require massive ! amounts of memory; what the peak memory needs are ! for a particular user; and how effective your working ! sets are tuned in general. ! ! ENVIRONMENT: VMS 4.x ! ! ! AUTHOR: Rand P. Hall ! Northeastern Univ. ! College of Engineering ! 360 Huntington Ave. ! Boston, Ma. ! ! CREATION DATE: May 1985 ! ! MODIFIED: ! November 1987 ! William A. Flatt ! Intercompany Pool ! E 1411 Mission Ave ! P.O.Box 3727 ! Spokane, WA 99220 ! ! CHANGED for variable number of display lines on terminals ! I.E. FALCO 5220 ! Set terminal to 132 column mode ! ! Non-DECCRT devices treated as hard copy ! ! Added process parameters ! Added system parameters ! ! Renamed from GETWS to SYSMON ! Added CLI interface ! ! VERSION ! 01 - original ! 02 - November 1987 !-- ! ! Options ! Selection of processes to show ! ! By Mode: ! /MODE=(ALL,INTERACTIVE,BATCH,NETWORK,OTHER) ! Value ! interactive 3 ! batch 2 ! network 1 ! other 0 ! /noprocess ! ! Notes: ! Default is All modes are shown. ! ! Any set of modes will show those modes only. ! (e.g. /MODE=INTERACTIVE will cause the interactive processes to show.) ! ! The modifier /NOPROCESS will suppress the process display. ! ! By User: ! /USER=XX...X ! ! Default is All users are shown. ! ! This may be a list of up to 10 users. This process will select them ! by comparing the list to the username for the process for the number ! of characters specified. ! ! SYSTEM is a valid user in this context. ! (e.g. /user=(sys,wwp) would select the processes for system and ! wwp.) ! ! By PROCESSname: ! /PROCESS=XX...X ! ! Default is All processes are (potentially) shown. ! ! This may be a list of up to 10 processes. SYSMON will select them ! by comparing the list to the processname for the process for the number ! of characters specified. ! ! ICP_ is a valid process name in this context. ! (e.g. /process=ICP_ would select all the processes whose processname ! began with "ICP_".) ! ! By process ID ! /ID=XX...X ! ! Default is All processes are (potentially) shown. ! ! This may be a list of up to 10 PIDs. SYSMON will select them ! by comparing the list to the PID for the process. An exact match is ! required. These will be input as hexidecimal numbers. If a list of ! Pids then enclosed in parentheses and separated by commas. ! ! On the first pass SYSMON will locate the processes in the list and ! build an internal list of them by position in the tables. ! Any non-existant process IDs will be listed. ! On subsequent passes the SYSMON will directly address the procees ! by position. ! When any specified process specified exits it will be noted and the ! internal list of process positions shortened by deleting that process. ! ! If (when) that list becomes empty and SYSMON is running interactively, ! then SYSMON will display the "SYSMON>" prompt and wait for further ! instructions. ! ! If (when) that list becomes empty and SYSMON is running ! non-interactively, then SYSMON will exit. ! ! ! Interval: ! /INTERVAL=n specifies the period in seconds between successive displays. ! If interval is not present the the system will repeat on successive ! prompts and quit on ctrl/Y, Ctrl/C, or Ctrl/Z. A new command string ! may also be entered as is the case for DEC's MONITOR after a CTRL/C. ! ! ! Beginning: ! /BEGINNING=absolute or delta time ! If specified then SYSMON will hibernate until the specified time. ! ! Ending: ! /ENDING=absolute or delta time ! If specified then SYSMON will exit after the specified time passes. ! If /ENDING is specified and /INTERVAL is omitted ! then /INTERVAL=60 is implied. ! ! Output: ! /OUTPUT=FILEname or device ! If omitted then SYS$OUTPUT is implied. ! ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! After the initial display the system will select changed processes based ! changes to those processes. ! ! Default is for changes to ppgcnt (process page count) to be shown. ! ! /changes=XXXXX ! ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - PROGRAM SYSMON implicit none include '($ssdef)' include '($jpidef)' include '($clidef)' include '($dvidef)' ! include '($syidef)' include '($stsdef)' include '($rmsdef)' INCLUDE '($LNMDEF)' integer*4 maxproc parameter (maxproc = 100) structure /itmlist/ !For getjpi itemlist. union map integer*2 bufferlen integer*2 itemcode integer*4 bufferaddr integer*4 lengthaddr end map map integer*4 endlist end map end union end structure record /itmlist/ syi_list(3) record /itmlist/ jpi_list(23) record /itmlist/ dvi_list(6) record /itmlist/ lnm_list(2) structure /iosblk/ INTEGER*4 STS, RESERVED end structure record /iosblk/ iosb character username*12,imagname*80,outstring*10,clear(6) character prcnam*15 integer*4 dfwscnt,wsquota,wsextent,wssize,wspeak,seedpid integer*4 ppgcnt,gpgcnt,imagname_addr,e,totalmem integer*4 imagecount,state,pageflts,bufio,dirio,cputim integer*4 proc_index,pid,pri,prib,mode integer*4 username_l,dfwscnt_l,wsquota_l,wssize_l integer*4 wspeak_l,ppgcnt_l,gpgcnt_l,wsextent_l integer*4 prcnam_l integer*4 status,bracket,period,str$left,str$right,str$trim integer*4 grp,grp_l integer*2 imagname_l character username_old(maxproc)*12, imagname_old(maxproc)*80, 2 outstring_old(maxproc)*10 character prcnam_old(maxproc)*15 character*23 ASCTIM integer*4 imagecount_old(maxproc), state_old(maxproc), 1 pageflts_old(maxproc), bufio_old(maxproc), 2 dirio_old(maxproc), cputim_old(maxproc) integer*4 dfwscnt_old(maxproc), wsquota_old(maxproc), 2 wsextent_old(maxproc), wssize_old(maxproc), 3 wspeak_old(maxproc), grp_old(maxproc), 4 pid_old(maxproc),pri_old(maxproc),prib_old(maxproc), 5 mode_old(maxproc) integer*4 ppgcnt_old(maxproc), gpgcnt_old(maxproc), 2 totalmem_old(maxproc) integer*4 ASCTIM_L, CVTFLG integer*4 I integer*4 J integer*4 k integer*4 old_proc_index integer*4 passes integer*4 SUM_MEM integer*4 SUM_PPGCNT integer*4 SUM_GPGCNT INTEGER*4 TOTMEM INTEGER*4 FREECNT INTEGER*4 MFYCNT INTEGER*4 VMSMEM INTEGER*4 INUSEMEM INTEGER*4 AWSTIME INTEGER*4 BORROWLIM INTEGER*4 GROWLIM INTEGER*4 PFRATH INTEGER*4 PFRATL INTEGER*4 WSDEC INTEGER*4 WSINC INTEGER*4 IOTA INTEGER*4 AWSMIN INTEGER*4 QUAN INTEGER*4 DMASIZE INTEGER*4 THRESH INTEGER*4 SWPPGCNT INTEGER*4 PROCCNT INTEGER*4 IJOBCNT INTEGER*4 BJOBCNT INTEGER*4 NJOBCNT character esc logical*1 changed logical*1 pass1 data clear /27,'[',72,27,'[',74/ !Esc sequence to clear screen. data esc /27/ data pass1 /.true./ ! State codes Ref: sys$library:lib.mlb ($statedef) CHARACTER*5 STATES(0:14) 1 /'OPEN ','COLPG','MWAIT','CEF ','PFW ','LEF ', 2 'LEFO ','HIB ','HIBO ','SUSP ','SUSO', 3 'FPG ','COM ','COMO ','CUR '/ CHARACTER*1 MODES(0:3) ! Process modes 1 /' ','N','B','I'/ CHARACTER*11 MODE_NAME(0:3) ! Process modes 1 /'OTHER ','NETWORK','BATCH','INTERACTIVE'/ INTEGER*2 LEN_MODE_NAME(0:3) 1 / 5, 7, 5, 11 / ! DEVICE stuff INTEGER*4 DEVTYPE,TT_PAGE,TT_SCOPE,TT_DECCRT,DEVBUFSIZ LOGICAL*1 SELF ! TRUE is output to terminal ! as SYS$OUTPUT COMMON /CRT_COMMON/ 1 DEVTYPE,TT_PAGE,TT_SCOPE,TT_DECCRT,DEVBUFSIZ, 2 SELF ! DCL Command stuff INTEGER*4 LIB$GET_FOREIGN INTEGER*4 CLI$DCL_PARSE INTEGER*4 LIB$GET_INPUT INTEGER*4 LIB$ADDX INTEGER*4 LIB$SUBX CHARACTER*255 CMDLINE INTEGER*2 CL_LEN INTEGER*4 CLI$GET_VALUE, CLI$PRESENT, STS CHARACTER*63 PARAMETER EXTERNAL SYSMON_CLD EXTERNAL CLI$_ABSENT EXTERNAL CLI$_COMMA EXTERNAL CLI$_CONCAT EXTERNAL CLI$_DEFAULTED EXTERNAL CLI$_LOCPRES EXTERNAL CLI$_NEGATED EXTERNAL CLI$_PRESENT EXTERNAL SYSMON_RESET_CLOSE,SYSMON_CLOSE EXTERNAL G_SCHDWK EXTERNAL SYI$_NODENAME EXTERNAL SYI$_VERSION EXTERNAL LIB$PUT_OUTPUT EXTERNAL LIB$GET_INPUT ! Options Stuff LOGICAL*1 LIST_MODE(0:3) LOGICAL*1 SHOW_PROCESS LOGICAL*1 SHOW_SUBPROCESS CHARACTER*64 OUTPUT_FILE INTEGER*4 LEN_OUTPUT_FILE CHARACTER*64 OUTPUT_OLD INTEGER*4 LEN_OUTPUT_OLD CHARACTER*132 BUFFER INTEGER*4 LEN_BUFFER CHARACTER*10 TEMP INTEGER*4 LEN_TEMP REAL*4 WAIT_INTERVAL CHARACTER*32 BEGINNING INTEGER*4 LEN_BEGINNING CHARACTER*32 ENDING INTEGER*4 LEN_ENDING CHARACTER*6 MODNAM /'SYSMON'/ INTEGER*4 TIME_BEGIN(2) ! Quadword binary time INTEGER*4 TIME_END(2) ! Quadword binary time to quit INTEGER*4 TIME_NOW(2) ! Quadword binary time now INTEGER*4 TIME_DIFF(2) ! Quadword TIME_END - TIME_NOW ! List Options stuff ! By Process ID format /ID=(PID1,PID2,...PIDn) INTEGER*4 MAX_PID PARAMETER (MAX_PID = 10) ! Maximum number of PIDs in list LOGICAL*1 BY_PID ! TRUE for selection by PID INTEGER*4 NUM_PIDS ! Number of pids in list CHARACTER*8 PID_LIST_CHAR(MAX_PID) ! List of PIDS in display hex INTEGER*4 PID_LIST(MAX_PID) ! List of PIDS INTEGER*4 PID_INDEX(MAX_PID) ! List of PID indexes INTEGER*4 PID_LEN(MAX_PID) ! Length of PID_LIST_CHAR terms INTEGER*2 I_PID ! INDEX to these PID things INTEGER*2 NO_PIDS ! Number of pids given, missing ! By USER NAME format /USER=(USERNAME1,USERNAME2,...USERNAMEn) INTEGER*4 MAX_USER PARAMETER (MAX_USER=10) ! Max number usernames in list ! LOGICAL*1 BY_USER ! TRUE for selection by USER INTEGER*4 NUM_USERS ! Number of user names CHARACTER*12 USER_NAME_LIST(MAX_USER)! List of usernames INTEGER*2 USER_LEN(MAX_USER) ! Length of usernames ! By PROCESS NAME format /PROCESS=(PROCESSNAME1,PROCESSNAME2,...PROCESSNAMEn) INTEGER*4 MAX_PROC PARAMETER (MAX_PROC=10) ! Maximum number of processnames ! in list LOGICAL*1 BY_PROCNAME ! TRUE for selection by Procname INTEGER*4 NUM_PROCNAMES ! Number of procnames CHARACTER*15 PROC_NAME_LIST(MAX_PROC)! List of procnames INTEGER*2 PROC_LEN(MAX_PROC) ! Length of procnames ! --------------------------------------------------------------------- ! SELECTION for Re-display ! format /SELECT=(MEMORY,GCNT,PCNT,FAULTS,DIRIO,BUFIO) ! --------------------------------------------------------------------- INTEGER*4 MAX_SELECT PARAMETER (MAX_SELECT=6) ! Maximum number of SELECTION ! alternatives LOGICAL*1 NO_SELECTION ! TRUE for no SELECTION LOGICAL*1 SELECT(MAX_SELECT) ! Selection table ! --------- ! OLD state ! --------- LOGICAL*1 OLD ! ----------- ! Verb Names ! ----------- CHARACTER*10 VERB INTEGER*2 VERB_LEN ! ---------------------------------------------------- ! DLB Stuff ! Dynamic load balancer option /[NO]DLB ! Displays some system generation dynamic parameters ! at the top of the screen and the value of the ! DLB_STATUS_INFO logical name ! ---------------------------------------------------- LOGICAL*1 DLB INTEGER*2 SCROLL_TOP ! top line of scrolling window INTEGER*2 SCROLL_WINDOW ! scrolling window in lines CHARACTER*80 DLB_STATUS INTEGER*4 DLB_STATUS_LEN ! ---------------------------- ! System NODENAME, VMS VERSION ! ---------------------------- CHARACTER*15 NODENAME INTEGER*4 NODENAME_LEN CHARACTER*8 VERSION INTEGER*4 VERSION_LEN CHARACTER*3 ANSWER CHARACTER*1 ASKIP ! --------- ! FUNCTIONS ! --------- INTEGER*4 SETIMR INTEGER*4 EXTRACT INTEGER*4 SYS$GETJPIW ! GET Job Process Information INTEGER*4 SYS$GETDVIW ! GET DeVIce Information INTEGER*4 SYS$GETSYIW ! GET SYstem Information INTEGER*4 SYS$ASCTIM ! ASCii TIMe INTEGER*4 SYS$BINTIM ! Get BINary TIMe INTEGER*4 SYS$SCHDWK ! SCHedule WaKeup INTEGER*4 SYS$TRNLNM ! TRaNslate Logical NaMe ! SET UP defaults OLD = .TRUE. ! EXTRACT COMMAND LINE DATA STS = LIB$GET_FOREIGN (CMDLINE, , CL_LEN) IF (.NOT. STS) CALL LIB$SIGNAL (%VAL(STS)) 100 CL_LEN = MAX (1,CL_LEN) STS = CLI$DCL_PARSE ('SYSMON '//CMDLINE(1:CL_LEN), 2 SYSMON_CLD, LIB$GET_INPUT) IF (.NOT. STS) GO TO 700 ! You get another chance ! ----------------------------------------------------------- ! Interval (Period to wait before repeating the scan of data) ! ----------------------------------------------------------- 120 STS = CLI$PRESENT ('INTERVAL') IF (STS .EQ. %LOC(CLI$_PRESENT)) THEN STS = CLI$GET_VALUE ('INTERVAL', TEMP, LEN_TEMP) READ (TEMP, '(F.0)') WAIT_INTERVAL ELSE WAIT_INTERVAL=0.0 ! No repeating requested ENDIF ! ------------------------------------------------------------------- ! MODE (kind of process i.e. 'OTHER ','NETWORK','BATCH','INTERACTIVE' ! ------------------------------------------------------------------- STS = CLI$PRESENT ('PROCESS') IF (STS .EQ. %LOC(CLI$_NEGATED)) THEN SHOW_PROCESS = .FALSE. ELSE SHOW_PROCESS = .TRUE. STS = CLI$PRESENT ('MODE') IF (STS .EQ. %LOC(CLI$_PRESENT)) THEN STS = CLI$PRESENT ('MODE.ALL') IF (STS .EQ. %LOC(CLI$_PRESENT)) THEN LIST_MODE(0) = .TRUE. LIST_MODE(1) = .TRUE. LIST_MODE(2) = .TRUE. LIST_MODE(3) = .TRUE. ELSE ! MODE=(ALL) i.e. selective DO I = 0, 3 STS = CLI$PRESENT 1 ('MODE.'//MODE_NAME(I)(:LEN_MODE_NAME(I))) LIST_MODE(I) = STS .EQ. %LOC(CLI$_PRESENT) ENDDO ENDIF STS = CLI$PRESENT ('SUBPROCESS') SHOW_SUBPROCESS = STS .EQ. %LOC(CLI$_PRESENT) ELSE LIST_MODE(0) = .TRUE. LIST_MODE(1) = .TRUE. LIST_MODE(2) = .TRUE. LIST_MODE(3) = .TRUE. ENDIF ENDIF ! ---------------------------- ! LooK for the process ID list ! ---------------------------- STS = CLI$PRESENT ('ID') IF (STS .EQ. %LOC(CLI$_PRESENT)) THEN BY_PID = .TRUE. NUM_PIDS = 0 STS = %LOC(CLI$_COMMA) DO WHILE (STS .EQ. %LOC(CLI$_COMMA) .OR. 1 STS .EQ. %LOC(CLI$_CONCAT)) IF (NUM_PIDS .LT. MAX_PID) THEN NUM_PIDS = NUM_PIDS + 1 STS = CLI$GET_VALUE 1 ('ID', PID_LIST_CHAR(NUM_PIDS), PID_LEN(NUM_PIDS)) ELSE WRITE (*, '(1X,A)') 'Too Many IDs - excess ignored' STS = SS$_NORMAL ENDIF ENDDO IF (STS .EQ. SS$_NORMAL) THEN ! Last or only value gets normal DO I = 1, NUM_PIDS READ (PID_LIST_CHAR(I)(1:PID_LEN(I)), ! Hex pid element 1 '(Z)', ! Length dependant format 2 IOSTAT = STS) ! Check for success 3 PID_LIST(I) ! Output integer PID IF (STS .NE. 0) THEN ! Test status WRITE (*, '(1X,A)') 1 'BAD PID of '//PID_LIST_CHAR(I)(1:PID_LEN(I)) GO TO 700 ENDIF ENDDO ELSE IF (STS .EQ. %LOC(CLI$_ABSENT)) THEN BY_PID = .FALSE. NUM_PIDS = 0 ENDIF ENDIF ELSE IF (STS .EQ. %LOC(CLI$_NEGATED) .OR. 2 STS .EQ. %LOC(CLI$_ABSENT)) THEN BY_PID = .FALSE. NUM_PIDS = 0 ENDIF ! ------------------------------ ! LooK for the process name list ! ------------------------------ STS = CLI$PRESENT ('PROCESS') IF (STS .EQ. %LOC(CLI$_PRESENT)) THEN SHOW_PROCESS = .TRUE. NUM_PROCNAMES = 0 STS = %LOC(CLI$_COMMA) DO WHILE (STS .EQ. %LOC(CLI$_COMMA) .OR. 1 STS .EQ. %LOC(CLI$_CONCAT)) IF (NUM_PROCNAMES .LT. MAX_PROC) THEN NUM_PROCNAMES = NUM_PROCNAMES + 1 STS = CLI$GET_VALUE 1 ('PROCESS', 2 PROC_NAME_LIST(NUM_PROCNAMES), 3 PROC_LEN(NUM_PROCNAMES)) ELSE WRITE (*, '(1X,A)') 1 'Too many process names - excess ignored' STS = SS$_NORMAL ENDIF ENDDO IF (STS .EQ. %LOC(CLI$_ABSENT)) THEN BY_PROCNAME = .FALSE. ELSE IF (STS .EQ. SS$_NORMAL) THEN BY_PROCNAME = .TRUE. ELSE WRITE (*, '(1X,A)') 1 'PROCESS get value error '// 2 PROC_NAME_LIST(NUM_PROCNAMES)(:PROC_LEN(NUM_PROCNAMES)) GO TO 700 ENDIF ELSE IF (STS .EQ. %LOC(CLI$_NEGATED)) THEN BY_PROCNAME = .FALSE. SHOW_PROCESS = .FALSE. ENDIF ! --------------------------- ! LooK for the USER name list ! ---------------------------- STS = CLI$PRESENT ('USER') IF (STS .EQ. %LOC(CLI$_NEGATED) .OR. 2 STS .EQ. %LOC(CLI$_ABSENT)) THEN BY_USER = .FALSE. ELSE IF (STS .EQ. %LOC(CLI$_PRESENT)) THEN NUM_USERS = 0 BY_USER = .TRUE. SHOW_PROCESS = .TRUE. STS = %LOC(CLI$_COMMA) DO WHILE (STS .EQ. %LOC(CLI$_COMMA) .OR. 1 STS .EQ. %LOC(CLI$_CONCAT)) IF (NUM_USERS .LT. MAX_USER) THEN NUM_USERS = NUM_USERS + 1 STS = CLI$GET_VALUE 1 ('USER', 2 USER_NAME_LIST(NUM_USERS), 3 USER_LEN(NUM_USERS)) ELSE WRITE (*, '(1X,A)') 1 'Too many user names - excess ignored' STS = SS$_NORMAL ENDIF ENDDO IF (STS .EQ. %LOC(CLI$_ABSENT)) THEN BY_USER = .FALSE. ELSE IF (STS .EQ. SS$_NORMAL) THEN BY_USER = .TRUE. ELSE WRITE (*, '(1X,A)') 1 'USER get value error '// 2 USER_NAME_LIST(NUM_USERS)(:USER_LEN(NUM_USERS)) GO TO 700 ENDIF ELSE IF (STS .EQ. %LOC(CLI$_NEGATED)) THEN BY_USER = .FALSE. SHOW_PROCESS = .FALSE. ENDIF ! ----------------------------------------------------------------------------- ! Selection i.e. what in a process must change for that the process is to be ! listed during the repeat scan. During the repeat display the ! previous state of the process will be listed followed by its current ! state. ! /SELECT=(MEMORY,GCNT,PCNT,FAULTS,DIRIO,BUFIO) ! ! To suppress selection the negative may be coded to indicate no ! selection. In that case the print of the before state will be ! Suppressed. ! /NOSELECT ! ----------------------------------------------------------------------------- STS = CLI$PRESENT ('SELECT') NO_SELECTION = .FALSE. IF (STS .EQ. %LOC(CLI$_PRESENT)) THEN SELECT(1) = 1 CLI$PRESENT ('SELECT.MEMORY') .EQ. %LOC(CLI$_PRESENT) SELECT(2) = 1 CLI$PRESENT ('SELECT.GCNT') .EQ. %LOC(CLI$_PRESENT) SELECT(3) = 1 CLI$PRESENT ('SELECT.PCNT') .EQ. %LOC(CLI$_PRESENT) SELECT(4) = 1 CLI$PRESENT ('SELECT.FAULTS') .EQ. %LOC(CLI$_PRESENT) SELECT(5) = 1 CLI$PRESENT ('SELECT.DIRIO') .EQ. %LOC(CLI$_PRESENT) SELECT(6) = 1 CLI$PRESENT ('SELECT.BUFIO') .EQ. %LOC(CLI$_PRESENT) ELSE SELECT (2) = .FALSE. SELECT (3) = .FALSE. SELECT (4) = .FALSE. SELECT (5) = .FALSE. SELECT (6) = .FALSE. IF (STS .EQ. %LOC(CLI$_ABSENT) .OR. 1 STS .EQ. %LOC(CLI$_DEFAULTED)) THEN SELECT (1) = .TRUE. ELSE IF (STS .EQ. %LOC(CLI$_NEGATED)) THEN SELECT (1) = .FALSE. NO_SELECTION = .TRUE. ELSE WRITE (*,'(1X, A)') 'SELECT error' ENDIF ENDIF ! -------------------------- ! DLB Dynamic load balancer ! -------------------------- STS = CLI$PRESENT ('DLB') IF (STS .EQ. %LOC(CLI$_PRESENT)) THEN DLB = .TRUE. ELSE IF (STS .EQ. %LOC(CLI$_NEGATED)) THEN DLB = .FALSE. ENDIF ! --------------------------------------------- ! OLD Display previous states of the processes ! --------------------------------------------- STS = CLI$PRESENT ('OLD') IF (STS .EQ. %LOC(CLI$_PRESENT)) THEN OLD = .TRUE. ELSE IF (STS .EQ. %LOC(CLI$_NEGATED)) THEN OLD = .FALSE. ENDIF ! ----------- ! ENDING TIME ! ----------- STS = CLI$PRESENT ('ENDING') IF (STS .EQ. %LOC(CLI$_PRESENT)) THEN STS = CLI$GET_VALUE ('ENDING', ENDING, LEN_ENDING) STS = SYS$BINTIM (ENDING(:LEN_ENDING), TIME_END) ! STS = SETIMR (0, TIME_END, %LOC(SYSMON_CLOSE), 0) ! IF (STS .NE. SS$_NORMAL) THEN ! Error? ! CALL FORPREMSG(MODNAM, 4, 0, G_SCHDWK, %VAL(STS)) ! CALL EXIT ! END IF e = sys$asctim (ASCTIM_L, ASCTIM,, CVTFLG) ! Current time in ASCII CALL SYS$BINTIM (ASCTIM, TIME_NOW) ! Convert to binary time e = LIB$SUBX (TIME_NOW, TIME_END, TIME_END) ! Convert ending delta time ! to absolute time. ! Note: Delta time is negative ! therefore subtract. IF (WAIT_INTERVAL .EQ. 0.0) WAIT_INTERVAL = 60.0 ! /ENDING= implies periodic ENDIF ! -------------- ! BEGINNING TIME ! -------------- STS = CLI$PRESENT ('BEGINNING') IF (STS .EQ. %LOC(CLI$_PRESENT)) THEN STS = CLI$GET_VALUE ('BEGINNING', BEGINNING, LEN_BEGINNING) STS = SYS$BINTIM (BEGINNING(:LEN_BEGINNING), TIME_BEGIN) ! Set timer for given period. IF (STS .NE. SS$_NORMAL) THEN ! Error? CALL FORPREMSG(MODNAM, 4, 0, G_SCHDWK, %VAL(STS)) CALL EXIT END IF STS = SYS$SCHDWK (,, TIME_BEGIN,) ! Sched a wake up call.. IF (STS .NE. SS$_NORMAL) THEN ! Error? CALL FORPREMSG(MODNAM, 4, 0, G_SCHDWK, %VAL(STS)) CALL EXIT END IF WRITE (*, 3) 3 FORMAT (' SYSMON-I-HIB Hibernating until specified time.') CALL SYS$HIBER ! Go to sleep ENDIF ! ----------- ! OUTPUT FILE ! ----------- STS = CLI$GET_VALUE ('OUTPUT', OUTPUT_FILE, LEN_OUTPUT_FILE) IF (LEN_OUTPUT_OLD .GT. 0) THEN ! /OUTPUT was defined ! before IF (OUTPUT_FILE(:LEN_OUTPUT_FILE) .NE. 2 OUTPUT_OLD(:LEN_OUTPUT_OLD)) THEN ! /OUTPUT has changed CLOSE (6) ! Close old OUTPUT file LEN_OUTPUT_OLD = 0 ! Mark as no old ENDIF ELSE OPEN (UNIT=5, FILE = 'SYS$INPUT', RECL=133, 1 CARRIAGECONTROL = 'NONE', STATUS = 'OLD') ! First pass open input ENDIF IF (LEN_OUTPUT_OLD .EQ. 0) THEN ! /OUTPUT was defined OPEN (UNIT=6, FILE = OUTPUT_FILE(:LEN_OUTPUT_FILE), 1 RECL=133, CARRIAGECONTROL = 'FORTRAN', STATUS = 'NEW') OUTPUT_OLD = OUTPUT_FILE(:LEN_OUTPUT_FILE) ! Store OUTPUT_FILE data LEN_OUTPUT_OLD = LEN_OUTPUT_FILE SELF = OUTPUT_FILE(:LEN_OUTPUT_FILE) .EQ. 'SYS$OUTPUT' ENDIF ! Set up getjpi itemlist. jpi_list(1).bufferlen=12 jpi_list(1).itemcode=jpi$_username jpi_list(1).bufferaddr=%loc(username) jpi_list(2).bufferlen=4 jpi_list(2).itemcode=jpi$_dfwscnt jpi_list(2).bufferaddr=%loc(dfwscnt) jpi_list(3).bufferlen=4 jpi_list(3).itemcode=jpi$_wsquota jpi_list(3).bufferaddr=%loc(wsquota) jpi_list(4).bufferlen=4 jpi_list(4).itemcode=jpi$_wsextent jpi_list(4).bufferaddr=%loc(wsextent) jpi_list(5).bufferlen=4 jpi_list(5).itemcode=jpi$_wssize jpi_list(5).bufferaddr=%loc(wssize) jpi_list(6).bufferlen=4 jpi_list(6).itemcode=jpi$_wspeak jpi_list(6).bufferaddr=%loc(wspeak) jpi_list(7).bufferlen=4 jpi_list(7).itemcode=jpi$_ppgcnt jpi_list(7).bufferaddr=%loc(ppgcnt) jpi_list(8).bufferlen=4 jpi_list(8).itemcode=jpi$_gpgcnt jpi_list(8).bufferaddr=%loc(gpgcnt) jpi_list(9).bufferlen=60 jpi_list(9).itemcode=jpi$_imagname jpi_list(9).bufferaddr=%loc(imagname) jpi_list(9).lengthaddr=%loc(imagname_l) jpi_list(10).bufferlen=4 jpi_list(10).itemcode=jpi$_grp jpi_list(10).bufferaddr=%loc(grp) jpi_list(10).lengthaddr=%loc(grp_l) jpi_list(11).bufferlen=15 ! process name jpi_list(11).itemcode=jpi$_prcnam ! jpi_list(11).bufferaddr=%loc(prcnam) jpi_list(11).lengthaddr=%loc(prcnam_l) jpi_list(12).bufferlen=4 jpi_list(12).itemcode=jpi$_imagecount jpi_list(12).bufferaddr=%loc(imagecount) jpi_list(13).bufferlen=4 jpi_list(13).itemcode=jpi$_state jpi_list(13).bufferaddr=%loc(state) jpi_list(14).bufferlen=4 jpi_list(14).itemcode=jpi$_pageflts jpi_list(14).bufferaddr=%loc(pageflts) jpi_list(15).bufferlen=4 jpi_list(15).itemcode=jpi$_bufio jpi_list(15).bufferaddr=%loc(bufio) jpi_list(16).bufferlen=4 jpi_list(16).itemcode=jpi$_dirio jpi_list(16).bufferaddr=%loc(dirio) jpi_list(17).bufferlen=4 jpi_list(17).itemcode=jpi$_cputim jpi_list(17).bufferaddr=%loc(cputim) jpi_list(18).bufferlen=4 jpi_list(18).itemcode=jpi$_pid jpi_list(18).bufferaddr=%loc(pid) jpi_list(19).bufferlen=4 jpi_list(19).itemcode=jpi$_pri jpi_list(19).bufferaddr=%loc(pri) jpi_list(20).bufferlen=4 jpi_list(20).itemcode=jpi$_prib jpi_list(20).bufferaddr=%loc(prib) jpi_list(21).bufferlen=4 ! process index jpi_list(21).itemcode=jpi$_proc_index ! jpi_list(21).bufferaddr=%loc(proc_index) jpi_list(22).bufferlen=4 ! process mode jpi_list(22).itemcode=jpi$_mode ! Other = 0 Network = 1 jpi_list(22).bufferaddr=%loc(mode) ! Batch = 2 Interactive = 3 jpi_list(23).endlist=jpi$c_listend seedpid=-1 ! Wildcard pid context. pass1 = .true. ASKIP = ' ' ASCTIM_L = 23 CVTFLG = 1 ! get some terminal characteristics dvi_list(1).bufferlen=4 dvi_list(1).itemcode=dvi$_DEVTYPE dvi_list(1).bufferaddr=%loc(DEVTYPE) dvi_list(2).bufferlen=4 dvi_list(2).itemcode=dvi$_TT_PAGE dvi_list(2).bufferaddr=%loc(TT_PAGE) dvi_list(3).bufferlen=4 dvi_list(3).itemcode=dvi$_TT_SCOPE dvi_list(3).bufferaddr=%loc(TT_SCOPE) dvi_list(4).bufferlen=4 dvi_list(4).itemcode=dvi$_TT_DECCRT dvi_list(4).bufferaddr=%loc(TT_DECCRT) dvi_list(5).bufferlen=4 dvi_list(5).itemcode=dvi$_DEVBUFSIZ dvi_list(5).bufferaddr=%loc(DEVBUFSIZ) dvi_list(6).endlist=0 e = sys$getdviw (,,'sys$output',dvi_list,,,,) ! Set up syi_list syi_list(1).bufferlen=15 syi_list(1).itemcode=%LOC(SYI$_NODENAME) ! SCSNODE sysgen Parameter syi_list(1).bufferaddr=%loc(NODENAME) syi_list(1).lengthaddr=%LOC(NODENAME_LEN) syi_list(2).bufferlen=15 syi_list(2).itemcode=%LOC(SYI$_VERSION) syi_list(2).bufferaddr=%loc(VERSION) syi_list(2).lengthaddr=%LOC(VERSION_LEN) syi_list(3).endlist= 0 e = SYS$GETSYIW ( , ! Default event flag 2 , ! No csidadr 3 , ! No Nodename, thus local 4 syi_list, ! Itmlst 5 iosb, ! IO status Block 6 , ! No astadr 7 ) ! No astprm if (e) e = iosb.sts if (e .ne. SS$_NORMAL) THEN WRITE (*, '(1x,A)') '$GETSYSIW trouble ' CALL LIB$SIGNAL (%VAL(e)) endif if (VERSION .GE. 'V5.0 ') then WRITE (*, '(1x,3a)') 1 'WARNING. VMS Version now '//VERSION//'. Designed for V4.n.' WRITE (*, '(1x,3a)') 1 'Type "YES" to continue.' READ (5, '(a)') ANSWER IF (ANSWER .NE. 'YES' .and. ANSWER .NE. 'yes') 1 STOP 'Aborting as requested' endif ! version IF (NODENAME_LEN .EQ. 0) THEN ! System not clustered ! therefore scsnode not defined ! Get it from SYS$NODE ! Set up lnm_list lnm_list(1).bufferlen=15 lnm_list(1).itemcode=LNM$_STRING lnm_list(1).bufferaddr=%loc(NODENAME) lnm_list(1).lengthaddr=%LOC(NODENAME_LEN) lnm_list(2).endlist= 0 STS = SYS$TRNLNM (, ! ATTRIBUTE not specified 2 'LNM$SYSTEM_TABLE', ! Logical name table search list 3 'SYS$NODE', ! Logical name to translate 4 , ! ACCESS MODE not specified 5 lnm_list) ! Logical name item list. IF (NODENAME_LEN .GT. 0) THEN ! IF (INDEX(NODENAME(:NODENAME_LEN),'::') .GT. 1) THEN ! NODENAME_LEN = INDEX(NODENAME(:NODENAME_LEN),'::') ! ENDIF ELSE ! no DECNET node either NODENAME = 'Date: ' ! Make it a date label NODENAME_LEN = 6 ENDIF ENDIF ! Set up lnm_list lnm_list(1).bufferlen=80 lnm_list(1).itemcode=LNM$_STRING lnm_list(1).bufferaddr=%loc(DLB_STATUS) lnm_list(1).lengthaddr=%LOC(DLB_STATUS_LEN) lnm_list(2).endlist= 0 ! IF a DEC_CRT then clear screen, write heading, and set scrolling region ! and (once only) define reset handler. IF (TT_DECCRT .eq. 1) THEN IF (SCROLL_TOP .EQ. 0) THEN ! First pass CALL DCLEXH(%LOC(SYSMON_RESET_CLOSE)) ! Declare exit handler ENDIF IF (DLB) THEN SCROLL_TOP = 5 ELSE SCROLL_TOP = 3 ENDIF SCROLL_WINDOW = TT_PAGE - SCROLL_TOP write (6,4) esc,'[?3h' ! 132 col write (6,4) esc,'[',SCROLL_TOP,';', ! scroll SCROLL_TOP 1 TT_PAGE,'r' ! thru TT_PAGE ELSE ENDIF 4 format (1h+,2a,i1,a,i2.2,5a) ! write(6,5)clear 5 format(1h+,6a) old_proc_index = maxproc Do WHILE (.TRUE.) CALL GETSYSINFO (TOTMEM, FREECNT, MFYCNT, VMSMEM, AWSTIME, 1 BORROWLIM, GROWLIM, PFRATH, PFRATL, WSDEC, WSINC, 2 IOTA, AWSMIN, QUAN, DMASIZE, THRESH, SWPPGCNT, 3 PROCCNT, IJOBCNT, BJOBCNT) e = sys$asctim (ASCTIM_L, ASCTIM,, CVTFLG) INUSEMEM = TOTMEM - FREECNT - MFYCNT WRITE (6, 15) ASKIP, NODENAME(:MAX(1,MIN(NODENAME_LEN,9))), ASCTIM, 2 TOTMEM, FREECNT, INUSEMEM, MFYCNT, VMSMEM, 3 PROCCNT, IJOBCNT, BJOBCNT 15 FORMAT (A1, A,' ',A, 2 ' Tot Mem:',i6,' Free:',i6,' In Use:', i6,' Mod:',i5, 3 ' (VMS perm:',i5,') Proc Tot:',i3,' Int:',i3,' Bat:',i2) IF (DLB) THEN WRITE (6, 16) BORROWLIM, GROWLIM, 1 PFRATH, PFRATL, WSDEC, WSINC, AWSMIN, AWSTIME, IOTA, 2 QUAN, DMASIZE, THRESH, SWPPGCNT 16 FORMAT (' Bor:',i4, ' Gro:',i4,' Pfrath:',i4,' Pfratl:',i2, 1 ' Wsdec:',i3, ' Wsinc:',i4,' Awsm:',i3, 3 ' Awst:',i3,' Iota:',i3,' Quant:',i3, 4 ' Tty_dma:',i3,' Mpw_th:',i4,' Swp_pg:'i3) STS = SYS$TRNLNM (, ! ATTRIBUTE not specified 2 'LNM$SYSTEM_TABLE', ! Logical name table search list 3 'DLB_STATUS_INFO', ! Logical name to translate 4 , ! ACCESS MODE not specified 5 lnm_list) ! Logical name item list. if (sts .eq. SS$_NORMAL) THEN WRITE (6,17) DLB_STATUS(:DLB_STATUS_LEN) 17 Format (' DLB_STATUS_INFO: ',A) endif ! sts ENDIF ! DLB IF (SHOW_PROCESS) THEN ! IF (.not. TT_SCOPE .OR. PASS1) write(6,6) write(6,6) 6 format(2x,'User Process name Pid State c/b', 1 ' Wdef Wquo Wsiz Wext', 1 ' Peak Mem Pcnt Gcnt Image Imagecnt Faults Bufio', 2 ' Dirio Cputim') ! Do this for all processes except system processes. e = 0 SUM_MEM = 0 SUM_PPGCNT = 0 SUM_GPGCNT = 0 do while (e.ne.ss$_nomoreproc) IF (BY_PID .AND. .NOT. PASS1) THEN IF (I_PID .GE. NUM_PIDS) THEN I_PID = 0 GO TO 610 ELSE I_PID = I_PID + 1 I = PID_INDEX(I_PID) SEEDPID = PID_LIST(I_PID) ! PRESELECT THE PROCESS ENDIF ENDIF e=sys$getjpiw(,seedpid,,jpi_list,,,) if ((e.eq.ss$_normal).and.(grp.GE.1)) then ! IF (BY_PID .AND. PASS1) THEN ! BUILD THE PID_INDEX! ! ! DO I = 1, NUM_PIDS ! IF (PID_LIST(I) .EQ. PID) THEN ! PID_INDEX(I) = PROC_INDEX ! GO TO 325 ! ENDIF ! ENDDO ! GO TO 600 ! ENDIF IF (BY_USER) THEN DO I = 1, NUM_USERS IF (USERNAME(:USER_LEN(I)) .EQ. 1 USER_NAME_LIST(I)(:USER_LEN(I))) THEN GO TO 300 ! FOUND THE USER ENDIF ENDDO GO TO 600 ! User not found - don't show ENDIF ! BY_USER 300 IF (BY_PROCNAME) THEN DO I = 1, NUM_PROCNAMES IF (PRCNAM(:PROC_LEN(I)) .EQ. 1 PROC_NAME_LIST(I)(:PROC_LEN(I))) THEN GO TO 325 ! FOUND THE PROCESS ENDIF ENDDO GO TO 600 ! User not found - don't show ENDIF ! BY_USER 325 CONTINUE ! Process selection block IF (LIST_MODE(MODE) .AND. 1 .not. SHOW_SUBPROCESS) THEN ! Total memory consumed is process paged plus group paged (sharable). totalmem=ppgcnt+gpgcnt ! Changed data block If (pass1) then do i = old_proc_index - 1, proc_index + 1, - 1 ! For empty process slots username_old (i) = ' ' ! Set to spaces prcnam_old(i) = ' ' ! outstring_old (i) = ' ' enddo IF (BY_PID) THEN DO I = 1, NUM_PIDS IF (PID_LIST(I) .EQ. PID) THEN PID_INDEX(I) = PROC_INDEX ! Try it GO TO 400 ENDIF ENDDO GO TO 600 ! Process not in pid list ENDIF else ! (.not. pass1) do i = old_proc_index - 1, proc_index + 1, - 1 if (state_old(i) .gt. 0) then IF (OLD) THEN ! Write an output record as it was. write(6,10)username_old (i), prcnam_old (i), 1 pid_old (i), states(state_old (i)), 2 pri_old (i), prib_old (i), 3 dfwscnt_old (i), 4 wsquota_old (i), wssize_old (i), 5 wsextent_old (i), wspeak_old (i), 6 totalmem_old (i), ppgcnt_old (i), 7 gpgcnt_old (i), outstring_old (i), 8 imagecount_old (i), pageflts_old (i), 9 bufio_old (i), dirio_old (i), 1 dfloat(cputim_old (i)) ENDIF ! OLD WRITE (6, 11) username_old (i), prcnam_old(i), 1 pid_old (i), 'terminated' 11 FORMAT(1X,a12,1X,a15,Z9.8,1X,a) username_old (i) = ' ' prcnam_old (i) = ' ' pid_old (i) = 0 state_old (i) = 0 pri_old (i) = 0 prib_old (i) = 0 dfwscnt_old (i) = 0 wsquota_old (i) = 0 wssize_old (i) = 0 wsextent_old (i) = 0 wspeak_old (i) = 0 totalmem_old (i) = 0 ppgcnt_old (i) = 0 gpgcnt_old (i) = 0 outstring_old (i) = ' ' imagecount_old (i) = 0 pageflts_old (i) = 0 bufio_old (i) = 0 dirio_old (i) = 0 cputim_old (i) = 0 endif enddo old_proc_index = proc_index ! ---------- ! SELECTion ! ---------- changed = NO_SELECTION 1 .or. (SELECT(1) .AND. totalmem .ne. totalmem_old (proc_index)) 2 .or. (SELECT(2) .AND. gpgcnt .ne. gpgcnt_old (proc_index)) 3 .or. (SELECT(3) .AND. ppgcnt .ne. ppgcnt_old (proc_index)) 4 .or. (SELECT(4) .AND. pageflts .ne. pageflts_old (proc_index)) 5 .or. (SELECT(5) .AND. dirio .ne. dirio_old (proc_index)) 6 .or. (SELECT(6) .AND. bufio .ne. bufio_old (proc_index)) endif ! Store the stuff 400 if (pass1 .or. changed) then ! Strip all but the imagename. bracket=1 do while (bracket.ne.0) bracket=index(imagname,']') e=str$right(imagname,imagname,bracket+1) enddo period= index(imagname,'.')-1 status=str$left(outstring,imagname,period) ! Pad prcnam with trailing blanks if (prcnam_l .lt. 15) prcnam (prcnam_l+1:15) = ' ' if (username(1:1) .eq. char(0)) username = ' ' ! SWAPPER if (changed) then IF (OLD) THEN ! Write an output record as it was. write(6,10)username_old (proc_index), prcnam_old (proc_index), 1 pid_old (proc_index), states(state_old (proc_index)), 2 pri_old (proc_index), prib_old (proc_index), 3 dfwscnt_old (proc_index), 4 wsquota_old (proc_index), wssize_old (proc_index), 5 wsextent_old (proc_index), wspeak_old (proc_index), 6 totalmem_old (proc_index), ppgcnt_old (proc_index), 7 gpgcnt_old (proc_index), outstring_old (proc_index), 8 imagecount_old (proc_index), pageflts_old (proc_index), 9 bufio_old (proc_index), dirio_old (proc_index), 1 dfloat(cputim_old (proc_index)) k = K + 1 endif ! OLD endif ! changed ! Write an output record as it is. write(6,10)username,prcnam,pid,states(state),pri,prib, 1 dfwscnt,wsquota,wssize, wsextent,wspeak, totalmem, 2 ppgcnt,gpgcnt,outstring,imagecount, 3 pageflts,bufio,dirio,dfloat(cputim) 10 format(1x,a12,1x,A15,z9.8,1x,A5,tl1,i2,'/',tl1,i2,1x,3(i4,' '),i4,1x, 1 i4,1x,i4,1x,i4,1x,i4,1x,a10, i3,I8,i8,i7,-2pf9.2) k = k + 1 if (pass1 .and. k .eq. SCROLL_WINDOW) THEN CALL LIB$WAIT (3.0) K = 1 IF (OLD .AND. MOD(SCROLL_WINDOW,2) .EQ. 0) K = 2 endif username_old (proc_index) = username dfwscnt_old (proc_index) = dfwscnt wsquota_old (proc_index) = wsquota wsextent_old (proc_index) = wsextent wssize_old (proc_index) = wssize wspeak_old (proc_index) = wspeak ppgcnt_old (proc_index) = ppgcnt gpgcnt_old (proc_index) = gpgcnt totalmem_old (proc_index) = totalmem outstring_old (proc_index) = outstring ! trimed imagename grp_old (proc_index) = grp prcnam_old (proc_index) = prcnam imagecount_old (proc_index) = imagecount state_old (proc_index) = state pageflts_old (proc_index) = pageflts bufio_old (proc_index) = bufio dirio_old (proc_index) = dirio cputim_old (proc_index) = cputim pri_old (proc_index) = pri prib_old (proc_index) = prib pid_old (proc_index) = pid endif endif ! LIST_MODE old_proc_index = proc_index ELSE IF (e .eq. ss$_suspended) THEN WRITE (6, 11) username_old (i), prcnam_old(i), 1 pid_old (i), 'Suspended' ELSE IF (e .eq. ss$_nonexpr) THEN IF (BY_PID) THEN IF (OLD) THEN ! Write an output record as it was. write(6,10)username_old (i), prcnam_old (i), 1 pid_old (i), states(state_old (i)), 2 pri_old (i), prib_old (i), 3 dfwscnt_old (i), 4 wsquota_old (i), wssize_old (i), 5 wsextent_old (i), wspeak_old (i), 6 totalmem_old (i), ppgcnt_old (i), 7 gpgcnt_old (i), outstring_old (i), 8 imagecount_old (i), pageflts_old (i), 9 bufio_old (i), dirio_old (i), 1 dfloat(cputim_old (i)) endif ! OLD WRITE (6, 11) username_old (i), prcnam_old(i), 1 pid_old (i), 'terminated' IF (NUM_PIDS .GT. 1) THEN ! delete the PID from the list NUM_PIDS = NUM_PIDS - 1 DO I = I_PID, NUM_PIDS PID_INDEX(I) = PID_INDEX(I+1) PID_LIST(I) = PID_LIST(I+1) ENDDO ELSE WRITE (*, '(1x,A)') 'No processes left in "/id=" list' BY_PID = .FALSE. GO TO 700 ! Get new instructions ENDIF ELSE WRITE (*, '(x,A)') 'Process ID Processing problem' GO TO 700 ENDIF ! BY_PID endif ! e .eq. 600 enddo IF (PASS1 .AND. BY_PID) THEN NO_PIDS = 0 ! Number of Pids with no processes DO I = NUM_PIDS, 1, -1 ! step backwards through pid list IF (PID_INDEX(I) .EQ. 0) THEN WRITE (*, 18) PID_LIST(I) 18 FORMAT (' Process with id=',Z8.8,' does not exist.') NO_PIDS = NO_PIDS + 1 DO J = I, NUM_PIDS - NO_PIDS PID_LIST(J) = PID_LIST(J+1) PID_INDEX(J) = PID_INDEX(J+1) ENDDO ENDIF ENDDO NUM_PIDS = NUM_PIDS - NO_PIDS IF (NUM_PIDS .EQ. 0) THEN BY_PID = .FALSE. GO TO 700 ENDIF ENDIF 605 pass1 = .false. seedpid = -1 ASKIP = '0' ENDIF ! SHOW_PROCESS 610 IF (WAIT_INTERVAL .GT. 0.0) THEN IF (LEN_ENDING .NE. 0) THEN ! Ending time given e = sys$asctim (ASCTIM_L, ASCTIM,, CVTFLG) ! Current time in ASCII CALL SYS$BINTIM (ASCTIM, TIME_NOW) ! Convert to binary time e = LIB$SUBX (TIME_END, TIME_NOW, TIME_DIFF) IF (TIME_DIFF(2) .LT. 0) THEN CALL EXIT ! EXIT exit handler ! will reset Terminal ! if needed. ENDIF ENDIF CALL LIB$WAIT (WAIT_INTERVAL) ELSE 700 WRITE (6,25) 25 FORMAT (' SYSMON> ',$) READ (5, '(Q,A)', END = 900) CL_LEN, CMDLINE K = 1 IF (OLD .AND. MOD(SCROLL_WINDOW,2) .EQ. 0) K = 2 IF (CL_LEN .EQ. 0) THEN PASSES = PASSES + 1 ELSE IF (CMDLINE(1:1) .EQ. '/') THEN GO TO 100 ! Parse the new SYSMON qualifiers ELSE ! No '/', Should be different verb STS = CLI$DCL_PARSE (CMDLINE(1:CL_LEN), 2 SYSMON_CLD, LIB$GET_INPUT) IF (.NOT. STS) GO TO 700 STS = CLI$GET_VALUE ('$VERB', VERB, VERB_LEN) IF (VERB(1:4) .EQ. 'EXIT') GO TO 900 ! To exit IF (VERB(1:4) .EQ. 'HELP') THEN CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'SYSMON' 2 ,'DECUS:[SYSMON]:SYSMON.HLB',,LIB$GET_INPUT) GO TO 700 ! To Prompt ENDIF IF (VERB(1:4) .EQ. 'SPAW') then CALL FTP$SPAWN_COMMAND GO TO 700 ENDIF IF (VERB(1:4) .EQ. 'SYSM') GO TO 120 ENDIF ENDIF ENDIF 800 enddo 900 IF (TT_DECCRT .eq. 1 .and. self) THEN CALL SYSMON_RESET_CLOSE ! write (*,5) esc,'[0;39r',esc,'[39;1H' !Reset scrolling region. ! if (devbufsiz .eq. 80) then ! write (*,4) esc,'[?3l' ! 80 col ! endif ELSE CALL SYSMON_CLOSE ENDIF end FUNCTION DCLEXH(EXIT_ROUTINE) IMPLICIT INTEGER (A-Z) INTEGER*4 EXBLK(4) EXBLK(2) = EXIT_ROUTINE EXBLK(3) = 1 EXBLK(4) = %LOC(EXBLK(4)) DCLEXH = SYS$DCLEXH(EXBLK(1)) RETURN END FUNCTION SETIMR (EFN, TIME, AST_ROUTINE, IREQUEST) IMPLICIT INTEGER (A-Z) INTEGER*4 ASTBLK(4) INTEGER*4 TIME(2) ASTBLK(2) = AST_ROUTINE ASTBLK(3) = 1 ASTBLK(4) = %LOC(ASTBLK(4)) SETIMR = SYS$SETIMR (%VAL(EFN), TIME, ASTBLK(1), IREQUEST) RETURN END SUBROUTINE SYSMON_RESET_CLOSE INTEGER*4 DEVTYPE,TT_PAGE,TT_SCOPE,TT_DECCRT,DEVBUFSIZ LOGICAL*1 SELF CHARACTER*1 ESC /27/ COMMON /CRT_COMMON/ 1 DEVTYPE,TT_PAGE,TT_SCOPE,TT_DECCRT,DEVBUFSIZ, 2 SELF write (6,4) esc,'[0;39r',esc,'[39;1H' !Reset scrolling region. if (devbufsiz .eq. 80) then write (6,4) esc,'[?3l' ! 80 col endif 4 format (' ',128A) ENTRY SYSMON_CLOSE CLOSE (6) END