c
c Title: MBAUSE
c R.F.Wrenn, October 1981
c
c This program determines the percent utilization of one or more MBA's.
c It displays this along with disk IO rates in real time.
c
      implicit integer (a-z)
      parameter max_mbas = 4			! maximum number of MBA's
      parameter max_drives = 16 - max_mbas	! maximum number of disk drives
      parameter filter1 = .05			! long term filter constant
      parameter filter2 = 1. - filter1		! long term filter constant
      external ioc$gl_devlist
      external ioc$gl_adplist, adp$l_link, adp$w_tr, adp$b_number
      external adp$w_adptype, at$_mba, adp$l_crb, crb$b_mask
      external ddb$l_link, ddb$l_ucb, ddb$t_name
      external ucb$b_devclass, dc$_disk, ucb$w_unit, ucb$l_link
      external ucb$l_opcnt, ucb$l_ioqfl
      external reset_pri
      integer*4 addrs(2)
      integer*4 adp_tr(max_mbas), adp_number(max_mbas)
      integer*4 mba_pfn(max_mbas), mba_va(2,max_mbas)
      integer*4 mba_busy(max_mbas), adp_crb(max_mbas)
      integer*4 chan_wait_queue(max_mbas)
      integer*4 drive_ucb(max_drives), drive_name_cnt(max_drives)
      integer*4 drive_unit_no(max_drives), drive_opcnt(max_drives)
      integer*4 new_opcnt(max_drives), drive_wait_queue(max_drives)
      integer*4 exit_block(4)
      integer*4 interval(2)
      character*15 drive_name(max_drives)
      character*4 string_buffer
      byte key_buf, cntlc, cntly, cntlw, null
      data cntlc /'03'X/, cntly /'19'X/, cntlw /'17'X/, null /'00'X/
      real*4 st_percent_utilized, lt_percent_utilized(max_mbas)
      real*4 st_qio_rate, lt_qio_rate(max_drives)
      common /prty/ previous_pri
c
      integer*4 errorv(2)
      data errorv(1) /'000F0001'X/
      logical*1 f77
c
c Test to see that this program was compiled correctly, e.g. FORTRAN/F77
c
      f77 = .true.
      do i = 1, 0
         f77 = .false.
         enddo
      if (.not. f77) then
         write (6,1010)
 1010    format (1x,'I''m sorry, but your version of MBAUSE was not',
     .              ' compiled correctly.'/
     .           1x,'Because I might crash your system, execution',
     .              ' can not continue.')
         call exit
         endif
c
c Find out info about MBAs present
c
      link = syspeek (%loc(ioc$gl_adplist),4)
      mba = 0
      do while (link .ne. 0)
         adp_type = syspeek (link+%loc(adp$w_adptype),2)
         if (adp_type .eq. %loc(at$_mba)) then
            mba = mba + 1
            if (mba .le. max_mbas) then
               adp_number(mba) = syspeek (link+%loc(adp$b_number),1)
               adp_tr(mba) = syspeek (link+%loc(adp$w_tr),2)
               adp_crb(mba) = syspeek (link+%loc(adp$l_crb),4)
               endif
            endif
         link = syspeek (link+%loc(adp$l_link),4)
         enddo
      number_of_mbas = min (mba, max_mbas)
c
c Get info about disk drive devices
c
      drive = 0
      ddb = syspeek (%loc(ioc$gl_devlist),4)
      do while (ddb .ne. 0)
         ucb = syspeek (ddb+%loc(ddb$l_ucb),4)
         dev_class = syspeek (ucb+%loc(ucb$b_devclass),1)
         if (dev_class .eq. %loc(dc$_disk) ) then
            do while (ucb .ne. 0 .and. drive .lt. max_drives)
               drive = drive + 1
               drive_ucb(drive) = ucb
               drive_name_cnt(drive) = syspeek (ddb+%loc(ddb$t_name),1)
               do i = 1, drive_name_cnt(drive)
                  drive_name(drive)(i:i) = 
     .                        char(syspeek(ddb+%loc(ddb$t_name)+i,1))
                  enddo
               drive_unit_no(drive) = syspeek (ucb+%loc(ucb$w_unit),2)
               ucb = syspeek (ucb+%loc(ucb$l_link),4)
               enddo
            endif         
         ddb = syspeek (ddb+%loc(ddb$l_link),4)
         enddo
      number_of_drives = drive
c
c Set the default previous priority in case we exit via the exit handler before
c the setpri routine is finished.
c
      previous_pri = 4
c
c Declare an exit handler to reset the priority on exit
c
      exit_block(1) = 0			! system uses this location for pointer
      exit_block(2) = %loc(reset_pri)	! address of exit handler
      exit_block(3) = 0			! number of arguments for handler
      exit_block(4) = %loc(status)	! location to store exit status code
      status = sys$dclexh (exit_block)
c
c Set the running priority as high as possible to avoid bias due to scheduler
c
      priority = 12
      status = sys$setpri (,,%val(priority),previous_pri)
c
c Initialize long term averages
c
      do mba = 1, number_of_mbas
         lt_percent_utilized(mba) = 0.
         enddo
      do drive = 1, number_of_drives
         lt_qio_rate(drive) = 0.
         enddo
c
c Note: come here to restart.
c
    1 continue
