#define LIST_SYMBOL_NAME "RMS_KEY_NUL_DUP_TOT_LIST"
#define RECORD_COUNT_SYMBOL_NAME "RMS_RECORDS"
#define FILL_SYMBOL_NAME "RMS_FILL"
#define IO_SYMBOL_NAME "RMS_IO_STATS"
#define LEVELS_SYMBOL_NAME "RMS_ROOT_LEVELS"


#define YEARS 2
#define RECORD_SAMPLE 50000
#define MIN_RECS_PER_BUCKET 5
#define BIG_SIZE 4000000
#define BIG_ROOT 3
#define MEDIUM_ROOT 2
#define MEDIUM_SIZE 10000
#define SMALL_ROOT 1
#define MAX_EMPTY_BUCKETS 2
#define MAX_KEY_WARNING 5
#define MAX_RRV_PERCENT 10

#define CHAIN_MIN 5
#define FILL_RANGES 10
#define RECENT_CHAINS 10
/*
** rms_tune_check_v6.c	 Hein van den Heuvel, February 2009
** Fooling around with io_size, useful, unused
** Want to be able to handle sequence like  3,2000,4,1000,5,2001,6,1200,7,...
** Buffer is useles when all buffers are used
** If sub-series is used up, a large IO is needed
** For non-sub-series just 1 bucket will do. How to recognize?
**
**  2/15/2007 : Add control-T output, Add Area block usage, Use RAB64 for larger IO.
**  5/17/2007 : List VBN's for duplicate key chain.
**  5/09/2007 : Detect empty sidr buckets
**  6/06/2006 : IO optimizations - multiple large buffers
**              Dcl symbol for record count, and fill, and IO stats
** 				Record uncompression to count bytes
**				FDL ANALYSIS Section generation
**				Integration of 'rms_show_keys' output
**				Bucket size vs Root Level Estimates integrated
**				Fill factor percentiles from 'indexed_file_count'
**				
**
**	6/15/2005 : dcl symbols for dups and NULL byte IF NOT ALREADY DEFINED.
**	6/07/2005 : identification option, new defaults
**      3/24/2003 : use unsigned chars to handle key sizes > 127 bytes.
**      3/21/2003 : deal with uncompressed, fixed length record files.
**
**	Based on, and extention to, sidr.c
**
**	This tool will highlight any 'obvious' potential
**	perforamce problem with an RMS indexed file
**
**	ROOT:	Reasonable root level based on size
**	SKIP:	First sequential GET needs many IO
**	RRVS:	Excessive RRV count in sample
**	RECS:	Low number of records / bucket in sample
**      KEYS:	Too many keys!
**	SIDR:	Excessive duplicate key chains
**
**	--- original comment ---
** sidr.c		Hein van den Heuvel, June 1993
**			(last mod, to reduce _BUG messages Apr/95)
**	Program to list sidr key values and some stats such as the 
**	highest number of duplicates per key for the selected file.
** 
** 	It can also DUMP per key sidr data buckets into fake indexed files.
**	This allows one to reduce data to analyze/ship and/or can be
**	used if there is a confidentiality issue with the main record data.
**
**	Potential uses:
**	- Aid to find out whether a convert is in order for secondary keys.
**	- Collect essential RMS support information for 'confidential' files.
**	- Provider of raw data to help guestimating buffer requirements.
**	- Quick & Dirty checklist to use alongside ANA/RMS/INT
**	- Framework to build tool to squish out deleted and ru_deleted records.
**	    (not currently implemented)
**
**	Usage: Define as external DCL command and pass filespec as parameter.
**	    $SIDR [-l] [-b=rfa.dat] indexed.dat
**	    	-l      Log each sidr record found
**	    	-k=n    Key number to use. Zero base. Default all.
**	    	-b=x.y  Binary SIDR & UDR pointers into file.
**              -d=x.y  Dump Data Buckets into file
**	-- 2003 options --
**              -m=n    Report only longest chain if longer than n.
**		-t	tune check
**		-s=n	Sample size for tuneup check (-1 for full scan)
**	-- 2005 options --
**              -v      Show File name, size, max bks and current date
**		-t	Top-Ten, old sidr output
**              
*/


#define IO_BUFFERS 10

#define CLUSTER_SIZE 16

#define xab$m_initidx 16
#define xab$m_key_ncmpr 64
#define XAB$C_COL  8
#define XAB$C_DSTG 32

#include <stdio>
#include <string>
#include <stdlib>
#include <descrip>

#define __NEW_STARLET
#include <rms>
#include <dcdef>
#include <iodef>
#include <dvidef>
#include <syidef>





#define DUMPEXTEND 1000
#define MAXKEY 99
#define MAXREC 10
#define MAXKEYSIZ 40
#define LOG_FORMAT_STRING "sidr %4d, vbn %6d, dups %4d  %s\n"

#pragma nostandard /* variant struct */
#pragma nomember_alignment

struct { // Layout for RMS on-disk AREA definition matching AREADEF in SYS$LIBRARY:LIB.MLB
	       unsigned int fill_0, fill_4, avail, cvbn, cnblk, used, nextvbn, nxt, nxblk;
               unsigned short deq, fill_1;
               unsigned int loc;
               unsigned short rfi[3];
               unsigned int alloc; // mis-aligned.
	       short fill_2[5]; } *area;
           
struct IRC$R_FLG_BITS {
	unsigned irc$v_vbn_pointer_size: 2;
	unsigned irc$v_deleted : 1;
	unsigned irc$v_rrv : 1;
	unsigned irc$v_noptrsz : 1;
	unsigned irc$v_ru_delete : 1;
	unsigned irc$v_ru_update : 1;
	unsigned irc$v_first_key : 1;
	} ;
#define VALID_RECORD 2
#define DELETED_RECORD 6
#define RRV_RECORD 10

#define IRC$C_VAROVHSZ3 11
#define IRC$C_FIXOVHSZ3 9
#define IRC$C_DATOVHSZ3 3
#define IRC$C_RRVOVHSZ3 9

struct {unsigned char	check, area;
        unsigned short	sample, free, next_id;
	unsigned int	next;
	unsigned char	level, flags, data[63*512-15]; } *bucket;


struct record_header {
        union {
	   unsigned char flg_byte;
	   struct IRC$R_FLG_BITS flg_bits;
		} flags      ;
	short	record_id, rrv_id;
	long	rrv_vbn;
	short	record_length;
	unsigned char	key_new_size, key_old_size;
	char	key_first_byte; } ;
#pragma standard /* variant struct */

struct  TOP_TEN {
	int	dups, chain, start_vbn, end_vbn;
	unsigned int null_key_value, null_key;
	char	key[MAXKEYSIZ+1];
	    }	top_ten[MAXREC];

struct {
	int	sidr_vbn;
	short	udr_id;
	long	udr_vbn;
	struct IRC$R_FLG_BITS flags;
	    } bin;

struct {
	int start_vbn;
	int end_vbn;
	int unused;
    int useful;
    char *buffer_address;
	} buffer_desc[IO_BUFFERS];
	
typedef struct { int len; char *addr; } desc;
typedef struct { short len, cod; void *address; int *retlen; } item;

// __align (8) char io_buffer[IO_BUFFERS][IO_BUFFER_SIZE * 512];
	
int	binary=0, log=0, dump=0, growth=0, min_report = 1, header_printed = 0;
int key_number = 0, buckets = 0, record_count = 0;
char *file_name, header_line[256];
int tune_check = 0, full_check = 1, sidr_check = 1, io_size, io_size_blocks;
unsigned int sample_size = RECORD_SAMPLE, alq=0;
unsigned int cache_hits=0, cache_miss=0, cache_blocks=0;

