From: 70604.2163@CompuServe.COM (Lee Burns)
Subject: "Who's on first?"
Reply-To: Info-Prime@Blx-A.Prime.COM
Date: Fri, 6 Nov 1992 03:25:45 GMT

Here's a utility which will list user timeslices & priorities along with
ID, Project, & user type - it's handy for seeing what the real mix of
priorities & timeslices are for all users.  Why do you need this?  You
need it if you want to have a chance at getting online users & BATCH users
to co-exist gracefully on the same system or for other traditionally
hard to tune environments.  

Along with the -PRAT option of SSA this utility can show "who's on
first" ... keep the dinosaurs alive!

C
C      List_prts.ftn,  Lee Burns, 10/92
C
C      List priority & timeslice of online processes
C      Subtitle: "Who's on first?"
C
C      Requires rev 23 due to G$METR call support
C      
C      Can't figure out why you want to know about priorities & timeslices?
C      This is how CPU resources are granted so if you want to favor one
C      group of users over another you will want to juggle either priority or
C      timeslice or both.  Unfortunately I can't explain it all in a freebie
C      program but I will answer brief questions re tuning etc. 
C
C      This program was developed to determine the proper tuning for a system
C      running a MIDAS+ replacement with custom client/server software.  The
C      software only did locking properly for non-remote access so voila - hand
C      off the request to a remote slave & now FAST thinks it's local.  BUT,
C      tuning now becomes more important because local processing will kill the
C      performance of the slave processes.  Hence this program.
C
C      Yes, you can run slaves & BATCH jobs on the same system as long as the 
C      priorities are done right!
C
      SUBROUTINE MAIN (CMDLIN,ERRCOD)
$INSERT SYSCOM>KEYS.INS.FTN
$INSERT SYSCOM>USER_TYPES.INS.FTN
C
C      Copy of NPX key defs for R$CALL etc 
C
      INTEGER*2 K$FUNC,K$WFRC,K$RTRY
      INTEGER*2 K$I2,K$I4,K$CHAR,K$VCHR,K$LOC,K$FL,K$DFL
      INTEGER*2 K$IN,K$OUT,K$REF
      PARAMETER (K$WFRC = 0,K$FUNC=8192,K$RTRY=16384)
      PARAMETER (K$I2=0,K$I4=256,K$CHAR=512,K$VCHR=768,K$LOC=1024,
     *           K$FL=1280,K$DFL=1536)
      PARAMETER (K$IN=128,K$OUT=64,K$REF=0)
