Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

MODULE UTLVFY	( !	Module to verify an index structure of ISAM file
	 IDENT = '01-01'
	 ) =

BEGIN

! COPYRIGHT (C) 1980
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A SINGLE
! COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLUSION OF THE ABOVE
! COPYRIGHT NOTICE. THIS SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT
! BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON EXCEPT FOR
! USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE TERMS. TITLE
! TO AND OWNERSHIP OF THE SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
!

!++					
! FACILITY:	RMS UTILITY (RMSUTL)
!
! ABSTRACT:	This module contains scanning loop for VERIFY.
!		It also does fix-ups and shows progress.

!
!
! AUTHOR:	S. Cohen			CREATION DATE:	23 May 80
!
! MODIFIED BY:
!
!--
!****************** Start RMS-10 V1.1 *********************
!********************* TOPS-10 ONLY ***********************
!
!PRODUCT	MODULE	 SPR
! EDIT	 EDIT	 QAR		DESCRIPTION
!======	======	=====		===========
!
! 100	  1	Dev		Make declarations for TX$APP and TX$TOUT
!				be EXTERNAL ROUTINE so RMS will compile 
!				under BLISS V4 (RMT, 10/22/85).
! 111	  2	Dev		(WXD, 3/26/86) Incorporate RMS development
!				edit 454 to fix VERIFY problem with scanning
!				empty buckets.
!				454 - In SCANBKT, do not scan a bucket with no
!				entries, and set PPLEV1 to 0 so that the
!				"previous bucket" checks do not take place
!				when the succeeding bucket is scanned.
! 113	  3	Dev		(WXD, 3/31/86) Fix bug in UNCLUTTER that writes
!				an RFA over a secondary index id.

! REQUIRE FILES:
! 

REQUIRE
	'SYS:RMSINT';

LIBRARY
	'RMSLIB';

EXTERNAL ROUTINE
	TX$APP : macrosub,
	TX$TOUT : macrosub;

!!! MACROS:

! U$*** - INTERFACE TO $UTLINT (EXTERNAL ACCESS TO RMS ROUTINES)
!
! U$BOTH - CALL $UTLINT & FALL THRU
! U$IFF - CALL $UTLINT IN RMS & TEST FOR FAILURE
! U$IFS - CALL $UTLINT IN RMS & TEST FOR SUCCESS
! U$SUC - CALL $UTLINT & ABORT IF FAILURE
!
!	THESE MACROS ACCEPT A $UTLINT FUNCTION CODE MINUS THE U$
!	THE REMAINING ARGUMENTS ARE FUNCTION-DEPENDENT
!	THE MACROS ASSUME THAT THERE IS A STRUCT CALLED "ARGBLK"
!	U$SUC USES THE ERROR LABEL "INTERR"
!
MACRO U$BOTH(FUNCT) =
	BLD_ARG_LST (ARGBLK, %NAME(U$,FUNCT), %REMAINING);
	$UTLINT	(ARGBLK,BUGERR)			!NOTE NO ERR LABEL
%;
MACRO U$IFF(FUNCT) =
	U$BOTH(FUNCT,%REMAINING);
	IF .ARGBLK EQL 0			!FAIL TEST
%;
MACRO U$IFS(FUNCT) =
	U$BOTH(FUNCT,%REMAINING);
	IF .ARGBLK NEQ 0			!SUCC TEST
%;
MACRO U$SUC(FUNCT) =
BEGIN
	BLD_ARG_LST (ARGBLK, %NAME(U$,FUNCT), %REMAINING);
	$UTLINT	(ARGBLK,INTERR);
END
%;

! ERRUX - EXPLANATION LINE OF ERR FOR UNEXP RMS ERROR
!
MACRO ERRUX =
	VERINFO (UTLURF, ZOWN, RMEVEC[.$FIELD(STS,.RAB)-ER$BAS], .$FIELD(STV,.RAB))
%;

! FIXING - TEST IF V$FIX APPLIES
! UNCING - TEST IF UNCLUTTER APPLIES
!
MACRO FIXING = (.V$FIX NEQ 0) %;
MACRO UNCING = (.SC$CASE EQL SC_UNCL) %;

! GB_VERIF - GET A BKT & OUTPUT APPROP MESSAGES IF NECES
!
MACRO GB_VERIF(PAGE$, SIZE$, LOCK$, BD$) =
BEGIN
	LOCAL R1;
	R1=$CALL (BD$GET, PAGE$, SIZE$, LOCK$, BD$, BBM_NONE);
	IF .R1 LSS 0 THEN $EXIT(%NAME('TRAP.U'));	!KLUDGE AN UNWIND
	IF .R1 GTR 1				!KLUDGILY DETECT CLOB BKT
	THEN VERRARB (UTLPNV, 0, PAGE$, .R1, .KDB[KDBREF]);
						!TELL USER ABOUT IT
END
%;

! IFSTAT - GENS PART OF "IF" FOR REFFING RMS STATUS CODE
!
MACRO IFSTAT = IF .$FIELD(STS,.RAB) %;

! MODBKT - PERFORM ACTION AND SET BKT UPD FLAG
!
MACRO MODBKT(ACTION,BD) =
	BEGIN
		ACTION
		SETUPD(BD);	!INDIC MUST WRITE
	END
%;

! VERR - OUTPUTS "USUAL" MSG DESCRIBING PROBLEM DETECTED DIRECTLY BY UTLVFY
!
MACRO VERR(TEXT$) =
	VERRARB ( UTLVEM, 0, UPLIT (%ASCIZ TEXT$), .ENT_RFA)
%;

! VERRFIX - OUTPUTS "USUAL" MSG FOR FIXABLE PROBLEM
!
MACRO VERRFIX(TEXT$) =
	VERRARB ( UTLVEF, 1, UPLIT (%ASCIZ TEXT$), .ENT_RFA, .FIXSFX)
%;

! VERRC - OUTPUTS "USUAL" MSG FOR PROBLEM DETECTED IN FILE BY CALL TO RMS
!
MACRO VERRC(TEXT$) =
BEGIN
	VERRARB ( UTLVEM, 0, UPLIT (%ASCIZ TEXT$), .ENT_RFA);
	ERRUX
END
%;