struct	RAB64	rab;
struct	RAB	binrab;
struct	FAB	binfab;
int	sys$create(), sys$open(), sys$connect(), sys$close();
int	sys$read(), sys$write(), sys$put(), sys$extend(), sys$display();
void   lib$init_timer(), lib$show_timer();


char	symbol_list[200];
FILE *fdl = NULL;

void control_t_ast()
{
	lib$show_timer();	
	printf ("key %d, %d buckets, %d records. %s\n", 
	    key_number, buckets, record_count, file_name); 
}

char *header() 
{
if (header_printed++) *header_line = 0;
return header_line;
}

int buf_read ( struct RAB64 *rab )
{
/*
** Private version of SYS$READ which maintains a list of large
** buffers. If target bucket not found in any buffer, then find 
** least useful buffer and read full buffer for target VBN.
** 
** Inputs from RAB as per RMS. 
** Output RAB$L_RBF and status. 
*/ 
int s, vbn, end, buffer, start, remaining, bytes, usz, bkz;
int least_useful = 999, least_useful_buffer=0, *useful_p;
	
vbn = rab->rab64$l_bkt;
usz = rab->rab64$q_usz;
bkz = usz / 512;
end = vbn + bkz;

for (buffer=0; buffer < IO_BUFFERS; buffer++) {
	start = vbn - buffer_desc[buffer].start_vbn;
	if ( start >= 0 ) {  
		if (end <= buffer_desc[buffer].end_vbn) {
			/*
			** found entire bucket in current buffer!
			*/
			cache_hits++;
			if (buffer_desc[buffer].unused-- > 0) {
                           buffer_desc[buffer].useful++;
			   } else {
			   buffer_desc[buffer].useful = -999;
			   }
			rab->rab64$pq_rbf = buffer_desc[buffer].buffer_address + start * 512;
			rab->rab64$q_rsz = usz;
			s = rab->rab64$l_sts = RMS$_OK_ALK;
       io_size += bkz; /* More optimistic for next IO. */
       io_size += bkz; /* More optimistic for next IO. */
			return s; 
		}
	}
}
/*
** NOT Found in any buffer, look for right buffer to use
** based on number of unused buckets. This simple cache manager
** assumes single use for each bucket in a buffer.
** Age each buffers as we go.
*/
cache_miss++;
for (buffer=0; buffer < IO_BUFFERS; buffer++) {
	if (least_useful >= --buffer_desc[buffer].useful) {
		least_useful = buffer_desc[buffer].useful;
		least_useful_buffer = buffer;
	}
}
buffer = least_useful_buffer;
remaining = alq - vbn;
if (io_size > io_size_blocks) io_size = io_size_blocks;
if (io_size > remaining) io_size = bkz;
if (io_size < bkz) io_size = bkz;

rab->rab64$q_usz = io_size * 512;
rab->rab64$pq_ubf = buffer_desc[buffer].buffer_address;
buffer_desc[buffer].start_vbn = vbn;
buffer_desc[buffer].end_vbn = vbn + io_size;
buffer_desc[buffer].unused = io_size / bkz;
buffer_desc[buffer].useful = io_size / bkz;
cache_blocks += io_size;

s = sys$read ( rab );

rab->rab64$q_usz = usz; /* restore. Redundant? */
rab->rab64$q_rsz = usz;
rab->rab64$pq_rbf = buffer_desc[buffer].buffer_address;
return s;
}

void open_binary()
{
int stat;
binrab.rab$l_rbf = (void *) &bin;
binrab.rab$w_rsz = sizeof bin;
binrab.rab$l_rop = RAB$M_WBH;
binary = 0;
stat = sys$create ( &binfab);
if ( stat & 1 ) stat = sys$connect ( & binrab ) ;
if ( stat & 1 ) binary = 2;
}

void close_binary()
{
int stat;
binary = 0;
stat = sys$close ( &binfab);
if ( stat & 1 ) binary = 1;
}
void set_symbol(char *symbol, char *value)
{
	desc	symbol_desc, value_desc;
    void	lib$set_symbol();
    symbol_desc.addr = symbol;
    symbol_desc.len = strlen(symbol);
    value_desc.addr = value;
    value_desc.len  = strlen (value); 
    lib$set_symbol ( &symbol_desc, &value_desc);
}

void format_key (char *keybuf, char *key, int type, 
		int size, int new_size, int old_size)
{
char current_char, *pos, *buf;
switch (type)
    {
    case XAB$C_STG:			/* string                           */
    case XAB$C_COL:
	pos = key;
	buf = keybuf + old_size;
	while (pos < key + new_size) 
		{
		current_char = *pos++;
		if (current_char < 32) current_char = '.';
		*buf++ = current_char;
		}
	while (buf < keybuf + size) *buf++ = current_char;
	*buf = 0;
	break;		
    case XAB$C_IN2:			/* signed 15 bit integer (2 bytes)  */
	sprintf( keybuf, "%5d", *((short *) key) );
	break;
    case XAB$C_BN2:			/* 2 byte binary                    */
	sprintf( keybuf, "%4X", *((short *) key) );
	break;
    case XAB$C_IN4:			/* signed 31 bit integer (4 bytes)  */
	sprintf( keybuf, "%10d", *((int *) key) );
	break;
    case XAB$C_BN4:			/* 4 byte binary                    */
	sprintf( keybuf, "%08X", *((int *) key) );
	break;
    case XAB$C_PAC:			/* packed decimal (1-16 bytes)      */
	{
	unsigned char *p;
	char *k;
	int i;
	k = keybuf;
	p = (void *) key;
	for (i = 0; i < size ; i++)
	    {
	    *k++ = (*p >> 4) + '0';
	    *k++ = (*p & 15) + '0';
	    p++;
	    }
	k--;
	if ((*k == '=') || (*k == ';')) 
	    {
	    *k = '-';
	    } else {
	    *k = '+';
	    }
	}
	break;
    case XAB$C_IN8:			/* signed 63 bit integer (4 bytes)  */
    case XAB$C_BN8:			/* 8 byte binary                    */
	{
	int (*p)[2];
	p = (void *) key;
	sprintf( keybuf, "%08X %08X", (*p)[0], (*p)[1]);
	break;
	}
    }
return;
}

void score_previous_key ( int dup_count, int chain_count,
	int start_vbn, int end_vbn,
	unsigned int null_key_value, unsigned int null_key,
	char *save_key )
{
int score, i;
/*
** found a new dupplicate count key value. Process it.
*/
if (dup_count > top_ten[MAXREC-1].dups)
    {
    /* 
    ** Higher than lowest high score, gotta have a place for it in top ten.
    */
    for (score=0; dup_count <= top_ten[score].dups; score++); 

    /*
    ** Make room moving down earlier entries.
    */
    for (i=MAXREC-1; i > score ; i--) top_ten[i] = top_ten[i-1]; 

    /*
    ** Move in current value.
    */
    top_ten[score].dups = dup_count;
    top_ten[score].chain = chain_count;
    top_ten[score].start_vbn = start_vbn;
    top_ten[score].end_vbn =end_vbn;
    top_ten[score].null_key_value = null_key_value;
    top_ten[score].null_key = null_key;
    strncpy ( top_ten[score].key, save_key, MAXKEYSIZ);
    }
}

