/* rmscheck.c	- DECUS C; RMS-11; RSX-11; do consistency checks on an
 *		- indexed file. so far only does within-bucket checks.
 * **** PROTOTYPE **** USE AT OWN RISK **** KNOWN TO HAVE BUGS ****
 *
 * use		RMSCHECK <in.rms.file >out.stream.file
 *
 * bugs		thinks all blocks are 512 bytes long
 *		thinks only one key
 *		thinks only one area
 */

#include <stdio.h>	/*						*/
#include <algol68.h>	/* keep it clean #defines (I like SIMULA)	*/
#include <rms180.h>	/* RMS-11 v1.8 on-disk structures		*/
#include <rms200.h>	/* RMS-11 v2.0 in-core structures		*/
#include <cx.h>		/* cysterns programmers' jargon			*/
#include <nboff.h>	/* name block					*/
#include <fdoff.h>	/* File Descriptor Block			*/
#define BUFSIZ 512	/* special for this kludge - not for final product */

char	buffer[BUFSIZ];	/* this chunk					*/
long	chunkn;		/* 0-origin chunk number			*/
int	howlong;	/* char length of this chunk			*/
long	vbn;		/* virtual block number of this chunk		*/
int	nxtbyt;		/* bucket next free byte 0-origin	B$NBY	*/
int	nxtrid;		/* bucket next record ID		B$NID	*/
int	hirid;		/* bucket high record ID		B$LID	*/
long	nxtbkt;		/* bucket next bucket pointer		B$NBK	*/
int	bktlvl;		/* bucket level (0=data)		B$LVL	*/
int	bktbcb;		/* bucket control bits			B$BCB	*/
struct	rmspro	prolog;	/* prologue block - first 512 bytes		*/
struct	rmsbkh*	bkhp;	/* points to this bucket header			*/
char *	pend;		/* end limit for p				*/
char *	p;		/*						*/
char *	qend;		/* end limit for q				*/
char *	q;		/*						*/
char	c;		/*						*/
int	i;		/*						*/
int *	ip;		/*						*/
unsigned	bplen;	/* byte length of bucket pointer		*/
long	testvbn;	/* a temporary VBN				*/
FDB *	fdbp;		/* points to stdin's FDB			*/
int	rrid;		/* record pointer record ID number		*/
			/* (1st byte of 5 in RP) (next 4 : bucket VBN)	*/
int	flags;		/* index header flags				*/
unsigned	testrid;	/* a record ID number			*/
static	long	lwinge;	/* last vbn we winged about			*/
BOOL	compressed;	/* TRUE if this is a 2-byte compressed deleted RRV */