! VERRARB - OUTPUTS ARBITRARY VERIFY ERR MSG TO REPORT FILE
!
MACRO	VERRARB(FMT, FIXABLE)=
BEGIN
	EXTERNAL %NAME(FMT);

%IF NOT FIXABLE %THEN
	CURRERR = .CURRERR+1;		!BUMP ERRS DETECTED FOR CURR BKT
	IF FIXING OR UNCING		!TERMINATE UPDATES FOR SAFETY
	THEN BEGIN			!YES
		VERINFO (UTLCRS);	!CHANGING TO RETR MODE
		SC$CASE = SC_VER;	!UNCL OFF
		V$FIX = 0;		!FIX OFF
		FIXSFX = UPLIT (%ASCIZ ' [Fixable]');
	END;
%FI

	IF TX$APP NEQ 0			!IF STAT IS KLUDGE TO INSURE
					!ADJSP IMMED FOLLS PUSHJ TX$TOUT
	THEN  $CALLM(TX$APP, %NAME(FMT), %REMAINING);
	V$ERR = V$ERR+1;		!FOR SUMMARY MSG

END %;

! VERINFO - OUTPUTS INFO MSG TO REPORT FILE
!
MACRO	VERINFO(FMT)=
BEGIN
	EXTERNAL %NAME(FMT);
	IF TX$APP NEQ 0			!IF STAT IS KLUDGE TO INSURE
					!ADJSP IMMED FOLLS PUSHJ TX$TOUT
	THEN  $CALLM(TX$APP, %NAME(FMT), %REMAINING);
END %;

!!! EQUATED SYMBOLS:

LITERAL	FLGDUP = XB$DUP;		!KLUDGE FOR "DUPLICATES" MACRO
LITERAL	RFMFIX = FB$FIX;		!DITTO "SIZEOFDATARECRD"
LITERAL	SIDHSZ = SIDRHDRSIZE;		!SHORTHAND

! EXTERNAL REFERENCES:
!

EXTERNAL
	BBM_NONE,			!FOR BD$GET TO LET VERIFY HANDLE BAD BKT
	BUF$K1,				!SPACE FOR KEY
	BUF$K2,				!SPACE FOR ANOTHER KEY
	BUGERR,				! CHKS FOR RMS BUG ERR & EXITS IF ONE
	FAB,				!FAB OF RMSUTL'S CURR RMS FILE
	FST : POINTER,			!PTR TO RMS'S INTERNAL FILE STRUCT
	INTERR,				!FOR CATAS FAILURES FROM RMS CALLS
	KDB : POINTER,			!PTR TO RMS'S INTERN DESC FOR CURR KEY
	KSIZB,				!# OF BYTES IN THIS KRF'S KEY
	KSIZW,				!DITTO, IN WORDS
	OUTRAB : POINTER,		!RPT FILE RAB
	PATH : POINTER,			!PTR TO RMS "PATH" VECTOR
	RAB,				!RAB OF FILE CURRENTLY OPEN IN RMSUTL
	RMEVEC:VECTOR,			!RMS ERRS NAME-VECTOR
	RST : POINTER,			!PTR TO RMS'S INTERNAL STREAM DATA
	SC$CASE,			!CTL TYPE OF SCAN
	 SC_SPACE,			!SPACE CMD
	 SC_UNCL,			!VERIF CMD
	 SC_VER,			!VERIFY CMD
	STCINA,				!PTR TO MOVST CONV TAB
	STRIPT,				!STRING PTR WITH BYTE SIZE DATA IN IT
	TEXTBP,				!BYTE PTR INTO RPT FILE BUFFER
	V$ACC,				!TRUE IF ACCESSING 2NDARY KEYS
	V$ERR,				!CNT OF VERIFY ERRORS DETECTED
	V$FIX,				!TRUE IF FLAWS SHOULD BE FIXED
	V$PREQ;				!DISP FREQ FOR PROGRESS-REPORT
BIND	STPLEN = STRIPT+1;		!2ND WD OF STRING PTR

OWN					!STATIC VARIABLES FOR MODULE
	ARGBLK : FORMATS[5],		!SPACE FOR ARGLISTS OF $UTLINT RMS ENTRY
	BDCURR : FORMATS[BDSIZE],	!BKT DESC, FOR CURR P OF SCAN
	BDLINK : FORMATS[BDSIZE],	!BKT DESC, FOR P LINKED TO CURR P
	BKT : POINTER,			!POINTER TO CURR BKT
	CID,				!ID OF CURR ENTRY IN BKT
	CPAGE,				!FILE PAGE AT WHICH CURR BKT LOCATED
	CURRERR,				!# OF NON-FIXABLE PROBS FOR CURR BKT
	DUPSTILL,			!IF ON, KEYVAL SEEN IN EARLIER BKT STILL HIGHEST SEEN SO FAR
	END_RFA,			!PHYS ADDR OF RFA TERM SCAN
	ENT_HIKEY,			!ENTPTR FOR ENTRY WITH HI KEY IN BKT
	ENTPTR : POINTER,		!PTR TO CURR ENTRY IN BKT
	ENT_RFA,			!PHYS ADDR OF CURR REC
	ENT_RRV,			!RRV ADDR (IE. USER RFA ADDR) OF ENTRY
	FIXSFX,				!PTR TO ASCIZ STRING INDICATING FIX INFO
	HSZ_PRIM,			!# OF WDS IN HDR OF UDR (3=V, 2=F)
	KREF,				!KEY OF REFERENCE FOR SCAN
	OOPAGE,				!P# OF OUT-OF-ORD KEY (TO RECOG BKT LP)
	PPAGE,				!FILE PAGE AT WHICH PREV BKT LOCATED
	PPLEV1,				!LEVEL 1 ENT OF PATH ON PREV KEY ACC
	PROGRESS,			!IN EFFECT SCANCNT MOD V$PREQ
	PT1 : POINTER,			!TEMP PTR
	RDP : FORMATS[RDSIZE],		!REC DESC PKT CONTAINS KVAL PTR/LEN
	RDP_RFA: FORMATS[RDSIZE],	!RECDESC FOR FBYRFA/RRV
	RDP_KEY : FORMATS[RDSIZE],	!FOR CKEYKU CALL (SIDR,UDR)
	SCANCNT,			!CNT OF RECS SEEN
	SIDR_OCC,			!ON IF SIDR HAS AT LEAST 1 NON-NULL RFA
	ZOWN : INITIAL (0);		!0 VALUE = NULL STRING

