Google
 

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