Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/rmsfnd.b36
There are 6 other files named rmsfnd.b36 in the archive. Click here to see a list.
%title 'F I N D E R -- $FIND service routines'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE finder (IDENT = '3.0'
		) =
BEGIN
!
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1984, 1986.
!	ALL RIGHTS RESERVED.
!
!	THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED  AND
!	COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND 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.  NO TITLE TO AND OWNERSHIP OF  THE
!	SOFTWARE IS HEREBY TRANSFERRED.
!
!	THE INFORMATION IN THIS SOFTWARE IS  SUBJECT  TO  CHANGE  WITHOUT
!	NOTICE  AND  SHOULD  NOT  BE CONSTRUED AS A COMMITMENT BY DIGITAL
!	EQUIPMENT CORPORATION.
!
!	DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF
!	ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!
!++
! FACILITY:	RMS
!
! ABSTRACT:
!
!	FINDER contains all routines which process
!	the $FIND service in RMS-20.
!
! ENVIRONMENT:	User mode, Top level
!
! AUTHOR: Ron Lusk , CREATION DATE:  1-Apr-83
!
! MODIFIED BY:
!
!	Ron Lusk, 7-Jul-83 : VERSION 2
! 01	-   Return relative record's page number in LSN if FB$SMU is set.
! 420	-   Use global addressing in fetching key buffer contents.
!       Andrew Nourse  Version 3
! 501   -   Implement remote FIND
! 504   -   Implement Image mode FIND
! 565	-   (RL) Return STV from FFF calls
!--

!
! TABLE OF CONTENTS
!
!
!	$FIND	    -	dispatcher for $FIND service
!	FINDASC	    -	$FIND for ASCII files
!       FINDIMA     -   $FIND for IMAGE files
!	FINDSEQ	    -	$FIND for Sequential files
!	FINDREL	    -	$FIND for Relative files
!	FINDIDX	    -	$FIND for Indexed files
!
!
! INCLUDE FILES:
!

REQUIRE 'rmsreq';

!
! MACROS:
!
!   None.
!
! EQUATED SYMBOLS:
!
!   None.
!
! OWN STORAGE:
!
!   None.
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
    F$Find;
%SBTTL '$FIND - $FIND dispatcher'

GLOBAL ROUTINE $find (rabblock, errorreturn) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	$FIND performs all processing of a $FIND macro.  It
!	is not called directly by any other routine within
!	RMS-20, but is called only from the primary RMS
!	dispatcher.
!
! FORMAL PARAMETERS
!
!	RABBLOCK	-   address of user Record Access Block
!		RABISI	-   Internal stream identifier
!		RABKBF	-   key buffer address (REL/IDX)
!		RABKRF	-   key of reference (IDX)
!		RABKSZ	-   size of key in buffer (IDX)
!		RABRAC	-   record access
!		RABRFA	-   record's file address (RFA access)
!		RABROP	-   record options
!		    RAH	-   Read-Ahead
!		    KGT	-   Key greater than (IDX)
!		    KGE	-   Key greater than or equal to (IDX)
!
!		    * RAB fields output *
!
!		RABBKT	-   relative record number of target (REL)
!		RABRFA	-   record's file address
!		RABSTS	-   status of operation
!		RABSTV	-   secondary status
!
!	ERRORRETURN	-   address of user error routine
!
! IMPLICIT INPUTS
!
!	?
!
! ROUTINE VALUE:
!
!	None, yet not novalue.
!
! SIDE EFFECTS:
!
!	?
!
!--

    BEGIN

    LOCAL
	!
	!	Data blocks for indexed files
	recdesc : BLOCK [rdsize],		! Record descriptor
	databd : BLOCK [bdsize];		! Bucket descriptor

    rmsentry ($find);
!+
!   Fetch the user's RAB and error address.
!-
    rab = .rabblock;				! Get RAB address
    erradr = .errorreturn;			!   and user error address
    rsetup (true);				! A $FIND is legal always


!+
!   Check for a remote file.  If it is use the DAP routine instead.
!-

    IF .Fst[Fst$v_Remote]
    THEN                                                                !m555
        Dap$Find( .Rab, .erradr )
    ELSE