GLOBAL ROUTINE VR$CLEAN : NOVALUE =
BEGIN
	$CALL (BD$PUT, BDCURR, 0);		!INSURE THINGS CLEAN
	$CALL (BD$PUT, BDLINK, 0);
	RETURN;
END;

GLOBAL ROUTINE VR$SCAN (RFA_LOW,RFA_HI) : NOVALUE =

! VR$SCAN - INIT SCAN OF DATA BKTS
! INPUTS:
!	RFA_LOW = THE PHYS ADDR OF ENTRY TO START SCAN
!	RFA_HI = PHYS ADDR OF ENTRY THAT TERMINATES SCAN (0 FOR EOF)
!	(SEE V$ACC, V$FIX, V$PREQ, & RAB IN EXTERNALS TOO)
! NOTES:
!	SET CONSTANT USER AND DATA STRUCT INFO (EG. KEY-OF-REF).
!	LOCATE BKT OF LOWER LIMIT OF SCAN & GET PTR TO ITS BKT.
!	SET KDB & USE IT TO SET KEY'S PARAMETERS.
!	ESTABLISH RFA OF UPPER LIMIT OF SCAN.
!	SET KEY PARAMATERS NEEDED IN SCAN.
!	CALL APPROP SCANNING ROUTINE

BEGIN
	IF FIXING				!SET FIX MSG
	THEN FIXSFX = UPLIT (%ASCIZ ' [Fixing]')
	ELSE FIXSFX = UPLIT (%ASCIZ ' [Fixable]');

	END_RFA = .RFA_HI;			!MAKE IT GLOBALLY AVAIL
	KREF = .$FIELD(KRF,.RAB);		!MAKE IT EASY TO USE KEY OF REF
	$FIELD(RAC,.RAB) = RB$KEY;		!WILL DO KEY ACCESSES
	PT1 = .FST[FSTKDB];			!GET PRIM KEY KDB
	HSZ_PRIM = .PT1[KDBHSZ];		!NEEDED BY ACCUDR

	CPAGE = BUCKETOFRFA(.RFA_LOW);		!GET PAGE $FIND WENT TO
	GB_VERIF (.CPAGE, .KDB[KDBDBKZ], 0, BDCURR);
						!GET BKT ADDR OR BARF
	BKT = .BDCURR[BKDBKTADR];		!PRESERVE IT

	$CALL (BD$PUT,BDLINK,0);		!INSURE CLEAN
	RDP_RFA[RDRECPTR] = 0;			!START AT BEGIN OF BKT
	RDP_RFA[RDRFA] = .RFA_LOW;		! AND LOOK FOR THIS
	U$IFF (FBYRFA, RDP_RFA, BDLINK)		!GET LOC OF THIS ENTRY
	THEN BEGIN
		TXTOUT (UTLSNF);		!STARTING REC NOT FOUND
		ENTPTR = .BKT + BHHDRSIZE;	!START AT TOP OF PAGE
	END
	ELSE ENTPTR = .RDP_RFA[RDRECPTR];	!SET OFFSET

	RDP[RDUSERSIZE] = .KSIZB;		!FOR MOVEKEY & CKEYKU
	RDP[RDUSERPTR] = BUF$K1;		!PT TO KEYVAL TOO
	RDP_KEY[RDUSERSIZE] = .KSIZB;		!SET KEY LEN
	IF .SC$CASE EQL SC_SPACE
	THEN $CALL (SCANSP)			!DO SPACE SCAN
	ELSE $CALL (SCANVER);			!DO VERIF SCAN
	RETURN;
END;

GLOBAL ROUTINE SCANSP : NOVALUE =

! SCANSP - LOOP FOR SPACE SCAN
! NOTES:
!	TABULATE TOTAL SPACE AVAILABLE & SPACE USED, REPORT AS PERCENTAGE

BEGIN
	LOCAL	CSPACE;
	LOCAL	FREEPT;
	LOCAL	SIZREC;
	LOCAL	TSPACE;
	LOCAL	USPACE;
	LOCAL T1;				!TEMP FOR SHORT-TERM USE

	TSPACE = 0;				!NO SPACE TABUL YET
	CSPACE = 0;
	USPACE = 0;
	REPEAT BEGIN				!EXIT ONLY ON ERR OR EOF
		TSPACE = .TSPACE + (.KDB[KDBDBKZ]*PAGESIZE) - BHHDRSIZE;
		USPACE = .USPACE + .BKT [BHNEXTBYTE] - BHHDRSIZE;
						!INCREM TOT & USED SPACE SEEN

IF .KREF EQL 0				!IF PRIM KEY
THEN BEGIN				!SCAN FOR CLUTTER TOO
	FREEPT = .BKT+.BKT[BHNEXTBYTE];		!SCAN TO END OF DATA
	WHILE .ENTPTR LSS .FREEPT		!SCAN TO 1ST FREE WD
	DO BEGIN
		IF RRVFLAG(ENTPTR) NEQ 0
		THEN BEGIN			!REPRES CHUNK OF CLUT
			CSPACE = .CSPACE + .FREEPT - .ENTPTR;
			EXITLOOP;		!RRV'S AT END OF BKT
		END;
		SIZREC=SIZEOFDATARECRD(ENTPTR);	!GET # OF WDS IN CURR ENT
		IF DELETEFLAG(ENTPTR) NEQ 0
		THEN CSPACE = .CSPACE+.SIZREC;	!TACK ON SIZE OF DEL REC
		ENTPTR = .ENTPTR + .SIZREC;	!HOP TO NEXT ENTRY
	END;					!END ITER OF MAIN LOOP
