From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 19-DEC-1990 16:21:22.18
To:	MRGATE::"ARISIA::EVERHART"
CC:	
Subj:	SOURCE: lkstat (part 1 of 2)

Received:  by crdgw1.ge.com (5.57/GE 1.80)
	 id AA22875; Wed, 19 Dec 90 15:58:59 EST
Received: From UCBVAX.BERKELEY.EDU by CRVAX.SRI.COM with TCP; Wed, 19 DEC 90 10:29:01 PST
Received: by ucbvax.Berkeley.EDU (5.63/1.42)
	id AA06037; Wed, 19 Dec 90 10:12:08 -0800
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 19 Dec 90 10:37:33 GMT
From: mcsun!cernvax!chx400!cgch!fizciba-geigy.ch!bnebga@uunet.uu.net  (Gary Nebbett)
Organization: Ciba-Geigy AG, Basel, Switzerland
Subject: SOURCE: lkstat (part 1 of 2)
Message-Id: <1990Dec19.113742@fizciba-geigy.ch>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com

/*
 * AUTHOR:       Gary Nebbett, CREATION DATE: 18th December, 1990
 */

#include <descrip.h>
#include <psldef.h>
#include <ssdef.h>
#include <ctype.h>
#include <stdio.h>
#include <libdef.h>
#include <syidef.h>
#include <dvidef.h>
#include <devdef.h>
#include <dcdef.h>
#include "lkstat.h"

#pragma builtins

#define DVS$_DEVCLASS   1
#define SS$_NOMOREDEV   2648
#define DYN$C_LKB       53
#define DYN$C_RSB       54
#define LKB$L_SQFL      0x38

#define MAXDEPTH        32
#define MAXRESNAM       512
#define MAXOUTLINE      512
#define MAXDISKS        255
#define VOLCKNAMSIZ     12


struct statistics {
    int resources;
    int master_res;
    int dir_only_res;
    int dir_res;
    int root_res;
    int master_root_res;
    int max_chain;
    int locks;
    int sys_owned;
    int proc_owned;
    int local;
    int prccpy;
    int mstcpy;
};

struct lkbsum {
    int local;
    int prccpy;
    int mstcpy;
    int granted;
    int waiting;
    int converting;
    int sys_owned;
    int proc_owned;
};

struct options {
    char all;
    char full;
    char stats;
    char names;
    FILE *out;
};

struct disktab {
    char devnam[64 + 1];
    char lcknam[VOLCKNAMSIZ + 1];
    int  indoff;
};


#define terminate(reason) {fprintf(reason, stderr); exit(0);}

static void cli(int argc, char **argv);
static void snap_rsbs();
static void sort_rsbs();
static void disp_rsbs();
static int disk_scan();
static char * fton(int fid, char *lcknam);

globalref unsigned long LCK$GL_HTBLSIZ, LCK$GL_MAXID;
globalref struct rsb **LCK$GL_HASHTBL[];

static struct options option;
static struct statistics stats;
static struct disktab disktab[MAXDISKS];
static struct lkbsum *locksum;
static struct rsb *rsblist;
static long rsb_tree;
static int rsblist_size;
static int numdisks;


main(int argc, char **argv)
{
    cli(argc, argv);

    rsblist_size = LCK$GL_MAXID * 2;
    if ((rsblist = calloc(rsblist_size, sizeof (struct rsb))) == 0)
        terminate("not enough memory\n");
    if ((locksum = calloc(rsblist_size, sizeof (struct lkbsum))) == 0)
        terminate("not enough memory\n");

    snap_rsbs();
    sort_rsbs();
    if (option.names) numdisks = disk_scan();
    disp_rsbs();
    return(SS$_NORMAL);
}

/* --------------------------------------------------------------------------
*/

/*
 * Analyse the command line. We expect flags to be grouped rather than
 * present individually (e.g. -l -s).
 */

