*COMDECK,PBPERFORM
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                         P B P E R F O R M                           * 
*                                                                     * 
*            PERFORM PERIODIC SYSTEM PERFORMANCE MEASUREMENTS         * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-  NON RECURSIVE, INTERRUPTABLE  ? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - THIS PROCEDURE IS CALLED ONCE EVERY PFINTVAL SECONDS    * 
*             TO MEASURE THE NPU PERFORMANCE. FOR ACCURATE RESULTS,   * 
*             THE SAMPLE INTERVAL TIME MUST BE 1,2,4 OR 8.            * 
*                                                                     * 
** INPUTS   - BTLOOP  - NR TIMES THROUGH MONITOR DURING SAMPLE TIME   * 
*             PFWLCNT - NR OF PROCESSED WORKLIST DURING SAMPLE TIME   * 
*             PFABFRS - SUM OF NR AVAILABLE BUFFERS EVERY 1/2 SECOND  * 
*             PFDLCHR - NR OF DL CHARACTER / 32 DURING SAMPLE TIME    * 
*             PFULCHR - NR OF UL CHARACTER / 32 DURING SAMPLE TIME    * 
*                                                                     * 
** OUTPUTS  - EVERY PFCOUNT * PFINTVAL AN UPLINE SVM IS BUILD AND     * 
*             SHIPPED TO CS FOR RECORDING THE PERFORMANCE.            * 
*             THE INPUTTED COUNTERS ARE RESET EVERY TIME.             * 
*                                                                     * 
** EXTERNAL SUBROUTINE USED -                                         * 
*             PBSWLE   - SWITCH BLOCK THROUGH BIP                     * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PBPERFORM;
  
VAR 
  MSG : PACKED RECORD 
              MLFCD  : INTEGER;             _LCD/FCD FOR PBFCOPY       ?
              MDCSN  : INTEGER;             _DN/SN                     ?
              MCNBT  : INTEGER;             _CN/BT                     ?
              MPSFC  : INTEGER;             _PFC/SFC                   ?
              MCPU   : INTEGER;             _PERCENTAGE OF CPU LOAD    ?
              MABFRS : INTEGER;             _AVERAGE NUMBER OF BUFFERS ?
              MLREGL : INTEGER;             _LOWEST REGULATION REACHED ?
              MIREGL : INTEGER;             _PERCENTAGE OF INPUT REGL  ?
              MDLC   : INTEGER;             _DOWNLINE CHARACTERS / SEC ?
              MULC   : INTEGER;             _UPLINE CHARACTERS / SEC   ?
              MABOD  : INTEGER;             _ACTIVE BATCH OUTPUT DEVS  ?
              MABID  : INTEGER;             _ACTIVE BATCH INPUT DEVS   ?
              MAIAC  : INTEGER;             _INTERACTIVE CONNECTIONS   ?
              MWLC   : INTEGER;             _AVERAGE NR WORKLISTS / SEC?
              MARES1 : INTEGER; 
              MARES2 : INTEGER;             _RESERVED FOR INSTALLATION ?
            END;
  
  CURLCB  : BZLCBP; 
  CURTCB  : B0BUFPTR; 
  WRKPTR  : B0BUFPTR; 
  MSGPTR  : B0BUFPTR; 
  CPAVAIL : INTEGER;
  CPCYCLE : INTEGER;
  
VALUE 
  MSG = ($1F02,                             _LCD/FCD (FOR PBFCOPY)     ?
         $0000,                             _DN/SN                     ?
         $0004,                             _CN/BT                     ?
         $1A00);                            _PFC/SFC                   ?
  
BEGIN 
PFCURCT := PFCURCT + 1;                     _BUMP PERFORM CYCLE COUNTER?
IF PFCURCT = PFCOUNT
THEN                                        _STATS TO BE GENERATED     ?
  BEGIN 
  PFCURCT := 0;                             _RESET WORK COUNTER        ?
  WITH MSG DO 
    BEGIN 