int walk_sidr_buckets (struct XABKEY *alt, int max_buckets,
	int compression)
{
int		i, stat, vbn, key_type, start_vbn, dup_count=0;
int		udr_records=0, ru_updated=0, ru_deleted=0, deleted=0;
int		empty=0, total_empty=0, worst_empty=0, chain_start_vbn, chain_end_vbn;
int		empty_start_vbn=0, worst_empty_start_vbn, worst_empty_end_vbn;
int		max_key_size, key_new_size, key_old_size=0, chain_count = 0;
long long int key_bytes=0, user_key_bytes=0, sidr_bytes=0;
unsigned int    null_key_value, null_key;
unsigned char	*sidr, *next_sidr;
char	*key, *p, save_key_print[255+1], save_key_binary[255+1], text[256];
char	after_empty_key[255+1];

buckets = 0;
record_count = 0;
key_type = alt->xab$b_dtp & ~(-XAB$C_DSTG); /* use corresponding ascending type */
max_key_size = alt->xab$b_tks;
start_vbn = alt->xab$l_dvb;
io_size = io_size_blocks;

for (i=0; i<MAXREC; i++) {
  top_ten[i].dups = 0;
  top_ten[i].chain = 0;
  top_ten[i].null_key = 0;
  top_ten[i].null_key_value =0;
  } 

key_new_size = max_key_size;
rab.rab64$l_bkt = start_vbn;
stat = buf_read ( &rab);
bucket = (void *) rab.rab64$pq_rbf;

/*
** Walk sidr records while 
**	- RMS status is success and 
**	- NOT last bucket in chain.
*/
while ((stat & 1) && rab.rab64$l_bkt ) {			/* bucket loop */
    int sidr_records_this_bucket;
    buckets++;
    vbn = rab.rab64$l_bkt;
    /* 
    ** For the primary key we try a more or less elaborate mechanisme to guess
    ** the best IO size as there are potentially so many bucket to read.
    ** For the alternates we'll just increase when lucky, decrease when not.
    */
    if ( (bucket->next - vbn) == alt->xab$b_dbs ) {
       if ( io_size < io_size_blocks) io_size += alt->xab$b_dbs;
    } else {
	   io_size /=2;
    }
    sidr_records_this_bucket = 0;
    for (sidr =  (void *) &bucket->data;  /* sidr loop */
	  sidr <  (unsigned char *) (char *) bucket + bucket->free;
	  sidr =  next_sidr) {
		if (binary == 1) open_binary();
		record_count++;
		sidr_records_this_bucket++;
		i = *(short *)sidr;
		sidr_bytes += i;
		next_sidr = sidr +i + sizeof (short);
		sidr += sizeof (short);
		key_new_size = max_key_size;
        key_old_size = 0;
		if (compression) {
		    key_new_size = *sidr++;
		    key_old_size = *sidr++;
		    key_bytes += 2 + key_new_size;
	    } else {
		    key_bytes += max_key_size;
	    }
		key = (char *) sidr;
/*
**  front compression
*/
		for ( i = 0;  i < key_new_size; i++) {
			save_key_binary[i + key_old_size] = key[i];
		}
/*
**  tail compression
*/
		for ( i = key_new_size + key_old_size; 
		   i <  max_key_size; i++) {
			   save_key_binary[i] = key[key_new_size - 1];
		   } 

		sidr += key_new_size;
	
		if (log && dup_count) printf ( LOG_FORMAT_STRING, 
			    record_count,  vbn , dup_count, save_key_print);
	
		if (!( (struct IRC$R_FLG_BITS *) sidr )->irc$v_first_key) chain_count++;

	while ( sidr < next_sidr )		/* pointer loop */
	    {
	    struct IRC$R_FLG_BITS irc_flags;
	    irc_flags = * (struct IRC$R_FLG_BITS *) sidr++; /* grab and skip */

	    if (irc_flags.irc$v_first_key)
		{
		/* 
		** Have a key marked as first. Finish last key first
		*/
		if (dup_count > 1) score_previous_key ( dup_count, chain_count, 
		       chain_start_vbn, chain_end_vbn,
                       null_key_value, null_key, save_key_print );

		/*
		** prepare for this time round
		*/
		dup_count = 0;
		chain_count = 1;
		chain_start_vbn = vbn;
		null_key = (alt->xab$v_nul) ? 0: 1;
		null_key_value = (unsigned char) save_key_binary[0];
		for (i=0; i < max_key_size; i++) {
		   if (null_key_value != (unsigned char) save_key_binary[i]) {
			null_key = 0;
			break;
			}
		   }
		format_key ( save_key_print, key, key_type, 
		      max_key_size, key_new_size, key_old_size );
		} /* first key */

	    dup_count++;
	    if (irc_flags.irc$v_ru_update) 
		 {
		 ru_updated++ ;
		 }
	    else if (irc_flags.irc$v_ru_delete) 
		 {
		 ru_deleted++ ;
		 }
	    else if (irc_flags.irc$v_deleted) 
		 {
		 deleted++;
		 }
	    else udr_records++;

	    
	    if (!(irc_flags.irc$v_noptrsz)) /* skip past pointer	*/
		{
		char *udr_rfa;
		int rfa_size;
		rfa_size = 4 + irc_flags.irc$v_vbn_pointer_size;
		if (binary)
		    {
		    bin.sidr_vbn = vbn;
		    bin.udr_vbn = 0;
		    udr_rfa = (void *) &bin.udr_id;
		    while (rfa_size--) *udr_rfa++ = *sidr++;
		    bin.flags = irc_flags;
		    sys$put (&binrab);
		    }
		else
		    sidr += rfa_size;
		}
	    }				/* while more pointers in sidr  */
	}				/* while more sidrs in bucket   */
	
    if (sidr_records_this_bucket) {
	    if ((empty > MAX_EMPTY_BUCKETS) && (empty > worst_empty)) {
	    	/* point to first record (could be marked deleted, but oh well
	    	** cheat with pointer to deal with fixed versus variable size
	    	*/
	    	unsigned char *r;
			worst_empty = empty;
			worst_empty_start_vbn = empty_start_vbn;
			worst_empty_end_vbn = vbn;
        	*after_empty_key=0;
        	if ( compression ) {
	        	format_key (after_empty_key, (char *) &bucket->data[4],
	    			alt->xab$b_dtp, alt->xab$b_tks, 
	    			bucket->data[2], bucket->data[3]);

          	} else {
	          	format_key (after_empty_key, (char *) &bucket->data[2],
	  				alt->xab$b_dtp, alt->xab$b_tks, alt->xab$b_tks, 0);
			} /* compression */
        	empty = 0;
        	empty_start_vbn = 0;
    	} /* worst empty */
	} else {
		if (0 == empty_start_vbn) empty_start_vbn = vbn;
      	empty++;
	    total_empty++;
  	}
    
    /*
    ** Set up to read next bucket and Sanity check.
    */
    chain_end_vbn = vbn;
    rab.rab64$l_bkt = bucket->next;
    if (bucket->flags & 1) {
	    if (rab.rab64$l_bkt != start_vbn){
		    fprintf (stderr, "%s- BUG!! VBN %d marked LAST points to %d instead of %d (start).\n", 
			header_line, vbn, rab.rab64$l_bkt, start_vbn);
		    stat = RMS$_BUG;
	    }
	    rab.rab64$l_bkt = 0;	    /* flag as done */
    } else if (buckets > max_buckets) {
		fprintf (stderr, "%s- BUG!! VBN %d. LOOP! More buckets read than in the file\n", header_line, vbn );
		stat = RMS$_BUG;
	} else if (rab.rab64$l_bkt == start_vbn){
		fprintf (stderr, "%s- BUG!! VBN %d. LOOP! Pointing to %d (start).\n", header_line, vbn, start_vbn );
		stat = RMS$_BUG;
	} else {
		stat = buf_read ( &rab);
    	bucket = (void *) rab.rab64$pq_rbf;
	}
} /* while not last bucket in chain */

if (binary) close_binary();
if (record_count > 0)
    {
    struct TOP_TEN *top;
    /*
    **	Print result for this key after processing last values.
    */
    if (log && dup_count) printf ( LOG_FORMAT_STRING, 
		    record_count,  rab.rab64$l_bkt, dup_count, save_key_print);
    if (dup_count > 1) score_previous_key 
	( dup_count , chain_count, chain_start_vbn, chain_end_vbn,
		null_key_value, null_key, save_key_print );
    
    top = &top_ten[0];
    if (top->null_key) {
        sprintf ( top->key, "NULL=%d", top->null_key_value);

/*       char symbol[20];
	sprintf ( symbol, "RMS_NULL_KEY_%d", alt->xab$b_ref);
	set_symbol ( symbol, top->key );
*/ 
        sprintf ( symbol_list + strlen(symbol_list), "|%d_%d_%d_%d",
		key_number,top->null_key_value,top->chain,buckets);
        set_symbol ( (char *) &LIST_SYMBOL_NAME, symbol_list);
	}
	
	sprintf (text, "Key %d, %8d Dups in %d Buckets for value \"%s\"", 
		    key_number, top->dups, top->chain, top->key);

	if (fdl) {
		user_key_bytes = max_key_size;
		user_key_bytes *= record_count;
		key_bytes *= 100;
		key_bytes /= user_key_bytes; /* now a ratio */
		i = 100 - key_bytes;
	    fprintf(fdl, "\nANALYSIS_OF_KEY %d\n", key_number);
	    if (top->chain > 1) fprintf (fdl, "!Dups: %s\n", text); 
	    fprintf(fdl, "\tDATA_KEY_COMPRESSION %d\n", i);
	    fprintf(fdl, "\tINDEX_COMPRESSION    %d  ! Faked \n", i);
	    sidr_bytes /= record_count;
	    i = sidr_bytes;
	    fprintf(fdl, "\tMEAN_DATA_LENGTH     %d\n", i);
	    fprintf(fdl, "\tDATA_RECORD_COUNT    %d\n", record_count);
    }


    if (min_report)
        {
        if (top->chain > min_report) printf ("%s- SIDR: %s\n", header(), text);
        } else {	    

        printf ("\nFound %d sidr records in %d buckets. %d empty bucket%s.\n", 
            record_count, buckets, total_empty, (total_empty==1)? "":"s");
        printf ("There were %d user data record pointers.\n", udr_records);
        printf ("There were %d deleted, %d RU_delete and %d RU_update pointers.\n",
	    deleted, ru_deleted, ru_updated);
        
        if (top_ten[0].dups) 
            {
            printf ("\n  Top Ten Table of Sidrs with more than 1 duplicate\n");
            printf ("\n Duplicates, Buckets, From VBN ->    To VBN, Key value" );
    	    printf ("\n---------------------------------------------------------\n");

    	    for (i=0;  i<MAXREC;  i++)
        	if (top_ten[i].dups) 
                    printf (" %10d %8d %9d -> %9d  %s\n", 
        		top_ten[i].dups, top_ten[i].chain, 
			top_ten[i].start_vbn, top_ten[i].end_vbn, top_ten[i].key);
            } else {
            printf ( "No duplicate key values found.\n");
            }
        }
    if (worst_empty)
        printf ("%s- SKIP: Key %d, vbn %d -> %d : %d Empty Buckets. Key: \"%s\". Convert!\n",
              header(), alt->xab$b_ref, worst_empty_start_vbn, worst_empty_end_vbn, 
              worst_empty, after_empty_key);
    } else {
    	printf ( "No alternate keys found !\n");
    }    
return stat;
}

