Trailing-Edge
-
PDP-10 Archives
-
BB-BT99S-BB_1990
-
10,7/rms10/rmssrc/utlvfy.b36
There are 11 other files named utlvfy.b36 in the archive. Click here to see a list.
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 ***********************
!
!PRODUCTMODULE 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.
!
! 124 4 10-35306 (SMW, 8/8/88) Undo edit 113. Fix problems
! 10-35629 happening when CHKDUP called by SIDRSCAN
! complains about duplicates causing SIDRADJ
! to write over random memory. Add debugging
! statements. Add dot to v$err reference.
! Goes with RMS-20 edit 471.
! 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 ![124]add dot
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 %;
![124] pvdbug - outputs debug msg of string followed by octal value
!
MACRO pVdbug(TEXT$, octvalue$) =
%if dbug %then
VERinfo ( UTLdbg, UPLIT (%ASCIZ TEXT$), octvalue$)
%fi
%;
!!! 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
pvdbug( 'SCANBKT starting on (CPAGE=)', .CPAGE ); ![124]
pvdbug( 'Bucket Header (BKT=)', .BKT ); ![124]
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
pvdbug('SCANBKT: ENTPTR=', .entptr); ![124]
pvdbug(' .ENTPTR[0]=', .entptr[0, wrd]); ![124]
%if dbug %then
verinfo(utlvem, uplit (%asciz 'SCANBKT: ENT_RFA='), .ent_rfa ); ![124]
%fi
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
pvdbug( 'SCANBKT: end of bucket, DUPSTILL=', .dupstill ); ![124]
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
pvdbug( 'ACCKEY: KDB[KDBREF] =', .kdb[kdbref] ); ![124]
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
%if dbug %then
verinfo(utlvem, uplit (%asciz 'ACCRRV: ENT_RRV='), .ent_rrv ); ![124]
%fi
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
pvdbug( 'ACCUDR: (ENTPTR=)', .entptr ); ![124]
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
![124]remove edit 113
![124] PT1 [(.RDP_KEY[RDSIDRELEMENT] + SIDRHDRSIZE + .KDB[KDBKSZW]), WRD] = .ENT_RFA;
![124]rdsidrelement already past header
PT1 [.RDP_KEY[RDSIDRELEMENT], WRD] = .ENT_RFA; ![124]end remove 113
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
%if dbug %then
verinfo(utlvem, uplit (%asciz 'SIDRPUT: [RDRRV]='), .rdp_rfa[rdrrv] ); ![124]
%fi
$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
rdp_key[rdsidrelement] = 0; ![124]init index in case bad return
U$IFF (CHKDUP, RDP_KEY, BDLINK) !SCAN FOR RFA MATCH
THEN if .rdp_key[rdsidrelement] eql 0 ![124]check strange failure
then return false ![124]for now
else ![124]
GOODRETURN !FAILURE=MATCH
ELSE BADRETURN; !SUCC=SCANNED ENTIRE SIDR
END;
END ELUDOM