!+
!   We now can dispatch to the correct routine to locate the
!   target record.  Notice that for all file organizations
!   except indexed, all parameters are stored in the Record
!   Status Table.  For indexed files, however, we must pass
!   a Record Descriptor and a Bucket Descriptor.  These
!   arguments are not used by this routine, but since they
!   are required for $GET, they will be passed fo FINDIDX.
!-

    CASE fileorg FROM 0 TO Fab$k_Idx OF
	SET

	[0] :                           ! Non-RMS file
            SELECT .Fst[Fst$h_File_Class] OF    		!a504 vv
                SET
                [0, Typ$k_Ascii]:
                    findasc ( true );                 ! ASCII           !m575
                [Typ$k_Image, Typ$k_Byte]:
                    findima ( true );                 ! IMAGE           !m575
                [OTHERWISE]:
                    BEGIN
                    F$Find( .Rab );                                     !m524 
		    usrstv = .rab [rab$h_stv];	! Return STV value	!A565

                    IF NOT $Rms_Status_Ok( .Rab )                       !a524
                    THEN Usererror( .Rab[Rab$h_Sts] );                  !a524
                    END;
                TES;                                             !a504 ^^

	[Fab$k_Seq] :
	    findseq ();				! Sequential

	[Fab$k_Rel] :
	    findrel ();				! Relative

	[Fab$k_Idx] :
	    findidx (recdesc, databd)		! Indexed
	TES;

    setsuccess;
    usrret ()					! Exit to user
    END;					! End of $FIND
%SBTTL 'FINDASC - $FIND for ASCII'

GLOBAL ROUTINE findasc ( eofcheck ) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Processes $FIND service for ASCII file.
!
! FORMAL PARAMETERS
!
!	EofCheck: Check for end-of-file if nonzero
!
! IMPLICIT INPUTS
!
!	RSTDATARFA  -	byte number of current record
!	RSTRSZ	    -	size in bytes of current record
!
! ROUTINE VALUE:
!
!	None.
!
! SIDE EFFECTS:
!
!	?
!
!--

    BEGIN

    LOCAL
	sizeoflastrecrd,
	temp;

    TRACE ('FINDASC');
!+
!   RFA access:
!-
![2] Using RFA from RAB, set up buffer, count, and pointers

    IF rfaadr
    THEN
	BEGIN

	LOCAL
	    pagenum,
	    rfanum,
	    pagebyte;

	! Clear End-Of-File, this is random access
	rst [rstflags] = .rst [rstflags] AND NOT flgeof;
	rst [rstdatarfa] = rfanum = .rab [rabrfa, 0];
	pagenum = .rfanum/ch_in_p;		! Get page number
	pagebyte = .rfanum MOD ch_in_p;		! and byte within page
	rst [rstnrp] = .pagenum;
	readbuffer ();
	! Read page containing start of record
	! Point page pointer to correct place in buffer
	rst [rstpagptr] = CH$PLUS (.rst [rstpagptr], .pagebyte);

	! Is RFA past end of file? If so, give EOF error

	IF .EofCheck AND (.rst [rstbytecount] LSS .pagebyte)           !m575
        THEN usererror (er$eof);	! Record not found

	! Update byte count
	rst [rstbytecount] = .rst [rstbytecount] - .pagebyte;
	RETURN true;
	END;

!+
!   SEQuential access:
!-
!+
!   If we are at EOF, then don't try finding a record.
!-

    IF .EofCheck AND endoffile THEN usererror (er$eof);                 !m575

!+
!   If the last RMS operation issued was a $FIND, or if the
!   last record fetched was too big for the user's buffer
!   (i.e., "partial" record), then we must skip a record and
!   position ourselves to the next one.  In all other cases
!   (i.e., the last JSYS was a $OPEN or $GET), we are
!   already positioned at the correct place.
!
!   This module also must insure that the current record's
!   starting address is maintained correctly.  This
!   procedure varies depending upon the current file
!   context.  For instance, if two successive $FINDs are
!   done, a record must be skipped and its length added to
!   the starting address of the last record.  If the last
!   record access was a "partial" record, the length of that
!   record must be added to its starting address, then the
!   rest of the record must be skipped and the amount that
!   was skipped also added into the current RFA address.
!
!   For normal conditions (i.e., a $FIND is done after a
!   successful $GET or $FIND), then the length of the last
!   record (i.e., current record to the user) must be added
!   to its starting byte number to produce the address of
!   the next record, which then immediately becomes the
!   current record.  This entire process must also be done
!   for sequenced files, except all bytes are in terms of
!   words and the line-number must be accounted for in
!   certain calculations.
!-

    IF (.rst [rstlastoper] EQL c$find) OR 	! If last RMS call was a $FIND
	(partialflag NEQ 0)			!   or last record was too big.
    THEN
	BEGIN					! To skip a record

	IF partialflag NEQ 0
	THEN 					! We must update current RFA
	    BEGIN
	    sizeoflastrecrd = .rst [rstrsz];	! Get last record's size
	    ! Compute start of this record
	    rst [rstdatarfa] = .rst [rstdatarfa] + .sizeoflastrecrd;
	    lookat ('	SIZEOFLAST: ', sizeoflastrecrd)
	    END;

	rst [rstrsz] = getascii (false);	! Skip a record
	clrflag (rst [rstflags], flgpartial);	! Clear the partial flag
	END;

