program hogs * * HOGS is a program that produces a display which is similar to the * display presented by MONITOR PROCESS/TOPCPU, except that it presents * more information about the process. MONITOR presents the process * name and the PID, but this is not real useful in most cases. HOGS * presents the following information for the top ten CPU users for * the last sample interval : * * Username, PID, Cur prio./Base prio., Image name, Process State (i.e, * COM, LEF, etc.), Process Type (Batch, Interactive, Detached, etc), * Total CPU minutes since process creation, CPU % during interval) * * HOGS uses the Screen Management routines. It requires a terminal which * is capable of displaying 24 rows and 132 columns. * * HOGS must be installed with WORLD privilege, since SYS$GETJPI is used * to obtain information about all processes on the system. As supplied, * HOGS requires VMS 4.4 or higher. If run under lower versions, then * references to the SMG routine SMG$SET_CURSOR_MODE must be removed. * * Written by : Bob Marshall * Lockheed Missiles and Space Co. * P.O. Box 3504, O/51-02/ B/586W * Sunnyvale, Calif. 94088 * (408)756-5737 * * 20 June 1986 ************************************************************* * parameter maxp=256 ! Maxprocesscnt * include '($smgdef)/nolist' include '($jpidef)/nolist' include '($ssdef)/nolist' include '($lnmdef)/nolist' include '($dvidef)/nolist' * integer*4 pbid,proc_id,top_id,header_id integer*4 status,smg$create_pasteboard, 1 smg$create_virtual_display, 2 smg$paste_virtual_display, 3 smg$put_line, 4 smg$change_pbd_characteristics, 5 smg$begin_display_update, 6 smg$end_display_update, 7 smg$home_cursor, 8 smg$delete_pasteboard, 9 smg$put_chars, 1 smg$put_chars_highwide, 1 smg$put_chars_wide, 2 smg$draw_rectangle, 3 smg$draw_line, 4 smg$control_mode, 5 smg$ring_bell, 6 smg$set_broadcast_trapping, 7 smg$get_broadcast_message, 8 smg$set_cursor_abs, 5 smg$set_cursor_mode * common /id/proc_id,top_id,header_id * ********************************** JPI stuff ********************************* * integer*4 pid(maxp),priob(maxp),prioc(maxp),sts integer*4 state(maxp),proc_idx,state_val,cputim(maxp) integer*4 pid_val,priob_val,prioc_val,cputim_val integer*4 idx(maxp),mode(maxp),mode_val,owner_val integer*4 delta_cpu(maxp),owner(maxp),grp integer*4 peek,prev_peek real*8 logint character username(maxp)*12,imagename(maxp)*80 character state_name(14)*5,bar*69,temp*6,bar_null*69 character process_type*1,this_username*12,node*12 character username_val*12,imagename_val*80,output_line*132 character date_buf*20,message*132 * integer*4 seedpid,sys$getjpiw,sys$trnlnm logical ifirst,exempt * external trap_message * structure /itmlst/ union map integer*2 buflen,itmcod integer*4 bufadr,retadr end map map integer*4 end_list end map end union end structure * record /itmlst/jpibuf(14),lnmbuf(2) * data ifirst/.TRUE./ data exempt/.FALSE./ * data wait/5.0/ ! Sample interval, in seconds * data state_name/'COLPG','MWAIT','CEF','PFW','LEF','LEFO','HIB', 1 'HIBO','SUSP','SUSPO','FPG','COM','COMO','CUR'/ * * Set up the request buffer for GETJPI * jpibuf(1).buflen=4 jpibuf(1).itmcod=jpi$_pid jpibuf(1).bufadr=%loc(pid_val) ! Process ID jpibuf(1).retadr=0 * jpibuf(2).buflen=8 jpibuf(2).itmcod=jpi$_logintim jpibuf(2).bufadr=%loc(logint) ! Process creation time jpibuf(2).retadr=0 * jpibuf(3).buflen=12 jpibuf(3).itmcod=jpi$_username jpibuf(3).bufadr=%loc(username_val) ! Username jpibuf(3).retadr=%loc(username_l) * jpibuf(4).buflen=4 jpibuf(4).itmcod=jpi$_state jpibuf(4).bufadr=%loc(state_val) ! Process state jpibuf(4).retadr=0 * jpibuf(5).buflen=4 jpibuf(5).itmcod=jpi$_prib jpibuf(5).bufadr=%loc(priob_val) ! Base priority jpibuf(5).retadr=0 * jpibuf(6).buflen=80 jpibuf(6).itmcod=jpi$_imagname jpibuf(6).bufadr=%loc(imagename_val) ! Image name jpibuf(6).retadr=0 * jpibuf(7).buflen=4 jpibuf(7).itmcod=jpi$_pri jpibuf(7).bufadr=%loc(prioc_val) ! Current priority jpibuf(7).retadr=0 * jpibuf(8).buflen=4 jpibuf(8).itmcod=jpi$_sts jpibuf(8).bufadr=%loc(sts) ! Process status flags jpibuf(8).retadr=0 * jpibuf(9).buflen=4 jpibuf(9).itmcod=jpi$_proc_index jpibuf(9).bufadr=%loc(proc_idx) ! Process index jpibuf(9).retadr=0 * jpibuf(10).buflen=4 jpibuf(10).itmcod=jpi$_cputim jpibuf(10).bufadr=%loc(cputim_val) ! CPU time jpibuf(10).retadr=0 * jpibuf(11).buflen=4 jpibuf(11).itmcod=jpi$_owner jpibuf(11).bufadr=%loc(owner_val) ! PID of process owner jpibuf(11).retadr=0 * jpibuf(12).buflen=4 jpibuf(12).itmcod=jpi$_mode jpibuf(12).bufadr=%loc(mode_val) jpibuf(12).retadr=0 * jpibuf(13).end_list=0 ! List terminator * ********* LNMBUF ******** * lnmbuf(1).buflen=12 lnmbuf(1).itmcod=lnm$_string lnmbuf(1).bufadr=%loc(node) lnmbuf(1).retadr=0 * lnmbuf(2).end_list=0 * * On our system, we don't want unprivileged users to run the program for * very long, so they are limited to about two minutes at a time. To * discourage them from writing a command procedure that loops infinitely * running HOGS, test SYS$INPUT to see if they are running from a command * procedure. Of course, this code doesn't prevent them from actually * running from a command procedure, but only a somewhat savvy user will * know how to defeat it. * status=lib$getdvi(dvi$_devclass,,'SYS$INPUT',iclass,,) if(iclass.ne.66)then type 1000,char(7) 1000 format(//1X,A1, 1 ' HOGS may not be run from a command procedure.'/) stop ' ' endif * * Get node name (translate SYS$NODE) * status=sys$trnlnm(,'LNM$SYSTEM','SYS$NODE',,lnmbuf) if(status)then icolon=index(node,'::') if(icolon.eq.0)then node=' ' else node=node(1:icolon-1) endif endif * * Initialize terminal * call term_char(0) * * Create a pasteboard * status=smg$create_pasteboard(pbid,'sys$output',irow,icol) if(.not.status)call lib$signal(%val(status)) * * Enable trapping of broadcast messages * status=smg$set_broadcast_trapping(pbid,trap_message,pbid) if(.not.status)call lib$signal(%val(status)) * * Create three virtual displays, one for the JPI info, one for the * TOPCPU bars, and one for the heading. * iatt=smg$m_border ! Place borders around virtual displays status=smg$create_virtual_display(10,69,proc_id,iatt) if(.not.status)call lib$signal(%val(status)) status=smg$create_virtual_display(10,60,top_id,iatt) if(.not.status)call lib$signal(%val(status)) status=smg$create_virtual_display(24,132,header_id) if(.not.status)call lib$signal(%val(status)) * * Set the terminal to 132 characters wide * status=smg$change_pbd_characteristics(pbid,132) if(.not.status)call lib$signal(%val(status)) * * Set the pasteboard for minimal updates and no tabs (i.e., don't depend * on the terminals physical tab settings being set correctly). * status=smg$control_mode(pbid,smg$m_minupd .or. smg$m_notabs) if(.not.status)call lib$signal(%val(status)) * * Turn off the cursor * status=smg$set_cursor_mode(pbid,1) if(.not.status)call lib$signal(%val(status)) * * Build the bars * do 1 i=1,69 bar(i:i)='#' bar_null(i:i)='O' 1 continue * * Fill up the header display * status=smg$paste_virtual_display(header_id,pbid,1,1) if(.not.status)call lib$signal(%val(status)) * status=smg$draw_rectangle(header_id,6,1,9,132,smg$m_bold) if(.not.status)call lib$signal(%val(status)) status=smg$draw_line(header_id,6,71,9,71,smg$m_bold) if(.not.status)call lib$signal(%val(status)) status=smg$put_chars_wide(header_id, 1 'H O G S',2,59,,smg$m_bold) if(.not.status)call lib$signal(%val(status)) status=smg$put_chars(header_id,'CPU',7,59) if(.not.status)call lib$signal(%val(status)) status=smg$put_chars(header_id,'CPU',7,67) if(.not.status)call lib$signal(%val(status)) output_line= 1' Username PID Prio. Image Name State Type min.'// 2' %' status=smg$put_chars(header_id,output_line(1:69),8,2) * if(node.ne.' ')then ln=icolon-1 write(output_line,2060)node(1:ln) 2060 format('Node ',A) ln=ln+5 jpos=66-ln status=smg$put_chars_wide(header_id,output_line, 1 3,jpos,,smg$m_bold) if(.not.status)call lib$signal(%val(status)) endif * if(.not.status)call lib$signal(%val(status)) status=smg$put_chars(header_id,'25%',8,85) if(.not.status)call lib$signal(%val(status)) status=smg$put_chars(header_id,'50%',8,100) if(.not.status)call lib$signal(%val(status)) status=smg$put_chars(header_id,'75%',8,115) if(.not.status)call lib$signal(%val(status)) status=smg$put_chars(header_id,'100%',8,128) if(.not.status)call lib$signal(%val(status)) * * Paste the virtual displays to the screen * status=smg$paste_virtual_display(proc_id,pbid,11,2) if(.not.status)call lib$signal(%val(status)) status=smg$paste_virtual_display(top_id,pbid,11,72) if(.not.status)call lib$signal(%val(status)) * status=smg$put_chars_wide(header_id, 1 'Press control-Y to exit',23,42,0, 2 smg$m_bold.or.smg$m_reverse) if(.not.status)call lib$signal(%val(status)) * * Get username of calling process * status=lib$getjpi(jpi$_username,,,,this_username,) if(.not.status)call lib$signal(%val(status)) * * Get group portion of UIC...if less than 10, allow unlimited time * to run program. * status=lib$getjpi(jpi$_grp,,,grp,,) if(.not.status)call lib$signal(%val(status)) if(grp.le.10)exempt=.TRUE. * * Initialize counter...allow program to run for only two minutes * loop_count=0 * * Prepare to do a wildcard GETJPIW, so we get data on all processes. * 5 seedpid = -1 np=0 sum_cpu=0 num_interactive=0 status=smg$home_cursor(proc_id) ! Put cursor in corner of display status=smg$home_cursor(top_id) ! Ditto * * As long as there are processes, keep looping * 10 continue * * Get some info on the process...GETJPIW is used to force a * synchronous completion, i.e., the request is satisfied before * the program continues executing. * status=sys$getjpiw(,%ref(seedpid),,%ref(jpibuf),,,) if(status.eq.ss$_nomoreproc)go to 20 ! End of process list...done * * Fix up the username field for NULL and JOB_CONTROL * if(username_val(1:1).eq.char(0))then if(priob_val.eq.0)then ! Assumed to be NULL process username_val='(NULL) ' null_proc_idx=proc_idx else username_val='SYSTEM' endif endif * * Save JPI values into buffers * username(proc_idx)=username_val priob(proc_idx)=priob_val prioc(proc_idx)=prioc_val state(proc_idx)=state_val imagename(proc_idx)=imagename_val owner(proc_idx)=owner_val mode(proc_idx)=mode_val * * Compute per-process CPU time for this interval * if(ifirst)then delta_cpu(proc_idx)=0 else if(pid(proc_idx).ne.pid_val)then * * New process, zero out CPU time * delta_cpu(proc_idx)=0 else delta_cpu(proc_idx)=cputim_val - cputim(proc_idx) sum_cpu=sum_cpu+delta_cpu(proc_idx) endif endif cputim(proc_idx)=cputim_val pid(proc_idx)=pid_val np=np+1 * * Interactive process? * if(mode_val.eq.3 .and. owner_val.eq.0) 1 num_interactive=num_interactive+1 idx(np)=proc_idx go to 10 ! Go get next process * * No more processes...prepare to update display * 20 continue * if(ifirst)then * * First time through, do nothing (stats are misleading) * ifirst=.FALSE. call lib$wait(2.0) go to 5 endif * * Begin virtual display updates. Stack up the updates and post them to * the screen all at once with end_display_update. * status=smg$begin_display_update(proc_id) if(.not.status)call lib$signal(%val(status)) status=smg$begin_display_update(top_id) if(.not.status)call lib$signal(%val(status)) status=smg$begin_display_update(header_id) if(.not.status)call lib$signal(%val(status)) * * Find the top ten CPU hogs * ntop=0 do 30 i=1,10 xmax=-1 jmax=0 do 40 j=1,np ip=idx(j) if(ip.lt.0)go to 40 if(delta_cpu(ip).gt.xmax)then xmax=delta_cpu(ip) jmax=j endif 40 continue * * jmax contains the pointer into the idx buffer for the process with the * highest CPU time usage that has not been counted yet. * if(jmax.eq.0)go to 50 ip=idx(jmax) idx(jmax)=-1 ! Set to -1 to indicate we have already counted * * CPU % for this process for this interval (roughly) * pct=100*delta_cpu(ip)/sum_cpu if(pct.lt.0.5)go to 50 ipct=pct+0.49 * * Extract the meaningful portion of the image name (i.e., exclude the * directory name and the file extension. * imagename_val=imagename(ip) irb=index(imagename_val,']') * * If we found a right bracket, keep looking until we find the last * such bracket. This gets around the "][" stuff. * if(irb.ne.0)then 15 irbnext=index(imagename_val(irb+1:),']') if(irbnext.ne.0)then irb=irbnext+irb go to 15 endif * idot=index(imagename_val(irb:),'.') if(idot.ne.0)then imagename_val(1:)=imagename_val(irb+1:idot+irb-2) else imagename_val(1:)=' ' endif else imagename_val(1:)='THINKING...' endif * xcpu=cputim(ip)/(100.0*60.0) temp='A lot' if(xcpu.lt.9999)write(temp,2050)xcpu if(ip.eq.null_proc_idx)temp=' -' 2050 format(F6.1) process_type=' ' if(mode(ip).eq.3)process_type='I' if(mode(ip).eq.2)process_type='B' if(mode(ip).eq.1)process_type='N' if(owner(ip).ne.0)process_type='S' if(process_type.eq.' ')process_type='D' ntop=ntop+1 * * Create the JPI output line * write(output_line,2000)username(ip),pid(ip),prioc(ip), 1 priob(ip),imagename_val(1:12),state_name(state(ip)), 2 process_type,temp,ipct 2000 format(A12,1X,Z8.8,2X,I2,'/',I2,2X,A12,1X,A5,3X, 1 A1,3X,A6,4X,I3) * * And write it to the display (won't actually be displayed yet) * mask=0 if(this_username.eq.username(ip) .and. 1 state_name(state(ip)).ne.'CUR')mask=smg$m_bold status=smg$put_line(proc_id,output_line(1:69),1,mask) * * Create the bar graph output line * nb=60*ipct/100.0 if(nb.eq.0)nb=1 if(ip.ne.null_proc_idx)write(output_line,2010)bar(1:nb) if(ip.eq.null_proc_idx)write(output_line,2010)bar_null(1:nb) 2010 format(A) * * Write bar to display * status=smg$put_line(top_id,output_line(1:60),1,mask) 30 continue * 50 continue * * Blank out the remainder of the displays, if any * do 60 i=ntop+1,10 write(output_line,2020) 2020 format(A69) status=smg$put_line(proc_id,output_line(1:60),1) status=smg$put_line(top_id,output_line(1:69),1) 60 continue * * Finally, post the updated display to the screen * status=smg$end_display_update(proc_id) if(.not.status)call lib$signal(%val(status)) status=smg$end_display_update(top_id) if(.not.status)call lib$signal(%val(status)) * call lib$date_time(date_buf) cpu_busy=100-100*delta_cpu(null_proc_idx)/sum_cpu cpu_busy=amax1(0.0,cpu_busy) cpu_busy=amin1(100.0,cpu_busy) write(output_line,2040)date_buf,num_interactive,cpu_busy 2040 format(A20,34X,'Interactive Users = ',I2,38X, 1 'CPU Busy = ',F5.1,'%') status=smg$put_chars(header_id,output_line(1:131),5,1) if(.not.status)call lib$signal(%val(status)) status=smg$end_display_update(header_id) if(.not.status)call lib$signal(%val(status)) * * Terminate after 10 loops, unless exempt (grp<10) * loop_count=loop_count+1 if(loop_count.gt.10 .and. .not.exempt)then status=smg$ring_bell(header_id) status=smg$put_chars( 1 header_id,'Time limit reached...terminating HOGS', 2 5,48,,smg$m_bold .or. smg$m_reverse .or. smg$m_blink) call lib$wait(5.0) call cleanup(pbid) ! Terminate program call exit endif * * Wait wait seconds * call lib$wait(wait) * * Go do it again * go to 5 * end * ********** END OF MAIN PROGRAM ******************************** * subroutine abort(pbid) * * Control-y processing * call cleanup(pbid) * end * ***************************************************** * subroutine cleanup(pbid) * * Just what it says * include '($smgdef)/nolist' * integer*4 pbid,status,smg$delete_pasteboard, 1 smg$set_cursor_mode,smg$delete_virtual_display, 2 smg$end_display_update * integer*4 proc_id,top_id,header_id common /id/proc_id,top_id,header_id * character message(20)*132 common /message_buf/message,num_message * * Turn cursor back on * status=smg$set_cursor_mode(pbid,0) if(.not.status)call lib$signal(%val(status)) * * Delete the pasteboard so that the qiow to reset the terminal will * work. The qiow doesn't seem to work unless I do this (?). * status=smg$end_display_update(proc_id) status=smg$end_display_update(top_id) status=smg$end_display_update(header_id) status=smg$delete_pasteboard(pbid) * call term_char(1) * * Display messages received while running HOGS, if any. * if(num_message.gt.0)then type 1000 1000 format(/, 1 ' While you were running HOGS you received the following', 2 ' message(s):',/) do 10 i=1,num_message call str$trim(message(i),message(i),l) type 1010,message(i)(1:l) 1010 format(1X,A) 10 continue endif * call exit * end * ********************************************************************** * subroutine term_char(iflag) * * Set terminal characteristics * integer*4 iflag * integer*4 sys$assign,sys$qiow,status * integer*2 tt_chan * external abort * include '($iodef)/nolist' * **********************************QIO STUFF************************************* * structure /iostat_block/! i/o status block integer*2 iostat byte transmit, 1 recieve, 2 crfill, 3 lffill, 4 parity, 5 zero end structure record /iostat_block/ iosb structure /characteristics/ byte class, 1 type integer*2 width union map integer*4 basic integer*4 extended end map map byte length(8) end map end union end structure record /characteristics/ save_char * common /hold/ tt_chan,save_char * if(iflag.eq.0)then * * Assign a channel to the terminal * status=sys$assign('SYS$INPUT',tt_chan,,) if(.not.status)call lib$signal(%val(status)) * * Save current terminal characteristics * status=sys$qiow(,%val(tt_chan),%val(io$_sensemode),,,, 1 save_char,%val(12),,,,) * * Disable interrupts back to DCL so my AST will work * status=lib$disable_ctrl('02000000'X) if(.not.status)call lib$signal(%val(status)) * * Enable my control-y AST * icode=io$_setmode .or. io$m_ctrlyast * status=sys$qiow(,%val(tt_chan),%val(icode),iosb,,, 1 abort,pbid,,,,) if(.not.status)call lib$signal(%val(status)) * else * * Interrupt processing * * <<< reset the terminal characteristics >>> * call lib$enable_ctrl('02000000'X) ! Reenable control=Y * status = sys$qiow( , %VAL( tt_chan), 1 %VAL( io$_setmode), * 2 iosb,,, 2 ,,, 3 save_char, 4 %val( 12),,,,) if ( .not. status) call lib$signal(%val(status)) * if ( .not. iosb.iostat) call lib$stop( %val( iosb.iostat)) return endif * end * ********************************************* * subroutine trap_message(pbid) * * Trap and save messages sent while HOGS is running. Save up to * twenty messages. * character message(20)*132,broadcast_message*132 * integer*4 pbid,status,smg$put_chars,smg$get_broadast_message integer*4 proc_id,top_id,header_id * common /id/proc_id,top_id,header_id * common /message_buf/message,num_message * include '($smgdef)/nolist' * integer num_message * data num_message/0/ * status=smg$get_broadcast_message(pbid,broadcast_message,lmess) * num_message=num_message+1 if(num_message.gt.20)return message(num_message)=broadcast_message * status=smg$ring_bell(header_id) status=smg$put_chars(header_id, 1 'You have a message waiting for you when you exit...',24,41,1, 2 smg$m_bold) return end