END;						!END CLUTTER CHK

		T1 = CHKFLAG (BKT[BHFLAGS],BHFLGEND);	!PRESERVE END STATUS
		CPAGE = .BKT[BHNEXTBKT];	!GET P# OF NEXT BKT FOR GETBKT
		$CALL (BD$PUT, BDCURR, 0);	!RELEASE BKT
		IF .T1 NEQ 0
		THEN BEGIN			!REACHED END OF DATA BKTS
			SCANCNT = (.USPACE*100)/.TSPACE;
						!COMPUTE PERCENTAGE
			VERINFO (UTLSSC, .KREF, .SCANCNT);
						!REPORT COMM RESULTS OF SCAN
			IF .KREF EQL 0		!DO MORE FOR PRIM KEY
			THEN BEGIN
				SCANCNT = (.CSPACE*100)/.TSPACE;
				VERINFO (UTLBCL, .SCANCNT);
			END;
			$FLUSH (.RAB);		!MAKE RMS FILE UP TO DATE
			RETURN;
		END;
		GB_VERIF (.CPAGE, .KDB[KDBDBKZ], 0, BDCURR);
						!GET PTR TO NEXT BKT
		BKT = .BDCURR[BKDBKTADR];	!PRESERVE IT
		ENTPTR = .BKT + BHHDRSIZE;	!PT TO 1ST ENTRY
	END;					!LOOP
	RETURN;					!INACCESSIBLE (BLISS STUPID)
END;						!END ROUTINE

GLOBAL ROUTINE SCANVER : NOVALUE =

! SCANVER - TOP-LEVEL LOOP FOR VERIFY SCAN
! NOTES:
!	DOES BKT I/O & DETECTS EOF
!	CALLS SCANBKT TO DO ALL RECORD-LEVEL WORK

BEGIN
	LOCAL T1;				!TEMP FOR SHORT-TERM USE

	ENT_RFA = -1;				!IN CASE 1ST DATA BKT EMPTY...
						!PREVENTS END_RFA=EOF=0 MATCHING
	DUPSTILL = 1;				!INDIC 1ST KEY
	OOPAGE = 0;				!NO PAGE SCANNED YET
	PPLEV1 = 0;				!INDIC NO PREV BKT YET
	PROGRESS = 0;				!INIT STATE OF SCAN
	SCANCNT = 0;				!INIT CNT OF RECS SCANNED
	REPEAT BEGIN				!EXIT ONLY ON ERR OR EOF
		CID = 0;			!INIT CURR ID
		CURRERR = 0;			!INDIC NO ERRS FOR CURR BKT YET
		IF .BKT[BHBTYPE] NEQ BTYPEDATA
		THEN VERR ('Bucket type not DATA');	!ASSUME TYPCOD WRONG

		IF .OOPAGE EQL .CPAGE		!BKTS IN LOOP?
		THEN VERINFO (UTLASK,.KREF);	!YES, TELL USER
		IF .OOPAGE EQL .CPAGE		!SEP TEST TO OUTWIT BLISS
		THEN RETURN;			!... AND ABORT SCAN

		$CALL (SCANBKT);		!PROCESS ENTRIES IN BKT

		T1 = CHKFLAG (BKT[BHFLAGS],BHFLGEND);	!PRESERVE END STATUS
		PPAGE = .CPAGE;			!SAVE P# OF PREV BKT
		CPAGE = .BKT[BHNEXTBKT];	!GET P# OF NEXT BKT FOR GETBKT
		$CALL (BD$PUT, BDCURR, 0);	!RELEASE BKT
		IF .END_RFA EQL -1
		THEN RETURN;			!FIXING A SINGLE REC
		IF .T1 NEQ 0 OR .ENT_RFA EQL .END_RFA
		THEN BEGIN			!REACHED END OF DATA BKTS
			VERINFO (UTLVCM, .KREF, .SCANCNT);
						!REPORT RESULT OF SCAN
			$FLUSH (.RAB);		!MAKE RMS FILE UP TO DATE
			RETURN;
		END;
		GB_VERIF (.CPAGE, .KDB[KDBDBKZ], 0, BDCURR);
						!GET PTR TO NEXT BKT
		BKT = .BDCURR[BKDBKTADR];	!PRESERVE IT
		ENTPTR = .BKT + BHHDRSIZE;	!PT TO 1ST ENTRY
	END;					!LOOP
	RETURN;					!INACCESSIBLE (BLISS STUPID)
END;						!END ROUTINE

GLOBAL ROUTINE SCANBKT:NOVALUE =
!
! SCANBKT - SCANS THE ENTRIES IN A BKT
! INPUTS
!	BKT = PTR TO CURRENT PAGE
!	ENTPTR = PTR TO 1ST ENTRY TO PROC IN CURR BKT
! NOTES:
!	VERIFIES KEYS ASCEND PROPERLY
!	CHKS IF BKT'S RECORDS CAN BE FOUND BY KEY ACCESS
!	VERIFIES INTER-PAGE LINKS VS. KEY-GREATER ACCESS
!	DOES RRV BACKCHECK (CORRECTING PROB IF V$FIX)
!	DOES UDR/SIDR COMPAT CHKS IF APPLIC (SEE ACCUDR)