!+
!   We must now update the RFA to point to the current
!   record's starting address.
!-
    rst [rstdatarfa] = 				! Compute start of next record
    .rst [rstdatarfa] + .rst [rstrsz];
!+
!   If this is a sequenced file, and if we need to update
!   the file pointer (such as on a $FIND-$FIND sequence),
!   then we must now move the file position to the next full
!   word in the file.
!-

    IF sequenced AND (chkflag (rst [rstflags], flgupdptr) NEQ 0)
    THEN
	BEGIN					! Move to next full word
	temp = (5 - .rst [rstdatarfa] MOD 5) MOD 5;
	rst [rstdatarfa] = .rst [rstdatarfa] + .temp;
	rst [rstbytecount] = .rst [rstbytecount] - .temp;
	temp = .rst [rstpagptr];		! Get sub-field

	IF .temp<30, 6> NEQ 36			! Word-aligned already?
	THEN
	    rst [rstpagptr] = POINT (.rst [rstpagptr] + 1, 36, 7);

!+
!   Clear the "update the pointer" flag.
!-
	clrflag (rst [rstflags], flgupdptr)
	END;

!+
!   Return RFA to user
!-
    rab [rabrfa, 0] = .rst [rstdatarfa];	![2] Return RFA to user
    RETURN true
    END;					! End of FINDASC
%SBTTL 'FINDIMA - $FIND for IMAGE'

GLOBAL ROUTINE findima ( EofCheck ) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Processes $FIND service for IMAGE file.
!
! FORMAL PARAMETERS
!
!	EofCheck: Check for end-of-file if nonzero
!
! IMPLICIT INPUTS
!
!	RSTDATARFA  -	byte number of current record
!	RSTRSZ	    -	size in bytes of current record
!
! ROUTINE VALUE:
!
!	None.
!
! SIDE EFFECTS:
!
!	?
!
!--

    BEGIN

    LOCAL
	sizeoflastrecrd,
	temp;

    TRACE ('FINDIMA');
!+
!   RFA access:
!-
![2] Using RFA from RAB, set up buffer, count, and pointers

    IF rfaadr
    THEN
	BEGIN

	LOCAL
	    pagenum,
	    rfanum,
            bytesperpage,
	    pagebyte;

	! Check if last oper was sequential write
        ! If so flush buffer
        IF (.rst[rst$v_last_operation] EQL C$Put)
        AND .rst[rst$v_last_sequential]
        THEN WriteBuffer();

	rst[rst$v_eof] = 0;        ! this is random access
	rst [rstdatarfa] = rfanum = .rab [rabrfa, 0];
        bytesperpage = %BPVAL/.Fst[Fst$h_Bsz]*pagesize;
	pagenum = .rfanum/.bytesperpage;		! Get page number
	pagebyte = .rfanum MOD .bytesperpage;		! and byte within page
	rst [rstnrp] = .pagenum;
	readbuffer ();
	! Read page containing start of record
	! Point page pointer to correct place in buffer
	rst [rstpagptr] = CH$PLUS (.rst [rstpagptr], .pagebyte);
	! Is RFA past end of file? If so, give EOF error

	IF .EofCheck AND (.rst [rstbytecount] LSS .pagebyte)              !m575
        THEN usererror (er$eof);	! Record not found

	! Update byte count
	rst [rstbytecount] = .rst [rstbytecount] - .pagebyte;
        
        rst[rst$v_last_sequential] = 0; ! This is not sequential
	RETURN true;
	END;


!+
!   SEQuential access:
!-
    rst[rst$v_last_sequential] = 1;     ! This is sequential           !a577

!+
!   If we are at EOF, then don't try finding a record.
!-

    IF .EofCheck AND EndofFile THEN usererror (er$eof);                !m575

!+
!   If the last RMS operation issued was a $FIND, or if the
!   last record fetched was too big for the user's buffer
!   (i.e., "partial" record), then we must skip a record and
!   position ourselves to the next one.  In all other cases
!   (i.e., the last JSYS was a $OPEN or $GET), we are
!   already positioned at the correct place.
!
!   This module also must insure that the current record's
!   starting address is maintained correctly.  This
!   procedure varies depending upon the current file
!   context.  For instance, if two successive $FINDs are
!   done, a record must be skipped and its length added to
!   the starting address of the last record.  If the last
!   record access was a "partial" record, the length of that
!   record must be added to its starting address, then the
!   rest of the record must be skipped and the amount that
!   was skipped also added into the current RFA address.
!
!   For normal conditions (i.e., a $FIND is done after a
!   successful $GET or $FIND), then the length of the last
!   record (i.e., current record to the user) must be added
!   to its starting byte number to produce the address of
!   the next record, which then immediately becomes the
!   current record.  This entire process must also be done
!   for sequenced files, except all bytes are in terms of
!   words and the line-number must be accounted for in
!   certain calculations.
!-

    IF (.rst [rstlastoper] EQL c$find) OR 	! If last RMS call was a $FIND
	(partialflag NEQ 0)			!   or last record was too big.
    THEN
	BEGIN					! To skip a record

	IF partialflag NEQ 0
	THEN 					! We must update current RFA
	    BEGIN
	    sizeoflastrecrd = .rst [rstrsz];	! Get last record's size
	    ! Compute start of this record
	    rst [rstdatarfa] = .rst [rstdatarfa] + .sizeoflastrecrd;
	    lookat ('	SIZEOFLAST: ', sizeoflastrecrd)
	    END;

	rst [rstrsz] = getimage (false);	! Skip a record
	clrflag (rst [rstflags], flgpartial);	! Clear the partial flag
	END;