int dump_buckets (int start_vbn, int bucket_size, int max_buckets)
{
int		i, stat, buckets=0;

/*
** Create Dump file and copy prologue to help ana/rms a little 
*/

binfab.fab$l_alq = bucket_size * DUMPEXTEND ;
binfab.fab$b_fac = FAB$M_BIO;
binfab.fab$b_org = FAB$C_IDX;
stat = sys$create ( &binfab);
if (!( stat & 1 )) return stat;
stat = sys$connect ( & binrab ) ;
if (!( stat & 1 )) return stat;

rab.rab64$l_bkt = 1;
stat = buf_read ( &rab) ;
bucket = (void *) rab.rab64$pq_rbf;
if (!( stat & 1 )) return stat;
binrab.rab$w_rsz = rab.rab64$q_rsz;
binrab.rab$l_rbf = (char *) bucket;
stat = sys$write ( &binrab );
if (!( stat & 1 )) return stat;

rab.rab64$l_bkt = start_vbn;
rab.rab64$q_usz = bucket_size * 512;
binrab.rab$w_rsz = bucket_size * 512;
stat = buf_read ( &rab);	    /* read first bucket */
bucket = (void *) rab.rab64$pq_rbf;

/*
** Now walk buckets while 
**	- RMS status is success and 
**	- NOT last bucket in chain.
*/
while ((stat & 1) && rab.rab64$l_bkt )			 /* bucket loop */
    {
    buckets++;
    if (!(buckets % DUMPEXTEND)) 
	{
    	stat = sys$extend ( &binfab);	    
    	if (!( stat & 1 )) return stat;
	}
		
    stat = sys$write ( &binrab);	    /* copy */
    if (!( stat & 1 )) return stat;

    /*
    ** Set up to read next bucket and Sanity check.
    */
    rab.rab64$l_bkt = bucket->next;
    if (bucket->flags & 1)
	{
	if (rab.rab64$l_bkt != start_vbn) stat = RMS$_BUG;
	rab.rab64$l_bkt = 0;
	}
    else
	{		
	if ((buckets > max_buckets) || (rab.rab64$l_bkt == start_vbn)) 
	    {
	    stat = RMS$_BUG;
	    }
	else
	    stat = buf_read ( &rab);
	    bucket = (void *) rab.rab64$l_rbf;
	}
    }					/* while not last bucket in chain */

return sys$close ( &binfab);
}