static void cli(int argc, char **argv)
{
    int i;

    option.out = stdout;

    if (argc == 1) return;

    for (i = (argv[1][0] == '-' ? 1 : 0); argv[1][i] != 0; i++)
        switch (argv[1][i]) {
            case 'l' :
                        option.full = 1;
                        break;
            case 's' :
                        option.stats = 1;
                        break;
            case 'a' :
                        option.all = 1;
                        break;
            case 'n' :
                        option.names = 1;
                        break;
            case 'o' :
                        if (argc >= 3) {
                            if ((option.out = fopen(argv[2], "w")))
                                break;
                            else
                                perror("fopen");
                        }
            default :
                        fprintf(stderr, "Usage: %s [-][lanso] [filename]\n",
                                argv[0]);
                        exit(0);
        }
}

/* --------------------------------------------------------------------------
*/

/*
 * Convert a CSID to a SCS node name.
 */

static char * cton(unsigned long csid)
{
    unsigned long status, code = SYI$_NODENAME;
    unsigned short len;
    static char scsname[16];
    struct dsc$descriptor buf;

    buf.dsc$b_class = buf.dsc$b_dtype = 0;
    buf.dsc$w_length = sizeof(scsname);
    buf.dsc$a_pointer = scsname;

    if ((status = lib$getsyi(&code, 0, &buf, &len, &csid, 0) != SS$_NORMAL))
        lib$stop(status);
    scsname[len] = 0;
    return(scsname);
}

/* --------------------------------------------------------------------------
*/

/*
 * This function tries to display resource names in the most accessible way
 * possible; as such it contains a great deal of knowledge about the resource
 * names used by various components of VMS. Indeed it even knows that some
 * resource names are normally sub-resources of other resources.
 *
 * Note that this function identifies resources only by the rsb$t_resnam
 * field; a resource is only completely identified when this is coupled
 * with an access mode, a group (or lack thereof) and a parent. If someone
 * has been creating locks with names similar to those used by VMS then
 * this function will be fooled.
 */


#define efid(x)     (((x) & 0xffff) + (((x) >> 8) & 0xff0000))
#define fstrlen(x)  (sizeof(x) - 1)
#define FIDOFF      18
#define RMSDEVOFF   11

static char sys$sys_id[] = "SYS$SYS_ID";
static char f11b$a[] = "F11B$a";
static char f11b$q[] = "F11B$q";
static char f11b$c[] = "F11B$c";
static char f11b$s[] = "F11B$s";
static char f11b$v[] = "F11B$v";
static char rms[] = "RMS$";

static char * resnam(struct rsb *rsb, int parid)
{
    static char buf[MAXRESNAM];
    char vollock[VOLCKNAMSIZ];
    unsigned long fid, *x;
    unsigned char *file, *c = rsb->rsb$t_resnam;
    int i, j = rsb->rsb$b_rsnlen;

    for (i = 0; (i < j) && isprint(*c); c++, i++)
        buf[i] = *c;
    buf[i] = 0;

    if (!memcmp(rsb->rsb$t_resnam, sys$sys_id, fstrlen(sys$sys_id))) {
        x = &(rsb->rsb$t_resnam[fstrlen(sys$sys_id)]);
        sprintf(&buf[fstrlen(sys$sys_id)], "#%d", *x & 0xffff);
    }
    else if (!memcmp(rsb->rsb$t_resnam, f11b$a, fstrlen(f11b$a))) {
        x = &(rsb->rsb$t_resnam[FIDOFF]);
        if (option.names && (file = fton(efid(*x), 
                                       
&(rsb->rsb$t_resnam[fstrlen(f11b$a)]))))
            sprintf(&buf[FIDOFF], "%s", file);
        else
            sprintf(&buf[FIDOFF], "#%d", efid(*x));
    }
    else if (!memcmp(rsb->rsb$t_resnam, f11b$q, fstrlen(f11b$q))) {
        x = &(rsb->rsb$t_resnam[FIDOFF]);
        sprintf(&buf[FIDOFF], "#%o,%o", (*x >> 16) & 0xffff, *x & 0xffff);
    }
    else if (!memcmp(rsb->rsb$t_resnam, f11b$c, fstrlen(f11b$c))) {
        x = &(rsb->rsb$t_resnam[fstrlen(f11b$c)]);
        memcpy(vollock, &(rsblist[parid].rsb$t_resnam[fstrlen(f11b$v)]), 
               VOLCKNAMSIZ);
        if (option.names && (file = fton(efid(*x), vollock)))
            sprintf(&buf[fstrlen(f11b$c)], "%s", file);
        else
            sprintf(&buf[fstrlen(f11b$c)], "#%d", efid(*x));
    }
    else if (!memcmp(rsb->rsb$t_resnam, f11b$s, fstrlen(f11b$s))) {
        x = &(rsb->rsb$t_resnam[fstrlen(f11b$s)]);
        memcpy(vollock, &(rsblist[parid].rsb$t_resnam[fstrlen(f11b$v)]), 
               VOLCKNAMSIZ);
        if (option.names && (file = fton(efid(*x), vollock)))
            sprintf(&buf[fstrlen(f11b$s)], "%s", file);
        else
            sprintf(&buf[fstrlen(f11b$s)], "#%d", efid(*x));
    }
    else if (!memcmp(rsb->rsb$t_resnam, rms, fstrlen(rms))) {
        x = &(rsb->rsb$t_resnam[fstrlen(rms)]);
        fid = (*x & 0xffff) + ((*(++x) & 0xff00) << 8);
        if (option.names && (file = fton(fid,
&(rsb->rsb$t_resnam[RMSDEVOFF]))))
            sprintf(&buf[fstrlen(rms)], "%.*s %s", 
                    VOLCKNAMSIZ, &rsb->rsb$t_resnam[RMSDEVOFF], file);
        else
            sprintf(&buf[fstrlen(rms)], "%.*s #%d", 
                    VOLCKNAMSIZ, &rsb->rsb$t_resnam[RMSDEVOFF], fid);
    }
    else {
        for (; (i < j); c++, i++) buf[i] = isprint(*c) ? *c : '.';
        buf[i] = 0;
    }

    return(buf);
}