!+
!   We must now update the RFA to point to the current
!   record's starting address.
!-
    rst [rstdatarfa] = 				! Compute start of next record
    .rst [rstdatarfa] + .rst [rstrsz];

!+
!   Return RFA to user
!-
    rab [rabrfa, 0] = .rst [rstdatarfa];	![2] Return RFA to user
    RETURN true
    END;					! End of FINDIMA
%SBTTL 'FINDSEQ - $FIND for sequential file'

GLOBAL ROUTINE findseq =

!++
! FUNCTIONAL DESCRIPTION:
!
!	FINDSEQ processes the $FIND service for RMS
!	sequential files.
!
!	This routine exits directly to the user on an error.
!
! FORMAL PARAMETERS
!
!	None.
!
! IMPLICIT INPUTS
!
!	RSTDATARFA  -	byte number of current record
!	RSTRSZ	    -	size in bytes of current record
!
! ROUTINE VALUE:
!
!	None, yet not NOVALUE.
!
! SIDE EFFECTS:
!
!	?
!
!--

    BEGIN

    LOCAL
	temp1,
	recordlength,
	crp : BLOCK [1],			! Byte number of current record
	rfapagenum,				! Page number of current record
	nrp,					! Byte number of next record
	bytesword,				! Number of bytes in one word
	header : BLOCK [1],			! Storage for record header
	checkpageflag,				! On for RFA addressing,
						!   off for sequential
	valid;					! Flag for exit from loop

    REGISTER
	tempac;

    TRACE ('FINDSEQ');
!+
!   For sequential access, we can  assume the next page exists  unless
!   the current record address points to  the top of a page, in  which
!   case we must check  for that page.  However,  for RFA or  relative
!   addressing, we must check if the target page exists because if the
!   file is only being read, we  will get an illegal instruction  trap
!   if the page doesn't exist.  We can also clear the user's RFA field
!   unless he is using RFA addressing.
!-
    checkpageflag = false;

    IF seqadr                                                         !m567
    THEN
	BEGIN
	rab [rabrfa, 0] = 0;			! Clear the RFA field
	tempac = .rst [rstnrp];			! Next record pointer

	IF (.tempac^w2p)^p2w EQL .tempac	! Top of new page
	THEN
	    checkpageflag = true;		! Check for EOF

	END
    ELSE 					! Must be sequential addressing
	checkpageflag = true;			! Check for RFA addressing

!+
!   This is the main loop.  It continues until any of the
!   following are found:
!
!	1)  Record unavailable
!	2)  EOF
!	3)  Valid record found
!
!-
    valid = false;				! Set flag as invalid

    WHILE .valid EQL false DO
	BEGIN
!+
!   Fetch the user's record-access parameter (RAC) and use
!   it to determine the location of the next record.
!
!-
!+
!   Save the current record address.
!-

	CASE recordaccess FROM RAB$K_SEQ TO RAB$K_BFT OF            !m570
	    SET
	    [RAB$K_SEQ,
             RAB$K_TRA] : tempac =.rst [rstnrp];   ! Get NRP for sequential
	    [RAB$K_KEY] : tempac =.UAddr(rab [rabkbf, 0]);  ! User's key buffer
	    [RAB$K_RFA] : 
!+
!   If the current record address is less than the address
!   of the first data record, or is greater than the maximum
!   RFA, then there is an error.
!-
                        BEGIN
                 	tempac = .rab [rabrfa, 0];      ! Get user's RFA

                        IF (.tempac LSS .fst [fstlobyte])  ! Must be in
                        OR	(.tempac GEQ bitn (8))     ! file data space
                        THEN usererror (er$rfa);           ! Bad RFA
                        END;

            [RAB$K_BLK,
             RAB$K_BFT]: Usererror( er$bug );   ! Should not get here
	    TES;

	crp = .tempac;
!+
!   Dequeue the current record.  Note that if a record is
!   "found" twice in succession, RMS will still perform the
!   $FINDs as two separate operations:  the record will be
!   unlocked and then locked again.
!-

	IF datalocked
        THEN unlock (rst [rstdatarfa]);	! Unlock the current record