BEGIN
	LABEL ITER,CURRENT,IDXSEQ;
	LOCAL CURRDUP;				![%47] # OF UNDEL RECS WITH CURR KEY VAL
	LOCAL CVAL;				!KEY COMPARE CASE

	WHILE .ENTPTR LSS .BKT+.BKT[BHNEXTBYTE]	!SCAN TO END OF DATA
	DO ITER: BEGIN
	    IF .CURRERR GEQ 3			!TREAT PAGE AS GARBAGE?
	    THEN BEGIN				!YES
		VERINFO (UTLASB);		!ABORT SCAN
		PPLEV1 = 0;			!REINIT NEXT/DOWN PTR CONSIS CHK
		RETURN;
	    END;

	    CURRENT : BEGIN
		IF .PROGRESS EQL .V$PREQ	!TIME TO REPORT?
		THEN BEGIN			!YES
			PROGRESS=0;		!RESET IT
			$FLUSH (.RAB);		!MAKE RMS FILE UP TO DATE
			STRIPT<RH> = BUF$K1;	!PT TO CURR KEY STRING
			STPLEN = .KSIZB;	!SET LENGTH OF KEY
			VERINFO (UTLVPR,STRIPT,.STCINA);
			$CALLM (RP$PUT);	!EMPTY RPT BUFFER
			$FLUSH (.OUTRAB);	!FORCE RPT DATA TO DSK TOO
		END;

		CID = .ENTPTR[DRRECORDID];	!SET CURR ID
		ENT_RFA = MAKERFA(.CPAGE,.CID);
						!SET ITS RFA TOO
		IF .END_RFA EQL .ENT_RFA	!HIT 1ST OUT OF BNDS KEY?
		THEN RETURN;			!YES

		IF RRVFLAG(ENTPTR) NEQ 0
		THEN EXITLOOP;			!RRV'S AT END OF BKT
		IF DELETEFLAG(ENTPTR) NEQ 0 AND FIXING
		THEN BEGIN			!DELETED & FIXING
			$CALL (DELENT, BDCURR, .ENTPTR);	!ZAP IT
			LEAVE ITER;		!NEXT REC NOW HAS CURR ENTPTR
		END;
		IF .KREF NEQ 0			!2NDARY KEY?
		THEN $CALL (ACCUDR)		!ACC USER DATA RECORD
		ELSE ENT_RRV = .ENTPTR[DRRRVADDRESS];
						!WILL SET CKEY IF HI-ER KEY

		BLD_ARG_LST (ARGBLK, 0, RDP, .ENTPTR+.KDB[KDBHSZ]);
		IF .KREF EQL 0			!IS IT PRIM KEY?
		THEN ARGBLK[RMS_FUNC]=U$CKEYKU	!COMPARE KEY STRING TO UDR
		ELSE ARGBLK[RMS_FUNC]=U$CKEYKK;	!COMP KS TO SIDR KEY
		$UTLINT	(ARGBLK,BUGERR);	!COMPARE KVCURR TO KEY OF REC
		IF .ARGBLK NEQ 0		!TRUE IF RECORD HAS EQL OR HIGHER KEY
		THEN	IF LSSFLAG(RDP) NEQ 0
			THEN	CVAL =1		!HIGHER ALW OK, PLUS CALL MOVEKEY
			ELSE	IF DUPLICATES	!EQL KEYS, DUPS OK?
				THEN CVAL=2	!OK, BUT NO MOVEKEY
				ELSE CVAL=4	!DUPS NOT OK, ERR
		ELSE	CVAL=3;			!REC LOWER NEVER OK
		IF .DUPSTILL EQL 1		!THEN 1ST TIME THRU
		THEN CVAL = 1;			!TREAT 1ST KEY AS "HIGHER"
						!(LOOP CONTINUED)

! HAVE FINISHED DETERMINING STATUS OF RECORD, NOW DO APPROP STUFF

		CASE .CVAL FROM 1 TO 4 OF SET
[1]:		BEGIN				!NEW HI KEY
		    IF .KREF EQL 0		!COPY KEYVAL, PR/SEC DEP
		    THEN U$SUC (MOVEKEY, .ENTPTR+.KDB[KDBHSZ], BUF$K1)
						!COPY KEY VAL FOR NEXT ITER
		    ELSE MOVEWORDS (.ENTPTR+.KDB[KDBHSZ], BUF$K1, .KSIZW);
						!JUST BLT THE KEY

		    ENT_HIKEY = .ENTPTR;	!SAVE ADDR OF ENTRY WITH HI KEY
		    CURRDUP = 0;		![%47] CLEAR CNT OF UNDEL DUPS
		    DUPSTILL = 0;		!CLEAR FLAG
		END;
[2]:		0;				!NO-OP FOR EQUAL KEYS
[3]:		BEGIN				!UPDATE KEY TO MIN MESSAGES
		    CURRDUP = 0;		![%47] CLEAR CNT OF UNDEL DUPS
		    IF .ENTPTR EQL .BKT+BHHDRSIZE	!1ST ENT ON PAGE?
		    THEN OOPAGE = .CPAGE;	!THEN SAVE FOR LOOP DETECTION

		    VERR('Key value out of order');
		    IF .KREF EQL 0		!COPY KEYVAL, PR/SEC DEP
		    THEN U$SUC (MOVEKEY, .ENTPTR+.KDB[KDBHSZ], BUF$K1)
						!COPY KEY VAL FOR NEXT ITER
		    ELSE MOVEWORDS (.ENTPTR+.KDB[KDBHSZ], BUF$K1, .KSIZW);
						!JUST BLT THE KEY
		END;
[4]:		BEGIN
		    IF .CURRDUP NEQ 0  AND  DELETEFLAG (ENTPTR) EQL 0
						![%47] DONT CONSID DEL RECS
		    THEN VERR('Duplicate key encountered');
		END;
		TES;

		IF DELETEFLAG (ENTPTR) NEQ 0
		THEN LEAVE CURRENT;			!SKIP DELETED RECS

		CURRDUP = .CURRDUP + 1;		![%47] INCR CNT OF UNDEL DUPS
		IF .V$ACC EQL TRUE
		THEN $CALL (ACCKEY);		!ACC UDR BY 2NDARY KEYS
		IF .KREF EQL 0
		THEN $CALL (ACCRRV);		!DO RRV BACK CHECK FOR UDR
						!IF UNCLUT, DEL RRV IF 1
	    END;				!END "CURRENT" BLK
	    IF .END_RFA EQL -1 THEN RETURN;	!FIXING A SINGLE REC
	    ENTPTR = .ENTPTR + SIZEOFDATARECRD(ENTPTR);	!HOP TO NEXT ENTRY
	END;					!END ITER OF MAIN LOOP