main(argc,argv)
int	argc;
char	**argv;
BEGIN
	stdin  -> _flag |= IO_NOS | _IONBF;
	fdbp = stdin -> io_fdb;
	howlong = 0;
	chunkn = 0L;
	vbn = 0L;
	lwinge = 0L;
	IF	( (fdbp->f_fatt.f_rtyp&0xFF) != (FB$FIX /*| FB$IDX*/) )	/* KLUDGE !! */
	THEN	winge("Not fixed-length indexed records");
		exit();
	FI
	IF	(get512())
	THEN	winge("Prologue failed");
		exit();
	ELSE	copy(&prolog,buffer,512);
	FI
	IF	(get512())
	THEN	winge("Area descriptor failed");
		exit();
	FI
	FOR	(vbn=3L,chunkn=2L;  !feof(stdin);  vbn += 1)
	DO	IF	(!((i=vbn)&0x3FF))	/* DECUS C can't & a long */
		THEN	fprintf(stderr,"up to %ld.\n",vbn);
		FI
		IF	(getrec())
		THEN	break;
		FI
		IF	(howlong%512)
		THEN	winge("All RMS chunks should be a multiple of 512. bytes");
			break;
		FI
		bkhp = buffer;
		IF	(bkhp->b_chk!=buffer[howlong-1])
		THEN	gringe("Check Byte Failed");
		FI
		IF	(bkhp->b_taa)
		THEN	gringe("not area 0");
		FI
		IF	( bkhp->b_adr != (vbn&0xFFFF) )
		THEN	gringe("virtual block number mismatch");
		FI
		nxtbyt = bkhp -> b_nby;
		IF	(nxtbyt>510)
		THEN	gringe("unbelievable B$NBY - 510 assumed");
			nxtbyt = 510;
		FI
		nxtrid = bkhp -> b_nid & 0xFF;
		hirid  = bkhp -> b_lid & 0xFF;
		IF	(hirid<nxtrid)
		THEN	winge("high record ID less than next record ID");
		FI
		nxtbkt = bkhp -> b_nbk;
		longit(&nxtbkt);
		bktlvl = bkhp -> b_lev & 0xFF;
		bktbcb = bkhp -> b_bcb & 0xFF;
		FOR	(pend=buffer+nxtbyt,p=buffer+016;  p<pend;  )
		DO	bplen = *p &0x3;
			flags = *p & 0xFC;
			compressed = flags & DC$NPS;
			IF	( bplen>2 && ! compressed )
			THEN	gringe("LOST: bad PS");
				break;
			ELSE	bplen = 2 + bplen;
			FI
			p += 1;	/* step over control byte */
			/* p points to 2nd byte of header */
			IF	(bktlvl)
			THEN	/* index bucket - expect only key, never RRV */
				testvbn = 0L;
				copy(&testvbn,p,bplen);
				longit(&testvbn);
				/* now have 32-bit VBN bucket pointer */
				p += bplen;
				/* p points to start of key */
				p += prolog . k_pkd . k_kysz;
			ELSE	/* data bucket - expect compressed or normal */
				testrid = *p &0xFF ;
				IF	(testrid>(bkhp->b_nid&0xFF))
				THEN	winge("excessive record ID");
				FI
				p += 1;
				/* p points past first two bytes of record header */
				IF	( compressed )
				THEN	/* compressed deleted RRV: no record pointer */
				ELSE	/* expect deleted or record */
					rrid = *p &0xFF;
					p += 1;
					copy(&testvbn,p,4);
					longit(&testvbn);
					p += 4;
					IF	(flags & DC$RRV)
					THEN	/* no more expected */
						IF	(testvbn == vbn)
						THEN	winge("RRV points to self");
						FI
					ELSE	/* not RRV: expect record */
/*						IF	(testvbn != vbn && )
kinky tafe records !!				THEN	winge("RRV doesn't point to self");
						FI
*/
/*						p += fdbp -> f_fatt . f_rsiz;
*/
p+=0242;	/* nasty bandaid for TechEd job */
					FI
				FI
			FI
		OD
		IF	(p!=pend)
		THEN	winge("crud at end of bucket");
		FI
	OD
	exit(IO_SUCCESS);
END

/*
 * get512()		read a 512-byte chunk, and ensure it has valid checksum
 *
 *			return TRUE if bad
 */
BOOL get512()
BEGIN
BOOL	retval;

	retval = FALSE;
	IF	(getrec())
	THEN	retval = TRUE;
	ELSE	retval = chk512();
	FI
	return(retval);
END


/*
 * chk512()		ensure that this chunk is 512 bytes long,
 *				has a standard checksum
 *
 *			return TRUE if bad
 */
BOOL	chk512()
BEGIN
BOOL	retval;

	retval = FALSE;
	IF	(howlong!=512)
	THEN	winge("Chunk should be 512 bytes");
		retval = TRUE;
	ELSE	FOR	(i=0,ip=buffer;	ip<buffer+510; ip++)
		DO	i += *ip;
		OD
		IF	(i != *(ip=buffer+510) )
		THEN	winge("bad checksum");
			retval=TRUE;
		FI
	FI
	return(retval);
END