void scan_primary(int max_primary_buckets, struct XABKEY *k, int fixed)
{
  int rrv_count=0, deleted_count=0, done=0, lrl=0,
      key_not_compressed, dat_not_compressed, var;
  int i, s, start_vbn, usz, stat, user_size, data_size, record_size;
  long long int total_bytes, user_bytes=0, data_bytes=0, 
  		deleted_bytes=0, used_bytes=0, key_bytes=0;
  int empty=0, worst_empty=0, records_this_bucket;
  int fill_range, fill[FILL_RANGES];
  int chain_size=0, chains=0, chain_total=0, chain_max=0;
  struct {int size, miss, hits; } recent_chains[RECENT_CHAINS];
  double ratio;
  char after_empty_key[255+1], symbol[255+1];
  struct record_header *record, *r;

  key_not_compressed = (k->xab$b_flg & xab$m_key_ncmpr);
  dat_not_compressed = k->xab$v_dat_ncmpr;
  var = !( dat_not_compressed && key_not_compressed && fixed);
    
  start_vbn = k->xab$l_dvb;
  if (start_vbn == 0 || k->xab$b_flg & xab$m_initidx ) {
    printf ("%s- INIT! Primary index has not been initialized?\n", header());
    return;
    }
  for (i=0; i<FILL_RANGES; i++) fill[i]=0;
  for (i=0; i<RECENT_CHAINS; i++) recent_chains[i].size = 100;
  
  rab.rab64$l_bkt = k->xab$l_dvb;
  usz = k->xab$b_dbs * 512;
  rab.rab64$q_usz = usz;
  stat = buf_read ( &rab) ;
  bucket = (void *) rab.rab64$pq_rbf;
  while ((stat & 1) && (!done)) {
    records_this_bucket = 0;
    buckets++;
    if (bucket->sample != (rab.rab64$l_bkt & 0xffff)) {
       fprintf (stderr, "%s- BUG!! Bad VBN Sample %04X in bucket %d (%08X) \n", 
	   header_line, bucket->sample, rab.rab64$l_bkt, rab.rab64$l_bkt);
       stat = RMS$_BUG;
       break;
    }
 
    fill_range = FILL_RANGES * (bucket->free -1) / usz;
    fill[fill_range]++;
    used_bytes += bucket->free;
    record = (void *) &bucket->data[0];
    while ( (char *) record < (char *) bucket + bucket->free) {

/* comments from RM3NEXTRE
**
**        If the record is not a RRV then the amount of record overhead
**        will depend on whether the file contains fixed length data
**        records with neither the primary key nor the data portion
**        compressed, or any other type of record. The difference is
**        in whether a two-byte record size overhead field is present
**        or not.
**       
**        If the file contains fixed length records and both key and
**        data compression are disabled, then the record's size (minus
**        the record overhead's contribustion) is a known constant;
**        otherwise, for the remaining record types the size maybe
**        obtained from the last two bytes of the record's overhead
**       
*/
      int rec_size;
      struct IRC$R_FLG_BITS irc_flags;
      irc_flags = record->flags.flg_bits;
      if (! irc_flags.irc$v_rrv) {
	      if (irc_flags.irc$v_deleted) {
		      deleted_count++;
          } else {
	          records_this_bucket++;
	          if (record_count++ > sample_size) done = 1;
          }
          record_size = 0;
          if (irc_flags.irc$v_vbn_pointer_size == VALID_RECORD) {
	          if (var) {
		          int varlen;
		          unsigned char *repeat, *next_chunk, *end;
				  short chunk_size;
				  
				  varlen = record->record_length;         
		          rec_size = IRC$C_VAROVHSZ3 + varlen;
		          
		          if (!irc_flags.irc$v_deleted) {
			          data_bytes += varlen;
			          i = ( key_not_compressed ) ? 
			                 k->xab$b_tks : 2 + record->key_new_size;
			          key_bytes += i;
					  if (dat_not_compressed) {
			              record_size += k->xab$b_tks + varlen - i;
		              } else {
			              /*
			              ** Uh Oh... walk chunks
			              */
			              record_size += k->xab$b_tks;
			              end = &(record->key_new_size) + varlen;
			              next_chunk = &(record->key_new_size) + i;
			              while (next_chunk < end) {
				              chunk_size = *(short *)next_chunk;
				              repeat = next_chunk + chunk_size + 2;
				              record_size += chunk_size + *repeat;
				              next_chunk = repeat + 1;
			              }
			              if (next_chunk > end && !irc_flags.irc$v_ru_update) {
fprintf (stderr, "%s- BUG!! Compression error at offset %d in bucket %d\n", 
	header_line, (int) record -  (int) bucket, rab.rab64$l_bkt);
						  }
					  }

		          }
	          } else {
		          if (irc_flags.irc$v_deleted) {
			          rec_size = IRC$C_FIXOVHSZ3 + k->xab$b_tks;
		          } else {       
			          rec_size = IRC$C_FIXOVHSZ3 + fixed;
			          data_bytes += fixed;
			          record_size += fixed;
			          key_bytes  += k->xab$b_tks;
		          }
	          }
		  user_bytes += record_size;
                  if (lrl < record_size) lrl = record_size;
	          record = (void *)( (char *) record + rec_size );
          } else {
	          fprintf (stderr, "%s- BUG!! Bad record flag %0X at byte %d in bucket %d\n", 
            	header_line, record->flags.flg_byte, 
            	(int) record -  (int) bucket, rab.rab64$l_bkt);
              record = (void *) ((char *) bucket + bucket->free) ;
          } /* valid record */
      } else { /* RRV ?  */ 
          rrv_count++;
          rec_size = (irc_flags.irc$v_noptrsz) ? IRC$C_DATOVHSZ3:IRC$C_RRVOVHSZ3;
          record = (void *) ((char *) record + rec_size);
      }
  } /* while data in bucket */

    if (records_this_bucket) {
      if ((empty > MAX_EMPTY_BUCKETS) && (empty > worst_empty)) {
	/* point to first record (could be marked deleted, but oh well
	** cheat with pointer to deal with fixed versus variable size
	*/
	r = (var) ? (void *) &bucket->data[0] :( void *) &bucket->level;
	worst_empty = empty;
        *after_empty_key=0;
        if ( key_not_compressed ) {
          format_key (after_empty_key, (char *) &r->key_new_size,
	  k->xab$b_dtp, k->xab$b_tks, k->xab$b_tks, 0);
          } else {
          format_key (after_empty_key, &r->key_first_byte,
	    k->xab$b_dtp, k->xab$b_tks,
            r->key_new_size, r->key_old_size);
          } /* compression */
        empty = 0;
        } /* worst empty */
      } else {
      empty++;
      }

   /*    CHECK FOR IO IN RECENT CHAIN ???  */

   if ( (bucket->next - rab.rab64$l_bkt) == k->xab$b_dbs ) {
       chain_size++;
       io_size += k->xab$b_dbs; /* More optimistic for next IO. */
       } else {
	   /*
	   ** try to get a reasonable starting IO size based on the
	   ** recent chain size history. 
	   ** No point in reading large buffers when the VBNs bounce all over the place
	   */  

	   int recent_size =0, recent_hits=0, recent_miss=0, recent;
	   recent = chains % RECENT_CHAINS;    
	   if (chain_size > chain_max) chain_max = chain_size;
	   recent_chains[recent].size = chain_size;
	   recent_chains[recent].miss = cache_miss;
	   recent_chains[recent].hits = cache_hits;
	   
	   for (i = 0; i < RECENT_CHAINS; i++) {
		   recent_size += recent_chains[i].size;
	   }
	   recent_miss = cache_miss;
	   recent_hits = cache_hits;
	   recent++;
	   recent %= RECENT_CHAINS; /* prior */
	   recent_miss -= recent_chains[recent].miss;
	   recent_hits -= recent_chains[recent].hits;
	   recent_miss++; /* sloppy counts, just in case it is zero */   
	   recent_size *= recent_hits; /* multiply first to avoid truncates */
	   recent_size /= RECENT_CHAINS; /* calculate average */
	   recent_size /= recent_miss; 
	   recent_size++; /* at least one, and round up */
	   
	   io_size -= k->xab$b_dbs;
	   
	   /*
	   ** Only count significant chains.
	   */  
	   if (chain_size > CHAIN_MIN) {
			chains++;
			chain_total += chain_size;
			chain_size = 0;
		}
	}
      
      
    if (bucket->flags & 1) { /* last bucket ?) */
      if (bucket->next != start_vbn) {
	fprintf (stderr, "%s- BUG!! Last bucket flag at VBN %d next %d, not %d\n",
		header_line, rab.rab64$l_bkt, bucket->next, start_vbn);  
	}
      done = 1;
      break;
      }

    if ((buckets > max_primary_buckets) || (bucket->next == start_vbn)){
	fprintf (stderr, "%s- BUG!! Loop at bucket = %d. start = %d, bucket count = %d\n",
               header_line, bucket->next, start_vbn, buckets); 
	done = 1;
        break;
        }
   
    if ( buckets > (sample_size / MIN_RECS_PER_BUCKET) ) {
       done = 1;
       
       } else {
    	       
       rab.rab64$l_bkt = bucket->next;
       stat = buf_read ( &rab);
       bucket = (void *) rab.rab64$pq_rbf;
       }
    } /* while not done and succesful reads */

  if (!(stat & 1))
  printf ("%s- OOPS: RMS Error %d. Last VBN %d.\n", header(), stat, rab.rab64$l_bkt);
  
if (record_count) {  
  data_size = data_bytes / record_count;
  user_size = user_bytes / record_count;
  sprintf (symbol, "%s,bkt=%d,rec=%d,rrv=%d,del=%d,lrl=%d,user_size=%d,data_size=%d",
     ( record_count > sample_size) ? "SAMPLE" : "total",
        buckets, record_count, rrv_count, deleted_count, lrl, user_size, data_size);   
  set_symbol ( (char *) &RECORD_COUNT_SYMBOL_NAME, symbol);
  if (fdl) fprintf(fdl,"\n! %s\n",symbol);
    
  total_bytes = usz;
  total_bytes *= buckets;  /* long long math */
  
  used_bytes *= 100;
  used_bytes /= total_bytes; /* Now a ratio */
  i = used_bytes; /* short */
  s = 0;
  s += sprintf (symbol, "fill=%d%% in %d ranges 0-100 ", i, FILL_RANGES);    
  for (i=0; i<FILL_RANGES; i++) {
	 s += sprintf (&symbol[s], ":%d", 100*fill[i]/buckets);
  }
  set_symbol ( (char *) &FILL_SYMBOL_NAME, symbol);
    if (fdl) fprintf(fdl,"! %s\n",symbol);
}     
  sprintf (symbol, "hit=%d,miss=%d,blocks_read=%d,series>%d=%d,max=%d,avg=%d",
     cache_hits, cache_miss, cache_blocks, CHAIN_MIN, chains, chain_max,
     chains? chain_total/chains : 0);   
  set_symbol ( (char *) &IO_SYMBOL_NAME, symbol);
  if (fdl) fprintf(fdl,"! %s\n",symbol);


  record_count += growth * ( record_count / 100 );
  
  if (fdl && record_count ){
        long long int user_key_bytes;
	int rec_per_bucket, key_per_bucket, bytes_per_bucket, compressed=0, 
		level, last_level, key_size, pointer_size, key_needed, dat, idx;  
	int cmp_rate;
	user_key_bytes = k->xab$b_tks;
	user_key_bytes *= record_count;
	data_bytes -= key_bytes;
	user_bytes -= user_key_bytes;
	key_size = k->xab$b_tks;
	
	s = sprintf (symbol,                "LVL/BKS/DAT/IDX:");
	pointer_size = ( buckets > 256*256*256) ? 4 : 3;
	while (compressed < 2) {
	  if (compressed++) {
		  key_size = key_bytes / record_count;
		  s += sprintf (&symbol[s], "\n!      Compressed:");
		  /*                            "LVL/BKS/DAT/IDX:"); */
	  }		   	
	  last_level = 6; /* refuse to display indexes deeper than 5 */
          i = (lrl + 15 + 13 + 511) / 512;
	  while ( i < 64 ) {
		bytes_per_bucket = 512 * i - 15;
		rec_per_bucket = bytes_per_bucket /(data_size + IRC$C_VAROVHSZ3);
		if (!rec_per_bucket) break;
		key_per_bucket = bytes_per_bucket / (key_size + pointer_size);
		key_needed = (record_count + rec_per_bucket -1 ) / rec_per_bucket;
		dat = key_needed;
		idx = 1;
		level = 1;
		while (key_needed > key_per_bucket) {
			level++;
			key_needed = (key_needed + key_per_bucket - 1)/ key_per_bucket;
			idx += key_needed;
		}
		if (level < last_level) {
			last_level = level;
	 		s += sprintf (&symbol[s], " %d/%d/%d/%d,",
	 			level,i,dat*i,idx*i);
 		}
                i++;
	  }
          symbol[--s]=0;
	}
	set_symbol ( (char *) &LEVELS_SYMBOL_NAME, symbol);
	if (fdl) fprintf(fdl,"\n! %s\n",symbol);

	key_bytes *= 100;
	key_bytes /= user_key_bytes; /* now a ratio */
	cmp_rate = 100 - key_bytes;

	fprintf(fdl, "\nFILE\n\tCLUSTER_SIZE %d\n",CLUSTER_SIZE);
    fprintf(fdl, "ANALYSIS_OF_KEY 0\n");
    if (!key_not_compressed) { 
    	fprintf(fdl, "\tDATA_KEY_COMPRESSION %d\n", cmp_rate);
    	fprintf(fdl, "\tINDEX_COMPRESSION    %d  ! Faked \n", cmp_rate);
    }
    if (!dat_not_compressed) {
	    data_bytes *= 100;
	    if (user_bytes) {
		    data_bytes /= user_bytes; /* now a ratio */
	    } else {
		    data_bytes = 100;
	    }
	    cmp_rate = 100 - data_bytes;
	    fprintf(fdl, "\tDATA_RECORD_COMPRESSION %d\n", cmp_rate);
    }
    fprintf(fdl, "\tMEAN_DATA_LENGTH     %d  ! average stored = %d\n",
    	user_size, data_size);
    fprintf(fdl, "\tDATA_RECORD_COUNT    %d\n",record_count);
    }

  if (worst_empty)
    printf ("%s- SKIP: %d empty data buckets before Primary Key: \"%s\". Convert.\n",
              header(), worst_empty, after_empty_key);

  if (record_count) {
    ratio = 100 * rrv_count / record_count;
    if (ratio > MAX_RRV_PERCENT) {
      printf ("%s- RRVS: %d moved records in %d %s. %.1f%%. Convert! Smaller fill?\n",
	header(), rrv_count, record_count, 
	(record_count > sample_size)? "record SAMPLE": "records", ratio);
      }
    }

  if (buckets) {
    ratio = 1.0 * record_count / buckets; 
    if (ratio < MIN_RECS_PER_BUCKET) {
      printf ("%s- RECS: Only %d records in %d bucket sampled. %.1f rec/bkt. Inefficient?\n",
        header(), record_count, buckets, ratio);
      }
    }
}