! END-OF-BKT CHKS

	IF .DUPSTILL EQL 0			!1ST KEY OR SAME HI KEY AS LAST BKT?
	THEN BEGIN				!NO
		$CALL (BD$PUT, BDLINK, 0);	!INSURE CLEAN SLATE
		RDP[RDRECPTR] = 0;		!INSURE SEARCH NOT "RESUMED"
		U$IFF (FNDDATA,RDP,BDLINK)	!FIND HI KEY REC (EVEN IF DEL)
		THEN	VERRC('Key access aborted')	!OOPS, NOTHING FND
		ELSE	IF CHKFLAG (RDP[RDSTATUS], (RDFLGLSS OR RDFLGPST)) NEQ 0
				OR		!REC FND, BUT WAS IT EXAC MATCH?
			 .RDP[RDRECPTR] NEQ .ENT_HIKEY
			THEN VERR('Key access failed');	!NO

		IF .PPLEV1 NEQ 0		!1ST TIME THRU OR AFT BKT ABORT?
		THEN IDXSEQ:BEGIN		!NO, SEE IF NOW AT NEXT IDX ENT
			IF .PATH[1,WRD] EQL .PPLEV1
			THEN LEAVE IDXSEQ;	!BKT PTED TO BY SAME IDX ENT
						!THIS MEANS INEFFIC IDX, POSSIB
						!EXTENSION TO UNCLUTTER...
			PPLEV1<PATHOFFSET> = .PPLEV1<PATHOFFSET>+.KSIZW+1;
						!UPD OFFSET TO EXPECTED VAL
			IF .PATH[1,WRD] EQL .PPLEV1
				AND
			 .CPAGE EQL .PATH[0,PATHBKT]
			THEN LEAVE IDXSEQ;	!CORR IDX ENT PTS AT CORR BKT

			GB_VERIF (.PPLEV1<PATHBKT>,.KDB[KDBIBKZ],0,BDLINK);
						!GET IDX BKT TO CHK LAST ENTRY
			PT1=.BDLINK[BKDBKTADR];	!MAKE PTR TO IDX BKT

			!MAKE FANCY CHKS: PREV IDX ENT MUST BE LAST ON PAGE
			! AND CURR IDX ENT MUST BE 1ST ON PREV'S NEXT PAGE
			!ALSO, REVERIFY THAT RIGHT BKT PTED TO

			IF .PPLEV1<PATHOFFSET> NEQ .PT1[BHNEXTBYTE]
				OR
			 .PATH[1,PATHBKT] NEQ .PT1[BHNEXTBKT]
				OR
			 .PATH[1,PATHOFFSET] NEQ BHHDRSIZE
				OR
			 .CPAGE NEQ .PATH[0,PATHBKT]
			THEN VERRARB (UTLBNC, 0, .PPAGE, .CPAGE);
						!BKT NOT IN DATA BKT CHAIN
		END;
		PPLEV1 = .PATH[1,WRD];		!SAV JUST FOUND INFO

		DUPSTILL = TRUE;		!RESET "NO GTR KEY YET"
	END;					!END IF NOT .DUPSTILL
    !+									!A454
    !   If the data bucket we just scanned has no entries
    !	(as in the case of all records deleted and expunged),
    !   set PPLEV1 to 0, to indicate that there are
    !   to be no "previous bucket" consistency checks
    !   when the next bucket is verified.
    !-

    IF .bkt [bhnextbyte] EQL bhhdrsize		! Header only?		!A454
    THEN 					!			!A454
	pplev1 = 0;				! No previous bucket	!A454
	RETURN;
END;						!END SCANBKT

GLOBAL ROUTINE ACCKEY : NOVALUE =
!
! ACCKEY - ACCESSES UDR BY THE SPECIFIED 2NDARY KEYS
! INPUTS:
!	BKT, ENTPTR
! NOTES:
!	ACCKEY CALLED ONLY IF KREF IS 0.
!	LOOPS THRU THE KDB'S FOR THE FILE, DOES A KEY ACCESS FOR EACH KEY
!	AFTER MOVEKEY-ING IT TO A BUFFER.
!	HOWEVER THE KEY ACCESS IS OMITTED IF THE RECORD ISNT LONG ENOUGH.
!	IF CANT FIND THE REC BY KEY,
!	THEN PUTSIDR IS CALLED IF V$FIX APPLIES
!	ELSE THE RRV IS ELIMINATED IF UNCLUTTERING.

BEGIN
	LABEL ITER;
	LOCAL STS;				!TEMP FOR RMS STATUS

	RDP_KEY[RDUSERPTR] = BUF$K2;		!MAKE KEY ADDR PASSABLE
	$FIELD(KBF,.RAB) = BUF$K2;		!USER-LEVEL TOO
	$FIELD(ROP,.RAB) = RB$RAH OR RB$NRP;	!DO EXACT MATCH (READAHEAD TOO)
						!NRP FOR PHYS ADDR OF SIDR
	WHILE TRUE DO ITER: BEGIN
		KDB = .KDB[KDBNXT];		!GET NEXT 2NDARY KEY
		IF .KDB EQL 0 THEN EXITLOOP;	!PAST LAST KEY
		IF .ENTPTR[DRRECSIZE] LSS .KDB[KDBMINRSZ]
		THEN LEAVE ITER;		!REC TOO SHORT TO ACC BY CUR KEY

		U$SUC (GETKDB, .KDB[KDBREF]);	!RESET CURR KDB IN RMS
		U$SUC (MOVEKEY, .ENTPTR+.HSZ_PRIM, BUF$K2);
						!COPY KEY VAL FOR THIS KEY
		$FIELD(KRF,.RAB)=.KDB[KDBREF];	!SET KRF OF CUR KEY
		RDP_KEY[RDUSERSIZE] = .KDB[KDBKSZ];	!MAKE KEY SIZE PASSABLE
		$FIELD(KSZ,.RAB) = .KDB[KDBKSZ]; !RESET AT USER-LEVEL TOO
		$FIND (.RAB);			!DO KEY ACCESS
		STS = .$FIELD(STS,.RAB);	!GET STS FLD
		IFSTAT EQL SU$SUC
		THEN IF $CALL(SIDRSCAN)		!IS THIS PARTIC REC IN SIDR ARR
		    THEN BEGIN			!YES
			IF UNCING	!ELIM RRV'S?
			THEN $CALL (SIDRADJ);	!RESET SIDR PTR TO ENT_RFA
			LEAVE ITER;		!DONE WITH THIS ENTRY
		    END;
		IF .STS NEQ ER$RNF		!FISHY FAILURE?
			AND .STS NEQ SU$SUC	!SIDRSCAN MAY HAVE FAILED
		THEN	BEGIN			!YES
			VERRARB (UTLAKF, 0,.KDB[KDBREF], .ENT_RFA, ZOWN);
						!ACC BY KEY N FAILED FOR X/Y
			ERRUX			!INEXPLIC ERR, TELL USER
		END
		ELSE	BEGIN			!ONE OR THE OTHER FAILED
			VERRARB (UTLAKF, 1,.KDB[KDBREF], .ENT_RFA, .FIXSFX);
						!ACC BY KEY N FAILED FOR X/Y
			IF FIXING THEN $CALL (SIDRPUT);
						!PUT OUT NEEDED SIDR ENTRY
		END;
	END;					!END KDB LOOP
	$CALL (M$KDB, 0);			!RESET PRIM KEY
	RDP_KEY[RDUSERSIZE] = .KSIZB;		!SET KEY LEN
	RETURN;