C
C      Local variables
C
      INTEGER*2 BUFFER(512),I,ERRCOD,SYS,NUSR,J,K,STARS(35),CUTYPE
      INTEGER*4 IDLTXT(3)
      LOGICAL NAMEQ$,REMOTE
      INTEGER*2 KEY,BUFSIZ,REV,CODE,SCAN,CMDLIN(65),USRNMS(3,26)
      INTEGER*2 TTAB(128),PIC(14),CL$NAM(6),CL$KEY,PINDEX,BINDEX
      INTEGER*4 I4SCN,SLVID(2)
      INTEGER*2 RCODE,MYNOD(17),OUTNM,OUTND(17),R$ALOC
      PARAMETER(KEY=4,REV=9,BUFSIZ=74)
      PARAMETER(SYS=1,CL$KEY=0)
      COMMON/ALGNCM/I4SCN,OUTNM,OUTND    /* Force COMMON alignment for CL$PIX 
      DATA STARS/35*'**'/                /* A line of asterisks
      DATA CL$NAM /9,'LIST_PRTS'/
      DATA PIC /21,'dec=6; -on entry; end    '/
      DATA IDLTXT /'IdleSIdlSusp'/           /* Idle / SysIdle / Suspend
C
C      The following is a table which equates a user type to a text
C      string indexed in USRNMS
C
      DATA TTAB/1,2,2,2,3,7,58*0,4,4,5,6,7,8,9,10,11,12,13,14,15,16,
     *17,18,19,20,21,18,22,23,24,26,24,25,37*0,24/
      DATA USRNMS /'term  ',
     *' rem  ',
     *' asr  ',
     *'phant ',
     *'slave ',
     *'batch ',
     *' fam  ',
     *' nsp  ',
     *' rts  ',
     *'child ',
     *' LSr  ',
     *'kernel',
     *' CSr  ',
     *' NSr  ',
     *' SMSr ',
     *'Audit ',
     *' ncm  ',
     *' DSM  ',
     *'kernel',
     *'kernel',
     *'ISCNsr',
     *'kernel',
     *'NameSr',
     *'kernel',
     *'spool ',
     *' PNX  '/
      ERRCOD = -1
      CALL CL$PIX(CL$KEY,CL$NAM,LOC(PIC),128,CMDLIN,LOC(I4SCN),PINDEX,
     *            BINDEX,CODE)           /* Easy way to parse arguments
      CALL ERRPR$(K$NRTN,CODE,0,0,CL$NAM(2),CL$NAM(1))
      SCAN = I4SCN                       /* See if any individual levels
      IF(SCAN .LT. 0) RETURN
      IF(SCAN .GT. 6) RETURN
      ERRCOD = 0
      CALL R$MYNM(MYNOD)                 /* Get my node name
      REMOTE = .TRUE.                    /* Start with true
      IF(OUTND(1) .EQ. 0) REMOTE = .FALSE.
      IF(NAMEQ$(MYNOD(2),MYNOD(1),OUTND(2),OUTND(1))) REMOTE = .FALSE.
      IF(MYNOD(1) .EQ. 0) REMOTE = .FALSE. /* Set false for any of several
      IF(.NOT. REMOTE) GOTO 50             /* reasons
      K = R$ALOC(OUTND,SLVID,RCODE)        /* Get a slave process
      IF(RCODE .NE. 0) REMOTE = .FALSE.    /* Oops - not politically correct
      IF(RCODE .NE. 0) GOTO 50             /* Demote to local only if error
      CALL R$CALL(K$FUNC,SLVID,'G$METR',6,RCODE,
     *SYS,1,K$I2+K$IN,
     *LOC(BUFFER),13,K$I2+K$IN+K$OUT+K$LOC,
     *13,1,K$I2+K$IN,
     *I,1,K$I2+K$IN,
     *REV,1,K$I2+K$IN,
     *CODE,1,K$I2+K$OUT)
      GOTO 75
50    CALL G$METR(SYS,LOC(BUFFER),13,I,REV,CODE)
C
C      Get the configured number of users whether local or remote
C
75    NUSR = BUFFER(11)
      CALL TNOU(STARS,69)                   /* Print banner stuff
      CALL TNOUA('* USER |',8)
      CALL TNOUA(' NAME             |',19)
      CALL TNOUA('  TYPE  |',9)
      CALL TNOUA(' PROJECT          |',19)
      CALL TNOUA('  PRI |',7)
      CALL TNOU('   TS *',7)
      CALL TNOU(STARS,69)
      DO 200 I=1,NUSR                       /* For every configured user
      IF(REMOTE) GOTO 80                    /* get priority & timeslice
      CALL G$METR(KEY,LOC(BUFFER),BUFSIZ,I,REV,CODE)
      GOTO 85                               /* Local call
80    CALL R$CALL(K$FUNC,SLVID,'G$METR',6,RCODE,
     *KEY,1,K$I2+K$IN,                      /* Remote call
     *LOC(BUFFER),BUFSIZ,K$I2+K$IN+K$OUT+K$LOC,
     *BUFSIZ,1,K$I2+K$IN,
     *I,1,K$I2+K$IN,
     *REV,1,K$I2+K$IN,
     *CODE,1,K$I2+K$OUT)
85    IF(BUFFER(70) .EQ. 0) GOTO 200       /* No timeslice 
      IF(BUFFER(2) .LT. 0) GOTO 200        /* Logged out
      IF(SCAN .EQ. 6) GOTO 100
      IF(SCAN .EQ. 5 .AND. (BUFFER(70) .EQ. -1 .OR. BUFFER(69) .LT. 0))
     *GOTO 100
      IF(BUFFER(69) .NE. SCAN) GOTO 200   /* Looking for specific level only
100   CALL IOA$('* %4:1D | %$',99,I)      /* Logged in plus meets scan
      CALL TNOUA(BUFFER(5),16)            /* criteria - print info
      CALL TNOUA(' | ',3)
      CUTYPE = BUFFER(2)
      CUTYPE = TTAB(CUTYPE)
      CALL TNOUA(USRNMS(1,CUTYPE),6)
      CALL TNOUA(' | ',3)
      CALL TNOUA(BUFFER(21),16)
      CALL TNOUA(' | ',3)
      IF(BUFFER(69) .LT. 0) GOTO 175
      CALL IOA$('%4:1D | %4:1D *%.',99,BUFFER(69),BUFFER(70))
      GOTO 200                            /* "User" priority
175   J = IABS(BUFFER(69))                /* "Idle" "Sysidl" etc
      IF(CUTYPE .GE. 6) J = 3             /* "Susp"ended phant/batch
      CALL IOA$('%A | %4:1D *%.',99,IDLTXT(J),4,BUFFER(70))
200   CONTINUE                            /* Try again
      IF(REMOTE) CALL R$RLS(SLVID,RCODE)  /* Done - release slave if any
      CALL TNOU(STARS,69)                 /* This could've been "96 tears"!
      RETURN
      END                                 /* End of list_prts.ftn

Usage is LIST_PRTS [0 / 1 / 2 / 3 / 4 / 5] - where optional value means
display specified priority level only.  Level 5 indicates that funny 
values like suspend, idle, & real-time timeslice users only will be
displayed.  No params means display all users.  Also supports "-on node".

Good luck ...

Newsgroups: comp.sys.prime