main (int argc, char *argv[])
{
struct FAB	fab;
struct XABSUM	sum;
struct XABKEY	key[MAXKEY], *alt;
struct XABDAT   dat;

$DESCRIPTOR (sys$command, "SYS$COMMAND:");

int		i, stat, key_type, key_compression, fixed, page_size, vcc_max_io_size;
int		max_buckets, max_root, timlen=0, verbose = 0;
int    sys$asctim(), sys$gettim(), sys$getsyi(), sys$assign(), sys$getdviw(), sys$qiow(); 
short	control_t_chan;
char		c, *arg, asctim[23+1], text[256], *io_buffer, *null, null_value[4],*key_name;
struct {int len; char *addr;} asctim_desc = { sizeof asctim, asctim };
item    getsyi_items[] = { sizeof vcc_max_io_size, SYI$_VCC_MAX_IO_SIZE, &vcc_max_io_size, 0,
                           sizeof page_size,       SYI$_PAGE_SIZE,       &page_size, 0,
                           0,0,0,0};
char		*dtp[] = {
"STG ", "IN2 ", "BN2 ", "IN4 ", "BN4 ", "PAC ", "IN8 ", "BN8 ",
"COL ", "#9? ", "#10?", "#11?", "#12?", "#13?", "#14?", "#15?",  
"#16?", "#17?", "#18?", "#19?", "#20?", "#21?", "#22?", "#23?", 
"#24?", "#25?", "#26?", "#27?", "#28?", "#29?", "#30?", "#31?", 
"DSTG", "DIN2", "DBN2", "DIN4", "DBN4", "DPAC", "DIN8", "DBN8",
"DCOL", "????"} ;

binrab = cc$rms_rab;
binfab = cc$rms_fab;
binrab.rab$l_fab = &binfab;
stat = sys$getsyi(0,0,0,getsyi_items,0,0,0);
io_size_blocks = vcc_max_io_size + 1;

while (--argc > 0 &&  **++argv == '-' )
    { 
    arg = *argv;
    switch (*++arg) {
	case 'i':
        c = *++arg;
        if ((c != '=') && (c != ':')) {
            argc=0;
        } else {
            sscanf( ++arg, "%d", &io_size_blocks);
        }
        break;
    
    case 'l':
	log = 1;
	break;
    case 'k':
	c = *++arg;
	if ((c == '=') || (c == ':'))
           {
	   sscanf( ++arg, "%d", &key_number);
	   if (key_number) {
		  full_check = 0;
          min_report = 0;
      } else {
	      sidr_check = 0;
      }
		
           }
	break;
    case 'm':
        c = *++arg;                             
        if ((c != '=') && (c != ':'))
            {
            argc = 0;
            }
        else sscanf( ++arg, "%d", &min_report);
        break;
    case 't':
        tune_check = 1;
        full_check = 0; 
        sidr_check = 0;
        break;
    case 'v':
        verbose = 1;
        lib$init_timer();
        break;
    case 's':
        c = *++arg;
        if ((c != '=') && (c != ':'))
            {
            argc = 0;
            }
        else sscanf( ++arg, "%d", &sample_size);  /* into unsigned */
        break;

    case 'g':
        c = *++arg;
        if ((c != '=') && (c != ':'))
            {
            argc = 0;
            }
        else sscanf( ++arg, "%d", &growth);
        break;

        
    case 'b':
	c = *++arg;
	if ((c != '=') && (c != ':'))
	    {
	    argc = 0;
	    } 
        full_check = 0;
	binary = 1;
	binfab.fab$l_fna = ++arg;
	binfab.fab$b_fns = strlen ( arg );
	break;
    case 'd':
	c = *++arg;
	if ((c != '=') && (c != ':'))
	    {
	    argc = 0;
	    } 
	dump = 1;
        full_check = 0;
	binfab.fab$l_fna = ++arg;
	binfab.fab$b_fns = strlen ( arg );
	break;
	
	case 'a':
	c = *++arg;
	if ((c != '=') && (c != ':'))
	    {
	    argc = 0;
	    } 
	fdl = fopen(++arg, "w", "dna=.FDL_ANALYZE");
	break;

    default:
	printf ("RMS_TUNE_CHECK: Illegal option -%c.\n", *arg);
	argc = 0;
	break;
	}
    }
if ( argc != 1 ) 
    {
    printf ("\nUsage: %s [-v] [-k[=n] [-m=n] indexed.dat\n", argv[0]);
    printf ("Version 6: 20-Apr-2009. control-T, Large-IO, Area Usage, Quick Check.\n\n");
    printf ("  -v       Display Date, Filesize, Bucketsize, Name\n");
    printf ("  -s=n     Sample record count for primary key tuneup check.\n");
    printf ("             Default %d, Used -1 for full scan)\n",
    			RECORD_SAMPLE);        
    printf ("  -m=n     Report only worst SIDR chain if any > n.\n");
    printf ("             Default is more than 1 bucket\n");
    printf ("  -k[=n]   Key number for Top Ten SIDRs (Zero base)\n");
    printf ("             -k=0 stops alternate key check.\n");   
    printf ("  -t       Quick tune_check, attribues only, no sampling at all\n");
    printf ("\nDefines DCL symbols %s,\n",LIST_SYMBOL_NAME);
    printf ("    %s, %s, %s\n", RECORD_COUNT_SYMBOL_NAME,
    	FILL_SYMBOL_NAME, IO_SYMBOL_NAME);
    printf ("\n---- special options ----\n");
    printf ("  -i=n    IO Buffer size in 512 byte block. Default = vcc_max_io_size + 1 = %d.\n", vcc_max_io_size + 1);
    printf ("  -l       Log each sidr record found.\n");
    printf ("  -b=x.y   Binary SIDR & UDR pointers into file.\n");
    printf ("  -d=x.y   Binary data buckets into file.\n\n");
    printf ("  -a=x[.y] x.FDL_ANALYZE data for EDIT/FDL/NOINT.\n");
    printf ("             Please consider -s=-1 and -k=0 with -a.\n");
    printf ("  -g=n     Growth percentage applied to record count\n\n");
 
    return 268435456; /* trivia... go figure */
    }
/*
** Allocate buffers, Fill in the fab, rab and keyxab
*/

io_buffer = malloc(IO_BUFFERS*io_size_blocks*512 + page_size);
if (!io_buffer) return 292; // SS$_INSFMEM;
io_buffer = (char *) (((unsigned int)io_buffer + page_size - 1) & -page_size); // page align
io_size = io_size_blocks;

for (i = 0; i < IO_BUFFERS; i++) {
	buffer_desc[i].start_vbn = 1024*1024*1024;
	buffer_desc[i].end_vbn = 0;
	buffer_desc[i].unused = 0;
	buffer_desc[i].useful = 0;
	buffer_desc[i].buffer_address = (char *) ((unsigned int)io_buffer + i * 512 * io_size_blocks);
}

symbol_list[0]=0;
set_symbol ( (char *) &LIST_SYMBOL_NAME, symbol_list);
fab = cc$rms_fab;
rab = cc$rms_rab64;
dat = cc$rms_xabdat;
key[0] = cc$rms_xabkey;
sum = cc$rms_xabsum;
fab.fab$l_fna = *argv;
fab.fab$b_fns = strlen( *argv );
fab.fab$b_shr = FAB$M_UPI | FAB$M_GET | FAB$M_PUT;
fab.fab$b_fac = FAB$M_GET | FAB$M_BRO ;
fab.fab$l_xab = (void *) &dat;
dat.xab$l_nxt = (void *) &key[0];
rab.rab64$l_fab = (void *) &fab;
rab.rab64$l_rop = RAB$M_BIO;
rab.rab64$q_usz = io_size_blocks * 512;
rab.rab64$l_rbf = (char *) -1;
rab.rab64$l_ubf = (char *) -1;

key[0].xab$l_nxt = (void *) &sum;

/*
** Open file, which fills in XABSUM or XABKEY and call work routine.
*/
stat = sys$open ( &fab );
if (!(stat & 1 ))		return stat;
if (fab.fab$b_org != FAB$C_IDX)	return RMS$_ORG;
if (key[0].xab$b_prolog != 3)	return RMS$_PLV; 
if (sum.xab$b_nok > MAXKEY) sum.xab$b_nok = MAXKEY;
for (i = 1; i < sum.xab$b_nok; i++)
    {
    key[i] = cc$rms_xabkey;
    key[i].xab$b_ref = i;
    key[i-1].xab$l_nxt = (void *) &key[i];
    }

/*
** Ask RMS to fill in the KEY and AREA XABs hooked off the FAB.
** We need the position, size and type for nice display.
** (Tried to use just 1 xabkey and re-display in the key loop,
** but RMS refuses to fill in XABKEY after block mode access?!)
*/
stat = sys$display ( &fab );
alq = fab.fab$l_alq;

if (stat & 1) stat = sys$connect ( &rab );	
if (!(stat & 1 ))		return stat;

/*
** Set up control-T out-of-band AST.
*/ 
stat = sys$assign ( &sys$command, &control_t_chan, 0, 0 );
if (stat & 1) {
	int devclass = 0, control_t_mask[] = {0, 0x00100000};
	item getdvi_item[] = {sizeof (int), DVI$_DEVCLASS, &devclass, 0, 0,0,0,0 } ;
	stat = sys$getdviw ( 0, control_t_chan, 0, getdvi_item, 0,0,0,0,0 );
    if ((stat & 1) && (devclass == DC$_TERM)) {
	    file_name = fab.fab$l_fna;
	    stat = sys$qiow ( 0, control_t_chan, IO$_SETMODE | IO$M_OUTBAND, 0, 0 , 0, 
	             &control_t_ast, control_t_mask, 0, 0, 0, 0 ) ;
    }
}

stat = sys$asctim (&timlen, &asctim_desc, 0, 0);
asctim[timlen]=0;         

    sprintf (header_line, "\n* %s ALQ=%d BKS=%d GBC=%d %s\n",
	asctim, alq, fab.fab$b_bks, fab.fab$w_gbc, fab.fab$l_fna);
    if (verbose) printf ("%s", header());
    if (tune_check || full_check) {
       long long int now, age;
       age = YEARS * 365 * 24 * 60 * 60;
       age *= 10000000; // 100 micro second clunks
       sys$gettim(&now);
       if ((now - dat.xab$q_cdt) > age ) {
           stat = sys$asctim (&timlen, &asctim_desc, &dat.xab$q_cdt, 0);
           printf ("%s-  OLD: More than %d year old. %s Time for a convert?\n",
             header(), YEARS, asctim);
       }
    }
       
    if (fdl) { 
        fprintf (fdl,"! Tune_check %s %s\n", asctim, fab.fab$l_fna );
	stat = sys$asctim (&timlen, &asctim_desc, &dat.xab$q_cdt, 0);
        fprintf (fdl,"!    Created %s ALQ=%d BKS=%d GBC=%d\n",
           	asctim, alq, fab.fab$b_bks, fab.fab$w_gbc );

        if (sample_size < 1024*1024*1024) {
		   printf ("- Warning: FDL generated using %d record sample\n",
		   sample_size);
	}
	
    /* if (sidr_check) printf ("- Hint: Alternate key check not critial for FDL.\n"); */

	    fprintf (fdl, "\n!  LVL DB IB DTP TKS POS NUL  Root-VBN  Data-VBN Name");
	    fprintf (fdl, "\n!-- -- -- -- --- --- --- --- --------- ---------\n");
	
	    for (i=0; i<sum.xab$b_nok; i++) {
	      null = "   ";
	      if (key[i].xab$b_dtp > 41) key[i].xab$b_dtp = 41;
	      if (key[i].xab$v_nul) {
	        null = null_value;
	        sprintf (null_value,"%3d",key[i].xab$b_nul); 
	        }
	      fprintf (fdl, "!%2d %2d %2d %2d %4s%3d %3d %s %9d %9d %s\n", 
	        i, key[i].xab$b_lvl, key[i].xab$b_dbs, key[i].xab$b_ibs,
	        dtp[key[i].xab$b_dtp], key[i].xab$b_tks,  key[i].xab$w_pos0, null,
	        key[i].xab$l_rvb, key[i].xab$l_dvb, key[i].xab$l_knm );
	      } // each key

         } // FDL

/*
** Report usage for first 8 areas (1 VBN full)
** The area descriptors start in the VBN  following the keys
** Key 0 lives in VBN 1, 5 keys per block after that.
*/   
	    rab.rab64$l_bkt = 2 + (3 + sum.xab$b_nok) / 5 ;
	    stat = buf_read ( &rab);
	    area = (void *) rab.rab64$pq_rbf;
	    if (sum.xab$b_noa > 8 ) sum.xab$b_noa = 8 ; // 512 divided by 64
	    for (i = 0; i < sum.xab$b_noa; i++) {
                int alloc, used;
                alloc  = area[i].alloc;
                used   = area[i].used + alloc - area[i].cnblk - area[i].nxblk; // used is only from cnblk chunk
		if (fdl) fprintf (fdl, "%s%d=%d/%d", (i)? ", " : "!Area=Used/Free: ", i, alloc, alloc - used);
                if ((key[0].xab$b_dan==i) && (tune_check || full_check)) {
                    int pct;
                    /* 
                    ** See whether there is enough free primary data space, or a significant extend
                    */
                    if (alloc > 1000000) { // 32-bit math protection
                        pct = (alloc - used)/(alloc/100);
                    } else {
                        pct = (100 * (alloc - used)) / alloc;
                    }
                    if ((pct < 5) && (area[i].deq < alloc/10)) {
                       printf ("%s- FREE: Only %d %% free (%d/%d) in Primary Data Area (%d) and Extend (%d) < 10%%\n",
                             header(), pct, alloc - used, alloc, i, area[i].deq);
                    }
                 } // primary data area?
	    } // each area
	    if (fdl) fprintf (fdl, "\n");
  
          max_root = 3;
          if (alq < 50000) max_root = 2;
          if (full_check) {
  	      max_root = SMALL_ROOT;
	      if (alq > MEDIUM_SIZE) max_root = MEDIUM_ROOT;
	      if (alq > BIG_SIZE) max_root = BIG_ROOT;
          }
	  key_name = "Primary ";
	  for (i = 0; i < sum.xab$b_nok; i++) {
	    if (key[i].xab$b_lvl > max_root ) {
	      printf ("%s- ROOT: %s key %d (IBS=%d,DBS=%d) index root level is high: %d (goal=%d).\n",
		header(), key_name, i, key[i].xab$b_ibs, key[i].xab$b_dbs, 
	        key[i].xab$b_lvl, max_root);
	      }  
	    if (i==0) {
	       max_root--; /* Alternate keys */
	       if (max_root==0) max_root = 1;
	       key_name = "Alternate";
	       }
	    }
	
	if (full_check) {
	    if (sum.xab$b_nok > MAX_KEY_WARNING) {
	        printf ("%s- KEYS:  Are those %d keys really all needed? ( %d",
		        header(), sum.xab$b_nok, key[0].xab$w_pos0);
	        for (i=1; i < sum.xab$b_nok; i++) {
	            printf (", %d", key[i].xab$w_pos0);
	        } // each key
	        printf (" )\n");
	    }

	  max_buckets = alq / key[0].xab$b_dbs ;
	  
	  fixed = (fab.fab$b_rfm == FAB$C_FIX) ? fab.fab$w_mrs : 0;
		       
	  scan_primary(max_buckets, &key[0], fixed);
	
	} /* full_check */
	
	if (key_number) {
	    if (key_number >= sum.xab$b_nok) return RMS$_KRF;
	    sum.xab$b_nok = key_number + 1;	    /* force just 1 pass true loop */
    } else {
	    if (dump) {
			printf (" Usage error. Must specify key for dump.\n");
		} else {
			key_number = 1;
	    }
    } // specifiv key?
	
	if (sidr_check) {    
	    for ( ; (key_number < sum.xab$b_nok) && (stat & 1) ; key_number++ ) {
		    alt = &key[key_number];
		    key_compression  = 2 ;
		    max_buckets = alq / alt->xab$b_dbs ;
		    if ( alt->xab$b_flg & xab$m_key_ncmpr ) key_compression = 0;
		    /*    if (alt->xab$v_dup) */
		    if (dump) {
			rab.rab64$q_usz = (key[0].xab$l_dvb - 1) * 512; /* prologue size */
			stat = 	dump_buckets (  alt->xab$l_dvb, alt->xab$b_dbs, max_buckets);
			} else if ( alt->xab$b_flg & xab$m_initidx ) {
				printf ( "\n Key %d NOT Initialized.\n", key_number);
			} else {
			    if (min_report == 0) printf ( "\n Key %d \n", key_number);
			    rab.rab64$q_usz = alt->xab$b_dbs * 512;
			    stat = walk_sidr_buckets ( alt, max_buckets, key_compression);
			}
	    } // each key
	} // sidr ?   
	  
	if (verbose) lib$show_timer();
	fclose(fdl);   
	return stat;
}