From:	SMTP%"turion@research.ptt.nl" 21-MAR-1994 18:18:40.99
To:	EVERHART
CC:	
Subj:	part 9 status tool

X-Newsgroups: comp.os.vms
From: turion_s@dnlts0research.ptt.nl. (Paul Turion)
Subject: part 9 status tool
Message-ID: <1994Mar21.144458.1508@news.research.ptt.nl>
Sender: turion_s@research.ptt.nl (Paul Turion)
Nntp-Posting-Host: dnlts0.research.ptt.nl
Reply-To: turion@research.ptt.nl
Organization: PTT Research
X-Newsreader: mxrn 6.18-4
Date: Mon, 21 Mar 1994 14:44:58 GMT
Lines: 449
To: Info-VAX@CRVAX.SRI.COM
X-Gateway-Source-Info: USENET


-- 
 ------- --------------------  			Paul Turion 
| p t t |  r e s e a r c h   |			The Netherlands
|      _|                    | 			e-mail address
|    _|_|   .  .  .  .  .    |			P.Turion@research.ptt.nl
|___|_|      
My interest is in the future because
I am going to spend the rest of my life there.
-+-+-+-+-+-+-+-+ START OF PART 9 -+-+-+-+-+-+-+-+
X15$:    MOVL    g`094SMP$GL_CPU_DATA`091R1`093,R0    ; Get the CPU database
X    BEQL    30$                ; This CPU doesn't exist
X    INCL    R4                ; Seen one more CPU
X    CMPL    CPU$L_CURPCB(R0),@#SCH$AR_NULLPCB ; Running 'the null job'?
X    BEQL    20$
X    MOVZBL    CPU$B_CUR_PRI(R0),-(SP)
X    BBS    (SP)+,PRIORITY_MASK,20$        ; but priority is 'masked'
X    INCL    R2                ; CPU is active.
X20$:    CMPB    CPU$B_CUR_PRI(R0),R3        ; Store the lowest executing
X priority
X    BLEQU    30$
X    MOVB    CPU$B_CUR_PRI(R0),R3
X30$:    INCL    R1
X    BRB    11$                ; Check for all 32 CPUs.
X35$:
XENDC
X`032
X;+ ---
X; Count done, calculate the load ave.
X;- ---
X    CVTLF    R2,R2                ;Float the count of processes
XIF    DF,VMS_V5
X    CVTLF    R4,R4                ;Float the count of CPUs
X    DIVF2    R4,R2                ;Load is Processes/CPUs.
XENDC
X; 1 min. load ave.
X    MULF3    R2,F11,R0            ;La=OldLa*F+NewLa*(1-F)
X    MULF3    M1,F1,R1
X    ADDF3    R0,R1,M1
X; 5 min. load ave.
X    MULF3    R2,F12,R0
X    MULF3    M5,F2,R1
X    ADDF3    R0,R1,M5
X; 15 min. load ave.
X    MULF3    R2,F13,R0
X    MULF3    M15,F3,R1
X    ADDF3    R0,R1,M15
X`032
X    CMPB    R3,#255                ; NULL JOB
X    BNEQ    40$
X    MOVB    #32,R3                ; TREAT AS PRIORITY 0
X40$:    SUBB3    R3,#32,R2
X    CVTBF    R2,R2
X; 1 min. priority ave.
X    MULF3    R2,F11,R0            ;La=OldLa*F+NewLa*(1-F)
X    MULF3    P1,F1,R1
X    ADDF3    R0,R1,P1
X; 5 min. priority ave.
X    MULF3    R2,F12,R0
X    MULF3    P5,F2,R1
X    ADDF3    R0,R1,P5
X; 15 min. priority ave.
X    MULF3    R2,F13,R0
X    MULF3    P15,F3,R1
X    ADDF3    R0,R1,P15
X`032
X;
X;   Update the disk queue length information
X;
XQUEUE_LEN:
X    CLRL    R2                ; R2 = Sun of queue lengths
X    PUSHR    #`094M<R10,R11>
X    CLRQ    R10                ; Indicate start of I/O d.b.
X10$:    JSB    G`094IOC$SCAN_IODB            ; Get next DDB and UCB into R10
V, R11
X    BLBC    R0,40$                ;  no more, done
X    CMPB    #DC$_DISK,UCB$B_DEVCLASS(R10)    ; Is this controller a disk?
X    BEQL    20$
X    CLRL    R10                ; Go for next controller
X    BRB    10$
X20$:    BBC    #DEV$V_MNT,UCB$L_DEVCHAR(R10),10$ ; Skip if not mounted
X    BITL    #<DEV$M_CDP+DEV$M_SSM>,UCB$L_DEVCHAR2(R10) ; class driver or sha
Vdow
X set member?
X    BNEQ    10$                ;          if so, skip
X    CVTWL    UCB$W_QLEN(R10),R0        ; Get queue length
X    BGEQ    30$
X    CLRL    R0                ; negative queu length is a temporary conditio
Vn
X30$:    CMPL    R0,R2
X    BLEQ    10$
X    MOVL    R0,R2
X    BRB    10$
X40$:    POPR    #`094M<R10,R11>            ; restore registers
X`032
X    CVTLF    R2,R2                ;Float the count
X; 1 min. queue ave.
X    MULF3    R2,F11,R0            ;La=OldLa*F+NewLa*(1-F)
X    MULF3    Q1,F1,R1
X    ADDF3    R0,R1,Q1
X; 5 min. queue ave.
X    MULF3    R2,F12,R0
X    MULF3    Q5,F2,R1
X    ADDF3    R0,R1,Q5
X; 15 min. queue ave.
X    MULF3    R2,F13,R0
X    MULF3    Q15,F3,R1
X    ADDF3    R0,R1,Q15
X    RSB                    ;Return to clock dispatcher
X`032
X`032
X`032
X    .SBTTL    END OF DRIVER
X;+ ---
X;
X; END OF DRIVER
X;
X;- ---
XLAV_END:                    ;LET DPTAB KNOW THE DRIVER SIZE
X;
X    .END
X`032
$ CALL UNPACK LAVDRIVER.TXT;1 258231164
$ create/nolog 'f'
X#include <nfbdef.h>
X#include <descrip.h>
X#include <iodef.h>
X#include <dvidef.h>
X#include <msgdef.h>
X
X#line 6 nd.c
X
X#define DAE_M_CHANNEL   128
X#define DAE_M_STATUS    64
X#define DAE_M_USER      32
X#define DAE_M_NODE      16
X#define DAE_M_FULL      8
X#define DAE_M_ALL       1
X
X#define DAE_V_CHANNEL   7
X#define DAE_V_STATUS    6
X#define DAE_V_USER      5
X#define DAE_V_NODE      4
X#define DAE_V_FULL      3
X#define DAE_V_ALL       0
X
X#define DAE_BRIEF       0
X#define DAE_FULL        8
X#define DAE_SYSTEM      9
X#define DAE_STATUS      64
X
X#define DAE_MAX_USER_LEN  8
X#define DAE_MAX_USERS     128
X#define DAE_MAX_USER_STR  DAE_MAX_USERS * (DAE_MAX_USER_LEN + 1)
X#define ___             0
X#define TRUE            1
X#define FALSE           0
X#define EMPTY           0
X#define FUNC_SIZE       3 + DAE_MAX_USER_STR
X#define MAXMESGLEN      128
X#define MAX_LINKS       128
X#define OBJ_NUM         252
X
Xstruct iosblock
X`123
X        short                   condition;
X        short                   trans_cnt;
X        int                     dev_specific;
X`125;
X
Xstruct nfb_block
X`123
X        unsigned char           func_code;
X        int                     object_num;
X`125;
X
Xstruct blk_desc
X`123
X        int                     size;
X        int                     addr_blk;
X`125;
X
Xstruct user_desc
X`123
X        int                     length;
X        int                     pointer;
X`125;
X
Xstruct com_blk
X`123
X        short                   channel;
X        int                     unit;
X        struct iosblock         iosb;
X        char                    func_code;
X        short                   user_len;
X        char                    user_string`091DAE_MAX_USER_STR`093;
X`125;
X
Xstruct itm_lst
X`123
X        short                   length;
X        short                   item_code;
X        int                     buf_addr;
X        int                     buf_len;
X        int                     endoflist;
X`125;
X
Xshort                           daemon_chan;
Xshort                           mbxchan;
Xchar                            mbxmesg`091MAXMESGLEN`093;
Xstruct  iosblock                iostatus;
Xstruct  iosblock                ast_iostat;
X
Xstruct  blk_desc                ncb_desc;
Xchar                            ncb`091100`093;
X
Xstruct  blk_desc                nfb_desc;
Xstruct  nfb_block               nfb;
X
Xstruct  user_desc               user_name;
X
Xint                             link_cnt;
Xstruct  com_blk                 connects`091MAX_LINKS`093;
X
X$DESCRIPTOR(device,"_NET:");
X$DESCRIPTOR(mbx_name,"DAEMON$MBX");
X
X
X
X/***************************************************************************
V***/
X/* What_daemon*/
X/*      This program is intended to as a server for looking up the current*/
X/* process on the system.  This can be done individually or through multiple
V*/
X/* requests.*/
X/***************************************************************************
V***/
X
Xmain()
X`123
X        int stat;  /* Return status for function calls */
X        int i;  /* Loop control variable */
X
X        link_cnt = 0;  /* Set our link count to zero initialy */
X
X        nfb_desc.size = 5;  /* Net function block for object # */
X        nfb_desc.addr_blk = &nfb;  /* Size and integer function code */
X
X        nfb.func_code = NFB$C_DECLOBJ;  /* Fill in network */
X        nfb.object_num = OBJ_NUM;  /* Function blk */
X
X        ncb_desc.size = 100;  /* Network control block descriptor length and
V */
X        ncb_desc.addr_blk = ncb;  /* Length and pointer to NCB */
X
X        for (i = 0; i < MAX_LINKS; i++)
X        `123
X                clearconnect(i);  /* Clear out all the connection blocks */
X        `125
X
X/* Create Daemon mailbox */
X
X        stat = sys$crembx(___,  /* Perm or temp flag */
X                          &mbxchan,  /* Mailbox channel */
X                          &MAXMESGLEN,  /* Maximum message length */
X                          ___,  /* Buffer quota */
X                          ___,  /* Protection mask */
X                          ___,  /* Access mode */
X                          &mbx_name);  /* Logical name for MBX */
X        if (`126stat&1) lib$stop(stat);
X
X/* Assign channel to device */
X
X        stat = sys$assign(&device,  /* Device name */
X                  &daemon_chan,  /* Returned channel number */
X                  ___,  /* Access mode */
X                  &mbx_name);  /* Mailbox name */
X        if (`126stat&1) lib$stop(stat);  /* Stop if a severe error message *
V/
X
X/* Use QIO call to declare process a network object */
X
X        stat = sys$qiow(___,  /* Event flag */
X                daemon_chan,  /* Device channel */
X                IO$_ACPCONTROL,  /* QIO function code */
X                ___,  /* Iostatus blk */
X                ___,  /* AST address */
X                ___,  /* AST parm */
X                &nfb_desc,  /* P1 - net function blk */
X                ___,___,___,___,___);  /* P2 - p6 */
X        if (`126stat&1)
X        `123
X            lib$signal(stat);  /* Signal a message and stop if a major error
V */
X            lib$signal(iostatus.condition);
X        `125
X
X        stat = set_mbx_ast();  /* Enable communication */
X        if (`126stat&1) lib$stop(stat);  /* (mailbox read ast) */
X
X        stat = sys$hiber();  /* Go to sleep (zzz...) */
X        if (`126stat&1) lib$stop(stat);  /* Signal a message and stop if maj
Vor error */
X
X        exit();
X`125 /* Main */
X
X
X
X/***************************************************************************
V***/
X/* Set_mbx_ast*/
X/*      This procedure is used to initialize the mailbox AST.*/
X/***************************************************************************
V***/
Xset_mbx_ast()
X
X`123
X        int mailbox_ast();  /* Routine to call upon IO completion */
X        int stat;  /* Status value of system calls */
X
X        stat = sys$qio(___,  /* QIO issue of AST routine on full mbx */
X                mbxchan,  /* MBX channel */
X                IO$_READVBLK,  /* Read virtual block function code */
X                &ast_iostat,  /* AST I/O status var */
X                mailbox_ast,  /* Routine to execute when message comes in */
X                ___,
X                &mbxmesg,  /* MBX message buffer */
X                MAXMESGLEN,  /* Maximum message length */
X                ___,___,___,___);
X        return;
X`125 /* Set_mbx_ast */
X
X
X
X/***************************************************************************
V***/
X/* Mailbox_ast*/
X/*      This procedure is intended to handle the AST on a mailbox.*/
X/***************************************************************************
V***/
X
Xmailbox_ast()
X
X`123
X        int             unit;  /* Unit number of current message */
X        int             index;  /* Index into connect table */
X        int             stat;  /* Status return value of system calls */
X        short           mesgtype;  /* Word for the message returned */
X
X        if (`126ast_iostat.condition&1) return;  /* Stop if AST QIO was bad
V */
X
X        mesgtype =  *(short *)&mbxmesg`0910`093;  /* Extract message type fr
Vom mbx message */
X        unit = *(short *)&mbxmesg`0912`093;  /* Extract unit number */
X
X        switch (mesgtype)  /* What message was received... */
X        `123
X                case MSG$_CONNECT:  /* Handle connect request */
X                        if (connect_accept(&index))  /* See if we can connec
Vt */
X                                stat = read_chan(index);  /* If we can, read
V the channel */
X                        else
X                                disconnect(index);  /* Disconnect the index,
V if one exists */
X                        stat = set_mbx_ast();  /* Set the mailbox AST again
V */
X                        return;  /* Go back to sleep until next AST fires */
X
X                case MSG$_NETSHUT:  /* Handle DECNET shutdown */
X                        stat = sys$wake(___,___);  /* Wake ourselves up */
X                        return;
X
X                case MSG$_REJECT:  /* Rejection and confirmation requests */
X                case MSG$_CONFIRM:
X                        stat = set_mbx_ast();  /* Just wait for another mail
V message */
X                        return;
X
X                case MSG$_ABORT:  /* Handle multitude of abortions */
X                case MSG$_DISCON:
X                case MSG$_EXIT:
X                case MSG$_INTMSG:
X                case MSG$_PATHLOST:
X                case MSG$_PROTOCOL:
X                case MSG$_THIRDPARTY:
X                case MSG$_TIMEOUT:
X                        index = findunit(unit);  /* Find the unit number giv
Ven */
X                        disconnect(index);  /* Do we have to get rid of any
V connect info */
X                        stat = set_mbx_ast();  /* - when we disconnect them?
V */
X                        return;
X
X                DEFAULT:  /* Handle fall through invalid requests */
X                        exit(mesgtype);
X        `125  /* End switch statement */
Xreturn;
X/************** %%%%%%%%%%%%%%%%%%%%% Join here with part 2  %%%%%%%% */
X/************** %%%%%%%%%%%%%%%%%%%%% Join here with part 1  %%%%%%%% */
X`125 /* Mailbox_ast */
X
X
X
X/***************************************************************************
V***/
X/* Connect_accept*/
X/*      This procedure is intended to handle the connect request from anothe
Vr*/
X/* node, and determine if we can handle a link to it or not.*/
X/***************************************************************************
V***/
X
Xconnect_accept(index)
X
Xint     *index;  /* Index into array of link blks */
X
X`123
X        int             unit;  /* Unit of device */
X        int             dummy_len;  /* Dummy place to put the length */
X        int             stat;  /* Status return value */
X        int             ret_code;  /* Code to return upon completion */
X        int             dev_chan;  /* Device channel we are going to talk on
V */
X
X        struct itm_lst  items;  /* We need an item list for SYS$GETDVI */
X        struct iosblock iosb;  /* We need an IO status block */
X
X        items.length = 4;  /* itemlist for GETDVI */
X        items.item_code = DVI$_UNIT;  /* We want a unit nubmer */
X        items.buf_addr = &unit;  /* Where to put the unit */
X        items.buf_len = &dummy_len;  /* Length of unit */
X        items.endoflist = 0;  /* Set end of item list */
X
X        *index = -1;  /* We don't point to anything yet */
X        getncb(&mbxmesg, &ncb_desc, &ncb);  /* Get the NCB of the calling pr
Vocess */
X
X        if (link_cnt<MAX_LINKS)  /* Have we reached the maximum links */
X        `123
X                stat = sys$assign(&device,  /* Assign a channel to that user
V */
X                                  &dev_chan,___,
X                                  &mbx_name);
+-+-+-+-+-+-+-+-  END  OF PART 9 +-+-+-+-+-+-+-+-