_ 
* * * *  IDLE MONITOR LOOP TIME FOR A SYSTEM WITH THE MINIMUM NR OF 
*        ACTIVE WLCB-S (7) IS AROUND 146 MICRO-SECS, IF THE SAMPLE
*        TIME (PFINTVAL) IS 8 SECS, BTLOOP CAN BE AS HIGH AS 54,000.
*        PFMONCY CONTAINS THE MAXIMUM NR OF MONITOR LOOPS DURING
*        PFINTVAL/2 SECONDS (FOR A COMPLETELY IDLE CPU).
*        FOR CORRECT MEASUREMENTS, THE PROTECT SWITCH MUST BE OFF.
? 
    INST ($0544,$FE00,     _LFA  BTLOOP   ? _GET MON LOOPS DIVIDED BY 2?
          BTLOOP,          _UPPER 15 BITS ? 
          $6400,CPCYCLE);  _STA  CPCYCLE  ? _STORE COUNTER LOCALLY     ?
  
    IF CPCYCLE > PFMONCY                    _GREATER THAN CALCULATED AT?
    THEN                                    _INITIALIZATION TIME       ?
      PFMONCY := CPCYCLE +                  _USE AS 1 PERCENT CPU LOAD ?
                 CPCYCLE / 100; 
  
    INST ($C400,CPCYCLE,   _LDA  CPCYCLE  ? _GET MON LOOPS DIVIDED BY 2?
          $2000,1000,      _MUI  =N1000   ? _MULTIPLY BY 1000          ?
          $3400,PFMONCY,   _DVI  PFMONCY  ? _DIVIDE BY MAX NR OF CYCLES?
          $6400,CPAVAIL);  _STA  CPAVAIL  ? 
                                            _GET CPU LOAD FACTOR WITH  ?
    MCPU   := 1000 - CPAVAIL;               _1/10TH OF A PERCENT ACCUR.?
    MABFRS := PFABFRS / (PFINTVAL * 2);     _AVERAGE NR AVAILABLE BFRS ?
    MLREGL := PFLREGL;                      _GET LOWEST NPU REGL LEVEL ?
    MDLC   := PFDLCHR * (32 / PFINTVAL);    _GET D/L CHARACTERS / SEC  ?
    MULC   := PFULCHR * (32 / PFINTVAL);    _GET U/L CHARACTERS / SEC  ?
    MWLC   := PFWLCNT / PFINTVAL;           _GET NR WORKLISTS / SEC    ?
_ 
* * * *  CALCULATE INPUT REGULATION PERCENTAGE
? 
    INST ($C400,PFIREGL,   _LDA  PFIREGL  ? _GET NR INPUT REGULATIONS  ?
          $2000,100,       _MUI  =N100    ? _MULTIPLY BY 100           ?
          $3400,PFCREGL,   _DVI  PFCREGL  ? _DIVIDE BY CALLS TO PTREGL ?
          $0900,           _INA  0        ? _MAKE SURE RESULT ISNT -0  ?
          $6CF9);          _STA  PFIREGL  ? _STORE PERCENTAGE          ?
  
    MIREGL := PFIREGL;                      _GET INPUT REGL PERCENTAGE ?
_ 
* * * *  CALCULATE NR OF ACTIVE PRINTER STREAMS 
? 
    MABOD    := 0;                          _CLEAR ACTIVE DEVICE CNTRS ?
    MABID    := 0;
    MAIAC    := 0;
    CURLCB  := CELCBACT.CEFRST;             _GET FIRST ACTIVE LCB      ?
    WHILE CURLCB " NIL DO 
      BEGIN 
      IF CURLCB'.BZDIAG = FALSE             _NOT ON-LINE DIAGNOSTICS   ?
      THEN
      IF CURLCB'.BZLINO.BDPORT " 0          _IF VALID LINE - NOT SUBLCB?
      THEN
        BEGIN 
        CURTCB := CURLCB'.BZTCBPTR;         _GET FIRST TCB FROM LCB    ?
        WHILE CURTCB " NIL DO 
          BEGIN 
          IF CURTCB'.BSTCB.BSDEVTYPE " N1CON
          THEN
            BEGIN                           _BATCH DEVICE TYPE         ?
            CASE CURLCB'.BZTIPTYPE OF 
                                            _*WARNING* HIDDEN *IF DEF-S?
              N1HASP: 
                BEGIN 
*IF DEF,HASPTIP 
                IF CURTCB'.BSTCB.BSHTPCB " NIL
                THEN
                  IF CURTCB'.BSTCB. 
                     BSDEVTYP = N1CR
                  THEN
                    MABID := MABID + 1      _ACTIVE HASP CR            ?
                  ELSE
                    MABOD := MABOD + 1;     _ACTIVE HASP LP/CP         ?
*ENDIF
                END;
              N1M4: 
                BEGIN 
*IF DEF,MODE4 
                IF CURTCB'.BSTCB. 
                   BSDEVTYP = N1CR
                THEN
                  MABID := ORD (CURTCB'.BSTCB.BS4CCBPTR'. 
                                BVCCB.BVCRON) + MABID 
                ELSE
                  MABOD := ORD (CURTCB'.BSTCB.BS4CCBPTR'. 
                                BVCCB.BVLPON) + MABOD;