END;

GLOBAL ROUTINE ACCRRV : NOVALUE =
!
! ACCRRV - VERIFIES THAT REC'S RRV (IF ONE) PTS AT IT.
! INPUTS:
!	CURRENT ENTRY AS SET BY SCANBKT
! NOTES:
!	IF UNCLUTTER MODE APPLIES, THE CHECK IS N/A BECAUSE
!	THE RRV IS SIMPLY DELETED, AND THE UDR PTED AT ITSELF.
!	IF FIX AND NOT UNCLUT, A BAD PTR IN AN RRV IS SIMPLY RESET

BEGIN
	PROGRESS=.PROGRESS+1;		!BUMP CNT OF RECS PROCESSED
	SCANCNT=.SCANCNT+1;		!BUMP CNT OF RECS PROCESSED

	IF .ENT_RRV EQL .ENT_RFA
	THEN RETURN;				!IF REC NEVER MOVED, NO BACK CHK TO MAKE
	RDP_RFA[RDRECPTR]=0;			!CLEAR STARTING POS
	RDP_RFA[RDRFA]=.ENT_RRV;		!PREP TO PASS IT

	$CALL (BD$PUT,BDLINK,0);		!INSURE CLEAN
	U$IFS (FBYRFA, RDP_RFA, BDLINK)		!GET RRV OF THIS UDR
		AND NOT UNCING		!AND CHK IF NOT SUBSUMED
	THEN BEGIN				!RRV FOUND
	    PT1 = .RDP_RFA[RDRECPTR];		!GET PTR TO RRV
	    IF RRVFLAG(PT1) EQL 0		!PTS BACK AT UDR?
	    THEN BEGIN				!YES, OOPS
		VERR ('Data record identified by back pointer');
		RETURN;
	    END;
	    IF .PT1[DRRRVADDRESS] NEQ .ENT_RFA
	    THEN BEGIN				!RRV/UDR OUT OF SYNC
		VERRFIX ('POINTER entry does not point at data record');
		IF FIXING
		THEN MODBKT (PT1[DRRRVADDRESS] = .ENT_RFA;, BDLINK);
						!PT RRV TO RIGHT PLACE
	    END;
	END
	ELSE BEGIN				!BAD RRV OR ZAPPING ALL RRV'S
		IF UNCING OR FIXING		!EITHER TYPE OF MODS ALLOWED?
		THEN MODBKT (ENTPTR[DRRRVADDRESS] = .ENT_RFA;, BDCURR);
						!YES, PT BACK AT SELF
		IF NOT UNCING
		THEN	BEGIN			!BAD RRV
			VERRFIX ('POINTER entry not found');
			ENT_RRV = .ENT_RFA;	!INDIC RRV NO GOOD
			IF .V$ACC EQL TRUE
			THEN $CALL(ACCKEY);	!RE-ACC TO DEAL WITH BAD RRV
		END
		ELSE	IF .ARGBLK NEQ 0
			THEN  $CALL (DELENT,BDLINK,.RDP_RFA[RDRECPTR]);
						!ZAP THE RRV IF IT WAS FND
	END;					!END OF "IF NO RRV"

	RETURN;
END;

GLOBAL ROUTINE ACCUDR : NOVALUE =
!
! ACCUDR - COMPARES SIDR KEY VALUE TO ASSOC PRIM DATA KEY VALUE
! NOTES:
!	SCANS ALL DUPS IN A PARTIC SIDR.
!	FOR EACH, IT MUST GET THE PRIMARY DATA BKT,
!	DO THE COMPARE AND REACT TO AN INEQUALITY.
!		IF NOFIX, IT JUST PRINTS AN ERR MSG.
!		IF V$FIX, IT 0'S THE BAD PTR

BEGIN
	LOCAL I;				!LOOP CTR
	LABEL ITER, EXIST;

	SIDR_OCC = 0;				!PRESUME EMPTY ENTRY
	SCANCNT=.SCANCNT+1;			!BUMP CNT OF SIDRS PROCESSED
	PROGRESS=.PROGRESS+1;			!BUMP CNT OF SIDRS PROCESSED

	INCR I FROM SIDHSZ+.KSIZW TO .ENTPTR[SIDRRECSIZE]+SIDHSZ-1
	DO ITER: BEGIN				!EXA EACH RFA IN SIDR VECTOR
	    RDP_RFA[RDRFA] = .ENTPTR[.I,WRD];	!SET ARG FOR FBYRRV
	    RDP_RFA[RDRECPTR]=0;		!CLEAR OUTPUT ARG
	    IF .ENTPTR[.I,WRD] EQL 0 THEN LEAVE ITER;
						!NO ENTRY IN THIS SLOT
	    EXIST: BEGIN			!EXISTING ENTRY
		SIDR_OCC = 1;			!INDIC SIDR NOT EMPTY
		RDP_KEY[RDUSERPTR] = 0;		!KLUDGY DISTING BETW BAD KEY/REC
		$CALL (BD$PUT,BDLINK,0);	!INSURE CLEAN
		U$IFF(FBYRRV, RDP_RFA, BDLINK)	!GET PTR TO UDR
		THEN LEAVE EXIST;		!NO MATCHING UDR
		PT1 = .RDP_RFA[RDRECPTR];	!MATER PTR TO UDR
		IF DELETEFLAG(PT1) NEQ 0
		THEN LEAVE EXIST;		!UDR DELETED

		RDP_KEY[RDUSERPTR] = .ENTPTR+SIDHSZ;	!SET PTR TO DATA
		U$IFF (CKEYKU, RDP_KEY, .PT1+.HSZ_PRIM) OR LSSFLAG(RDP_KEY) NEQ 0
						!COMPARE KVCURR TO KEY OF REC
		THEN LEAVE EXIST;		!KEY VALUES DONT MATCH

		IF .SIDR_OCC GEQ 0		!SEEN A VALID ENTRY YET?
		THEN SIDR_OCC = -1		!NO, INDIC NON-EMPTY & VALID
		ELSE IF NODUPLICATES THEN VERR('Duplicate key encountered');

		LEAVE ITER;			!ALL OK, DONE THIS ENTRY
	    END;				!EXIST
	    !BEGIN "NO LONGER EXIST"
		VERRARB (UTLNMR, 1, .I+1-SIDHSZ-.KSIZW, .RDP_RFA[RDRFA], .ENT_RFA, .FIXSFX);
						!NO MAT UDR FOR SIDR ELEM N
		IF FIXING THEN MODBKT(ENTPTR[.I,WRD]=0;, BDCURR);
						!ASSUME UDR DELETED OR KEY UPD
		IF .RDP_KEY[RDUSERPTR] NEQ 0	!REACH HERE CAUSE KEYS NOT MAT?
		THEN VERRARB(UTLAKM, 1, .KREF, .RDP_RFA[RDRFA]);
						!YES, INDIC 2ND ERR LIKELY
	    !END "NO LONGER EXIST"
	END;					!END ITER
