Trailing-Edge
-
PDP-10 Archives
-
RMS-10_T10_704_FT2_880425
-
10,7/rms10/rmssrc/rmsfnx.b36
There are 6 other files named rmsfnx.b36 in the archive. Click here to see a list.
MODULE FNDX =
BEGIN
GLOBAL BIND FNDXV = 1^24 + 0^18 + 7; !EDIT DATE: 1-JAN-78
%([
FUNCTION: THIS MODULE CONTAINS ALL ROUTINES WHICH PROCESS
THE $FIND MACRO FOR INDEXED FILES.
AUTHOR: S. BLOUNT
THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!COPYRIGHT (C) 1977, 1979 BY DIGITAL EQUIPMENT CORPORATION
********** TABLE OF CONTENTS **************
ROUTINE FUNCTION
======= ========
FIDXSEQ FIND NEXT SEQUENTIAL RECORD
FBYKEY FIND A RECORD BY KEY ACCESS
FRECRFA FIND A RECORD BY RFA ACCESS
POSRP ATTEMPT TO POSITION TO RP
POSRFA ATTEMPT TO POSITION TO RP BY RFA ADDRESS
POSNEXT POSITION TO NEXT RECORD
REVISION HISTORY:
RMS
EDIT EDIT DATE WHO PURPOSE
==== ==== ==== === =======
1 10-DEC-76 SB FIX BUG IF GET SEQ TO
EMPTY FILE
2 13-DEC-76 SB RETURN ER$EOF FOR EDIT 1
3 22-DEC-76 SB CHANGE ER$RNF TO ER$DEL
4 3-MAY-77 SB ADD SUPPORT FOR SIDRELEMENT FIELD
5 22-JUN-77 SB FIX POSRP SO IT RELEASES THE CURRENT
BUCKET EVEN IF IT DIDNT CALL POSRFA
(FOR FIND-GET ON SECONDARY KEYS)
5 6 1-JAN-78 SB FIX FBYKEY SO SIDRELEMENT IS RIGHT
IF 1ST SIDR PTR IS DELETED.
*************************************************
* *
* NEW REVISION HISTORY *
* *
*************************************************
****************** Start RMS-10 V1.1 *********************
********************* TOPS-10 ONLY ***********************
PRODUCT MODULE SPR
EDIT EDIT QAR DESCRIPTION
====== ====== ===== ===========
100 7 Dev Make declarations for routine names
be EXTERNAL ROUTINE so RMS will compile
under BLISS V4 (RMT, 10/22/85).
***** END OF REVISION HISTORY *****
])%
%([ FORWARD DECLARATIONS ])%
%([ EXTERNAL DECLARATIONS ])%
EXTERNAL ROUTINE
PUTBKT, ! FLUSH A BUCKET
LOCKIT, ! LOCK A BUCKET
CKEYKK, ! COMPARE KEYS
SDATABKT, ! SEARCH A DATA BUCKET
FNDDATA, ! LOCATE A DATA RECORD BY KEY
CRASH, ! FOR DEBUGGING
DUMP, ! SAME
FBYRFA, ! LOCATE RECORD BY RFA
FBYRRV; ! LOCATE RECORD BY RRV
%([ ERROR MESSAGES REFERENCED IN THIS MODULE ])%
EXTERNAL
MSGRFA, ! BAD RFA VALUE
MSGKDB, ! KDB IS SCREWED UP
MSGCANTGETHERE, ! RMS HAS GONE WILD
MSGFLAGS, ! BAD FLAG VALUES
MSGPTR, ! BAD PTR VALUE
MSGINPUT; ! BAD INPUT TO A ROUTINE
REQUIRE 'RMSREQ';
EXTDECLARATIONS;
! FIDXSEQ
! =======
! ROUTINE TO FIND THE NEXT SEQUENTIAL RECORD IN
! AN INDEXED FILE. THIS ROUTINE MUST DETERINE
! THE CURRENT POSITION IN THE FILE AND THEN ATTEMPT
! TO LOCATE THE NEXT SEQUENTIAL RECORD. ALL ERROR
! CODES ARE GENERATED WITHIN THIS ROUTINE (OR THE
! ROUTINES IT CALLS).
! INPUT:
! RECDESC RECORD DESCRIPTOR PACKET
! <NO FIELDS USED AS INPUT>
!
! DATABD BUCKET DESCRIPTOR OF CURRENT BUCKET (IF ANY)
! OUTPUT:
! TRUE: RECORD LOCATED WITHIN BUCKET
! FALSE: ERROR
! BUSY
! NO MEMORY AVAILABLE
! END-OF-FILE
! ROUTINES CALLED:
! POSCUR
! GETKDB
! INPUT ARGUMENTS MODIFIED:
! RECORD DESCRIPTOR:
! RECPTR ADDRESS OF RECORD IN BUCKET
! RFA RFA OF CURRENT RECORD
! RRV RRV ADDRESS OF CURRENT RECORD
! NOTES:
!
! 1. THE BUCKET DESCRIPTOR (DATABD) WHICH IS PASSED TO THIS
! ROUTINE MAY NOT BE NULL. IN THIS CASE, FBYRFA MUST DETERMINE
! IF THE NEW RECORD IS ON THE SAME BUCKET AS THE CURRENT
! RECORD AND IF NOT, RELEASE THE CURRENT BUCKET.
GLOBAL ROUTINE FIDXSEQ ( RECDESC, DATABD ) =
BEGIN
ARGUMENT (RECDESC,BASEADD);
ARGUMENT (DATABD,BASEADD);
MAP
RECDESC: POINTER,
DATABD: POINTER;
EXTERNAL ROUTINE
GETKDB, ! LOCATE A KEY DESCRIPTOR BLOCK
POSNEXT, ! POSITION TO CURRENT RECORD
PUTBKT; ! RELEASE BUCKET
REGISTER
TEMPAC; ! TEMP REGISTER
LOCAL
NRPKEYOFREF,
RECORDPTR: POINTER; ! PTR TO DATA RECORD
TRACE ('FIDXSEQ');
CHECKEXACTCOUNT;
%([ FIRST, WE MUST SET UP OUR KEY DESCRIPTOR BLOCK ])%
NRPKEYOFREF = .RST [ RSTNRPREF ]; ! GET NRP KEY OF REF
IF (KDB = CALLGETKDB ( LCI ( NRPKEYOFREF ) )) IS FALSE ! LOCATE THE KDB
THEN RMSBUG ( MSGKDB ); ! BAD KRF
%([ NOW, WE MUST SET UP THE RP RFA, RRV ADDRESS, AND
KEY STRING DESCRIPTOR FOR THE CURRENT RECORD ])%
RECDESC [ RDRRV ] = .RST [ RSTNRPRRV ]; ! RRV FORMAT
RECDESC [ RDRFA ] = .RST [ RSTNRP ]; ! RFA FORMAT
RECDESC [ RDUSERSIZE ] = .KDB [ KDBKSZ ]; ! USE FULL KEY SIZE
RECDESC [ RDUSERPTR ] = .RST [ RSTKEYBUFF ]; ! ADDR OF KEY
RECDESC [ RDSIDRELEMENT ] = .RST [ RSTSIDRELEMENT ];
%([ INDICATE THAT THE LAST OPERATION WAS NOT A $FIND
SO THAT WE WILL PROCEED TO THE NEXT RECORD AFTER
THE NRP ])%
RST [ RSTLASTOPER ] = ZERO;
%([ POSITION TO THE CORRECT RECORD ])%
TEMPAC = CALLPOSNEXT ( %(RD)% BPT ( RECDESC ),
%(BKT)% BPT ( DATABD ) );
%([ ON RETURN, WE MAY HAVE TO FLUSH THE BUCKET THAT WAS
ALLOCATED IN THE ROUTINE, SO WE MUST CHECK TO SEE
IF THE BUCKET DESCRIPTOR IS NULL. ])%
IF ( .TEMPAC IS FALSE ) AND ( NOT NULLBD ( DATABD ) )
THEN %(FLUSH THE BUCKET)%
BEGIN
CALLPUTBKT ( %(NO UPDATE)% PCI ( FALSE ),
%(BUCKET)% BPT ( DATABD ) );
TEMPAC = FALSE
END; %(OF IF FAILED AND THERE WAS A BKT DESC)%
%([ SET UP THE RRV VALUE FOR THE CURRENT RECORD POSITION ])%
RECORDPTR = .RECDESC [ RDRECPTR ]; ! GET PTR TO RECORD
RECDESC [ RDRRV ] = .RECORDPTR [ DRRRVADDRESS ];
%([ RETURN THE STATUS TO FINDIDX ])%
RETURN .TEMPAC
END; %(OF FIDXSEQ)%
! FBYKEY
! ======
! ROUTINE TO PROCESS THE $FIND MACRO WITH KEY ACCESS IN
! AN INDEXED FILE. THIS ROUTINE PERFORMS THE FOLLOWING
! FUNCTIONS:
!
! 1. LOCATE THE DATA RECORD BY TRAVERSING THE INDEX
! 2. CHECK THAT THE RECORD FOUND HAS KEY ATTRIBUTES
! WHICH THE USER WANTED.
! INPUT:
! RECDESC RECORD DESCRIPTOR PACKET
! FLAGS <NULL>
!
! DATABD BUCKET DESCRIPTOR OF DATA LEVEL (RETURNED)
! OUTPUT:
! TRUE: RECORD FOUND
! FALSE: ERROR
! RECORD NOT FOUND
! INPUT ARGUMENTS MODIFIED:
! RECORD DESCRIPTOR:
! RECPTR ADDRESS OF USER DATA RECORD
! SIDRELEMENT OFFSET INTO CURRENT SIDR OF RECORD POINTER
! NOTES:
!
! 1. ON ERROR RETURN, THE ERROR CODE WILL BE SET UP
!
! 2. NOTE THAT THIS ROUTINE DOES NOT LOCK THE INDEX.
!
! 3. ON INPUT TO THIS ROUTINE, THE INDEX IS ALREADY LOCKED.
GLOBAL ROUTINE FBYKEY ( RECDESC, DATABD ) =
BEGIN
ARGUMENT (RECDESC,BASEADD);
ARGUMENT (DATABD,BASEADD);
MAP
RECDESC: POINTER,
DATABD: POINTER;
EXTERNAL ROUTINE
SKIPRECORD,
LOCKIT, ! LOCK THE FILE
FBYRRV,
FNDDATA, ! LOCATE DATA LEVEL
PUTBKT, ! RELEASE A BUCKET
GETKDB; ! LOCATE A KDB
LABEL LOOP,
ITERATION;
REGISTER
TEMPAC;
LOCAL
SAVEKDB,
TEMP,
RECORDPTR: POINTER, ! TEMP PTR TO DATA RECORD
SAVEDSTATUS, ! TEMP STORAGE FOR STATUS
KEYOFREFERENCE,
RPRFA, ! RFA OF CURRENT RECORD
ARRAYPTR: POINTER, ! PTR TO CURRENT POINTER ARRAY
UDRPTR: POINTER, ! PTR TO USER DATA RECORD
SIDRPTR: POINTER, ! PTR TO CURRENT SIDR
RFAOFUDR, ! RFA OF USER DATA RECORD
RFAOFSIDR, ! RFA OF SECONDARY DATA RECORD
UDRBD: FORMATS[ BDSIZE ]; ! BKT DESC FOR UDR BUCKET
TRACE ('FBYKEY');
SAVEDSTATUS = TRUE; ! INIT STATUS INDICATOR
%([ SET UP THE CORRECT KEY DESCRIPTOR ])%
KEYOFREFERENCE = .RAB [ RABKRF ];
IF (KDB = CALLGETKDB ( LCI ( KEYOFREFERENCE ) )) IS FALSE THEN
RETURNSTATUS ( ER$KRF );
%([ SET UP THE SEARCH KEY IN THE RECORD DESCRIPTOR PACKET ])%
IF ( RECDESC [ RDUSERPTR ] = .RAB [ RABKBF ] ) LSS MINUSERBUFF
THEN
RETURNSTATUS ( ER$KBF );
%([ NOW, CHECK THE KEY SIZE AND SET IT UP ])%
RECDESC [ RDUSERSIZE ] = ( TEMPAC = .RAB [ RABKSZ ] );
IF ( .TEMPAC GTR .KDB [ KDBKSZ ] )
OR
( .TEMPAC IS ZERO )
THEN
RETURNSTATUS ( ER$KSZ );
%([ USER KEY SPEC IS OK...GO DO THE FIND. ])%
%([ SEARCH THE INDEX STRUCTURE FOR THE TARGET RECORD ])%
RECDESC [ RDLEVEL ] = DATALEVEL; ! SEARCH TO DATA LEVEL
IF (TEMPAC = CALLFNDDATA ( BPT ( RECDESC ), ! TRAVERSE INDEX TO DATA
BPT ( DATABD ) ) ) IS FALSE THEN
%([ HOW DID WE DO? ])%
RETURN .TEMPAC;
%([ WE SUCCEEDED IN GETTING TO THE DATA LEVEL. WE MUST NOW
CHECK TO SEE IF THE KEY MEETS THE USER'S SPECIFICATIONS.
ALSO, IT COULD BE DELETED OR ALL THE RFA PTRS IN THE
SIDR COULD BE EMPTY.
THIS LOOP IS VERY LARGE AND IS EXECUTED UNTIL WE FIND A
RECORD WHICH MEETS THE USER'S CRITERIA ])%
LOOP: BEGIN
REPEAT %(FOREVER)%
ITERATION:BEGIN
%([ IF WE ARE POSITIONED PAST THE LAST RECORD IN
THE FILE, OR IF THE BUCKET WAS EMPTY,
THEN THE RECORD WAS NOT FOUND. ])%
IF CHKFLAG ( RECDESC [ RDSTATUS ], RDFLGPST + RDFLGEMPTY ) ISON
THEN LEAVE LOOP WITH ( SAVEDSTATUS = ER$RNF );
%([ IS THE KEY WE FOUND .GTR. THAN OUR SEARCH KEY? ])%
IF ( LSSFLAG ( RECDESC ) ISON )
THEN %(WE MUST CHECK FOR APPROX SEARCH)%
BEGIN
%([ DID THE USER SPECIFY APPROX SEARCH? IF
BOTH ROPKGT AND ROPKGE ARE OFF THEN HE
WANTED AN EXACT MATCH AND WE DIDN'T FIND ONE ])%
RTRACE (%STRING(' K(S) < K(I)...',%CHAR(13),%CHAR(10)));
IF ( CHKFLAG ( RAB [ RABROP ], ROPKGT+ROPKGE) IS OFF)
THEN %(HE WANTED AN EXACT MATCH)%
LEAVE LOOP WITH (SAVEDSTATUS = ER$RNF)
END %(OF IF LSSFLAG IS ON)%
ELSE %(THIS WAS AN EXACT MATCH)%
BEGIN
%([ DID HE WANT A RECORD WITH A KEY THAT
WAS .GTR. THAN THIS ONE? ])%
IF ( CHKFLAG ( RAB [ RABROP ], ROPKGT ) ISON )
THEN
BEGIN
%([ WE MUST SKIP A RECORD UNTIL WE
FIND ONE THAT IS GREATER ])%
UNTIL LSSFLAG ( RECDESC ) ISON
DO
BEGIN
IF CALLSKIPRECORD ( BPT ( RECDESC ),
BPT ( DATABD ),
PCI ( FALSE ) ) IS FALSE THEN
LEAVE LOOP WITH (SAVEDSTATUS = ER$RNF )
END; %(OF UNTIL LSSFLAG IS ON)%
LOOKAT (' TARGET REC AT: ', RECDESC [ RDRECPTR ] );
END %(OF IF HE WANTED A GREATER THAN KEY)%
END; %(OF ELSE THIS WAS AN EXACT MATCH)%
%([ WE ARE NOW POSITIONED AT THE CORRECT
RECORD. IF THIS IS THE PRIMARY KEY,
ALL WE MUST CHECK IS THAT THE RECORD
ISNT'T DELETED ])%
%([ FIRST, COMPUTE THE RFA OF THE CURRENT RECORD
(UDR OR SIDR) FOR USE LATER. ])%
RECORDPTR = .RECDESC [ RDRECPTR ]; ! RECORD PTR
RPRFA =MAKERFA ( .DATABD [ BKDBKTNO ], .RECORDPTR[DRRECORDID]);
IF (.KEYOFREFERENCE IS REFPRIMARY )
AND
( CHKFLAG ( RECDESC [ RDSTATUS ], RDFLGDELETE ) IS OFF)
THEN
LEAVE LOOP WITH ( SAVEDSTATUS = TRUE );
%([ EITHER THIS IS A DELETED PRIMARY
KEY OR A SECONDARY KEY. ])%
IF .KEYOFREFERENCE ISNT REFPRIMARY
THEN
BEGIN
%([ THIS IS A SECONDARY KEY. WE
MUST SCAN THE SIDR ARRAY, LOOKING
FOR A NON-DELETED RECORD POINTER (RFA).
IF WE FIND ONE, WE CAN GO ACCESS
THE RECORD. IF NOT, WE CAN CHECK
FOR A CONTINUATION SIDR RECORD
AND CONTINUE PROCESSING IT. ])%
SIDRPTR = .RECDESC [ RDRECPTR ];
%([ COMPUTE # OF RECORD PTRS IN ARRAY ])%
TEMPAC = .SIDRPTR [ SIDRRECSIZE ] - .KDB [ KDBKSZW ];
LOOKAT (' SCANNING SIDR AT: ', SIDRPTR );
LOOKAT (' # OF PTRS: ',TEMPAC );
ARRAYPTR = (RECORDPTR = .SIDRPTR + SIDRHDRSIZE + .KDB [ KDBKSZW ]);
%([ SCAN ALL RECORD POINTERS ])%
INCR J FROM 0 TO .TEMPAC - 1
DO
BEGIN
RFAOFUDR = .RECORDPTR [ .J, WRD ] AND (NOT ALLRFAFLAGS);
IF (.RFAOFUDR ISNT NULLRFA)
THEN
BEGIN
%([ WE FOUND AN RFA ])%
LOOKAT (' RFA FOUND: ',RFAOFUDR);
%([ SET UP THE INPUT RFA SO WE CAN
LOCATE THE DATA RECORD BY RFA ])%
%([ WE MUST FIRST SET UP THE PRIMARY KDB ])%
SAVEKDB = .KDB; ! SAVE CURRENT KDB
KDB = .FST [ FSTKDB ]; ! GET PRIMARY
RECDESC [ RDRFA ] = .RFAOFUDR;
TEMP = CALLFBYRRV (%(RD)% BPT ( RECDESC ),
%(BKT)% LCT ( UDRBD ) );
KDB = .SAVEKDB; ! RESTORE KDB
IF .TEMP IS FALSE
THEN BEGIN
RTRACE (%STRING(' **RRV NOT FOUND',%CHAR(13),%CHAR(10)));
IF .USRSTS ISNT SU$SUC
THEN LEAVE LOOP WITH (SAVEDSTATUS=.USRSTS)
END %(OF IF .TEMP IS FALSE)%
ELSE BEGIN
%([ WE FOUND THE USER DATA RECORD.
WE MUST NOW CHECK TO
SEE IF IT IS DELETED ])%
UDRPTR = .RECDESC [ RDRECPTR ];
%([ IS THIS RECORD DELETED? ])%
IF DELETEFLAG ( UDRPTR ) IS OFF
THEN %(THIS RECORD IS OK)%
BEGIN
LOOKAT (' FOUND UDR AT: ',UDRPTR);
%([ FLUSH THE SIDR BKT ])%
CALLPUTBKT ( PCI ( FALSE ),
BPT ( DATABD ) );
%([ COMPUTE OFFSET INTO THIS ARRAY ])%
RECDESC [ RDSIDRELEMENT ] = .RECORDPTR - .ARRAYPTR + .J + 1; !**[5]**
%([ MAKE THE USER DATA BKT THE
CURRENT BKT TO BE RETURNED. ])%
MOVEBKTDESC (%(FROM)% UDRBD, %(TO)% DATABD );
LEAVE LOOP WITH (SAVEDSTATUS=TRUE)
END; %(OF IF UDR WASNT DELETED)%
%([ AT THIS POINT, THE UDR WAS DELETED,
SO WE MUST RELEASE IT AND GO BACK
AND FINISH OUR SIDR SCAN ])%
RTRACE (%STRING(' UDR IS DELETED',%CHAR(13),%CHAR(10)));
%([ RELEASE IT'S BUCKET ])%
CALLPUTBKT ( PCI ( FALSE ),
LCT ( UDRBD ) );
END; !END OF "ELSE UDR FND"
END; %(OF IF NULLSIDRFLAG IS OFF)%
END; %(OF IF SIDR POINTER SCAN LOOP)%
%([ RESTORE THE PTR TO THE CURRENT SIDR ])%
RECDESC [ RDRECPTR ] = .SIDRPTR
END; %(OF IF THIS IS A SECONDARY KEY)%
%([ AT THIS POINT, WE HAVE LOCATED A DELETED
PRIMARY DATA RECORD OR A SECONDARY DATA RECORD
WHICH CONTAINS ONLY DELETED RECORD POINTERS.
WE THEREFORE MUST SKIP OVER THE CURRENT RECORD
AND POSITION TO THE NEXT ONE. ])%
RTRACE (%STRING(' SKIPPING TO NEXT REC...',%CHAR(13),%CHAR(10)));
IF CALLSKIPRECORD ( BPT ( RECDESC ),
BPT ( DATABD ),
PCI ( FALSE ) ) IS FALSE THEN
%([ DID WE DO IT? ])%
LEAVE LOOP WITH (SAVEDSTATUS = ER$RNF );
%([ WE HAVE NOW SKIPPED THE CURRENT RECORD
SO WE CAN GO BACK AND SEE IF WE CAN USE
THIS NEW RECORD. ])%
RTRACE (%STRING(' **NEW INTERATION...',%CHAR(13),%CHAR(10)))
END; %(OF REPEAT FOREVER)%
END; %( OF LOOP: )%
%([ COME HERE WHEN WE HAVE FINISHED THE OPERATION.
HOWEVER, WE MUST CHECK IF IT WAS SUCCESFUL.
NOTE THAT WHEN WE GET HERE, VREG WILL CONTAIN EITHER
"TRUE" OR THE ERROR CODE. ])%
IF .SAVEDSTATUS ISNT TRUE
THEN
BEGIN
%([ FLUSH THE DATA BUCKET ])%
CALLPUTBKT ( %(NO)% PCI ( FALSE ),
%(BKT)% BPT ( DATABD ) );
LOOKAT (' ERROR CODE FROM FBYKEY: ', SAVEDSTATUS );
RETURNSTATUS (.SAVEDSTATUS)
END; %(OF IF THERE WAS AN ERROR)%
%([ COME HERE IF THERE WAS NO ERROR DURING THE
"FINDING" OF THE RECORD. WE MUST NOW SET UP
THE RFA OF THE CURRENT RECORD (UDR OR SIDR) AND
THE RRV ADDRESS (ONLY UDR). ])%
RECORDPTR = .RECDESC [ RDRECPTR ]; ! PTR TO UDR
RECDESC [ RDRRV ] = .RECORDPTR [ DRRRVADDRESS ];
%([ NOW, FORM THE ID OF THE RP ])%
RECDESC [ RDRFA ] = .RPRFA;
GOODRETURN
END; %(OF FBYKEY)%
! FRECRFA
! =======
! ROUTINE TO FIND A SPECIFIED RECORD BY ITS RFA ADDRESS.
! THIS ROUTINE IS CALLED ONLY DIRECTLY FROM FINDIDX.
! IT IS NOT CALLED INTERNALLY WHEN A RECORD NEEDS TO FOUND
! BY THE RFA ADDRESS. THIS ROUTINE IS A SEPARATE ONE MERELY
! TO AVOID CLUTTERING UP THE MAIN PROGRAM WITH SPECIAL ERROR
! MESSAGE MANIPULATIONS.
! INPUT:
! RECDESC RECORD DESCRIPTOR PACKET
!
! DATABD BUCKET DESCRIPTOR OF DATA BUCKET (RETURNED)
! OUTPUT:
! TRUE: RECORD WAS FOUND
! FALSE: ERROR
! RECORD NOT FOUND
! BAD RFA
! ROUTINES CALLED:
! FBYRRV
GLOBAL ROUTINE FRECRFA ( RECDESC, DATABD ) =
BEGIN
ARGUMENT (RECDESC,BASEADD);
ARGUMENT (DATABD,BASEADD);
MAP
RECDESC: POINTER,
DATABD: POINTER;
EXTERNAL ROUTINE
FBYRRV, ! FIND RECORD BY RRV
PUTBKT; ! RELEASE A BUCKET
REGISTER
REG2 = 2,
SAVEDSTATUS; ! SAVE THE RESULTS HERE
TRACE ('FRECRFA');
%([ SET UP THE USER'S RFA IN THE PACKET ])%
IF ( RECDESC [ RDRFA ] = .RAB [ RABRFA ] ) IS ZERO
THEN
RETURNSTATUS ( ER$RFA ); ! DONT ALLOW BAD RFA'S
%([ WE MUST NOW CHECK TO SEE IF THIS PAGE EVEN EXISTS. THIS
IS BECAUSE IF THE FILE IS ONLY BEING READ, THE MONITOR
WON'T LET US CREATE A NEW PAGE (I.E., MAP A NON-EXISTENT
PAGE AND TOUCH IT). ])%
%([ DOES THIS PAGE EXIST? ])%
IF $CALL (PAGEXIST, .FST[FSTJFN], BUCKETOFRFA (.RAB [RABRFA])) IS FALSE
THEN RETURNSTATUS ( ER$RFA );
%([ TRY TO LOCATE THE RECORD ])%
IF (SAVEDSTATUS = CALLFBYRRV ( BPT ( RECDESC ),
BPT ( DATABD ) ) ) IS FALSE THEN
%([ WHAT HAPPENED? ])%
RETURNSTATUS ( ER$RNF ); ! RECORD NOT FOUND ERROR
%([ AT THIS POINT, FBYRRV MIGHT HAVE SUCCEEDED BUT THE
RECORD HAS BEEN DELETED. THEREFORE, WE MUST MAKE
A SPECIAL CHECK FOR THIS CONDITION. ])%
IF ( CHKFLAG ( RECDESC [ RDSTATUS], RDFLGDELETE ) ISON )
THEN
BEGIN
CALLPUTBKT ( %(NO UPDATE)% PCI ( FALSE ),
%(BKT)% BPT ( DATABD ) );
RETURNSTATUS ( ER$DEL ) ! RECORD IS DELETED
END;
%([ RETURN THE STATUS PASSED BACK TO US FROM FBYRRV ])%
RETURN .SAVEDSTATUS;
END; %(OF FRECRFA)%
! POSRP
! =====
! ROUTINE TO POSITION TO THE CURRENT RECORD IN AN INDEXED FILE.
! THE CURRENT RECORD IS DENOTED BY A 3-TUPLE AS FOLLOWS:
!
! 1. ADDRESS OF DATA RECORD (RFA)
! 2. ADDRESS OF RRV RECORD (RRV)
! 3. KEY STRING OF CURRENT RECORD
!
! THE CURRENT POSITION IN THE FILE IS LOCATED ACCORDING
! TO THE ABOVE PARAMETERS IN THE GIVEN ORDER. THAT IS,
! WE TRY TO LOCATE THE DATA RECORD BY ITS RFA, THEN WE
! TRY THE RRV ADDRESS, THEN THE KEY STRING. IF ALL FAILS,
! THEN THE ORIGINAL POSITION AND EVERYTHING BEYOND IT HAS
! BEEN DELETED OR OTHERWISE REMOVED SOMEHOW.
!
! FOR SECONDARY KEYS, WE MUST ATTEMPT TO LOCATE THE SIDR
! BY ITS RFA VALUE. HOWEVER, IF THAT FAILS, WE CAN ONLY
! RESORT TO THE ORIGINAL KEY STRING TO TRY TO LOCATE THE RECORD.
! INPUT:
! RECDESC RECORD DESCRITOR PACKET
! <NO FIELDS USED AS INPUT>
!
! DATABD BUCKET DESCRIPTOR OF CURRENT BUCKET (IF ANY)
! OUTPUT:
! TRUE: RECORD LOCATED
! FALSE: RECORD COULD NOT BE FOUND
! INPUT ARGS MODIFIED:
! RECORD DESCRIPTOR:
! RECPTR ADDRESS OF RECORD IN BUCKET
!
! NOTES:
!
! 1. IF THE INPUT BUCKET DESCRIPTOR (DATABD) IS NON-NULL,
! THEN IT IS USED AS THE CURRENT BUCKET TO SEE IF THE
! RECORD CAN BE LOCATED. IF THE RECORD IS NOT FOUND
! BY RFA, THE BUCKET IS FLUSHED AND A NEW ONE IS USED.
! HOWEVER, ALL OF THIS IS ACTUALLY DONE IN POSRFA.
!
! 2. IF WE CANNOT LOCATE THE CURRENT RECORD BY ITS RFA
! AND IF IT IS A PRIMARY KEY, THEN WE MUST LOCATE IT
! BY IT'S RRV ADDRESS. NOTE THAT WE HAVE 2 CHOICES FOR
! LOCKING--WE CAN LOCK BOTH THE RRV AND THE UDR BUCKETS,
! OR WE CAN SIMPLY LOCK THE ENTIRE INDEX FOR THE DURATION
! OF THE OPERATION. THE SECOND APPROACH IS BETTER SINCE
! WE WILL HAVE TO LOCK THE INDEX ANYWAY IF WE CAN'T FIND
! THE RECORD BY ITS RRV AND MUST USE THE KEY, AND SINCE
! IT WILL TAKE 2 LOCKS IN EITHER CASE.
GLOBAL ROUTINE POSRP ( RECDESC, DATABD ) =
BEGIN
ARGUMENT (RECDESC,BASEADD);
ARGUMENT (DATABD,BASEADD);
MAP
RECDESC: POINTER,
DATABD: POINTER;
EXTERNAL ROUTINE
POSRFA; ! POSITION TO RECORD BY ITS RP RFA
REGISTER
TEMPAC, ! TEMP REGISTER
RFA: FORMAT; ! RFA OF CURRENT RECORD
TRACE ('POSRP');
CHECKEXACTCOUNT;
%([ DO WE HAVE AN RFA? IF SO, WE MUST LOCATE THE
APPROPRIATE DATA RECORD. ])%
IF .RECDESC [ RDRFA ] ISNT ZERO
THEN %(TRY TO USE THE RFA)%
BEGIN
IF CALLPOSRFA ( %(RD)% BPT ( RECDESC ),
%(BKT)% BPT ( DATABD ) ) ISNT FALSE THEN
%([ DID WE FIND THE RECORD? ])%
GOODRETURN; ! YES
RTRACE (%STRING(' DIDNT FIND BY RFA',%CHAR(13),%CHAR(10)))
END; %(OF IF RFA ISNT ZERO)%
%([ AT THIS POINT, WE MAY HAVE A CURRENT BUCKET WHICH WE
MUST FLUSH. THIS COULD OCCUR IN TWO CASES:
1. WE CALLED POSRFA AND IT DIDNT FLUSH THE BUCKET (NORMAL)
2. WE HAD A CURRENT BUCKET BUT THE NRP RFA (RDRFA) WAS ZERO
THIS WOULD HAPPEN IF WE DID A $FIND-$GET ON A
SECONDARY KEY SINCE THE RFA OF THE SIDR IS NOT
KEPT ACROSS CALLS OF THIS KIND.
])%
IF NOT NULLBD ( DATABD )
THEN
CALLPUTBKT ( %(NO)% PCI ( FALSE ),
%(BKT)% BPT ( DATABD ) );
%([ IF WE HAD AN UNEXPECTED LOCKING ERROR, EXIT NOW ])%
IF .USRSTS ISNT SU$SUC THEN BADRETURN;
%([ WE NOW HAVE FAILED TO FIND THE CURRENT RECORD BY ITS RFA.
SO, WE MUST TRY TO LOCATE IT BY ITS RRV ADDRESS
OR MAYBE EVEN BY KEY. IF WE ARE LOCKING, THEN WE MUST ATTEMPT TO LOCK THE
INDEX STRUCTURE. ])%
IF LOCKING AND ( NOT INDEXLOCKED )
THEN
BEGIN
IF LOCKINDEX ( ENQBLK, ENQSHR ) IS FALSE THEN ! WAIT FOR IT
RETURNSTATUS ( ER$EDQ ) ! SHOULD NOT FAIL
END; %(OF IF LOCKING)%
%([ HMMM...WE COULDN'T FIND THE RECORD BY ITS RFA VALUE.
LET'S TRY THE RRV ADDRESS (IF THIS SUCCEEDS, THEN WE
KNOW THAT THE DATA RECORD HAS MOVED TO A NEW BUCKET
SINCE WE LAST ACCESSED IT) . NOTE THAT THIS IS DONE
ONLY FOR PRIMARY KEYS. ])%
RECDESC [ RDRFA ] = .RECDESC [ RDRRV ];
IF PRIMARYKEY
AND
( .RECDESC [ RDRRV ] ISNT ZERO )
THEN %(TRY TO LOCATE BY RRV)%
BEGIN
IF CALLFBYRRV ( %(RD)% BPT ( RECDESC ),
%(BKT)% BPT ( DATABD ) ) ISNT FALSE THEN
%([ DID WE GET IT? ])%
GOODRETURN;
RTRACE (%STRING(' COULDNT FIND REC BY RRV...',%CHAR(13),%CHAR(10)))
END; %(OF IF SEARCH FOR THE RRV)%
%([ AT THIS POINT, WE COULDN'T LOCATE THE RECORD
EITHER BY ITS RFA OR BY ITS RRV ADDRESS (PRIMARY
KEY ONLY). THEREFORE, WE MUST ATTEMPT THE LAST
RESORT OF POSITIONING BY KEY. ])%
RTRACE (%STRING(' POSITIONING BY KEY...',%CHAR(13),%CHAR(10)));
RECDESC [ RDLEVEL ] = DATALEVEL; ! GO ALL THE WAY
TEMPAC = CALLFNDDATA ( %(RD)% BPT ( RECDESC ),
%(BKT)% BPT ( DATABD ) );
%([ IF WE ARE PAST THE END OF A BUCKET, THEN WE KNOW THAT
WE ARE AT THE EOF. SO, LET'S SET A FALSE VALUE AND RETURN. ])%
IF PASTLASTFLAG ( RECDESC ) ISON THEN RETURNSTATUS ( ER$EOF );
%([ RETURN WITH THE RESULTS AND LET POSNEXT FIGURE
OUT WHAT TO DO WITH IT. ])%
RETURN .TEMPAC
END; %(OF POSRP)%
! POSRFA
! ======
! ROUTINE TO ATTEMPT TO FIND THE CURRENT RECORD BY ITS RFA
! ADDRESS. THIS ROUTINE MAY BE CALLED WITH A "CURRENT
! BUCKET". IT WILL USE THAT BUCKET IF POSSIBLE. IF NOT,
! IT WILL RELEASE IT AND GET A NEW BUCKET TO USE TO SEARCH
! FOR THE RECORD.
!
! THIS ROUTINE MUST NOT ONLY LOCATE THE RECORD BY ITS RFA,
! BUT IT MUST ALSO CHECK TO INSURE THAT THE RECORD IS, IN FACT,
! THE ONE REPRESENTED BY THE "CURRENT-RECORD". FOR PRIMARY
! KEYS, THIS MEANS THE RRV ADDRESS MUST ALSO AGREE. FOR
! SECONDARY KEYS, THE KEY STRING MUST BE COMPARED (NOTE THAT
! THIS KEY COMPARISON COULD ONLY FAIL IF THE SIDR RECORD MOVED,
! THE ORIGINAL BUCKET RAN OUT OF ID'S, AND A NEW SIDR RECORD
! WAS INSERTED WHICH GOT THE SAME ID AS THE ORIGINAL SIDR THAT
! MOVED EARLIER. SINCE THIS IS AN EXTREMELY RARE OCCURANCE, WE WILL
! OPTIMIZE THIS ALGORITHM BY NOT CHECKING THE KEY STRING
! FOR EQUALITY. WHEN A BUCKET RUNS OUT OF ID'S, WE WILL TELL
! THE USER TO RE-ORGANIZE THE FILE.
! INPUT:
! RECDESC RECORD DESCRIPTOR PACKET
! RFA RFA OF TARGET RECORD
!
! DATABD BUCKET DESCRIPTOR OF CURRENT BUCKET(IF ANY)
! OUTPUT:
! TRUE: RECORD FOUND
! FALSE: RECORD NOT FOUND
! BUCKET IS BUSY
! ENQ/DEQ ERROR
!
! INPUT ARGS MODIFIED:
! RECORD DESCRIPTOR:
! RECPTR ADDRESS OF TARGET RECORD
! ROUTINES CALLED:
! FBYRFA
! CKEYKK
! PUTBKT
! NOTES:
!
! 1. THE INPUT BUCKET DESCRIPTOR (DATABD) MAY BE NON-NULL,
! IN WHICH CASE WE CAN GET THE NEXT RECORD WITHOUT
! RELEASING THE CURRENT BUCKET.
!
! 2. THIS ROUTINE MAY RETURN (ONLY ON AN ERROR) THE INPUT
! BUCKET DESCRIPTOR WITHOUT RELEASING IT. IT IS THEREFORE
! THE RESPONSIBILITY OF "POSRP" TO FLUSH THE CURRENT
! BUCKET.
!
! 3. IT MAY BE TRUE THAT THIS ROUTINE WILL POSITION TO
! A RECORD WHICH IS IN THE SAME BUCKET AS THE CURRENT
! RECORD. IN FACT, IT WILL ALWAYS BE TRUE EXCEPT IN THE
! CASE OF A $FIND RANDOM/$FIND SEQUENTIAL SEQUENCE (BECAUSE
! THE $FIND SEQ OPERATES ON THE NRP, NOT THE RP). IF SO,
! THEN THIS ROUTINE WILL ATTEMPT NOT TO UNLOCK THE CURRENT
! BUCKET IN THE PROCESS OF ACCESSING THE "NRP" RECORD.
GLOBAL ROUTINE POSRFA ( RECDESC, DATABD ) =
BEGIN
ARGUMENT (RECDESC,BASEADD);
ARGUMENT (DATABD,BASEADD);
MAP
RECDESC: POINTER,
DATABD: POINTER;
REGISTER
TEMPAC, ! TEMP REGISTER
RFA: FORMAT, ! TARGET RFA
RECORDPTR: POINTER; ! PTR TO TARGET RECORD
LOCAL
CURRENTBUCKET, ! # OF CURRENT BUCKET
LOCKFLAG, ! TRUE IF WE LOCK EACH BUCKET
SAVEDSTATUS, ! SAVE RESULTS OF LAST ROUTINE
FOUNDRFA, ! TRUE IF WE FOUND RECORD BY RFA
KEYPOINTER: POINTER; ! PTR TO SIDR KEY
TRACE ('POSRFA');
CHECKEXACTCOUNT;
%([ FETCH THE RFA VALUE FROM THE RECORD DESCRIPTOR ])%
RFA = .RECDESC [ RDRFA ];
LOOKAT (' TRY TO LOCATE RFA: ', RFA );
RECDESC [ RDRECPTR ] = ZERO;
%([ IF WE HAVE A CURRENT BUCKET, AND IF THE RFA WE ARE TRYING
TO LOCATE IS IN IT, THEN WE DON'T WANT TO UNLOCK THE BUCKET.
IF THERE IS NO CURRENT BUCKET, WE MUST LOCATE THE RFA AND
LOCK THE BUCKET WHEN WE DO SO. ])%
FOUNDRFA = FALSE; ! ASSUME WE DON'T FIND IT
IF ( NOT NULLBD ( DATABD ) ) ! IS THERE A CURRENT BUCKET?
AND
( BUCKETOFRFA ( .RFA ) IS .DATABD [ BKDBKTNO ] )
THEN %(WE ALREADY HAVE THE CORRECT BUCKET)%
BEGIN
RTRACE (%STRING(' RFA ON CURRENT BKT...',%CHAR(13),%CHAR(10)));
%([ NOW, TRY TO LOCATE THE RFA ON THE CURRENT BUCKET ])%
IF CALLSDATABKT (%(RD)% BPT ( RECDESC ),
%(BKT)% BPT ( DATABD ) ) ISNT FALSE THEN
FOUNDRFA = 1 ! GOT IT
END; %(OF IF WE HAVE THE RIGHT BUCKET)%
%([ AT THIS POINT, ONE OF THE FOLLOWING IS TRUE:
1. WE LOCATED THE RFA ON THE CURRENT BUCKET (FOUNDRFA=1)
2. THERE WAS NO CURRENT BUCKET
3. THE CURRENT BUCKET DID NOT CONTAIN THE RFA
FOR THE LAST 2 CONDITIONS, WE MUST RELEASE THE CURRENT BUCKET,
IF ANY, AND ATTEMPT TO LOCATE THE RFA DIRECTLY. ])%
IF .FOUNDRFA IS FALSE
THEN %(KEEP LOOKING)%
BEGIN
%([ RELEASE CURRENT BUCKET ])%
IF NOT NULLBD ( DATABD )
THEN
CALLPUTBKT ( %(NO)% PCI ( FALSE ),
%(BKT)% BPT ( DATABD ) );
%([ WE NOW MUST LOCATE THE RFA RECORD. IF WE ARE LOCKING,
THEN WE MUST ALSO INSURE THAT WE CAN SEARCH THE
BUCKET SAFELY. FOR PRIMARY KEYS, WE WILL LOCK THE
BUCKET BEFORE WE SEARCH IT. FOR SECONDARY KEYS, WE MUST
LOCK THE FILE'S INDEX STRUCTURE SINCE WE WILL BE
SEARCHING ONE OF THE SIDR BUCKETS. ])%
LOCKFLAG = FALSE; ! ASSUME NO LOCKING
IF LOCKING
THEN
BEGIN
IF PRIMARYKEY
THEN
LOCKFLAG = TRUE
ELSE
BEGIN
IF LOCKINDEX ( ENQBLK, ENQSHR ) IS FALSE THEN ! LOCK INDEX
RETURNSTATUS ( ER$EDQ )
END %(OF ELSE SECONDARY KEY)%
END; %(OF IF LOCKING)%
%([ LOCATE THE RECORD ])%
RECDESC [ RDRECPTR ] = ZERO; ! START AT TOP
IF (TEMPAC = CALLFBYRFA ( %(RD)% BPT ( RECDESC ),
%(BKT)% BPT ( DATABD ),
%(LOCK)% LCI ( LOCKFLAG ) ) ) IS FALSE THEN
RETURN .TEMPAC
END; %(OF IF FOUNDRFA IS FALSE)%
%([ WE HAVE NOW LOCATED THE CORRECT RFA. HOWEVER,
FOR PRIMARY KEYS, WE MUST CHECK THE RRV ADDRESS ALSO.
FOR SECONDARY KEYS, WE MUST COMPARE THE KEY STRING
TO INSURE THAT A NEW ID HASN'T BEEN ALLOCATED SINCE
WE LAST ACCESSED THIS RECORD (WHICH HAS NOW MOVED) ])%
RECORDPTR = .RECDESC [ RDRECPTR ]; ! GET PTR TO RECORD
IF PRIMARYKEY
THEN %(PRIMARY KEY)%
BEGIN
%([ CHECK FOR CORRECT RRV ])%
IF RRVFLAG ( RECORDPTR ) IS OFF ! THIS CAN'T BE AN RRV
THEN
IF .RECDESC [ RDRRV ] IS .RECORDPTR [ DRRRVADDRESS ]
THEN %(THIS IS THE PLACE)%
GOODRETURN;
END
ELSE %(SECONDARY KEYS)%
BEGIN
%([ THIS NEXT COMPARISON IS NECESSARY <<<ONLY>>>
IF THE ID'S IN THE SIDR BUCKET RUN OUT AND
THE FILE IS NOT RE-ORGANIZED. OTHERWISE,
IT IS SUPERFLUOUS. THUS, FOR NOW, WE WILL COMMENT
OUT THE CODE FOR SPEED. ])%
! RTRACE (' COMPARING KEY...?M?J');
! KEYPOINTER = .RECORDPTR + SIDRHDRSIZE;
! IF CALLCKEYKK ( %RD% BPT ( RECDESC ), ! ARE THE KEYS EQUAL?
! %PTR% LPT ( KEYPOINTER ) ) ISNT FALSE
!
! AND
!
! ( LSSFLAG ( RECDESC ) IS OFF )
! THEN %WE FOUND IT%
GOODRETURN
END; %(OF ELSE IF SECONDARY KEY)%
%([ WE COULDN'T FIND THE RECORD BY ITS RFA FOR SOME
REASON. SO, FLUSH THE BUCKET AND EXIT ])%
RTRACE (%STRING(' COULDNT FIND RFA RECORD...',%CHAR(13),%CHAR(10)));
CALLPUTBKT ( %(NO)% PCI ( FALSE ),
%(BKT)% BPT ( DATABD ) );
BADRETURN
END; %(OF POSRFA)%
! POSNEXT
! =======
! ROUTINE TO POSITION AN INDEXED FILE TO THE "NEXT" RECORD
! TO BE ACCESSED. THIS ROUTINE IS CALLED PRIMARILY
! WHEN A $FIND OR $GET SEQUENTIAL HAS BEEN DONE.
! IT THEN MUST POSITION TO THE CURRENT RECORD-POINTER
! POSITION IN THE FILE, AND THEN LOCATE THE FOLLOWING
! RECORD IN SEQUENCE.
!
! THERE IS A SPECIAL CASE CONDITION WHEN THE NRP
! IS ZERO (I.E., THIS IS THE FIRST $GET DONE AFTER
! THE CONNECT TO THE FILE). IN THAT CASE, THE FIRST
! NON-DELETED RECORD IN THE FILE SHOULD BE LOCATED
! AND RETURNED AS THE CURRENT POSITION. THE KEY
! STRING WHICH IS USED IN THIS CASE IS ALL ZERO (SINCE
! THE KEY BUFFER WAS CLEARED WHEN IT WAS ALLOCATED).
! INPUT:
! RECDESC RECORD DESCRIPTOR PACKET
! RFA RFA OF NRP DATA RECORD
! RRV ADDRESS OF DATA RECORD RRV
! USERPTR ADDRESS OF KEY STRING FOR CURRENT RECORD
! USERSIZE SIZE OF KEY STRING FOR CURRENT RECORD
! SIDRELEMENT OFFSET INTO CURRENT SIDR OF RECORD POINTER
!
! DATABD BUCKET DESCRIPTOR OF CURRENT BUCKET (IF ANY)
! OUTPUT:
! TRUE: RECORD LOCATED
! FALSE: NO RECORD POSITION FOUND
! BUSY
! NO MEMORY FOR BUCKETS
! NO NEXT RECORD FOUND (ALL DELETED)
!
! INPUT ARGUMENTS MODIFIED:
! RECORD DESCRIPTOR:
! RFA RFA OF CURRENT RECORD (UDR OR SIDR)
! NOTES:
!
! 1. THIS ROUTINE MAY RETURN A FALSE VALUE AND AN
! ALLOCATED BUCKET. IF SO, IT IS THE CALLER'S
! RESPONSILBILITY TO FLUSH THE BUCKET WHICH IS
! RETURNED.
!
! 2. PRIMARY DATA BUCKETS ARE LOCKED AS THEY ARE SKIPPED
! IF WE ARE USING THE PRIMARY KEY. SIDR BUCKETS ARE NOT
! LOCKED AND THE PRIMARY DATA BUCKETS POINTED TO BY THE
! THE SIDR'S AREN'T LOCKED EITHER (TO AVOID UNNECESSARY
! LOCKING) SINCE THE ENTIRE INDEX IS ALREADY LOCKED.
! ROUTINES CALLED:
! POSRP
GLOBAL ROUTINE POSNEXT ( RECDESC, DATABD ) =
BEGIN
ARGUMENT (RECDESC,BASEADD);
ARGUMENT (DATABD,BASEADD);
MAP
RECDESC: POINTER,
DATABD: POINTER;
REGISTER
TEMPAC, ! TEMPORARY AC
RECORDPTR: POINTER; ! POINTER TO CURRENT RECORD
EXTERNAL ROUTINE
POSRP; ! POSITION TO THE CURRENT RECORD
LOCAL
POINTERCOUNT, ! # OF ELEMENTS IN SIDR ARRAY
SIDRPTR: POINTER, ! PTR TO CURRENT SIDR
ARRAYPTR: POINTER, ! PTR TO CURRENT POINTER ARRAY
CURRENTOFFSET, ! OFFSET INTO CURRENT ARRAY
UDRBD: FORMATS[ BDSIZE ], ! BKT DESC FOR UDR BUCKET
RFAOFUDR, ! ADDRESS OF UDR
SAVEDSTATUS; ! RESULTS OF LAST SUBROUTINE CALL
LITERAL LOCKPRIMARY = 1, ! LOCK THE PRIMARY BUCKETS
DONTLOCK = FALSE; ! DON'T LOCK SECONDARY BUCKETS
LABEL SCANSIDR,LOOP2;
EXTERNAL ROUTINE
SKIPRECORD;
TRACE ('POSNEXT');
CHECKEXACTCOUNT;
%([ FIRST, POSITION TO THE RECORD WHICH REPRESENTS
THE NRP. IN OTHER WORDS, ATTEMPT TO POSITION TO THE
LOCATION WITHIN THE FILE AT WHICH WE CAN BEGIN OUR
SCAN OF THE DATA RECORDS. ])%
IF ( TEMPAC = CALLPOSRP ( %(RD)% BPT ( RECDESC ),
%(BKT)% BPT ( DATABD ) ) ) IS FALSE THEN
RETURN .TEMPAC;
%([ SINCE SIDR'S NEVER ARE ACTUALLY DELETED, WE MUST HAVE
FOUND THE CORRECT SIDR EITHER BY RFA OR BY KEY. THUS,
LET'S DO A QUICK CHECK TO MAKE SURE WE AREN'T AT THE END
OF A BUCKET ])%
%IF DBUG %THEN
IF PASTLASTFLAG ( RECDESC ) ISON THEN RMSBUG ( MSGFLAGS );
%([ IF THE LAST OPERATION WAS A $FIND,
THEN WE SHOULDN'T BE HERE ])%
IF .RST [ RSTLASTOPER ] IS C$FIND
THEN
RMSBUG ( MSGCANTGETHERE ); !*********
%FI
%([ SET UP THE RFA VALUE OF THE CURRENT RECORD ])%
RECORDPTR = .RECDESC [ RDRECPTR ]; ! FETCH PTR TO RECORD
RECDESC [ RDRFA ] = MAKERFA ( .DATABD [ BKDBKTNO ], .RECORDPTR [ DRRECORDID ] );
%([ WE ARE NOW POSITIONED AT THE RECORD WHICH MEETS THE
USER KEY SPECIFICATION. FOR PRIMARY KEYS, WE MUST POSITION
THRU THE RECORDS UNTIL WE GET AN RRV ADDRESS MATCH.
FOR SECONDARY KEYS, WE MUST SIMPLY COMPUTE THE OFFSET
INTO THE POINTER ARRAY WHERE OUR RFA IS ])%
IF PRIMARYKEY
THEN %(THIS IS A PRIMARY KEY)%
BEGIN
RTRACE (%STRING(' SCANNING UDRS...',%CHAR(13),%CHAR(10)));
%([ AT THIS POINT, THE RECORD WE FOUND HAS THE
KEY WHICH IS GREATER THAN OR EQUAL TO THE
KEY OF THE CURRENT RECORD. IF THE FILE
HAS DUPLICATES ALLOWED, THEN WE KNOW THAT THE
RFA'S MUST ALSO AGREE BECAUSE RECORDS ARE NEVER
SQUEEZED OUT FROM A FILE WITH DUPLICATES.
FOR NON-DUPLICATES FILES, WE KNOW THAT WE
HAVE FOUND A RECORD WITH THE SAME KEY VALUE
AS OUR LAST POSITION IN THE FILE. EVEN IF THIS
IS NOT THE ACTUAL RECORD THAT WE WERE POSITIONED
AT, (THE REAL ONE GOT DELETED AND A NEW ONE
WITH THE SAME KEY WAS INSERTED), IT IS STILL
THE ONE WE WANT BECAUSE A RECORD IS DENOTED
ONLY BY ITS KEY, NOT BY THE REST OF ITS CONTENTS. ])%
%([ THE LAST OPERATION WAS NOT A $FIND.
WE MUST CONTINUE TO SKIP RECORDS UNTIL
WE GET A NON-DELETED ONE. HOWEVER, IF
THIS IS THE FIRST TIME THRU THE LOOP
AND THE FIRST $FIND WE HAVE DONE (NRP=0),
THEN WE DONT WANT TO SKIP THE INITIAL
RECORD. ])%
INCR J FROM 1 TO PLUSINFINITY
DO
BEGIN
%([ THIS MUST NOT BE THE FIRST ITERATION THRU
THE LOOP IF THERE IS NO NRP, AND WE MUST
NOT HAVE REACHED A RECORD WITH A KEY .GTR.
THAN OUR SEARCH KEY. IF THIS IS TRUE, THEN
WE CAN SKIP THE CURRENT RECORD. ])%
IF ( ((.J ISNT 1) OR (.RECDESC [ RDRRV ] ISNT ZERO) )
AND
( LSSFLAG ( RECDESC ) IS OFF ) )
THEN
BEGIN
LOOKAT (' SKIPPING REC AT: ', RECDESC [ RDRECPTR ]);
IF (TEMPAC = CALLSKIPRECORD ( BPT ( RECDESC ),
BPT ( DATABD ),
PCI ( LOCKPRIMARY ) ) ) IS FALSE THEN
RETURN .TEMPAC
END; %(OF SKIPPING A RECORD)%
%([ CHECK THIS RECORD TO SEE IF DELETED ])%
IF CHKFLAG ( RECDESC [ RDSTATUS ], RDFLGDELETE) IS OFF
THEN %(USE THIS RECORD)%
GOODRETURN;
%([ CLEAR THE LESS-THAN FLAG SO WE WILL CONTINUE
WITH THE NEXT RECORD ])%
CLRFLAG ( RECDESC [ RDSTATUS ], RDFLGLSS )
END %(INCR J LOOP)%
END; %(IF PRIMARY KEY)%
%([ AT THIS POINT, WE MUST PROCESS THE SECONDARY KEY.
WE HAVE LOCATED THE SIDR EITHER BY ITS RFA OR BY ITS KEY VALUE.
WE MUST NOW SEARCH IT FOR THE RP WHICH WE HAVE.
NOTE THAT WE MUST FIND THIS RP (FOR DUPLICATE SIDR'S) BECAUSE A RECORD
POINTER IN A SIDR RECORD IS NEVER FLUSHED AWAY. ])%
%([ START OUR SEARCH AT THE APPROPRIATE RECORD POINTER ])%
CURRENTOFFSET = .RECDESC [ RDSIDRELEMENT ];
%([ IF THE CORRECT SIDR HAS BEEN COMPRESSED, THEN WE WILL
START AT THE TOP OF THE NEW SIDR (WHICH HAS A KEY GREATER
THAN THE OLD SIDR) ])%
IF LSSFLAG ( RECDESC ) ISON THEN CURRENTOFFSET = ZERO;
%([ SET UP SOME PTRS, CTRS, ETC. ])%
SIDRPTR = .RECDESC [ RDRECPTR ]; ! PTR TO SIDR
POINTERCOUNT = .SIDRPTR [ SIDRRECSIZE ] - .KDB [ KDBKSZW ] - .CURRENTOFFSET;
%([ CREATE A POINTER TO THE START -1 OF THE SIDR ARRAY ])%
ARRAYPTR = .SIDRPTR + SIDRHDRSIZE + .KDB [ KDBKSZW ] -1;! PTR TO ARRAY
RECORDPTR = .ARRAYPTR + .CURRENTOFFSET;
LOOKAT (' SIDRPTR: ', SIDRPTR );
LOOKAT (' POINTERCOUNT: ', POINTERCOUNT );
%([ HERE, WE HAVE LOCATED THE RFA IN THE SERIES OF SIDR
RECORDS. WE HAVE THE FOLLOWING VALUES:
RECORDPTR => CURRENT ARRAY ELEMENT
SIDRPTR => CURRENT SIDR
POINTERCOUNT = # OF PTRS REMAINING IN SIDR
])%
%([ THE LAST OPERATION WAS NOT A $FIND, SO LOCATE THE
NEXT NON-DELETED POINTER IN THE SIDR ARRAY ])%
LOOP2: BEGIN
REPEAT %(UNTIL WE GET A UDR)%
BEGIN
INCR J FROM 1 TO .POINTERCOUNT
DO
BEGIN
%([ INCREMENT PTR NOW ])%
INC ( RECORDPTR, 1 );
LOOKAT (' CHECKING SIDR AT: ', RECORDPTR );
%([ IS THE POINTER DELETED? ])%
IF NOT DELETEDRFA ( RECORDPTR )
THEN
BEGIN
RTRACE (%STRING(' RFA IS NOT DELETED...',%CHAR(13),%CHAR(10)));
%([ GET THE RFA FROM THE ARRAY FOR THE UDR ])%
RFAOFUDR = .RECORDPTR [ WHOLEWORD ] AND (NOT ALLRFAFLAGS );
RECDESC [ RDRFA ] = .RFAOFUDR;
IF CALLFBYRRV ( BPT ( RECDESC ),
LCT ( UDRBD ) ) ISNT FALSE
%([ COULD WE GET THIS UDR? ])%
THEN
BEGIN
LOOKAT (' FOUND UDR AT: ', RECDESC [ RDRECPTR ]);
%([ BUT, IS IT DELETED? ])%
IF CHKFLAG (RECDESC[RDSTATUS], RDFLGDELETE) IS OFF
THEN
BEGIN
LOOKAT (' UDR IS AT: ', RECDESC [ RDRECPTR ] );
%([ SET UP THE RFA OF THE CURRENT SIDR RECORD ])%
RECDESC [ RDRFA ] = MAKERFA ( .DATABD [ BKDBKTNO ], .SIDRPTR [ DRRECORDID ] );
%([ FLUSH THE SIDR BUCKET ])%
CALLPUTBKT ( %(NO)% PCI ( FALSE ),
%(BKT)% BPT ( DATABD ) );
%([ COMPUTE OFFSET OF POINTER ])%
RECDESC [ RDSIDRELEMENT ] = .RECORDPTR - .ARRAYPTR;
%([ MAKE THIS BKT CURRENT ])%
MOVEBKTDESC (%(FROM)% UDRBD, %(TO)% DATABD );
GOODRETURN
END; %(OF IF NOT DELTED)%
%([ RECORD WAS DELETED..])%
RTRACE (%STRING(' UDR IS DELETED',%CHAR(13),%CHAR(10)));
CALLPUTBKT ( PCI ( FALSE ),
LCT ( UDRBD ) )
END %(OF IF FBYRRV SUCCEEDED)%
END %(OF IF NOT DELETEDRFA)%
%([ WE COULDN'T GET THE UDR FOR SOME REASON.
WE SHOULD GO TO THE NEXT ELEMENT
IN THE SIDR. ])%
END; %(OF INCR J FROM 1 TO .POINTERCOUNT)%
%([ AT THIS POINT, WE WENT THRU THE ENTIRE
REST OF THE SIDR AND COULDN'T GET A
USEABLE DATA RECORD. SO, WE MUST SKIP TO
THE NEXT SIDR. NOTE THAT THIS MAY FAIL
IF ITS THE EOF, ETC. ])%
RECDESC [ RDRECPTR ] = .SIDRPTR; ! RESTORE PTR TO SIDR
IF ( TEMPAC = CALLSKIPRECORD (BPT ( RECDESC ),
BPT ( DATABD ),
PCI ( DONTLOCK ) )) IS FALSE
THEN RETURN .TEMPAC;
%([ NOW, SET UP SOME COUNTERS ETC. ])%
SIDRPTR = .RECDESC [ RDRECPTR ];
POINTERCOUNT = .SIDRPTR [ SIDRRECSIZE ] - .KDB [ KDBKSZW ];
ARRAYPTR = (RECORDPTR = .SIDRPTR + SIDRHDRSIZE -1 + .KDB [ KDBKSZW ]) ! **START AT 1ST RFA -1
END; %(OF REPEAT)%
END; %( OF LOOP2 )%
RMSBUG ( MSGCANTGETHERE )
END; %(OF POSNEXT)%
END
ELUDOM