c
c Set up Mass bus display
c
      mbd_line_1 = 1
      status = lib$erase_page(1,1)
      status = lib$put_screen
     .         ('VAX MASSbus Utilization',mbd_line_1,28)
      status = lib$put_screen
     .         ('                  Short term   Long term   Mean chan.'
     .    ,mbd_line_1+1,13)
      status = lib$put_screen
     .         ('Channel   Nexus     % use        % use     wait Q len'
     .    ,mbd_line_1+2,13)
      mbd_line_n = mbd_line_1 + 2
      do mba = 1, number_of_mbas
         string_buffer = 'MBA'//char(ichar('A')+adp_number(mba))
         status = lib$put_screen (string_buffer,mbd_line_n+mba,14)
         write (string_buffer, '(i4)') adp_tr(mba)
         status = lib$put_screen (string_buffer,mbd_line_n+mba,22)
         enddo
c
c Set up disk drive display
c
      ddd_line_1 = mbd_line_n + max_mbas + 2
      status = lib$put_screen
     .         ('VAX Disk Drive I/O Rates',ddd_line_1,28)
      status = lib$put_screen
     .         ('Disk    Short term   Long term   Mean drive'
     .    ,ddd_line_1+1,18)
      status = lib$put_screen
     .         ('drive    QIOs/sec     QIOs/sec   wait Q len'
     .    ,ddd_Line_1+2,18)
      ddd_line_n = ddd_line_1 + 2
      do drive = 1, number_of_drives
         write (string_buffer, '(a,i1)')
     .        drive_name(drive)(1:drive_name_cnt(drive)),
     .        drive_unit_no(drive)
         status = lib$put_screen (string_buffer, ddd_line_n+drive, 18)
         enddo
c
c Now sample once every 1/4 second and update the display every 5 sec.
c Select a .25 second time interval (units are 0.1 microseconds)
c
      interval(1) = -250*1000*10 
      interval(2) = -1
c
      do while (.true.)
         do mba = 1, number_of_mbas
            mba_busy(mba) = 0
            chan_wait_queue(mba) = 0
            enddo
         do drive = 1, number_of_drives
            drive_wait_queue(drive) = 0
            drive_opcnt(drive) = 
     .              syspeek(drive_ucb(drive)+%loc(ucb$l_opcnt), 4)
            enddo
         status = sys$setimr(%val(1), interval,,)
         do i = 1, 20
            status = sys$wflor (%val(1), %val('00000002'X))
            status = sys$setimr(%val(1), interval,,)
            do mba = 1, number_of_mbas
               buffer = syspeek (adp_crb(mba)+%loc(crb$b_mask),1)
               buffer = buffer .and. '01'X
               if (buffer .ne. 0) mba_busy(mba) = mba_busy(mba) + 1
               link = syspeek (adp_crb(mba),4)
               do while (link .ne. adp_crb(mba))
                  link = syspeek (link,4)
                  chan_wait_queue(mba) = chan_wait_queue(mba) + 1
                  enddo
               enddo
            do drive = 1, number_of_drives
               base = drive_ucb(drive)+%loc(ucb$l_ioqfl)
               link = syspeek (base, 4)
               do while (link .ne. base)
                  link = syspeek (link, 4)
                  drive_wait_queue(drive) = drive_wait_queue(drive)+1
                  enddo
               enddo
            enddo
c
c Grab qio counts quickly
c
         do drive = 1, number_of_drives
            new_opcnt(drive) = 
     .             syspeek(drive_ucb(drive)+%loc(ucb$l_opcnt), 4)
            enddo
c
c Update the disk drive display
c
         do drive = 1, number_of_drives
            st_qio_rate = (new_opcnt(drive) - drive_opcnt(drive)) / 5.
            drive_opcnt(drive) = new_opcnt(drive)
            write (string_buffer, '(f4.1)') st_qio_rate
            status = lib$put_screen (string_buffer,ddd_line_n+drive,29)
            lt_qio_rate(drive) = filter2 * lt_qio_rate(drive) +
     .                           filter1 * st_qio_rate
            write (string_buffer, '(f4.1)') lt_qio_rate(drive)
            status = lib$put_screen (string_buffer,ddd_line_n+drive,42)
            write (string_buffer, '(f4.2)') drive_wait_queue(drive)/20.
            status = lib$put_screen (string_buffer,ddd_line_n+drive,53)
            enddo
c
c Update the MASSbus display
c
         do mba = 1, number_of_mbas
            st_percent_utilized = mba_busy(mba) * 5
            write (string_buffer, '(f4.1)') st_percent_utilized
            status = lib$put_screen (string_buffer,mbd_line_n+mba,34)
            lt_percent_utilized(mba) = filter2*lt_percent_utilized(mba)
     .                               + filter1*st_percent_utilized
            write (string_buffer, '(f4.1)') lt_percent_utilized(mba)
            status = lib$put_screen (string_buffer,mbd_line_n+mba,47)
            write (string_buffer, '(f4.2)') chan_wait_queue(mba)/20.
            status = lib$put_screen (string_buffer,mbd_line_n+mba,58)
            enddo
c
c Let outstanding timer timeout
c
         status = sys$wflor (%val(1), %val('00000002'X))
         call readkey (key_buf)
         if (key_buf .eq. cntlw) go to 1
         enddo
      stop
      end
c
      subroutine reset_pri
      implicit integer*4 (a-z)
      external ss$_normal
      common /prty/ previous_pri
      integer*4 errorv(2)
      data errorv(1) /'000F0001'X/
      errorv(2) = sys$setpri (,,%val(previous_pri),)
      if (errorv(2) .ne. %loc(ss$_normal)) then
         call sys$putmsg(errorv,,)
         end if
      return
      end