Trailing-Edge
-
PDP-10 Archives
-
cuspbinsrc_2of2_bb-fp63b-sb
-
10,7/rms10/rmssrc/rmsfnd.b36
There are 6 other files named rmsfnd.b36 in the archive. Click here to see a list.
MODULE FINDER =
BEGIN
GLOBAL BIND FINDV = 1^24 + 0^18 + 13; !EDIT DATE: 7-SEP-78
%([
FUNCTION: THIS MODULE CONTAINS ALL ROUTINES WHICH PROCESS
THE $FIND MACRO IN RMS-20.
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
======= ========
$FIND DISPATCHER FOR $FIND MACRO
FINDASC PROCESSES $FIND FOR ASCII FILES
FINDSEQ PROCESSES $FIND FOR SEQUENTIAL FILES
FINDREL PROCESSES $FIND FOR RELATIVE FILES
FINDIDX PROCESSES $FIND FOR INDEXED FILES
REVISION HISTORY:
EDIT WHO DATE PURPOSE
==== === ==== =======
1 JK 5-AUG-76 NEW ASCII CHANGES.
2 SB 29-SEP-76 PUT REL RECORD # IN BKT FIELD ON FIND
3 SB 1-OCT-76 ADD CHECK FOR UPDPTR BIT IN FINDASC
4 SB 3-OCT-76 FIX BUG IN EDIT 2 (ZAP USER'S RFA)
5 SB 6-NOV-76 ADD RHDRDELETE BIT IN SEQ/REL REC HEADER
6 SB 1-MAR-77 PUT IN READ-AHEAD
7 SB 11-MAR-77 ACCOUNT FOR CHECK-BYTE
8 SB 23-MAR-77 UNDO EDIT 7
********** CODE FREEZE FOR RMS-20 RELEASE 1 ************
9 SB 25-MAR-77 CALL GTBYTE ONLY IF NEC IN FINDSEQ
10 SB 5-APR-77 SET UP RSZW FOR RELATIVE FILES, SPEED IT UP
*************************************************
* *
* NEW REVISION HISTORY *
* *
*************************************************
PRODUCT MODULE SPR
EDIT EDIT QAR DESCRIPTION
====== ====== ===== ===========
16 11 11856 A GET PAST THE LAST RECORD IN A SEQUENTIAL FILE
WILL PRODUCE EITHER: 1. A NEW PAGE IN THE FILE
(READ/WRITE ACCESS) AT CLOSE TIME, OR 2. AN
IMMEDIATE ILLEGAL MEMORY READ INTERRUPT (READ
ACCESS ONLY); IF THE LAST RECORD ENDS IN THE
LAST WORD OF THE LAST PAGE OF THE FILE.
20 12 12112 A RACE PROBLEM EXISTS BETWEEN THE TIME AN INDEXED
RECORD IS FOUND, AND LOCKED, ALLOWING SOME OTHER
USER TO POSSIBLY DELETE THE RECORD.
****************** Start RMS-10 V1.1 *********************
********************* TOPS-10 ONLY ***********************
PRODUCT MODULE SPR
EDIT EDIT QAR DESCRIPTION
====== ====== ===== ===========
100 13 Dev Make declarations for routine names
be EXTERNAL ROUTINE so RMS will compile
under BLISS V4 (RMT, 10/22/85).
***** END OF REVISION HISTORY *****
])%
%([ EXTERNAL DECLARATIONS ])%
EXTERNAL ROUTINE
CRASH,
GETWINDOW,
DOEOF,
DUMP,
NUMBERTORFA,
GETASCII,
GTBYTE,
LOCKIT,
! MAPIT,
! MOVEASCII,
RSETUP;
%([ ERROR MESSAGES REFERENCED WITHIN THIS MODULE ])%
EXTERNAL
MSGFAILURE, ! ROUTINE FAILURE
! MSGUNLOCKED, ! RECORD IS UNLOCKED
MSGCANTGETHERE, ! BAD CONTROL FLOW
MSGKEY, ! KEY ADDRESSING NOT DETECTED
MSGPTR, ! BAD POINTER RETURNED
MSGEOP; ! END OF PAGE FOUND
FORWARD ROUTINE FINDASC, ! FORWARD DECLARATIONS
FINDREL,
FINDSEQ;
REQUIRE 'RMSREQ';
EXTDECLARATIONS;
! $FIND
! =====
! PROCESSOR FOR $FIND MACRO.
! THIS ROUTINE PREFORMS 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.
!
! FORMAT OF THE $FIND MACRO:
!
! $FIND <RAB-NAME> [,<ERROR-ADDRESS>]
!
! RAB FIELDS USED AS INPUT TO $FIND:
!
! ISI INTERNAL STREAM IDENTIFIER
! KBF KEY BUFFER ADDRESS (RELATIVE/INDEXED)
! KRF KEY OF REFERENCE (INDEXED)
! KSZ SIZE OF KEY IN BUFFER (INDEXED)
! RAC RECORD ACCESS
! RFA RECORD'S FILE ADDRESS
! ROP RECORD OPTIONS
! RB$RAH READ-AHEAD
! RB$KGT KEY IS GREATER THAN (INDEXED)
! RB$KGE KEY IS GREATER THAN OR EQUAL TO (INDEXED)
! RAB FIELDS WHICH ARE RETURNED BY $FIND:
!
! BKT RELATIVE RECORD NUMBER OF TARGET RECORD (RELATIVE)
! RFA RECORD'S FILE ADDRESS
! STS STATUS OF OPERATION
! STV ADDITIONAL STATUS INFORMATION
! INPUT:
! ADDRESS OF USER RECORD BLOCK ( RAB )
! ADDRESS OF USER ERROR ROUTINE
! OUTPUT:
! <STATUS FIELD>
! GLOBALS USED:
! FINDASC
! FINDREL
! FINDSEQ
GLOBAL ROUTINE %NAME('$FIND') ( BLOCK, ERRORRETURN ) =
BEGIN
ARGUMENT (BLOCK,BASEADD);
ARGUMENT (ERRORRETURN,BASEADD);
LOCAL
%IF INDX %THEN
RECDESC: FORMATS[ RDSIZE ], ! RECORD DESCRIPTOR FOR INDEXED FILES
%FI
DATABD: FORMATS[ BDSIZE ]; ! BUCKET DESCRIPTOR
%IF INDX %THEN
EXTERNAL ROUTINE
FINDIDX;
%FI
RMSENTRY ( $FIND );
%([ FETCH THE USER'S RAB AND ERROR ADDRESS ])%
RAB = .BLOCK; ! GET RAB ADDRESS
ERRADR = .ERRORRETURN; ! AND USER ERROR ADDRESS
CALLRSETUP ( PCI (TRUE )); ! A $FIND IS LEGAL ALWAYS
%([ WE NOW CAN DISPATCH TO THE CORRECT ROUTINE TO
LOCATE THE TARGET RECORD. NOTICE THAT FOR ALL
FILE ORGANIZATIONS EXCEPT INDEXED, ALL PARAMATERS
ARE STORED IN THE RST. HOWEVER, FOR INDEXED FILES,
WE MUST PASS A RECORD DESCRIPTOR PACKET AND A
BUCKET DESCRIPTOR. THESE ARGUMENTS ARE NOT USED BY
THIS ROUTINE, BUT SINCE THEY ARE REQUIRED FOR $GET,
THEY WILL BE PASSED TO FINDIDX. ])%
CASE FILEORG FROM 0 TO 3 OF
SET
[0]: %( ASCII )% CALLFINDASC;
[1]: %( SEQ )% CALLFINDSEQ;
[2]: %( REL )% CALLFINDREL;
%IF INDX %THEN
[3]: %( IDX )% CALLFINDIDX ( LCT ( RECDESC ), LCT ( DATABD ) )
%FI
TES; %( END OF CASE FILORG )%
SETSUCCESS;
USEREXIT %( EXIT TO USER )%
END; %( OF $FIND )%
! FINDASC
! ======
! PROCESSES $FIND MACRO FOR ASCII FILE
! INPUT:
! <NONE>
! OUTPUT:
! <NONE>
! IMPLICIT INPUTS:
!
! RSTDATARFA BYTE NUMBER OF CURRENT RECORD
! RSTRSZ SIZE IN BYTES OF CURRENT RECORD
!
! GLOBALS USED:
! GTBYTE
! SKIP
GLOBAL ROUTINE FINDASC =
BEGIN
LOCAL
SIZEOFLASTRECRD,
TEMP;
TRACE ( 'FINDASC' );
%([ IF WE ARE AT EOF, THEN FORGET THE WHOLE THING ])%
IF ENDOFFILE THEN ERROR ( ER$EOF );
%( [ IF THE LAST RMS OPERATION ISSUED WAS A
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 AN 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 "$FIND"'S 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.
THE FOLLLOWING FIELDS WITHIN THE RST ARE USED BELOW:
RSTDATARFA STARTING BYTE # OF CURRENT RECORD
RSTRSZ SIZE IN ASCII BYTES OF CURRENT RECORD
=====
])%
IF ( .RST [ RSTLASTOPER ] IS C$FIND ) ! IF LAST RMS CALL WAS A $FIND
OR
( PARTIALFLAG ISON ) ! OR LAST RECORD WAS TOO BIG...
THEN
BEGIN %( TO SKIP A RECORD )%
IF PARTIALFLAG ISON
THEN %(WE MUST UPDATE CURRENT RFA)%
BEGIN
SIZEOFLASTRECRD = .RST [ RSTRSZ ]; ! GET LAST RECORD'S SIZE
RST [ RSTDATARFA ] = .RST [ RSTDATARFA ] + .SIZEOFLASTRECRD; ! COMPUTE START OF THIS RECORD
LOOKAT ( ' SIZEOFLAST: ', SIZEOFLASTRECRD )
END; %( OF IF PARTIALFLAG ISON )%
RST [ RSTRSZ ] = CALLGETASCII ( PCI ( FALSE )); ! SKIP A RECORD
CLRFLAG ( RST [ RSTFLAGS ], FLGPARTIAL ); ! CLEAR THE PARTIAL FLAG
END; %( OF IF LASTOPER = FIND OR PARTIALFLAG )%
%([ WE MUST NOW UPDATE THE RFA TO POINT TO THE CURRENT
RECORD'S STARTING ADDRESS ])%
RST [ RSTDATARFA ] = .RST [ RSTDATARFA ] + .RST [ RSTRSZ ]; ! COMPUTE START OF NEXT RECORD
%([ 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 ) ISON )
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 PTR" FLAG ])%
CLRFLAG ( RST [ RSTFLAGS ], FLGUPDPTR )
END;
GOODRETURN
END; %( OF FINDASC )%
! FINDSEQ
! ======
! PROCESSES $FIND MACRO FOR SEQUENTIAL FILE
! INPUT:
! <NONE>
! OUTPUT:
! <NONE>
! IMPLICIT INPUTS:
!
! RSTDATARFA BYTE NUMBER OF CURRENT RECORD
! RSTRSZ SIZE IN BYTES OF CURRENT RECORD
! GLOBALS USED:
! GTBYTE
! DUMP
! LOCKIT
! NOTES:
!
! 1. THIS ROUTINE EXITS DIRECTLY TO THE USER ON AN ERROR.
GLOBAL ROUTINE FINDSEQ =
BEGIN
LOCAL
TEMP1,
RECORDLENGTH,
CRP: FORMAT, ! BYTE NUMBER OF CURRENT RECORD
RFAPAGENUM, ! PAGE NUMBER OF THE CURRENT RECORD
NRP, ! BYTE NUMBER OF NEXT RECORD
BYTESWORD, ! # OF BYTES IN ONE WORD
HEADER: FORMAT, ! STORAGE FOR RECORD HEADER
CHECKPAGEFLAG, ! ON FOR RFA ADDRESSING, OFF FOR SEQUENTIAL
VALID; ! FLAG FOR EXIT FROM LOOP
REGISTER TEMPAC;
TRACE ( 'FINDSEQ' );
!** [16] ROUTINE:FINDSEQ, AT LINE 7615, EGM, 27-JUL-78
%([16])% %([ FOR SEQUENTIAL ACCESS, WE CAN ASSUME THE NEXT PAGE EXISTS )%
%([16])% %( UNLESS THE CURRENT RECORD ADDRESS POINTS TO THE TOP OF )%
%([16])% %( A PAGE, IN WHICH CASE WE MUST CHECK FOR THAT PAGE )%
%([16])% %( HOWEVER, FOR RFA 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'R RFA FIELD UNLESS HE
IS USING RFA ADDRESSING ])%
CHECKPAGEFLAG = FALSE;
IF RFAADR
THEN
CHECKPAGEFLAG = TRUE ! CHECK FOR RFA ADDRESSING
!** [16] ROUTINE:FINDSEQ, AT LINE 7626, EGM, 27-JUL-78
%([16])% ELSE %(MUST BE SEQUENTIAL ADDRESSING)%
%([16])% BEGIN
%([16])% RAB [ RABRFA ] = ZERO; ! CLEAR THE RFA FIELD
%([16])% TEMPAC = .RST [ RSTNRP ]; ! NEXT RECORD POINTER
%([16])% IF (.TEMPAC ^ W2P) ^ P2W EQL .TEMPAC ! TOP OF NEW PAGE
%([16])% THEN
%([16])% CHECKPAGEFLAG = TRUE; ! CHECK FOR EOF
%([16])% END; %(OF ELSE MUST BE SEQ ADRESSING)%
%( [ 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 IS FALSE DO
BEGIN %( TO FIND A RECORD )%
%([ FETCH THE USER'S RECORD-ACCESS PARAMETER (RAC)
AND USE IT TO DETERMINE THE LOCATION OF THE
NEXT RECORD. ])%
%( SAVE THE CURRENT RECORD ADDRESS )%
IF SEQADR
THEN
TEMPAC = .RST [ RSTNRP ] ! GET NRP
ELSE %(MUST BE RFA ADDRESSING)%
BEGIN
TEMPAC = .RAB [ RABRFA ]; ! GET USER'S 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. THIS CHECK SHOULD NEVER FAIL UNLESS
RFA ADDRESSING WAS BEING USED ])%
IF ( .TEMPAC LSS .FST [ FSTLOBYTE ] ) ! MUST BE IN FILE DATA SPACE
OR
( .TEMPAC GEQ BITN ( 8 ) ) THEN USERERROR ( ER$RFA ); ! CHECK RFA
END; %(OF ELSE MUST BE RFA ADDRESSING)%
CRP = .TEMPAC;
%( [ DEQ CURRENT RECORD - NOTE THAT IF A
RECORD IS "FOUND" TWICE IN SUCCESSION, IT WILL
BE TREATED AS SEPARATE OPERATIONS (I.E. RECORD
WILL BE UNLOCKED AND LOCKED AGAIN
] )%
IF DATALOCKED THEN UNLOCK ( RST [ RSTDATARFA ] ); ! UNLOCK THE CURRENT RECORD
%([ FETCH THE RECORD POINTER AND MAKE IT CURRENT ])%
RST [ RSTDATARFA ] = .CRP; ! SAVE RP FOR USER
%([ IF THE CURRENT PAGE IS IN OUR WINDOW, THEN
WE DONT HAVE TO CALL AN EXTERNAL ROUTINE TO GET IT ])%
RFAPAGENUM = .CRP [ RFAPAGE ];
IF ( .CURRENTWINDOW IS ZERO ) ! THERE IS NO CURRENT BUCKET
OR
( .CURRENTFILEPAGE ISNT .RFAPAGENUM )
THEN
BEGIN %( GET THE NEW PAGE )%
IF CALLGETWINDOW ( %( PAGE NO. )% LCI ( RFAPAGENUM ),
%( PAGE MUST EXIST )% LCI ( CHECKPAGEFLAG ) )
!** [16] ROUTINE:FINDSEQ, AT LINE 7692, EGM, 27-JUL-78
%([16])% IS FALSE THEN
%([16])% BEGIN %( PAGE DOES NOT EXIST )%
%([16])% IF RFAADR
%([16])% THEN ! RFA ERROR
%([16])% USERERROR ( ER$RFA )
%([16])% ELSE ! END OF FILE
%([16])% CALLDOEOF
%([16])% END; %( OF PAGE DOESN'T EXIST )%
END; %( OF GET THE NEW PAGE )%
%([ 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 IS EOPMARKER ! CHECK FOR END-OF-PAGE
THEN
BEGIN %( WE HAVE FOUND A END-OF-PAGE MARKER )%
RTRACE (' END-OF-PAGE MARKER FOUND');
%([ FOR RFA ADDRESSING, WE CAN GIVE IMMEDIATE ERROR ])%
IF RFAADR THEN USERERROR ( ER$RFA );
IF BLOCKED
THEN %(WE CAN BUMP THE PTR TO THE NEXT FILE PAGE)%
NRP = ( .CRP OR OFSETMASK ) + %O'1' ! BUMP TO NEXT PAGE
ELSE
RMSBUG ( MSGEOP ); ! END-OF-PAGE MARKER FOUND
END %( OF IF HEADER IS EOPMARKER )%
ELSE %( HEADER ISNT EOPMARKER )%
BEGIN
LOOKAT ( ' HEADER READ = ', HEADER );
%([ CHECK THAT UNDEFINED BITS IN HEADER ARE OFF ])%
IF .HEADER [ RHDRUNDEF ] ISON THEN USERERROR ( ER$RFA ); ! CHECK UNUSED PORTION OF HEADER
%([ WE WILL NOW COMPUTE THE STARTING BYTE #
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 NOONE ELSE CAN COME
IN AND 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 THRU THIS LOOP. ])%
%([ FIRST, CHECK THAT THIS RECORD HAS BEEN
WRITTEN (THE "VALID" BIT IS ON) ])%
IF ( .HEADER AND RHDRVALID ) IS OFF
THEN %(IS PROBABLY THE EOF)%
BEGIN
IF RFAADR THEN USERERROR ( ER$RFA ); ! BAD RFA
CALLDOEOF ! SEQ ACCESS MEANS EOF
END; %(OF IF VALID BIT IS OFF)%
IF ( .HEADER AND RHDRDELETE ) IS OFF
THEN
BEGIN
IF LOCKING THEN LOCKREC ( CRP ); ! LOCK RECORD
HEADER = . ( .RST [ RSTPAGPTR ] ) ! RE-FETCH HEADER
END; %( OF RECORD EXISTS )%
%([ WE NOW MUST CHECK THE HEADER AGAIN TO MAKE SURE ITS STILL GOOD ])%
IF ( .HEADER AND RHDRDELETE ) IS OFF
THEN
VALID = TRUE ! LEAVE THE LOOP
ELSE %(RECORD HAS BEEN DELETED)%
BEGIN
IF RFAADR THEN USERERROR ( ER$DEL )
END %(OF ELSE RECORD IS DELETED)%
END; %( OF IF HEADER ISNT EOPMARKER )%
%( UPDATE ALL DATA BASES )%
RST [ RSTRSZW ] = .RECORDLENGTH; ! SAVE RECORD SIZE IN WORDS
RST [ RSTRSZ ] = .HEADER [ RHDRSIZE ]; ! AND IN BYTES
IF CHKFLAG( RAB [RABROP], ROPNRP) ISON
THEN RST [RSTNRP] = .CRP !CAUSE SEQ GET TO ALW GET FND REC
ELSE IF ( SEQADR ) OR ( CURRENTJSYS IS C$GET )
THEN RST [ RSTNRP ]= .NRP; ! UPDATE THE NRP IF SEQUENTIAL ACCESS-MODE
END; %( OF WHILE LOOP )%
%( 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 ] = .RST [ RSTDATARFA ];
GOODRETURN %( BACK TO $FIND )%
END; %( OF FINDSEQ )%
! FINDREL
! ======
! PROCESSOR FOR $FIND MACRO FOR A RELATIVE FILE
! INPUT:
! <NONE>
! OUTPUT:
! <NONE>
! IMPLICIT INPUTS:
!
! RSTDATARFA BYTE NUMBER OF CURRENT RECORD
! RSTRSZ SIZE IN BYTES OF CURRENT RECORD
!
! GLOBALS USED:
! NUMBERTORFA
! GTBYTE
! LOCKIT
GLOBAL ROUTINE FINDREL =
BEGIN
LOCAL
CRP,
TEMPNRP,
HEADER,
TEMP,
CURRENTEMTPAGE, ! PAGE NUMBER ALREADY CHECKED TO SEE IF IT EXISTS
VALID,
BYTENUM;
REGISTER
TEMPAC; ! AC USED FOR TEMPORARY CALCULATIONS
MAP
HEADER: FORMAT,
BYTENUM: FORMAT;
TRACE ( 'FINDREL' );
%([ LOOP UNTIL A VALID RECORD IS FOUND ])%
VALID = FALSE; ! ASSUME RECORD IS NOT VALID
CURRENTEMTPAGE = ZERO; ! 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 THE CURRENT 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 ]; ! DONT UPDATE REAL NRP UNTIL OPERATION SUCCEEDS
WHILE .VALID IS 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 0 TO 2 OF
SET
[0]: %( SEQ )% .TEMPNRP; %( CRP = NRP )%
[1]: %( KEY )% . ( .RAB [ RABKBF ]); %( CRP = EA )%
[2]: %( RFA )% .RAB [ RABRFA ]; %( CRP = RFA )%
! ??? [3]:
TES); %( END OF SET RABADR )%
%([ 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 = CALLNUMBERTORFA ( LCI ( CRP ))) IS FALSE
THEN
BEGIN ! THE RECORD NUMBER WAS BEYOND THE MRN
%([ THE RECORD NUMBER OF THE TARGET RECORD
WAS .GTR. THAN THE MAXIMUM RECORD NUMBER
OF THE FILE. IF THE USER WAS PROCESSING THE
FILE SEQUENTIELLY, THEN HE SHOULD GET AN EOF
ERROR; OTHERWISE, HE SHOULD GET A RECORD-NOT
-FOUND ERROR. ])%
IF SEQADR THEN CALLDOEOF;
USRSTS = ER$KEY; ! ASSUME KEY ERROR
IF RFAADR THEN USRSTS = ER$RFA;
USEXITERR ! EXIT TO USER
END; %( OF IF NUMBERTORFA IS FALSE )%
%([ 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 THRU (IF KEY ACCESS IS BEING USED).
IF IT DOES EXIST, THEN WE CAN GO AHEAD AND READ IT. ])%
IF CALLGTBYTE ( LCI ( BYTENUM ), %( RFA ADDRESS )%
PCI ( TRUE )) %( ABORT IF NON-EXISTENT )%
IS FALSE
THEN BEGIN %(WE HAVE FOUND A NON-EXISTENT PAGE)%
IF ( NOT SEQADR ) THEN USERERROR ( ER$RNF ); ! RECORD NOT FOUND
%([ 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 ] )
ISNT
( .CURRENTEMTPAGE )
THEN BEGIN %(WE MUST CHECK THIS PAGE)%
TEMPAC = $CALL (NEXTPAGE, .FST[FSTJFN], .TEMPAC);
IF .TEMPAC IS FALSE
THEN
CALLDOEOF %([ IF NO MORE PAGES EXIST, ITS THE EOF ])%
ELSE
CURRENTEMTPAGE = .TEMPAC; ! REMEMBER THIS PAGE
END %(OF IF WE HAVEN'T CHECKED THIS PAGE)%
END %( OF IF GTBYTE IS FALSE )%
ELSE %(WE HAVE MAPPED IN THE CORRECT PAGE)%
BEGIN
HEADER = . ( .RST [ RSTPAGPTR ] ); ! FETCH HEADER
IF .HEADER IS EOPMARKER THEN RMSBUG ( MSGPTR ); ! BAD HEADER FOUND
IF ( .HEADER [ RHDRUNDEF ] ISNT ZERO )
THEN USERERROR ( ER$RFA ); ! BAD RFA
%([ CHECK TO SEE IF THIS RECORD HAS BEEN WRITTEN ])%
IF ( .HEADER AND RHDRVALID ) IS OFF
THEN %(THE RECORD WAS NEVER CREATED)%
BEGIN
RAB [ RABRFA ] = ZERO; ! ZAP RFA
IF NOT SEQADR THEN USERERROR ( ER$RNF );
END %(OF IF VALID BIT IS OFF)%
ELSE %(THE RECORD WAS WRITTEN AT SOME TIME)%
BEGIN
IF ( .HEADER AND RHDRDELETE ) IS OFF
THEN
BEGIN
IF LOCKING THEN LOCKREC ( CRP );
HEADER = . ( .RST [ RSTPAGPTR ] )
END; %( OF IF RECORD EXISTS )%
%([ RE-CHECK THE RECORD HEADER ])%
IF ( .HEADER AND RHDRDELETE ) IS OFF
THEN
VALID = TRUE ! RESET THE 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]: %(SEQ)% 0; !DO NOTHING
[1]: %(KEY)% USERERROR ( ER$RNF );
[2]: %(RFA)% USERERROR ( ER$DEL )
TES; %(END OF CASE RECORDACCESS)%
RAB [ RABRFA ] = ZERO
END %(OF ELSE RECORD IS DELETED)%
END %( OF IF RECORD IS VALID)%
END; %( OF ELSE IF GTBYTE IS TRUE )%
LOOKAT ( ' RECORD HEADER: ', HEADER);
%([ UPDATE USERS PARAMETER BLOCK ])%
IF ( SEQADR ) OR ( CURRENTJSYS IS C$GET )
THEN TEMPNRP = .CRP +1; ! UPD LOOP VAR 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; %( OF WHILE VALID IS FALSE LOOP )%
IF CHKFLAG( RAB [RABROP], ROPNRP) ISON
THEN RST [RSTNRP] = .CRP !CAUSE SEQ GET TO ALW BE FND REC
ELSE IF ( SEQADR ) OR ( CURRENTJSYS IS C$GET )
THEN RST [ RSTNRP ]= .CRP + 1; ! UPDATE THE NRP IF SEQ ACC-MODE
%([ STORE THE NUMBER OF THE CURRENT RECORD IN
THE BKT 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, USER'S SHOULD NOT
ASSUME THAT A NON-ZERO RECORD NUMBER IN BKT
REFLECTS A SUCCESSFUL OPERATION. ])%
RAB [ RABRFA ] = ( RAB [ RABBKT ] = .CRP);
GOODRETURN
END; %( OF FINDREL )%
! FINDIDX
! =======
! ROUTINE TO PROCESS THE $FIND MACRO FOR AN INDEXED FILE.
! THIS ROUTINE IS CALLED ALSO BY THE $GET PROCESSOR IN
! ORDER TO POSITION TO THE CORRECT RECORD.
! INPUT:
! RECDESC RECORD DESCRIPTOR PACKET
! <NO FIELDS USED AS INPUT>
!
! DATABD BUCKET DESCRIPTOR (RETURNED)
! OUTPUT:
! <NO STATUS RETURNED>
! INPUT ARGS MODIFIED:
! RECORD DESCRIPTOR:
! RFA RFA OF TARGET RECORD
! RRV RRV ADDRESS OF TARGET RECORD
!
! BUCKET DESCRIPTOR
! ALL FIELDS RETURNED
! ROUTINES CALLED:
! FIDXSEQ
! FBYKEY
! FBYRRV
! PUTBKT
! LOCKIT
! SETNRP
! RAB FIELDS REFERENCED:
! RAC RECORD ACCESS VALUE
! KRF KEY OF REFERENCE
! NOTE:
! 1. IF THERE WAS AN ERROR DURING THIS ROUTINE, IT WILL NOT
! RETURN. IT WILL EXIT DIRECTLY TO THE USER.
GLOBAL ROUTINE FINDIDX ( RECDESC, DATABD ): NOVALUE =
BEGIN
%IF INDX %THEN
ARGUMENT (RECDESC,BASEADD);
ARGUMENT (DATABD,BASEADD);
MAP
RECDESC: POINTER,
DATABD: POINTER;
EXTERNAL ROUTINE
FBYRFA,
FIDXSEQ, ! FIND SEQ RECORD
FRECRFA, ! FIND THE RECORD BY RFA ADDRESSNG
FBYKEY,
SETNRP,
PUTBKT;
LOCAL
BDPTR: POINTER, ! PTR TO CURRENT BUCKET DESC
SAVEDSTATUS, ! STORE STATUS HERE
NEXTBUCKET, ! NEXT BUCKET FOR READ-AHEAD
BUCKETSIZE, ! SIZE OF A BUCKET
TPTR: POINTER, ! TEMP POINTER
NEXTBD: FORMATS[ BDSIZE ], ! BUCKET DESC OF NEXT BUCKET
LOCKACCESS, ! SHARED/EXCLUSIVE
RECORDPTR: POINTER; ! PTR TO CURRENT RECORD
EXTERNAL ROUTINE
FBYRRV, ! LOCATE RECORD BY RRV ADDRESS
GETBKT;
TRACE ('FINDIDX');
%([ SET UP THE PRIMARY KEY DESCRIPTOR ])%
KDB = .FST [ FSTKDB ];
%([ CLEAR SOME FIELDS IN THE RECORD DESCRIPTOR WHICH
WE WILL PASS TO THE LOWER LEVEL ROUTINES ])%
%([ NOTE THAT BOTH THE FLAGS AND STATUS FIELDS ARE CLEARED ])%
RECDESC [ RDSTATUS ] = ZERO; ! CLEAR STATUS BITS
RECDESC [ RDFLAGS ] = RDFLGHORIZOK; ! HORIZONTAL SEARCH OK
%([ FETCH THE CURRENT BUCKET AND SET IT NULL (IN THE RST) ])%
FETCHCURRENTBKT ( DATABD );
%([ DISPATCH TO THE CORRECT ROUTINE ])%
IF SEQADR
THEN BEGIN !SEQ ACCESS
SETNULLBD ( CBD ); ! INDICATE THAT THERE IS NO CURRENT BKT
SAVEDSTATUS = CALLFIDXSEQ ( BPT ( RECDESC ),
BPT ( DATABD ) );
END %(OF IF SEQUENTIAL ACCESS)%
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 NOW MUST 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) IS FALSE ! WAIT, SHARED
THEN RETURNSTATUS ( ER$EDQ ); ! SHOULDN'T FAIL
END; %(OF IF LOCKING)%
%([ DISPATCH TO CORRECT ROUTINE DEPENDING ON RECORD ACCESS ])%
IF KEYADR
THEN SAVEDSTATUS = CALLFBYKEY ( BPT ( RECDESC ),
BPT ( DATABD ) )
ELSE SAVEDSTATUS = CALLFRECRFA ( BPT ( RECDESC ),
BPT ( DATABD ) );
END; %(OF ELSE KEY OR RFA ACCESS)%
%([ 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 ISNT FALSE
THEN BEGIN %(WE MUST DO SOME UNLOCKING & LOCKING)%
IF ( NOT BKTLOCKED ( DATABD ) ) %([ LOCK THE BUCKET IF IT IS NOT LOCKED ])%
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 ) IS FALSE
THEN BEGIN
RTRACE (' ***LOCK AREADY LOCKED');
SAVEDSTATUS = FALSE; ! RETURN FAILURE
CALLPUTBKT ( %(NO)% PCI ( FALSE ),
%(BKT)% BPT ( DATABD ) );
USRSTS = ER$RLK ! SET ERROR CODE
END %(OF COULDNT LOCK BUCKET)%
END; %(OF IF NOT BKTLOCKED)%
!** [20] ROUTINE:FINDIDX, AT LINE 8219, EGM, 7-SEP-78
%([20])% %([ IT IS POSSIBLE THAT ANOTHER USER COULD HAVE DELETED ])%
%([20])% %([ THIS RECORD BETWEEN THE TIME WE FOUND IT AND LOCKED IT ])%
%([20])% %([ IF THIS IS THE CASE, UNLOCK THE BUFFER AND SAY THE ])%
%([20])% %([ RECORD WAS NEVER FOUND ])%
%([20])%
%([20])% RECORDPTR = .RECDESC [ RDRECPTR ];
%([20])% IF DELETEFLAG ( RECORDPTR ) IS ON
%([20])% THEN BEGIN !REC ACTU DELETED
%([20])% RTRACE (' UNLOCKING BKT - REC. DELETED!');
%([20])% UNLOCKBUCKET ( .DATABD [ BKDBKTNO ] );
%([20])% SAVEDSTATUS = FALSE; ! RETURN FAILURE
%([20])% USRSTS = ER$RNF ! SET ERROR CODE
%([20])% END; %(OF IF DELETEFLAG)%
%([20])%
END; %(OF IF LOCKING)%
%([ UNLOCK THE INDEX STRUCTURE, IF NECESSARY ])%
IF INDEXLOCKED THEN UNLOCKINDEX;
%([ WE HAVE NOW DONE THE $FIND. WAS IT OK? ])%
IF .SAVEDSTATUS IS FALSE
THEN BEGIN
RTRACE (' ERROR IN FIND...');
%([ CLEAR THE USER'S RFA AND OUR RECORD POINTER ])%
RST [ RSTDATARFA ] = ZERO;
IF NOT RFAADR THEN RAB [ RABRFA ] = ZERO;
USEXITERR ! EXIT TO USER
END; %(OF IF THE FIND FAILED)%
%([ 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 PEFORMING THE
NORMAL CLEAN-UP OPERATIONS, WHICH WILL BE
DONE IN THE $GET ROUTINE. ])%
SETCURRENTBKT ( DATABD ); ! SAVE CURRENT BKT
%([ SAVE THE PTR TO THE CURRENT RECORD AND SET THE
RECORD SIZE OF THIS RECORD (THIS IS USED ONLY ON
AN $UPDATE TO CHECK IF THE RECORD SIZE HAS BEEN
CHANGED BY THE USER. IF RECORD-LENGTH MODIFICATION
IS SUPPORTED, THEN THIS OPERTION IS UNNECESSARY) ])%
RST [ RSTPAGPTR ] = ( RECORDPTR = .RECDESC [ RDRECPTR ]); ! AND PTR TO CURRENT RECORD
IF FIXEDLENGTH
THEN RST [RSTRSZ] = .FST [ FSTMRS ]
ELSE RST [RSTRSZ] = .RECORDPTR [ DRRECSIZE ] ;
RST [ RSTRSZW ] = SIZEINWORDS ( .RST [ RSTRSZ ], .FST [ FSTBSZ ] );
IF CURRENTJSYS IS C$GET
THEN RETURN;
%([ UPDATE THE NEXT-RECORD-POINTER DATA IN THE RST ])%
CALLSETNRP ( BPT ( RECDESC ), BPT ( DATABD ) ); ! UPDATE DATA BASE
%([ SET UP THE RFA IN THE USER'S RAB ])%
RAB [ RABRFA ] = .RECDESC [ RDRRV ];
RETURN;
%FI
END; %(OF FINDIDX)%
END
ELUDOM