!+
!   Fetch the record pointer and make it current.
!-
	rst [rstdatarfa] = .crp;		! Save record pointer for user
!+
!   If the current page is in our window, then we don't have
!   to call an external routine to get it.
!-
	rfapagenum = .crp [rfapage];

	IF (.currentwindow EQL 0) OR 		! There is no current bucket
	    (.currentfilepage NEQ .rfapagenum)
	THEN
	    BEGIN				! Get the new page

	    IF getwindow (.rfapagenum, 		! Page number
		    .checkpageflag)		! Page must exist
		EQL false
	    THEN
		BEGIN				! Page does not exist

		IF rfaadr
		THEN 				! RFA error
		    usererror (er$rfa)
		ELSE 				! End of file
		    doeof ()

		END;

	    END;

!+
!   Now, the page we want is in our window.  We must set up
!   a pointer to it in the RST.
!-
	tempac = (rst [rstpagptr] = (.curentbufferadr) + .crp [ofset]);
!+
!   The record is now available to us.  We must pick up the
!   record header to see if it is a valid record.
!-
	header = ..tempac;
!+
!   If the header is an end-of-page marker, then we need to
!   bump our pointer to the start of the next file page.
!   This condition should occur only if the file has the
!   FB$BLK attribute.
!-

	IF .header EQL eopmarker		! Check for end-of-page
	THEN
	    BEGIN				! Found end-of-page marker
	    rtrace ('	End-of-page marker found');
!+
!   For RFA addressing, we can give an immediate error.
!-

	    IF rfaadr THEN usererror (er$rfa);

	    IF blocked
	    THEN 				! We can bump the pointer
	    					!   to the next file page
		nrp = (.crp OR ofsetmask) + %O'1'	! Bump to next page
	    ELSE
		rmsbug (msgeop);		! End-of-page marker found

	    END
	ELSE
	    BEGIN
	    lookat ('	Header read =  ', header);
	    !
	    !	Check that undefined bits in header are off.
	    !

	    IF .header [rhdrundef] NEQ 0	! Check unused part of header
	    THEN
		usererror (er$rfa);

!+
!   We will now compute the starting byte number of the next
!   record.  We will do this by computing the number of full
!   words this record occupies and adding the size of the
!   record header.
!-
	    recordlength = sizeinwords (.header [rhdrsize], .fst [fstbsz]);
	    nrp = .crp + .recordlength + headersize;
	    lookat ('	Updated NRP = ', nrp);

!++
!   We must now check to see if this record actually exists,
!   or if it has been deleted sometime in the past.  Before
!   we can check the "valid" bit for sure, we must lock the
!   record so than no one else can come in an delete it
!   after we have already examined the deleted bit.
!   However, the overhead for locking the record is extreme.
!   Therefore, we will check the bit to see if the record
!   exists or not.  If so, we will lock the record and check
!   again.  If either check fails, the record has been
!   deleted.  If it is deleted after we have checked the bit
!   but before we can lock it, that's OK because we will
!   continue and the record will be unlocked during the next
!   pass through this loop.
!--

!+
!   First, check that this record has been written; that is,
!   if the "valid" bit is on.
!-

	    IF (.header AND rhdrvalid) EQL 0
	    THEN 				! Is probably the EOF
		BEGIN

		IF rfaadr THEN usererror (er$rfa);	! Bad RFA

		doeof ()			! Sequential access means EOF
		END;

	    IF (.header AND rhdrdelete) EQL 0
	    THEN
		BEGIN

		IF locking THEN lockrec (crp);	! Lock record

		header = .(.rst [rstpagptr])	! Re-fetch header
		END;

!+
!   We now must check the header again to make sure it's
!   still good.
!-

	    IF (.header AND rhdrdelete) EQL 0
	    THEN
		valid = true			! Leave the loop
	    ELSE 				! Record has been deleted
		BEGIN

		IF rfaadr THEN usererror (er$del)

		END

	    END;

!+
!   Update all data pages.
!-
	rst [rstrszw] = .recordlength;		! Save record size in words
	rst [rstrsz] = .header [rhdrsize];	! And in bytes

	IF chkflag (rab [rabrop, 0], ropnrp) NEQ 0
	THEN
	    rst [rstnrp] = .crp			! Cause sequential GET to
	    					!   always get found record
	ELSE

	    IF (seqadr) OR (currentjsys EQL c$get)	!
	    THEN
		rst [rstnrp] = .nrp;		! Update the NRP if

						!   sequential access-mode
	END;

    !+
    !   Fall thru as soon as a valid record is found.
    !-

    lookat ('	Record found at: ', crp);
    lookat ('	NRP = ', nrp);
!+
!   Set up the user's RFA because the operation was OK.
!-
    rab [rabrfa, 0] = .rst [rstdatarfa];
    RETURN true
    END;					! End of FINDSEQ