/* --------------------------------------------------------------------------
*/

/*
 * We form a sorted binary tree of the RSBs; rather than adding the dec field
 * (the 10 bytes used by DEC in the lib$insert_tree, etc functions) to each RSB
 * structure, we define a small structure that just has an index into the array
 * of RSBs and work with this.
 */

struct rsb_node {char dec[10]; int index;};

static rsb_cmp(int rsbn, struct rsb_node *rsb_node)
{
    return(memcmp(rsblist[rsbn].rsb$t_resnam, 
                  rsblist[rsb_node->index].rsb$t_resnam, RSB$K_MAXLEN));
}

static rsb_alloc(int rsbn, struct rsb_node **rsb_node)
{
    if ((*rsb_node = malloc(sizeof **rsb_node)) == 0)
        terminate("not enough memory\n");
    (*rsb_node)->index = rsbn;
    return(1);
}

/*
 * Here we sort the RSBs based on the resource name, and collect some
 * summary information as well.
 */

static void sort_rsbs()
{
    unsigned long status, flag = 0;
    struct rsb_node *rsb_node;
    struct rsb *rsb = rsblist;
    struct lkbsum *lks = locksum;
    int rsbn;

    for (rsbn = 0; rsbn < stats.resources; rsbn++, rsb++, lks++) {
        status = lib$insert_tree(&rsb_tree, rsbn, &flag, rsb_cmp, 
                                 rsb_alloc, &rsb_node, 0);
        if (status != LIB$_NORMAL && status != LIB$_KEYALRINS)
            lib$stop(status);

        if (rsb->rsb$v_direntry) stats.dir_res++;
        if (!rsb->rsb$w_lckcnt)  stats.dir_only_res++;
        if (!rsb->rsb$l_parent)  stats.root_res++;
        if (!rsb->rsb$l_csid)    stats.master_res++;
        if (!rsb->rsb$l_csid && !rsb->rsb$l_parent) stats.master_root_res++;
        stats.locks  += rsb->rsb$w_lckcnt;
        stats.mstcpy += lks->mstcpy;
        stats.prccpy += lks->prccpy;
        stats.local  += lks->local;
        stats.sys_owned  += lks->sys_owned;
        stats.proc_owned += lks->proc_owned;
    }
}

/* --------------------------------------------------------------------------
*/

static char *mode[] = {"NL", "CR", "CW", "PR", "PW", "EX"};
static char rmod[] = {'K', 'E', 'S', 'U'};