*ENDIF
                END;
              N1BSC:  
                BEGIN 
*IF DEF,BSC 
                IF CURLCB'.BZBSCEXT'. 
                   BCCHAINS [4] = CURTCB    _BZS3ITCB = CURTCB         ?
                THEN
                  MABID := MABID + 1;       _ACTIVE BISYNC CR          ?
                IF CURLCB'.BZBSCEXT'. 
                   BCCHAINS [3] = CURTCB    _BZS3OTCB = CURTCB         ?
                THEN
                  MABOD := MABOD + 1;       _ACTIVE BISYNC LP/CP       ?
*ENDIF
                END;
              N13270: 
                BEGIN 
*IF DEF,3270TIP 
                IF CURTCB'.BSTCB.BS3TPCBP " NIL 
                THEN
                  MABOD := MABOD + 1;       _ACTIVE 3270 PRINTER      ? 
*ENDIF
                END;
              END; _CASE BZTIPTYPE? 
          END _IF BSDEVTYPE " N1CON?
          ELSE
            IF CURTCB'.BSTCB.BSCN " 0       _INTERACTIVE DEVICE        ?
            THEN
              MAIAC := MAIAC + 1;           _BUMP ACTIVE I/A CONNECTNS ?
          CURTCB := CURTCB'.BSTCB.BSCHAIN;  _ADVANCE TO NEXT TCB       ?
          END; _WHILE CURTCB " NIL? 
        END; _IF BDPORT " 0?
      CURLCB := CURLCB'.BZTMRCHN;           _GET NEXT ACTIVE LCB       ?
      END; _WHILE CURLCB " NIL? 
_ 
* * * *  PASS PERFORMANCE STATISTICS TO HOST IF HOST IS AVAILABLE 
? 
    IF CS " 0 
    THEN                                    _HOST AVAILABLE            ?
      IF PB1BFAVAIL (B0THDIS)               _AND A BUFFER AVAILABLE    ?
      THEN
        BEGIN 
        MDCSN  := CS * $100 + CKLOCNODE;    _INSERT DN/SN              ?
        WRKPTR := NIL;                      _COPY PERFORMANCE MESSAGE  ?
        ADDR (MSG, MSGPTR);                 _DEFEAT TYPE CHECKING      ?
        PBFCOPY (MSGPTR, WRKPTR);           _TO DYNAMIC BUFFER         ?
        PBSWLE  (WRKPTR);                   _PASS SVM FURTHER UPLINE   ?
        END;
    END; _WITH MSG DO?
  END; _IF PFCURCT = PFCOUNT? 
_ 
* * * *  CLEAR COUNTERS EVERY TIME PBPERFORM IS CALLED
? 
  BTLOOP  := 0;                             _RESET MONITOR LOOP COUNT  ?
  PFDLCHR := 0;                             _RESET D/L CHAR COUNT      ?
  PFULCHR := 0;                             _RESET U/L CHAR COUNT      ?
  PFWLCNT := 0;                             _RESET WORKLIST COUNT      ?
  PFABFRS := 0;                             _RESET AVAILABLE BFR COUNT ?
  PFIREGL := 0;                             _RESET INPUT REGULATIONS   ?
  PFCREGL := 0;                             _RESET NR PTREGL CALLS     ?
  PFLREGL := NPUREG;                        _RESET LOWEST REGULATION LV?
END; _PROCEDURE PBPERFORM?
_$J+? 
_*****************************
*                            *
*         PNPSTAT            *
*  PERIODIC STATISTICS DUMP  *
*                            *
*****************************?
_$R-,G-,I-     NON-RECURSIVE
               INTERRUPTABLE ?
_***********************************************************************
*                                                                      *
**OVERVIEW- PNPSTAT IS ENTERED PERIODICALLY FROM PBTIMAL, THE OPS      *
*           LEVEL TIMER, TO DUMP AND CLEAR STATISTICS.  THE PERIOD     *
*           OF PNPSTAT IS A BUILD-TIME PARAMETER.  EACH TIME           *
*           PNPSTAT IS ENTERED IT SEARCHES THE ACTIVE LINE            * 
*           STATISTICS BLOCKS UNTIL A NON-ZERO BLOCK IS FOUND OR       *
*           UNTIL THE CYCLE IS COMPLETED.                              *
*           THE ORDER OF SEARCH IS:                                    *
*                                                                      *
*                   1ST ACTIVE LINE STATS                              *
*                         .                                            *
*                         .                                            *
*                   LAST ACTIVE LINE STATS                             *
*                                                                      *
**INPUT- NONE                                                          *
*                                                                      *
**OUTPUT- STATISTICS DUMPED AND CLEARED.                               *
*                                                                      *
**EXTERNAL SUBROUTINES-                                                *
*             1) PNDSTAT      DUMP AND CLEAR STATISTICS                *
*                                                                      *
***********************************************************************?
PROCEDURE PNPSTAT;
  