%SBTTL 'FINDREL - $FIND for relative file'

GLOBAL ROUTINE findrel =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Processor for $FIND service for a relative file.
!
!	If FB$SMU is set in the FAC field, then return the
!	page number containing the record in the LSN field
!	of the user's RAB.  Zero LSN if a SMU find fails.
!
! FORMAL PARAMETERS
!
!	None.
!
! IMPLICIT INPUTS
!
!	?
!
! ROUTINE VALUE:
!
!	None.
!
! SIDE EFFECTS:
!
!	?
!
!--

    BEGIN

    LOCAL
	crp,
	tempnrp,
	header : BLOCK [1],
	temp,
	currentemtpage,				! Page number already checked
						!   to see if it exists
	valid,
	bytenum : BLOCK [1];

    REGISTER
	tempac;					! AC for temporary calculations

    TRACE ('FINDREL');
!+
!   Especially for FB$SMU, zero the LSN field of the RAB.
!-

    IF (.fab [fabfac, 0] AND fb$smu) NEQ 0	! SMU set?
    THEN
	rab [rablsn, 1] = 0;			! Zero the LSN

!+
!   Loop until a valid record is found.
!-
    valid = false;				! Assume record is not valid
    currentemtpage = 0;				! Clear this value
!+
!   In this loop, we will update the user's permanent NRP
!   only when a good record is found.  This is to avoid the
!   situation which would arise if the user tried to read a
!   record, when he was already at the last record in the
!   file.  In such a case, it is important that his NRP not
!   be changed from what it was before he attempted to read
!   the record.  There is a small drawback to this
!   technique, though.  If the user tries to read a record,
!   and the only one on thecurrent page is locked by
!   someone else, he will get an error message (as he
!   should), but his NRP will not have been changed from
!   what it was before he did the $GET.
!-
    tempnrp = .rst [rstnrp];			! Don't update real NRP until
    						!   operation succeeds

    WHILE .valid EQL false DO
	BEGIN
!+
!   Fetch the address of the target record, which depends on
!   the user's record-access (RAC) field value.
!-
	crp = (CASE recordaccess FROM racseq TO racrfa OF
	    SET
	    [racseq] : .tempnrp;		! Sequential (CRP = NRP)!M420
	    [rackey] : 				! Key retrieval		!M420
		BEGIN				! Fetch key value	!A420

		LOCAL 				!			!A420
		    kbuf;			! For building global	!A420

		kbuf = .rab [rabkbf, 0];	! User's key buffer	!A420

		IF .kbuf<lh> EQL 0		! Local address?	!A420
		THEN 				!			!A420
		    kbuf = .kbuf OR .blksec;	! Yes - build global	!A420

		..kbuf				! Return key value	!A420
		END;				!			!A420
	    [racrfa] : .rab [rabrfa, 0];	! RFA (CRP = RFA)	!M420
	    TES);
!+
!   Unlock the current record.
!-

	IF datalocked THEN unlock (rst [rstdatarfa]);

!+
!   Store the current record number in the RST.
!-
	rst [rstdatarfa] = .crp;		! Set CRP in user's RAB
!+
!   Find the starting byte address of this record.
!-

	IF (bytenum = numbertorfa (.crp)) EQL false
	THEN
	    BEGIN				! Record number was beyond MRN
!+
!   The record number of the target record was greater than
!   the maximum record number of the file.  If the user was
!   processing the file sequentially, then he should get an
!   EOF error; otherwise, he should get a record-not-found
!   error.
!-

	    IF seqadr THEN doeof ();

	    usrsts = er$key;			! Assume key error

	    IF rfaadr THEN usrsts = er$rfa;

	    usrerr ()				! Exit to user
	    END;

!+
!   We must now position to the target record.  However, we
!   must also check to see if the page exists.  If not, then
!   we may be through (if key access is being user).  If it
!   does exist, then we can go ahead and read it.
!-

	IF gtbyte (.bytenum, 			! RFA address
		true)				! Abort if non-existent
	    EQL false
	THEN
	    BEGIN				! Found a non-existent page

	    IF ( NOT seqadr)			! Record not found?
	    THEN
		usererror (er$rnf);

!+
!   This page is non-existent.  This could be caused either
!   by a sparse file, or by the true last page in the file.
!   If the file is sparse (there is more to come), then we
!   will continue to process it.  But if we have reached the
!   last page in the file, we must give an EOF error return.
!-

	    IF (tempac = .bytenum [rfapage]) NEQ (.currentemtpage)
	    THEN
		BEGIN				! We must check this page
		tempac = nextpage (.fst [fstjfn], .tempac);

		IF .tempac EQL false
		THEN
		    doeof ()			! If no more pages, it's EOF
		ELSE
		    currentemtpage = .tempac;	! Remember this page

		END

	    END
	ELSE
	    BEGIN
	    header = .(.rst [rstpagptr]);	! Fetch header

	    IF .header EQL eopmarker THEN rmsbug (msgptr);	! Bad header found

	    IF (.header [rhdrundef] NEQ 0) THEN usererror (er$rfa);	! Bad RFA

