-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+
X    struct rsb *rsb = &rsblist`5Brsb_node->index`5D;
X    struct lkbsum *lks = &locksum`5Brsb_node->index`5D;
X    char buf`5BMAXOUTLINE`5D, depth`5BMAXDEPTH`5D, flags`5B`5D = "DOX";
X    struct parent p;
X    unsigned long status;
X    int i;
X
X    if (rsb->rsb$l_parent == parent->s0addr) `7B
X        if (!rsb->rsb$v_direntry) flags`5B0`5D = ' ';
X        if (rsb->rsb$w_lckcnt) flags`5B1`5D = ' ';
X        if (!(rsb->rsb$w_status & `7E3)) flags`5B2`5D = ' ';
X
X        for (i = 0; i < rsb->rsb$b_depth; i++) depth`5Bi`5D = ' ';
X        depth`5Bi`5D = 0;
X
X        if (option.full)
X            sprintf(buf,`20
X        "%x %s %3d %s %3d %3d %3d %3d %3d %3d %3d %3d %3d %c %4o %6.6s %s%s\
Vn",
X                    rsb->rsb$l_hshchn, flags,
X                    rsb->rsb$w_refcnt & 0xffff, mode`5Brsb->rsb$b_cgmode`5D,
V`20
X                    rsb->rsb$w_lckcnt & 0xffff,
X                    lks->local, lks->prccpy, lks->mstcpy,
X                    lks->sys_owned, lks->proc_owned,
X                    lks->granted, lks->converting, lks->waiting,
X                    rmod`5Brsb->rsb$b_rmod`5D, rsb->rsb$w_group & 0xffff,`20
X                    rsb->rsb$l_csid ? cton(rsb->rsb$l_csid) : "",`20
X                    depth, resnam(rsb, parent->index));
X        else  `20
X            sprintf(buf, "%x %s %3d %s %3d %c %4o %6.6s %s%s\n",`20
X                    rsb->rsb$l_hshchn, flags,
X                    rsb->rsb$w_refcnt & 0xffff, mode`5Brsb->rsb$b_cgmode`5D,
X                    rsb->rsb$w_lckcnt & 0xffff,
X                    rmod`5Brsb->rsb$b_rmod`5D, rsb->rsb$w_group & 0xffff,`20
X                    rsb->rsb$l_csid ? cton(rsb->rsb$l_csid) : "",`20
X                    depth, resnam(rsb, parent->index));
X        fputs(buf, option.out);
X
X        if (rsb->rsb$w_refcnt && option.all) `7B
X            p.s0addr = rsb->rsb$l_hshchn; p.index = rsb_node->index;
X            if ((status = lib$traverse_tree(&rsb_tree, rsb_disp, &p))`20
X                        != LIB$_NORMAL)
X                lib$stop(status);
X        `7D
X    `7D
X    return(1);
X`7D
X
X
Xstatic void disp_rsbs()
X`7B
X    unsigned long status;
X    struct parent parent = `7B0, 0`7D;
X
X    if (option.full)
X        fprintf(option.out,`20
X"rsb      fla sub cg lck lcl cpy mst sys prc gra cvt wai m grou node  name\n
V");
X    else
X        fprintf(option.out, "rsb      fla sub cg lck m grou node   name\n");
X
X    if ((status = lib$traverse_tree(&rsb_tree, rsb_disp, &parent)) !=
XLIB$_NORMAL)
X        lib$stop(status);
X
X    if (!option.stats) return;
X
X    fprintf(option.out,`20
X        "\nreso mast root rmst  dir diro lock  lcl pcpy mcpy  sys proc chn\n
V");
X    fprintf(option.out,`20
X            "%4d %4d %4d %4d %4d %4d %4d %4d %4d %4d %4d %4d %3d\n",`20
X            stats.resources, stats.master_res,
X            stats.root_res, stats.master_root_res,
X            stats.dir_res, stats.dir_only_res,`20
X            stats.locks, stats.local,
X            stats.prccpy, stats.mstcpy,
X            stats.sys_owned, stats.proc_owned,
X            stats.max_chain);
X`7D
X
X/* -------------------------------------------------------------------------
V-
X*/
X
Xstatic struct exec_mode_errors `7B
X    int lkb_probe;
X    int lkb_type;
X    int rsb_probe;
X    int rsb_type;
X`7D eme;
X
X/*
X * This function attempts to produce a summary of all the LKBs chained to
X * a particular queue of an RSB. The description of the function copy_rsbs
X * contains a description of the perils we face whilst following pointer
X * chains and the precautions that we take.
X */
X
Xstatic int`20
Xscan_chain(struct rsb *rsb, unsigned long *head, struct lkbsum *lks)
X`7B
X    struct lkb *lkb;
X    int i;
X
X    for (i = 0, lkb = *head; lkb != head; i++) `7B
X        lkb = (unsigned long)lkb - LKB$L_SQFL;
X        if (!_PROBER(PSL$C_EXEC, sizeof (struct lkb), lkb))`20
X            `7Beme.lkb_probe++; break;`7D
X        if (lkb->lkb$b_type != DYN$C_LKB)`20
X            `7Beme.lkb_type++; break;`7D
X        if (lkb->lkb$v_mstcpy)`20
X            lks->mstcpy++;
X        else if (rsb->rsb$l_csid)
X            lks->prccpy++;
X        else
X            lks->local++;
X        if (lkb->lkb$l_pid)
X            lks->proc_owned++;
X        else
X            lks->sys_owned++;
X        lkb = lkb->lkb$l_sqfl;
X    `7D
X    return(i);
X`7D
X
Xstatic void scan_locks(struct rsb *rsb, struct lkbsum *lks)
X`7B
X    lks->granted = scan_chain(rsb, &rsb->rsb$l_grqfl, lks);
X    lks->converting = scan_chain(rsb, &rsb->rsb$l_cvtqfl, lks);
X    lks->waiting = scan_chain(rsb, &rsb->rsb$l_wtqfl, lks);
X`7D
X
X/*
X * This function examines each of the chains of the resource hash table.
X *
X * The lock database may change whilst we are running; although we could
X * lock the database against changes (by raising IPL to IPL$_SYNCH and
X * obtaining the SCS spin lock), this seems rather inappropriate for
X * a program of this type. Instead we probe each potentially dangerous
X * memory reference. Due to the nature of the probe instruction we must
X * insure that the previous access mode was also executive (because the
X * LKBs and RSBs are stored in non-paged pool which is only readable
X * from executive mode); this is achieved by recursively invoking this`20
X * function.
X *
X * As a futher check that we are not just following pointers ad infinitum
X * the "type" of each block is checked.
X *
X * The maximum length of the resource hash chains examined is recorded.
X *
X * The rsb$l_hshchn field of the saved RSB is used to remember the address
X * of the RSB. This makes further investigation of a resource with SDA
X * possible.
X *
X * If requested, we also produce a summary of the LKBs chained to each
X * RSB.
X */
X
Xstatic unsigned long copy_rsbs()
X`7B
X    int i, j, k;
X    struct rsb *rsb;
X    union `7Bunion psldef pslbits; int pslint;`7D psl;
X
X    _MOVPSL(&psl.pslint);
X    if (psl.pslbits.psl$v_prvmod > PSL$C_EXEC)
X        return(sys$cmexec(copy_rsbs, 0));
X
X    for (i = j = 0; j < LCK$GL_HTBLSIZ; j++) `7B
X        rsb = (*LCK$GL_HASHTBL)`5Bj`5D;
X        for (k = 0; rsb && (i < rsblist_size); k++) `7B
X            if (!_PROBER(PSL$C_EXEC, sizeof (struct rsb), rsb))`20
X                `7Beme.rsb_probe++; break;`7D
X            if (rsb->rsb$b_type != DYN$C_RSB)`20
X                `7Beme.rsb_type++; break;`7D
X            rsblist`5Bi`5D = *rsb;
X            if (option.full) scan_locks(rsb, &locksum`5Bi`5D);
X            rsblist`5Bi++`5D.rsb$l_hshchn = rsb;
X            rsb = rsb->rsb$l_hshchn;
X        `7D
X        if (k > stats.max_chain) stats.max_chain = k;
X        if (i >= rsblist_size) break;
X    `7D
X    stats.resources = i;
X    return(SS$_NORMAL);
X`7D
X
X/*
X * This function invokes the executive mode code that examines the resource
X * and lock blocks. The executive mode code may detect a number of errors
X * due to the changable nature of the data structures that it examines; we
X * report a summary of these errors upon return to user mode. An error just
X * means that the information subsequently reported is known to be incomplet
Ve.
X */
X
Xstatic void snap_rsbs()
X`7B
X    unsigned long status;
X
X    status = sys$cmexec(copy_rsbs, 0);
X    if (status != SS$_NORMAL) lib$stop(status);
X
X    if (eme.lkb_probe `7C`7C eme.lkb_type `7C`7C eme.rsb_probe `7C`7C eme.rs
Vb_type)`20
X        fprintf(stderr,`20
X                "lkb_probe %d, lkb_type %d, rsb_probe %d, rsb_type %d\n",
X                eme.lkb_probe, eme.lkb_type,
X                eme.rsb_probe, eme.rsb_type);
X
X    if (stats.resources == rsblist_size)
X        fprintf(stderr, "more resources than expected\n");
X`7D
X
X/* -------------------------------------------------------------------------
V-
X*/
X
X/*
X * This function attempts to convert a FID and volume lock name pair to a
X * filename. First performs a linear search of disktab looking for a match
X * against the volume lock name. Most VAX systems I have seen have less than
X * 10 disks and this search strategy does not seem inappropriate for a table
V of
X * that size. If your configuration has rather more disks you may wish to
X * review this decision.
X *
X * Assuming we locate a device, we then try to convert the FID to a filename
V.
X * Hopefully lib$fid_to_name will do most of the work, but we must provide i
Vt
X * with the file generation number, which is not contained in the resource
X * name. We find the generation number by seeking to the appropriate place
X * in indexf.sys and reading the header we find there. We open and close
X * indexf.sys each time in case file descriptors become a scarce comodity.
X *
X * If lib$fid_to_name does fail we report the first 20 characters of the
X * filename from the information in the file header. One expected cause
X * of failure is a file which does not exist in any directory. We
X * strip the device from the name reported by lib$fid_to_name to help
X * keep the length of the output produced by this program as low as possible
V.
X * Assuming that you do not regularly change the volume labels of your disks
X * you should find that the volume lock name is the same a the current
X * (or a recent) label of the volume.
X */
X
X#define nonames(x) `7Bperror(x); option.names = 0; return(0);`7D
X
Xstatic char * fton(int fid, char *lcknam)
X`7B
X    static char buf`5B256`5D, *c;
X    struct fh2 fh;
X    FILE *f;
X    int i;
X    unsigned short len;
X    unsigned long status;
X    struct dsc$descriptor dev, file;
X
X    for (i = 0; i < numdisks; i++)
X        if (memcmp(lcknam, disktab`5Bi`5D.lcknam, VOLCKNAMSIZ) == 0) break;
X    if (i == numdisks) return(0);
X
X    sprintf(buf, "%s`5B000000`5Dindexf.sys", disktab`5Bi`5D.devnam);
X    if ((f = fopen(buf, "r")) == 0) nonames("fopen indexf.sys");
X    if (fseek(f, 512 * (fid + disktab`5Bi`5D.indoff), SEEK_SET) == EOF)`20
X        nonames("fseek indexf.sys");
X    if (fread(&fh, sizeof(fh), 1, f) != 1) nonames("fread indexf.sys");
X    fclose(f);
X
X    dev.dsc$b_dtype = dev.dsc$b_class = 0;
X    dev.dsc$w_length = strlen(disktab`5Bi`5D.devnam);
X    dev.dsc$a_pointer = disktab`5Bi`5D.devnam;
X    file.dsc$b_dtype = file.dsc$b_class = 0;
X    file.dsc$w_length = sizeof(buf);
X    file.dsc$a_pointer = buf;
X    status = lib$fid_to_name(&dev, &fh.fh2$w_fid, &file, &len, 0, 0);
X    if (status == SS$_NORMAL) `7B
X        buf`5Blen`5D = 0;
X        for (c = buf; (*c != ':') && (*c != 0); c++);
X        return(++c);
X    `7D
X    else `7B
X        sprintf(buf, "`5B`5D%.20s", (unsigned long)&fh + (fh.fh2$b_idoffset
V * 2));
X        return(buf);
X    `7D
X`7D
X
X/* -------------------------------------------------------------------------
V-
X*/
X
X/*
X * This function attempts to calculate the offset to the start of file heade
Vrs
X * from the beginning of indexf.sys. If it encounters an error it reports
X * the fact and disables further attempts to convert FIDs to filenames, but
X * does not otherwise upset the running of the program.
X */
X
Xstatic header_offset(char *device)
X`7B
X    struct hm2 hb;
X    char buf`5B256`5D;
X    FILE *f;
X    int base;
X
X    sprintf(buf, "%s`5B000000`5Dindexf.sys", device);
X    if ((f = fopen(buf, "r")) == 0) nonames("fopen indexf.sys");
X    if (fseek(f, 512, SEEK_SET) == EOF) nonames("fseek indexf.sys");
X    if (fread(&hb, sizeof(hb), 1, f) != 1) nonames("fread indexf.sys");
X    base = hb.hm2$w_ibmapvbn + hb.hm2$w_ibmapsize - 2;
X    fclose(f);
X
X    return(base);
X`7D
X
X/* -------------------------------------------------------------------------
V-
X*/
X
X/*
X * This function uses sys$device_scan (only available since VMS V5.2) to loc
Vate
X * the disk devices on the system (up to a maximum of MAXDISKS). Essentially
X * we just want to establish a relationship between device names and volume
X * lock names; this relationship is recorded in disktab.
X *
X * We do not record any disk devices that are not mounted as FILES-11.
X *
X * Obtaining the device lock name has not been easy. sys$getdvi will provide
X * an item of information that it calls DVI$_DEVLOCKNAM. Although there is
X * no guarantee that the volume lock name as used internally by VMS will be
X * related to this name, it appears to be the case that a relationship does
X * exist.
X *
X * The system service description of this item is perplexing; it claims that
X * the device name lock is a 64-byte hexadecimal string. In fact it appears
X * to be a string 32 bytes long, each byte representing a hexadecimal digit.
X * The suggested use is that someone could prepend a facility prefix and
X * append a file ID to form a lock resource name. However as lock resource
X * names are limited to 31 characters this seems to be a non-starter.
X *
X * Converting the string to the volume lock name as used internally involves
X * scanning the string from right to left, interpreting each pair of charact
Vers
X * as the hex value of another character. The first character (or two,
Xdepending
X * upon your viewpoint) seems to encode the mount state of the device; we sk
Vip
X * over this.
X *
X * The code that performs this conversion relies upon the order of expressio
Vn
X * evaluation; as this program is totally useless on anything other than a
X * VMS system I don't think that portability is an issue.
X */
X
Xstatic int disk_scan()
X`7B
X    struct dsc$descriptor device, lock;
X    char devlcknam`5B64`5D, *c;
X    unsigned long context`5B2`5D = `7B0, 0`7D, class, code, status, i, j;
X    unsigned short len;
X    union devdef sts;
X    struct item `7B
X        unsigned short buflen;
X        unsigned short itemcode;
X        unsigned long  buffer;
X        unsigned long  retlen;
X    `7D itmlst`5B2`5D;
X
X    class = DC$_DISK;
X    itmlst`5B0`5D.buflen = sizeof(class);
X    itmlst`5B0`5D.itemcode = DVS$_DEVCLASS;
X    itmlst`5B0`5D.buffer = &class;
X    itmlst`5B1`5D.buflen = itmlst`5B1`5D.itemcode = 0;
X    device.dsc$b_dtype = device.dsc$b_class = 0;
X    lock.dsc$b_dtype = lock.dsc$b_class = 0;
X
X    for (i = 0; i < MAXDISKS;) `7B
X        device.dsc$w_length = sizeof(disktab`5B0`5D.devnam);
X        device.dsc$a_pointer = disktab`5Bi`5D.devnam;
X        status = sys$device_scan(&device, &len, 0, itmlst, context);
X        if (status == SS$_NOMOREDEV) break;
X        if (status != SS$_NORMAL) lib$stop(status);
X        disktab`5Bi`5D.devnam`5Blen`5D = 0;
X
X        device.dsc$w_length = len;
+-+-+-+-+-+-+-+-  END  OF PART 2 +-+-+-+-+-+-+-+-