struct parent {unsigned long s0addr; int index;};

/*
 * This function produces a report of the collected information. LKBs are
 * only scanned if the -l option is given, so we check the presence of
 * this option and only report the LKB summary if it was collected.
 *
 * The rsb structure definition contains a description of various flags;
 * we just report three things under the banner flags:
 *
 * D means that the RSB is a directory entry.
 * O means that the RSB is Only a directory entry and has no other use.
 * X means that other flags were present.
 *
 * I think that most of the other flags are only used during cluster 
 * transitions and are unlikely to be seen by this program. If you see
 * an X and wonder just what bit was set, I can only say sorry!
 *
 * If a resource has sub-resources, we recursively invoke this function
 * to display the sub-resources.
 */

static rsb_disp(struct rsb_node *rsb_node, struct parent *parent)
{
    struct rsb *rsb = &rsblist[rsb_node->index];
    struct lkbsum *lks = &locksum[rsb_node->index];
    char buf[MAXOUTLINE], depth[MAXDEPTH], flags[] = "DOX";
    struct parent p;
    unsigned long status;
    int i;

    if (rsb->rsb$l_parent == parent->s0addr) {
        if (!rsb->rsb$v_direntry) flags[0] = ' ';
        if (rsb->rsb$w_lckcnt) flags[1] = ' ';
        if (!(rsb->rsb$w_status & ~3)) flags[2] = ' ';

        for (i = 0; i < rsb->rsb$b_depth; i++) depth[i] = ' ';
        depth[i] = 0;

        if (option.full)
            sprintf(buf, 
        "%x %s %3d %s %3d %3d %3d %3d %3d %3d %3d %3d %3d %c %4o %6.6s %s%s\n",
                    rsb->rsb$l_hshchn, flags,
                    rsb->rsb$w_refcnt & 0xffff, mode[rsb->rsb$b_cgmode], 
                    rsb->rsb$w_lckcnt & 0xffff,
                    lks->local, lks->prccpy, lks->mstcpy,
                    lks->sys_owned, lks->proc_owned,
                    lks->granted, lks->converting, lks->waiting,
                    rmod[rsb->rsb$b_rmod], rsb->rsb$w_group & 0xffff, 
                    rsb->rsb$l_csid ? cton(rsb->rsb$l_csid) : "", 
                    depth, resnam(rsb, parent->index));
        else   
            sprintf(buf, "%x %s %3d %s %3d %c %4o %6.6s %s%s\n", 
                    rsb->rsb$l_hshchn, flags,
                    rsb->rsb$w_refcnt & 0xffff, mode[rsb->rsb$b_cgmode],
                    rsb->rsb$w_lckcnt & 0xffff,
                    rmod[rsb->rsb$b_rmod], rsb->rsb$w_group & 0xffff, 
                    rsb->rsb$l_csid ? cton(rsb->rsb$l_csid) : "", 
                    depth, resnam(rsb, parent->index));
        fputs(buf, option.out);

        if (rsb->rsb$w_refcnt && option.all) {
            p.s0addr = rsb->rsb$l_hshchn; p.index = rsb_node->index;
            if ((status = lib$traverse_tree(&rsb_tree, rsb_disp, &p)) 
                        != LIB$_NORMAL)
                lib$stop(status);
        }
    }
    return(1);
}