VAR 
  DONE : BOOLEAN; 
_  ******  CAUTION - HIDDEN *IF DEF,HLIP  ******  ? 
*IF DEF,HLIP
  I         : INTEGER;                      _LOCAL PORT NUMBER COUNTER ?
  NEXTTRUNK : B0BUFPTR;                     _LOCAL TRUNK LCB POINTER   ?
  
VALUE 
  I         = 1;                            _INITIAL PORT TO CHECK     ?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR HLIP CODE  ******  ? 
  
BEGIN 
DONE := FALSE;                              _RESET STAT DUMPED FLAG    ?
WHILE (DONE = FALSE) DO                     _LOOP TIL STATISTICS DUMPED?
  BEGIN 
  IF CUNXTLCB = NIL                         _END OF ACTIVE LINE CHAIN  ?
  THEN
    BEGIN 
    CUNXTLCB := CELCBACT.CEFRST;            _GO TO TOP OF CHAIN        ?
_  ******  CAUTION - HIDDEN *IF DEF,HLIP  ******  ? 
*IF DEF,HLIP
    REPEAT                                  _AND FOR EACH TRUNK PORT   ?
    IF I @ C0NPBL                           _IF THIS IS A TRUNK PORT   ?
    THEN
      BEGIN                                 _TEST FOR STATISTICS       ?
      ADDR (CGLCBP'[I],NEXTTRUNK);
      IF NEXTTRUNK'.BZZLCB.BZSTIC " CRZERO.CRLNCNTS 
      THEN
        BEGIN                               _IF THERE ARE NUMBERS      ?
        PNDSTAT (NEXTTRUNK);                _REPORT THEM AND           ?
        DONE := TRUE;                       _EXIT BOTH WHILE LOOPS     ?
        END 
      ELSE                                  _ELSE LOOK AT THE NEXT PORT?
        I := I + 1; 
      END _ IF I @ C0NPBL ? 
    ELSE
      BEGIN 
      I    :=  1;                           _RESET TO TEST FIRST TRUNK ?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR HLIP CODE  ******  ? 
  
      DONE :=  TRUE;                        _EXIT WHILE LOOP           ?
  
_  ******  CAUTION - HIDDEN *IF DEF,HLIP  ******  ? 
*IF DEF,HLIP
      END;
    UNTIL DONE = TRUE;                      _FOUND STATS OR CHECKED ALL?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR HLIP CODE  ******  ? 
    END 
  ELSE
    BEGIN 
    IF CUNXTLCB'.BZSTIC " CRZERO.CRLNCNTS   _IF STATISTICS PRESENT     ?
    THEN
      BEGIN                                 _DUMP THEM                 ?
      PNDSTAT (CUNXTLCB);                   _LINE POINTER IS PASSED    ?
      DONE := TRUE;                         _POP WHILE LOOP            ?
      END;
    CUNXTLCB := CUNXTLCB'.BZTMRCHN;         _NEXT LINE ON TIMER CHAIN  ?
    END;
  END; _ WHILE... ? 
END; _ PROCEDURE PNPSTAT ?
_$J+? 
_*****************************
*                            *
*          PGDSTAT           *
*       DUMP STATISTICS      *
*                            *
*****************************?
_$R-,G-,I+     NON-RECURSIVE
               NON-INTERRUPTABLE ?
_***********************************************************************
*                                                                      *
**OVERVIEW - THIS PROCEDURE IS CALLED TO DUMP LINE STATISTICS -       * 
*           IF A CONTROLLING CS IS ESTABLISHED AND BUFFER AVAILABLE.   *
*           THE STATISTICS ARE CLEARED IF DUMPED.                      *
*                                                                      *
**INPUT -    LINE CONTROL BLOCK POINTER                               * 
*                                                                      *
**CALLING PROGRAMS-                                                    *
*               1) PNPSTAT    PERIODIC STATISTICS DUMP                 *
*                             (THE PERIOD IS A BUILD TIME PARAMETER    *
*                              MONITORED BY PBTIMAL, OPS LEVEL TIMER)  *
*               3) PNSGATH    BUMP STATISTICS SPECIFIED BY USER        *
*                             (DUMP STATISTICS IF OVERFLOWS)           *
*                                                                      *
**OUTPUT- A SM CONTAINING THE STATISTICS TO DUMP.                      *
*                                                                      *
**EXTERNAL SUBROUTINES-                                                *
*               1) PBBFAVAIL       CHECK FOR BUFFER AVAILABILITY       *
*               2) PBGET1BF        GET A BUFFER                        *
*               3) PBREL1BF        RELEASE A BUFFER                    *
*               4) PBSWLE          MAKE A WORKLIST ENTRY TO BIP        *
*                                                                      *
**NOTE- BECAUSE OF THE DIFFERENT INTERPRETATIONS OF THE CONTROL        *
*       BLOCK ADDRESS, TYPE CHECKING IS DEFEATED.                      *
*                                                                      *
***********************************************************************?
PROCEDURE PGDSTAT (ADDR : B0BUFPTR);
CONST 
      P     = P3;                           _PORT NUMBER    - LN STATS ?
      SP    = P4;                           _SUBPORT NUMBER - LN STATS ?
      LILCD = P18;                          _LCD FOR LINE STATS SM     ?