/*
 * getrec()	read next chunk
 *		increment chunkn
 *
 *		return	1:	EOF
 *			0:	OK		howlong = length of chunk
 *			never:	error		$$ferr = specific error
 *			
 */
int	getrec()
BEGIN
int	retval;

	IF	(feof(stdin))
	THEN	retval = 1;
	ELSE	howlong = fget(buffer,BUFSIZ,stdin);
		IF	(ferror(stdin))
		THEN	error("\7read fail $$ferr=%oo vbn=%lo",$$ferr,vbn);
		ELSE	IF	(feof(stdin))
			THEN	retval = 1;
			ELSE	retval = 0;
			FI
		FI
	FI
	chunkn += 1;
	return(retval);
END

/*
 * winge(string)
 *
 * Dump the current chunk (i.e. bucket or block) with some virtual block
 * number identification and the reason why it is defective (=string).
 *
 * Do not exit() because it may be a warning rather than fatal error.
 *
 * in:	implicit:	vbn			the 1-origin virtual block number of the LAST block we read
 *						so it may not be the start block of the chunk
 *			chunkn			the 0-origin chunk number of this chunk. Chunk number is not a DEC concept.
 *			howlong			length (chars) of the chunk we choked on
 *			buffer[howlong]		the chunk we didn't like
 *			p			pointer into buffer[]
 *			lwinge			last vbn we dumped: don't dump contents twice
 *	explicit:	why			text of why we don't like this chunk, no '\n' needed at end
 *
 * out:			text to stdout
 *			lwinge updated
 */

#ifdef hate
winge(why)
char *	why;
BEGIN
#define ROWSIZE (16)	/* number of bytes to dump per row */

	IF	(lwinge!=vbn)
	THEN	printf("\f\7Virtual Block Number %lo=%ld.   Chunk Number %lo=%ld.   Length %o=%d.\n"
			,vbn,vbn,chunkn,chunkn,howlong,howlong);
fprintf(stderr,"block # %lo=%ld. is bad because %s\n",vbn,vbn,why);
	FI
	IF	(p>buffer && p<=buffer+howlong)
	THEN	printf(" pointer: %o=%d.\n",p-buffer,p-buffer);
	FI
	printf(" %s\n\n",why);
	IF	(lwinge!=vbn)
	THEN	FOR	(p=buffer,pend=buffer+howlong;  p<pend;  p+=ROWSIZE)
		DO	qend = minu( p+ROWSIZE, pend );
			printf("%6o %5d.  ",p-buffer,p-buffer);
			FOR	(q=p;  q<qend;  q++)
			DO	c = *q & 0xFF;
				putchar(' ');
				putchar( c&0x80 ? '%' : ' ' );
				c &= 0x7F;
				IF	(c==127)
				THEN	putchar('D');
					c = 'E';
				ELSE	IF	(c<32)
					THEN	putchar('^');
						c += 0100;
					ELSE	putchar(' ');
					FI
				FI
				putchar(c);
			OD
			putchar('\n');
			printf("               ");
			FOR	(q=p;  q<qend; q++)
			DO	printf(" %3o",*q&0xFF);
			OD
			putchar('\n');
		FI
		lwinge = vbn;
	OD
END
#else
winge(why)
char * why;
BEGIN
/*	IF	(lwinge!=vbn)
	THEN	printf("%ld.\n",lwinge=vbn);
	FI
*/
END
#endif
gringe(why)
char * why;
BEGIN
	IF	(lwinge!=vbn)
	THEN	printf("%ld.\n",lwinge=vbn);
	FI
END

/*
 *	longit(longpointer)
 *
 *	swap words in a long, because PDP-11 stores long integers with
 *	words swapped (hi word has low address) so sign bit is bit 15
 *	even in long-word format. sigh.
 */
longit(intp)
int	intp[2];
BEGIN
int	temp;
	temp = intp[0];
	intp[0]=intp[1];
	intp[1]=temp;
END


/* end: rmscheck.c */
