program SYSTAT

c	Program	:  SYSTAT.FOR
c	Author	:  John F. Priebe
c	Version :  V1.1
c	Date	:  06-Oct-1986
c	System	:  VAX/VMS V4.2
c	Purpose	:  Displays the process name and image name (among other
c		   things) of all the processes on the system.
c	Notes	:  Some of the details of calling system services are taken
c		   from the Guide to Programming on VAX/VMS (FORTRAN Edition).
c		   This program is a rewrite of a similiar (and all too
c		   common) one written in DCL.

      include '($SSDEF)'
      include '($JPIDEF)'

      structure /itmlst/
        union
          map
            integer*2  buflen
            integer*2  code
            integer*4  bufadr
            integer*4  retlenadr
          end map
          map
            integer*4  end_list
          end map
        end union
      end structure

      record /itmlst/ jpi_list(7)
c
      integer*2     i
      integer*4     anypid
      character*15  name
      integer*4     priority
      integer*4     uic
      integer*4     pid
      character*7   terminal
      character*39  imagname
      integer*4     name_len, priority_len, uic_len, pid_len,
     +              terminal_len, imagname_len
      character*80  outstring
      integer*2     outstring_len

      integer*4     status, sys$getjpiw, sys$fao
c
c     set up itmlst
c
      jpi_list(1).buflen    = 15
      jpi_list(1).code      = jpi$_prcnam
      jpi_list(1).bufadr    = %loc(name)
      jpi_list(1).retlenadr = %loc(name_len)
      jpi_list(2).buflen    = 4
      jpi_list(2).code      = jpi$_pri
      jpi_list(2).bufadr    = %loc(priority)
      jpi_list(2).retlenadr = %loc(priority_len)
      jpi_list(3).buflen    = 4
      jpi_list(3).code      = jpi$_uic
      jpi_list(3).bufadr    = %loc(uic)
      jpi_list(3).retlenadr = %loc(uic_len)
      jpi_list(4).buflen    = 4
      jpi_list(4).code      = jpi$_pid
      jpi_list(4).bufadr    = %loc(pid)
      jpi_list(4).retlenadr = %loc(pid_len)
      jpi_list(5).buflen    = 7
      jpi_list(5).code      = jpi$_terminal
      jpi_list(5).bufadr    = %loc(terminal)
      jpi_list(5).retlenadr = %loc(terminal_len)
      jpi_list(6).buflen    = 39
      jpi_list(6).code      = jpi$_imagname
      jpi_list(6).bufadr    = %loc(imagname)
      jpi_list(6).retlenadr = %loc(imagname_len)
      jpi_list(7).end_list  = 0
c
      anypid = -1
c
c     loop around for all processes on the system
c
 200  write(5,210)
 210  format(' ')
      write(5,220)
 220  format(' ', 'PROCESS_NAME       UIC       PID     TERM'
     +            '             IMAGE_NAME')
      write(5,230)
 230  format(' ', '------------------------------------'
     +            '------------------------------------------')
 250  status = SYS$GETJPIW(,anypid,,jpi_list,,,)
      if (status .eq. ss$_nomoreproc) goto 800
      if (status .eq. ss$_suspended) then
        imagname = '--- SUSPENDED ---'
        goto 300
      end if
      if (.not. status) call LIB$SIGNAL(%val(status))
c
c     display information
c
 300  status = SYS$FAO('!15AS !9<!%U!>  !XL  !7AS  !34AS',
     1                 outstring_len, outstring,
     2                 name,
     3                 %val(uic),
     4                 %val(pid),
     5                 terminal,
     6                 imagname
     9                )
      do 260 i = 1, outstring_len
        if (ichar(outstring(i:i)) .eq. 0) outstring(i:i) = ' '
 260  continue
      type *, outstring
      if (.not. status) call LIB$SIGNAL(%val(status))
      goto 250
c
 800  write(5,810)
 810  format(' ')
      end