static void disp_rsbs()
{
    unsigned long status;
    struct parent parent = {0, 0};

    if (option.full)
        fprintf(option.out, 
"rsb      fla sub cg lck lcl cpy mst sys prc gra cvt wai m grou node  
name\n");
    else
        fprintf(option.out, "rsb      fla sub cg lck m grou node   name\n");

    if ((status = lib$traverse_tree(&rsb_tree, rsb_disp, &parent)) !=
LIB$_NORMAL)
        lib$stop(status);

    if (!option.stats) return;

    fprintf(option.out, 
        "\nreso mast root rmst  dir diro lock  lcl pcpy mcpy  sys proc chn\n");
    fprintf(option.out, 
            "%4d %4d %4d %4d %4d %4d %4d %4d %4d %4d %4d %4d %3d\n", 
            stats.resources, stats.master_res,
            stats.root_res, stats.master_root_res,
            stats.dir_res, stats.dir_only_res, 
            stats.locks, stats.local,
            stats.prccpy, stats.mstcpy,
            stats.sys_owned, stats.proc_owned,
            stats.max_chain);
}

/* --------------------------------------------------------------------------
*/

static struct exec_mode_errors {
    int lkb_probe;
    int lkb_type;
    int rsb_probe;
    int rsb_type;
} eme;

/*
 * This function attempts to produce a summary of all the LKBs chained to
 * a particular queue of an RSB. The description of the function copy_rsbs
 * contains a description of the perils we face whilst following pointer
 * chains and the precautions that we take.
 */

static int 
scan_chain(struct rsb *rsb, unsigned long *head, struct lkbsum *lks)
{
    struct lkb *lkb;
    int i;

    for (i = 0, lkb = *head; lkb != head; i++) {
        lkb = (unsigned long)lkb - LKB$L_SQFL;
        if (!_PROBER(PSL$C_EXEC, sizeof (struct lkb), lkb)) 
            {eme.lkb_probe++; break;}
        if (lkb->lkb$b_type != DYN$C_LKB) 
            {eme.lkb_type++; break;}
        if (lkb->lkb$v_mstcpy) 
            lks->mstcpy++;
        else if (rsb->rsb$l_csid)
            lks->prccpy++;
        else
            lks->local++;
        if (lkb->lkb$l_pid)
            lks->proc_owned++;
        else
            lks->sys_owned++;
        lkb = lkb->lkb$l_sqfl;
    }
    return(i);
}

static void scan_locks(struct rsb *rsb, struct lkbsum *lks)
{
    lks->granted = scan_chain(rsb, &rsb->rsb$l_grqfl, lks);
    lks->converting = scan_chain(rsb, &rsb->rsb$l_cvtqfl, lks);
    lks->waiting = scan_chain(rsb, &rsb->rsb$l_wtqfl, lks);
}

/*
 * This function examines each of the chains of the resource hash table.
 *
 * The lock database may change whilst we are running; although we could
 * lock the database against changes (by raising IPL to IPL$_SYNCH and
 * obtaining the SCS spin lock), this seems rather inappropriate for
 * a program of this type. Instead we probe each potentially dangerous
 * memory reference. Due to the nature of the probe instruction we must
 * insure that the previous access mode was also executive (because the
 * LKBs and RSBs are stored in non-paged pool which is only readable
 * from executive mode); this is achieved by recursively invoking this 
 * function.
 *
 * As a futher check that we are not just following pointers ad infinitum
 * the "type" of each block is checked.
 *
 * The maximum length of the resource hash chains examined is recorded.
 *
 * The rsb$l_hshchn field of the saved RSB is used to remember the address
 * of the RSB. This makes further investigation of a resource with SDA
 * possible.
 *
 * If requested, we also produce a summary of the LKBs chained to each
 * RSB.
 */

static unsigned long copy_rsbs()
{
    int i, j, k;
    struct rsb *rsb;
    union {union psldef pslbits; int pslint;} psl;

    _MOVPSL(&psl.pslint);
    if (psl.pslbits.psl$v_prvmod > PSL$C_EXEC)
        return(sys$cmexec(copy_rsbs, 0));

    for (i = j = 0; j < LCK$GL_HTBLSIZ; j++) {
        rsb = (*LCK$GL_HASHTBL)[j];
        for (k = 0; rsb && (i < rsblist_size); k++) {
            if (!_PROBER(PSL$C_EXEC, sizeof (struct rsb), rsb)) 
                {eme.rsb_probe++; break;}
            if (rsb->rsb$b_type != DYN$C_RSB) 
                {eme.rsb_type++; break;}
            rsblist[i] = *rsb;
            if (option.full) scan_locks(rsb, &locksum[i]);
            rsblist[i++].rsb$l_hshchn = rsb;
            rsb = rsb->rsb$l_hshchn;
        }
        if (k > stats.max_chain) stats.max_chain = k;
        if (i >= rsblist_size) break;
    }
    stats.resources = i;
    return(SS$_NORMAL);
}

/*
 * This function invokes the executive mode code that examines the resource
 * and lock blocks. The executive mode code may detect a number of errors
 * due to the changable nature of the data structures that it examines; we
 * report a summary of these errors upon return to user mode. An error just
 * means that the information subsequently reported is known to be incomplete.
 */

static void snap_rsbs()
{
    unsigned long status;

    status = sys$cmexec(copy_rsbs, 0);
    if (status != SS$_NORMAL) lib$stop(status);

    if (eme.lkb_probe || eme.lkb_type || eme.rsb_probe || eme.rsb_type) 
        fprintf(stderr, 
                "lkb_probe %d, lkb_type %d, rsb_probe %d, rsb_type %d\n",
                eme.lkb_probe, eme.lkb_type,
                eme.rsb_probe, eme.rsb_type);

    if (stats.resources == rsblist_size)
        fprintf(stderr, "more resources than expected\n");
}

/* --------------------------------------------------------------------------
*/

/*
 * This function attempts to convert a FID and volume lock name pair to a
 * filename. First performs a linear search of disktab looking for a match
 * against the volume lock name. Most VAX systems I have seen have less than
 * 10 disks and this search strategy does not seem inappropriate for a table of
 * that size. If your configuration has rather more disks you may wish to
 * review this decision.
 *
 * Assuming we locate a device, we then try to convert the FID to a filename.
 * Hopefully lib$fid_to_name will do most of the work, but we must provide it
 * with the file generation number, which is not contained in the resource
 * name. We find the generation number by seeking to the appropriate place
 * in indexf.sys and reading the header we find there. We open and close
 * indexf.sys each time in case file descriptors become a scarce comodity.
 *
 * If lib$fid_to_name does fail we report the first 20 characters of the
 * filename from the information in the file header. One expected cause
 * of failure is a file which does not exist in any directory. We
 * strip the device from the name reported by lib$fid_to_name to help
 * keep the length of the output produced by this program as low as possible.
 * Assuming that you do not regularly change the volume labels of your disks
 * you should find that the volume lock name is the same a the current
 * (or a recent) label of the volume.
 */

#define nonames(x) {perror(x); option.names = 0; return(0);}

static char * fton(int fid, char *lcknam)
{
    static char buf[256], *c;
    struct fh2 fh;
    FILE *f;
    int i;
    unsigned short len;
    unsigned long status;
    struct dsc$descriptor dev, file;

    for (i = 0; i < numdisks; i++)
        if (memcmp(lcknam, disktab[i].lcknam, VOLCKNAMSIZ) == 0) break;
    if (i == numdisks) return(0);

    sprintf(buf, "%s[000000]indexf.sys", disktab[i].devnam);
    if ((f = fopen(buf, "r")) == 0) nonames("fopen indexf.sys");
    if (fseek(f, 512 * (fid + disktab[i].indoff), SEEK_SET) == EOF) 
        nonames("fseek indexf.sys");
    if (fread(&fh, sizeof(fh), 1, f) != 1) nonames("fread indexf.sys");
    fclose(f);

    dev.dsc$b_dtype = dev.dsc$b_class = 0;
    dev.dsc$w_length = strlen(disktab[i].devnam);
    dev.dsc$a_pointer = disktab[i].devnam;
    file.dsc$b_dtype = file.dsc$b_class = 0;
    file.dsc$w_length = sizeof(buf);
    file.dsc$a_pointer = buf;
    status = lib$fid_to_name(&dev, &fh.fh2$w_fid, &file, &len, 0, 0);
    if (status == SS$_NORMAL) {
        buf[len] = 0;
        for (c = buf; (*c != ':') && (*c != 0); c++);
        return(++c);
    }
    else {
        sprintf(buf, "[]%.20s", (unsigned long)&fh + (fh.fh2$b_idoffset * 2));
        return(buf);
    }
}

/* --------------------------------------------------------------------------
*/

/*
 * This function attempts to calculate the offset to the start of file headers
 * from the beginning of indexf.sys. If it encounters an error it reports
 * the fact and disables further attempts to convert FIDs to filenames, but
 * does not otherwise upset the running of the program.
 */

static header_offset(char *device)
{
    struct hm2 hb;
    char buf[256];
    FILE *f;
    int base;

    sprintf(buf, "%s[000000]indexf.sys", device);
    if ((f = fopen(buf, "r")) == 0) nonames("fopen indexf.sys");
    if (fseek(f, 512, SEEK_SET) == EOF) nonames("fseek indexf.sys");
    if (fread(&hb, sizeof(hb), 1, f) != 1) nonames("fread indexf.sys");
    base = hb.hm2$w_ibmapvbn + hb.hm2$w_ibmapsize - 2;
    fclose(f);

    return(base);
}

/* --------------------------------------------------------------------------
*/

/*
 * This function uses sys$device_scan (only available since VMS V5.2) to locate
 * the disk devices on the system (up to a maximum of MAXDISKS). Essentially
 * we just want to establish a relationship between device names and volume
 * lock names; this relationship is recorded in disktab.
 *
 * We do not record any disk devices that are not mounted as FILES-11.
 *
 * Obtaining the device lock name has not been easy. sys$getdvi will provide
 * an item of information that it calls DVI$_DEVLOCKNAM. Although there is
 * no guarantee that the volume lock name as used internally by VMS will be
 * related to this name, it appears to be the case that a relationship does
 * exist.
 *
 * The system service description of this item is perplexing; it claims that
 * the device name lock is a 64-byte hexadecimal string. In fact it appears
 * to be a string 32 bytes long, each byte representing a hexadecimal digit.
 * The suggested use is that someone could prepend a facility prefix and
 * append a file ID to form a lock resource name. However as lock resource
 * names are limited to 31 characters this seems to be a non-starter.
 *
 * Converting the string to the volume lock name as used internally involves
 * scanning the string from right to left, interpreting each pair of characters
 * as the hex value of another character. The first character (or two,
depending
 * upon your viewpoint) seems to encode the mount state of the device; we skip
 * over this.
 *
 * The code that performs this conversion relies upon the order of expression
 * evaluation; as this program is totally useless on anything other than a
 * VMS system I don't think that portability is an issue.
 */

static int disk_scan()
{
    struct dsc$descriptor device, lock;
    char devlcknam[64], *c;
    unsigned long context[2] = {0, 0}, class, code, status, i, j;
    unsigned short len;
    union devdef sts;
    struct item {
        unsigned short buflen;
        unsigned short itemcode;
        unsigned long  buffer;
        unsigned long  retlen;
    } itmlst[2];

    class = DC$_DISK;
    itmlst[0].buflen = sizeof(class);
    itmlst[0].itemcode = DVS$_DEVCLASS;
    itmlst[0].buffer = &class;
    itmlst[1].buflen = itmlst[1].itemcode = 0;
    device.dsc$b_dtype = device.dsc$b_class = 0;
    lock.dsc$b_dtype = lock.dsc$b_class = 0;

    for (i = 0; i < MAXDISKS;) {
        device.dsc$w_length = sizeof(disktab[0].devnam);
        device.dsc$a_pointer = disktab[i].devnam;
        status = sys$device_scan(&device, &len, 0, itmlst, context);
        if (status == SS$_NOMOREDEV) break;
        if (status != SS$_NORMAL) lib$stop(status);
        disktab[i].devnam[len] = 0;

        device.dsc$w_length = len;
        lock.dsc$w_length = sizeof(devlcknam);
        lock.dsc$a_pointer = devlcknam;
        code = DVI$_DEVLOCKNAM;
        status = lib$getdvi(&code, 0, &device, 0, &lock, &len);
        if (status != SS$_NORMAL) lib$stop(status);

        code = DVI$_DEVCHAR;
        status = lib$getdvi(&code, 0, &device, &sts, 0, 0);
        if (status != SS$_NORMAL) lib$stop(status);

        if (sts.dev$v_mnt && !sts.dev$v_for) {
            for (j = 0, c = &devlcknam[len - 3]; j < VOLCKNAMSIZ; j++)
                disktab[i].lcknam[j] = *c - (*(c--) > '9' ? ('A' - 10) : '0') +
                               ((*c - (*(c--) > '9' ? ('A' - 10) : '0')) << 4);
            disktab[i].lcknam[j] = 0;
            disktab[i].indoff = header_offset(disktab[i].devnam);
            i++;
        }
    }
    return(i);
}