!+
!   Check to see if this record has been written.
!-

	    IF (.header AND rhdrvalid) EQL 0
	    THEN 				! The record was never created
		BEGIN
		rab [rabrfa, 0] = 0;		! Zap RFA

		IF NOT seqadr THEN usererror (er$rnf);

		END
	    ELSE 				! The record was written once
		BEGIN

		IF (.header AND rhdrdelete) EQL 0
		THEN
		    BEGIN

		    IF locking THEN lockrec (crp);

		    header = .(.rst [rstpagptr])
		    END;

!+
!   Recheck the record header.
!-

		IF (.header AND rhdrdelete) EQL 0	! Check delete bit
		THEN
		    valid = true		! Set flag so we'll fall thru
		ELSE 				! The record is deleted
		    BEGIN
!+
!   Decide what to do depending on RAC value.
!-

		    CASE recordaccess FROM 0 TO 2 OF
			SET

			[0] :
			    0;			! Sequential--do nothing

			[1] :
			    usererror (er$rnf);	! Key

			[2] :
			    usererror (er$del)	! RFA
			TES;

		    rab [rabrfa, 0] = 0
		    END

		END

	    END;

	lookat ('	Record header: ', header);
!+
!   Update user's parameter block.
!-

	IF (seqadr) OR (currentjsys EQL c$get)	!
	THEN
	    tempnrp = .crp + 1;			! Update loop variable to CRP+1

!+
!   Store the size in bytes and words of this record.
!-
	rst [rstrsz] = .header [rhdrsize];	! Save size of this record
	rst [rstrszw] = sizeinwords (.rst [rstrsz], .fst [fstbsz])
	END;

    IF (chkflag (rab [rabrop, 0], ropnrp) NEQ 0) AND 	! NRP?
	(currentjsys EQL c$find)		!   and $FIND?
    THEN
	rst [rstnrp] = .crp			! Make sequential GET to
						!   always be found record
    ELSE

	IF (seqadr) OR (currentjsys EQL c$get)	!
	THEN
	    rst [rstnrp] = .crp + 1;		! Update the NRP if sequential

    						!   access-mode
!+
!   Store the number of the current record in the RABBKT
!   field.  Note that if there is an error later during the
!   processing of this record, the BKT field will still
!   contain the number of the target record.  Thus, users
!   should not assume that a non-zero record number in BKT
!   reflects a successful operation.
!-
    rab [rabrfa, 0] = (rab [rabbkt, 0] = .crp);
!+
!   If we are doing a $FIND with FB$SMU set, return
!   the record's page number in the relative file
!   so LIBOL can do some locking.
!-

    IF (.fab [fabfac, 0] AND fb$smu) NEQ 0	! SMU in progress?
    THEN
	rab [rablsn, 1] = .bytenum [rfapage];	! Return the page number

    RETURN true
    END;					! End of FINDREL
%SBTTL 'FINDIDX - $FIND for ISAM file'

GLOBAL ROUTINE findidx (			! Find indexed record
    recdesc : REF BLOCK, 			! Record descriptor
    databd : REF BLOCK				! Bucket descriptor
    ) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Routine to perform the $FIND service for an indexed
!	file.  This routine is called also by the $GET
!	processor in order to position to the correct
!	record.
!
!	If there is an error during this routine, it will
!	not return but will exit directly to the user.
!
! FORMAL PARAMETERS
!
!	RECDESC	    -	Record descriptor packet
!	    RFA	    -	RFA of target record (returned)
!	    RRV	    -	RRV address of target record (returned)
!
!	DATABD	    -	Data bucket descriptor, all fields
!			returned.
!
! IMPLICIT INPUTS
!
!	RAB	    -	User's Record Access Block
!	    RABRAC  -	Record access value
!	    RABKRF  -	Key of reference
!
! ROUTINE VALUE:
!
!	None.
!
! SIDE EFFECTS:
!
!	?
!
!--

    BEGIN

    LOCAL
	bdptr : REF BLOCK,			! Current bucket descriptor
	savedstatus,				! Store status here
	nextbucket,				! Next bucket for read-ahead
	bucketsize,				! Size of a bucket
	tptr : REF BLOCK,			! Temp pointer
	nextbd : BLOCK [bdsize],		! Descriptor of next bucket
	lockaccess,				! Shared/exclusive
	recordptr : REF BLOCK;			! Current record

    TRACE ('FINDIDX');
    kdb = .fst [fstkdb];			! Set up primary KDB
    !
    !   Clear some fields in the Record Descriptor which we will
    !   pass to the lower level routines.
    !
    recdesc [rdstatus] = 0;			! Clear status bits
    recdesc [rdflags] = rdflghorizok;		! Horizontal search OK
    fetchcurrentbkt (databd);			! Set current bucket to null