!	IF .SIDR_OCC EQL 0 AND UNCING		!EMPTY AND UNCLUTTERING?
!	THEN $CALL (DELENT, BDCURR, .ENTPTR);	!YES, ELIM THE EMPTY SIDR
	IF .SIDR_OCC EQL 0			!EMPTY RFA LIST?
	THEN VERINFO (UTLERL, .ENT_RFA);	!YES, TELL USER
	RETURN;
END;

GLOBAL ROUTINE DELENT (BKDESC, RECPTR) : NOVALUE =

! DELENT - EXPUNGES ANY TYPE OF ENTRY FROM A BKT
! INPUTS:
!	BKDESC OF THE BKT THAT CONTAINS THE ENTRY
!	RECPTR = ADDR IN BUFFER OF THE ENTRY TO BE EXPUNGED
! NOTES:
!	IF ENTRY IS UDR, THEN ITS RRV IS ALSO EXPUNGED, IF ONE

BEGIN
	MAP BKDESC: POINTER;
	MAP RECPTR: POINTER;
	$CALL (BK$DENT, .CPAGE, .BKDESC[BKDBKTADR], .RECPTR);
						!COMMON ROUTINE DOES THE WORK
	SETUPD (BKDESC);			!INDIC BKT UPD
	RETURN;
END;

GLOBAL ROUTINE SIDRADJ : NOVALUE =

! SIDRADJ - RESET RFA IN SIDR TO POINT AT ACTU REC IF NECES
! NOTES:
!	ADJUSTMENT APPLIES ONLY IF UNCLUTTERING.
!	RDP_KEY AND BDLINK ARE SETUP IN SIDRSCAN.

BEGIN
	IF .ENT_RRV EQL .ENT_RFA	!BACK PTR = ACTU ADDR?
	THEN RETURN;			!YES, SO NO UN-INDIRECTING TO DO

	PT1 = .RDP_KEY[RDRECPTR];	!GET ADDR OF SIDR PTING AT CURR REC
	PT1 [(.RDP_KEY[RDSIDRELEMENT] + SIDRHDRSIZE + .KDB[KDBKSZW]), WRD] = .ENT_RFA;
	SETUPD(BDLINK);			!SET FLAG SAYING BKT MODIFIED
	RETURN;
END;					!END SIDRADJ

GLOBAL ROUTINE SIDRPUT : NOVALUE =

! SIDRPUT - CREATE SIDR ENTRY FOR UDR THAT LACKED ONE

BEGIN
	IF UNCING
	THEN RDP_RFA[RDRRV] = .ENT_RFA	!MAP TO REC ITSELF
	ELSE RDP_RFA[RDRRV] = .ENT_RRV;	!USE RRV, IF ONE

	$FIELD(RBF,.RAB) = .ENTPTR + .HSZ_PRIM;
					!PUTSIDR USES UDR TO LOC KEY VALUE
	U$IFF (PUTSIDR, RDP_RFA)	!INSERT KEY IN SIDR
	THEN VERR ('Could not insert key into secondary index');
	RETURN;
END;

GLOBAL ROUTINE SIDRSCAN =

! SIDRSCAN - INSURE THAT RFA AS WELL AS KEY WAS IN THE SIDR
! RETURNS:
!	TRUE IF RECORD IS IN SIDR ARRAY, SETTING UP RDP_KEY AND BDLINK (USUALLY)
!	FALSE OTHERWISE
! NOTES:
!	IF DUPLICATES NOT ALLOWED, THE $FIND DATA IS ADEQUATE.
!	OTHERWISE HAVE TO USE RMS ROUTINES TO ACTU SCAN SIDRS.
!	HOWEVER IF UNCLUT, THEN RMS ROUTINES ALWAYS CALLED SO THAT RD&BD SETUP.
!	THUS ONLY TIME THEY ARE NOT SETUP IS NO UNC & $FIND ADEQ.

BEGIN
	IF NOT UNCING
	THEN BEGIN				!THEN TRY TO DO QUICK CHK
		IF .$FIELD(RFA,.RAB) EQL .ENT_RRV
		THEN GOODRETURN;		!IT WAS 1ST OR NO DUPS
		IF NODUPLICATES THEN BADRETURN;	!NO DUPS, SO SCAN CANT SUCC
	END;

	RDP_KEY[RDRECPTR]=0;			!CLEAR STARTING POS
	RDP_KEY[RDRFA] = .RST[RSTNRP];		!PASS RFA OF THE FND SIDR
						!START DUP SRCH WITH THIS REC
	$CALL (BD$PUT,BDLINK,0);		!INSURE CLEAN
	U$SUC (FBYRFA, RDP_KEY, BDLINK);	!PHYS LOCATE SIDR FROM ITS RFA
	RDP_KEY[RDFLAGS] = RDFLGRETEX;		!RET ON MATCH, DONT CORRECT IT
	RDP_KEY[RDRRV] = .ENT_RRV;		!COMPARE AGAINST THIS
	U$IFF (CHKDUP, RDP_KEY, BDLINK)		!SCAN FOR RFA MATCH
	THEN GOODRETURN				!FAILURE=MATCH
	ELSE BADRETURN;				!SUCC=SCANNED ENTIRE SIDR
END;

END ELUDOM