VAR 
      BFR        : B0BUFPTR;                _SM BUFFER                 ?
BEGIN 
IF CS " 0                                   _CHECK IF CS IS ACCESSIBLE ?
THEN
  IF PB1BFAVAIL (B0THDIS)                   _CHECK IF BUFFER AVAILABLE ?
  THEN
    BEGIN 
    BFR := PBGET1BF (BEDBSIZE);             _GET A BUFFER FOR STATS SM ?
    WITH BFR' DO                            _SET INDEX TO STATS BUFFER ?
_ 
****  FORMAT LINE / TRUNK STATISTICS
? 
        BEGIN 
        WITH ADDR'.BZZLCB DO                _SET INDEX TO LCB          ?
          BEGIN 
          IF BZDIAG = FALSE                 _CHECK IF DIAGNOSTICS OFF  ?
          THEN
            BEGIN                           _YES DIAGS NOT IN PROGRESS ?
*IF DEF,HLIP
            IF BZTIPTYPE = N0HDLC           _CHECK IF TRUNK OR LINE    ?
            THEN
              BFDATAC[SFC] := CHR(D9TR)     _SET SFC - TRUNK STATISTICS?
            ELSE
              BFDATAC[SFC] := CHR(D9LI);    _SET SFC - LINE STATISTICS ?
*ENDIF
*IF -DEF,HLIP,1 
            BFDATAC[SFC] := CHR(D9LI);      _SET SFC - LINE STATISTICS ?
            BFDATAC[P]  := CHR(BZLINO.      _SET PORT                  ?
                               BDPORT); 
            BFDATAC[SP] := CHR(BZLINO.      _SET SUBPORT               ?
                               BDSUBPORT);
            BFLCD       := LILCD;           _SET LCD                   ?
            CPLINE      := BZSTIC;          _PLACE LINE STATS IN SM BFR?
            BZSTIC      := CRZERO.CRLNCNTS; _CLEAR LINE STATISTICS     ?
  
            END _IF BZDIAG = FALSE? 
          ELSE
            BEGIN                           _DIAGNOSTICS IN PROGRESS   ?
            PBREL1BF (BFR,BEDBSIZE);        _RELEASE THE STATS SM BFR  ?
            GOTO 10;                        _BYPASS DISPATCHING OF SM  ?
            END; _IF BZDIAG = FALSE ELSE? 
          END; _WITH ADDR'.BZZLCB DO? 
_ 
****  COMPLETE THE STATISTICS SERVICE MESSAGE AND SEND IT TO CS 
? 
      BFDATAC[DN]   := CHR(CS);             _SET DN  - CS              ?
      BFDATAC[SN]   := CHR(CKLOCNODE);      _SET SN  - THIS NODE       ?
      BFDATAC[CN]   := CHR(0);              _SET CN  - 0               ?
      BFDATAC[BTPT] := CHR(HTCMD + $80);    _SET BT  - HI PRIORITY CMD ?
      BFDATAC[PFC]  := CHR(D8STI);          _SET PFC - STATISTICS      ?
      BFFCD         := DN;                  _SET FCD - DN              ?
  
      PBSWLE (BFR);                         _DISPATCH THE STATS SM     ?
      END; _WITH BFR' DO? 
    END; _IF PBBFAVAIL .... ? 
10: 
END; _PROCEDURE PGDSTAT?