!+
!   Dispatch to the correct routine.
!-

    IF seqadr
    THEN
	BEGIN					! Sequential access
	setnullbd (cbd);			! Indicate no current bucket
	savedstatus = fidxseq (.recdesc, .databd);
	END
    ELSE
	BEGIN					! Random access
!+
!   We can release the current bucket because since this is
!   a random access, it is unlikely that both the target
!   record and the current record are in the same bucket.
!-
	releascurentbkt;
!+
!   We must now lock the entire index structure so that we
!   can move around the file at will until we reach the
!   target record.
!-

	IF locking
	THEN
	    BEGIN

	    IF lockindex (enqblk, enqshr) EQL false	! Wait, shared
	    THEN
		returnstatus (er$edq);		! Shouldn't fail

	    END;

!+
!   Dispatch to correct routine depending on record access.
!-

	IF keyadr THEN savedstatus = fbykey (.recdesc, .databd) ELSE savedstatus = frecrfa (.recdesc, .databd)

	;
	END;

!+
!   At this point, we have either succeeded or failed in
!   our efforts to locate the next record.  However, in
!   either case, we may have locked the index of the file
!   which now must be unlocked.  Also, if we located the
!   target record, we must lock its bucket if we have not
!   already done so.
!-

    IF locking AND .savedstatus NEQ false
    THEN
	BEGIN					! Do some unlocking & locking
!+
!   Lock the bucket if it is not locked.
!-

	IF ( NOT bktlocked (databd))
	THEN
	    BEGIN				! Lock the bucket descriptor
	    lockaccess = enqshr;		! Assume read-only

	    IF NOT inputmode THEN lockaccess = enqexc;

	    rtrace ('	Locking the bucket...');

	    IF lockbd (databd, enqaa, .lockaccess) EQL false
	    THEN
		BEGIN
		rtrace ('	***Lock already locked');
		savedstatus = false;		! Return failure
		putbkt (false, 			! No update
		    .databd);			! Bucket
		usrsts = er$rlk			! Set error code
		END

	    END;

!+
!   It is possible that another user could have deleted this
!   record between the time we found it and locked it.  If
!   this is the case, unlock the buffer and say the record
!   was never found.
!-
	recordptr = .recdesc [rdrecptr];

	IF deleteflag (recordptr) EQL 1
	THEN
	    BEGIN				! Record actually deleted
	    rtrace ('	Unlocking bucket - record deleted!');
	    unlockbucket (.databd [bkdbktno]);
	    savedstatus = false;		! Return failure
	    usrsts = er$rnf			! Set error code
	    END;

	END;

!+
!   Unlock the index structure, if necessary.
!-

    IF indexlocked THEN unlockindex;

!+
!   We have now done the $FIND.  Was it OK?
!-

    IF .savedstatus EQL false
    THEN
	BEGIN
	rtrace ('	Error in $FIND...');
	!
	!   Clear the user's RFA and our record pointer.
	!
	rst [rstdatarfa] = 0;

	IF NOT rfaadr THEN rab [rabrfa, 0] = 0;

	usrerr ()				! Exit to user
	END;

!+
!   The $FIND was successful.  We must now save the current
!   RFA and the current bucket.  However, if we are
!   currently processing a $GET macro, then we should return
!   without performing the normal clean-up operations, which
!   will be done in the $GET routine.
!-
    setcurrentbkt (databd);			! SAVE CURRENT BKT
!+
!   Save the pointer to the current record and set the
!   record size of this record (this is used only on $UPDATE
!   to check if the record size has been changed by the
!   user.  If record-length modification is supported, then
!   this operation is unnecessary.
!-
    rst [rstpagptr] = (recordptr = .recdesc [rdrecptr]);

    IF fixedlength				! What format?
    THEN
	rst [rstrsz] = .fst [fstmrs]		! Get record size from FST
    ELSE
	rst [rstrsz] = .recordptr [drrecsize];	! Get it from the record

    rst [rstrszw] = sizeinwords (.rst [rstrsz], .fst [fstbsz]);

    IF currentjsys EQL c$get THEN RETURN;	! Leave if we are $GETting

!+
!   Update the Next-Record-Pointer data in the RST.
!-
    setnrp (.recdesc, .databd);			! Update data base
!+
!   Set up the RFA in the user's RAB.
!-
    rab [rabrfa, 0] = .recdesc [rdrrv];
    RETURN;
    END;					! End of FINDIDX

END						! End of Module FINDER

ELUDOM