Trailing-Edge
-
PDP-10 Archives
-
704rmsf2
-
10,7/rms10/rmssrc/rmsudm.b36
There are 6 other files named rmsudm.b36 in the archive. Click here to see a list.
MODULE UD2 =
BEGIN
GLOBAL BIND UD2V = 1^24 + 0^18 + 16; !EDIT DATE: 7-JAN-77
%([
PURPOSE: UTILITIES FOR RMSUDR.
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
AUTHOR: S. BLOUNT
********** TABLE OF CONTENTS **************
ROUTINE FUNCTION
======= ========
ALCRFA ALLOCATE A NEW RFA FOR A RECORD
SHUFFLEIDS SHUFFLE THE ID'S IN A DATA BUCKET
FBYRFA FIND A RECORD GIVEN ITS RFA
FBYRRV FOLLOW RRV RECORD TO RECORD GIVEN ITS RFA
SKIPRECORD SKIP A DATA RECORD
REVISION HISTORY:
EDIT DATE WHO PURPOSE
==== ==== === ========
1 24-AUG-76 JK ADD 'UPDRRVS' ROUTINE.
2 1-SEP-76 JK REPLACE REFS TO ZERO ID BY 'NULLID'.
3 1-SEP-76 JK FIX 'UPDRRVS'.
4 1-SEP-76 JK FIX 'UPDRRVS' -- 'UPDBKD' SHOULD BE MAPPED 'FORMAT'.
5 2-SEP-76 JK REMOVE EDIT 3 (EDIT 4 FOUND REAL CULPRIT).
6 2-SEP-76 JK REMOVE EDIT 5, REINSTATE EDIT 3, UPDATE RRV REC. CORRECTLY.
7 2-SEP-76 JK 'UPDRRVS' NOW HANDLES "RRV NOT FOUND" CORRECTLY.
8 3-SEP-76 JK SPLIT RMSUDR INTO RMSUDR, RMSUD2, RMSSPT.
9 8-SEP-76 JK SIMPLIFY 'FBYRFA'.
10 19-OCT-76 SB MAKE SKIPRECORD PROCESS SIDR'S
11 28-OCT-76 SB EDIT LOOKATFIELD, CLEAR RECPTR IN FBYRRV
12 5-NOV-76 SB FIX FBYRRV TO SET UP RRV FIELD IN RD
13 11-NOV-76 SB MAKE FBYRRV USE PRIMARY KDB ALWAYS
14 30-DEC-76 SB ADD LOCK-FLAG TO SKIPRECORD
15 7-JAN-77 SB ADD FLGREO TO SHUFFLEIDS
*************************************************
* *
* NEW REVISION HISTORY *
* *
*************************************************
****************** Start RMS-10 V1.1 *********************
********************* TOPS-10 ONLY ***********************
PRODUCT MODULE SPR
EDIT EDIT QAR DESCRIPTION
====== ====== ===== ===========
100 16 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 ])%
FORWARD ROUTINE SHUFFLEIDS ; ! FIND HOLE OF UNUSED ID'S IN A BKT
%([ EXTERNAL DECLARATIONS ])%
EXTERNAL ROUTINE
CRASH, ! DEBUGGING
GTNBKT, ! GET THE NEXT BUCKET
CKEYKK, ! KEY COMPARISON ROUTINE
CKEYKU, ! KEY COMPARISON ROUTINE
GETBKT, ! OBTAIN A BUCKET
PUTBKT, ! RELEASE A BUCKET
SDATABKT, ! SEARCH A DATA BUCKET
DUMP; ! SAME
%([ ERROR MESSAGES REFERENCED IN THIS MODULE ])%
EXTERNAL
MSGINPUT, ! BAD INPUT VALUES
MSGKDB, ! BAD KDB IS PASSED TO ROUTINE
MSGPTR, ! SOMETHING WRONG IN PTR
MSGCANTGETHERE; ! BAD LOGIC FLOW
REQUIRE 'RMSREQ';
EXTDECLARATIONS;
! ALCRFA
! ======
! THIS ROUTINE ALLOCATES A NEW RFA FOR A RECORD WHICH IS BEING
! INSERTED INTO THE FILE. FOR MOST CASES, THIS ROUTINE IS
! TRIVIAL. BUT, IN SOME CASES WE MUST GARBAGE COLLECT THE
! RECORD ID'S IN THE BUCKET HEADER TO LOOK FOR A SPARE ONE.
! INPUT:
! BKTDESC BUCKET DESCRIPTOR OF BUCKET WHERE RECORD IS TO GO
! OUTPUT:
! NOT FALSE: RFA OF NEW RECORD
! FALSE: ERROR
! ID'S RAN OUT (SHOULD NOT HAPPEN)
! INPUT ARGUMENTS MODIFIED:
! <NONE>
! BUCKET HEADER FIELDS MODIFIED:
! NEXTID
! LASTID (IF ID'S MUST BE SHUFFLED)
GLOBAL ROUTINE ALCRFA ( BKTDESC ) =
BEGIN
ARGUMENT (BKTDESC,BASEADD); ! CURRENT BUCKET
REGISTER
NEWRFA: FORMAT, ! THE RFA OF RECORD
BKTPTR: POINTER,
TEMPAC;
MAP
BKTDESC: POINTER;
TRACE ('ALCRFA');
CHECKEXACTCOUNT;
%([ SET UP A BUCKET POINTER ])%
BKTPTR = .BKTDESC [ BKDBKTADR ];
%([ PUT THE BUCKET NUMBER INTO THE NEW RFA ])%
NEWRFA < RH > = .BKTDESC [ BKDBKTNO ]; ! 'RH' STANDS FOR RFABUCKET IN BUCKET.REQ
NEWRFA < LH > = ( TEMPAC = .BKTPTR [ BHNEXTID ] ); ! GET NEXT ID.'LH' STANDS FOR RFAID
%([ BUMP THE NEXT ID IN THE BUCKET HEADER AND CHECK IF IT'S TOO HIGH ])%
IF ( BKTPTR [ BHNEXTID ] = .TEMPAC + 1 )
GTR
.BKTPTR [ BHLASTID ]
THEN %(WE MUST GARBAGE COLLECT ON THE ID'S)%
BEGIN
RTRACE (%STRING('** NO ID FOUND IN BUCKET',%CHAR(13),%CHAR(10)));
IF ( NEWRFA < LH > = CALLSHUFFLEIDS ( BPT ( BKTDESC ) ) ) IS FALSE ! 'LH' STANDS FOR RFAID
THEN
RETURN FALSE
END; %(OF WE MUST GARBAGE COLLECT)%
%([ WE NOW HAVE OUR ID ])%
LOOKAT (' NEW RFA FOR RECORD: ',NEWRFA);
RETURN .NEWRFA
END; %(OF ALCRFA)%
! SHUFFLEIDS
! ==========
! ROUTINE TO SCAN A DATA BUCKET IN SEARCH OF A "HOLE" OF UNUSED
! RECORD ID'S. THIS ROUTINE IS CALLED WHENEVER "NEXTID"
! IS GREATER THAN "LASTID" IN THE BUCKET HEADER. SUCH A
! SITUATION MEANS THAT WE MUST SCAN THE BUCKET TO SEE IF
! WE CAN COLLESCE SOME OF THE UNUSED RECORD ID'S.
!
! THERE ARE SEVERAL WAYS IN WHICH THIS COULD BE DONE. THE FULL
! BUCKET SCAN TO FIND THE LARGEST HOLE IS A VERY EXPENSIVE
! OPERATION (IT IS AN O(N**2) ALGORITHM....THAT MEANS THAT AS
! THE NUMBER (N) OF RECORDS IN THE BUCKET INCREASES, THE TIME
! TO SEARCH FOR THE LARGEST ID GOES UP AT A RATE OF N SQUARED).
! THEREFORE, WE WOULD LIKE TO SOMETHING WHICH WOULD SPEED UP
! THE SEARCH. THE TECHNIQUE USED IN THIS ROUTINE IS TO SEARCH
! FOR ANY HOLE WHICH IS NON-EMPTY AND TO USE THE FIRST SUCH
! HOLE WHICH IS FOUND. THIS MEANS THAT THIS ROUTINE MAY
! HAVE TO BE CALLED A LITTLE MORE THAN WOULD OTHERWISE BE THE
! CASE, BUT EACH OPERATION WILL BE FAIRLY QUICK. ALSO, SINCE
! RECORDS AT THE TOP OF THE BUCKET WILL TEND TO BE OLDER, IT
! SEEMS REASONABLE THAT THEY ALSO WILL HAVE LOWER ID'S AND THUS
! WILL LIKELY GIVE RISE TO LARGER ID HOLES.
!
! IF THIS ROUTINE IS CALLED, THEN THE FILE SHOULD BE RE-ORGANIZED.
! THIS IS BECAUSE THE RECORD SEARCH ALGORITHMS ASSUME THAT RECORD
! ID'S CANNOT BE RE-USED. IF THIS IS NOT TRUE, THEN A KEY
! COMPARISON MUST BE MADE WHENEVER THE CURRENT RECORD IS BEING
! LOCATED. THUS, TO AVOID THIS OVERHEAD, WE WILL TELL THE USER
! IF HIS ID'S RUN OUT THAT HE SHOULD RE-ORGANIZE THE FILE.
! INPUT:
! BKTDESC BUCKET DESCRIPTOR OF BUCKET
! OUTPUT:
! NOT FALSE: NEW ID TO USE
! FALSE: NO ID'S LEFT IN BUCKET (SHOULD NOT HAPPEN)
! ROUTINES CALLED:
! <NONE>
GLOBAL ROUTINE SHUFFLEIDS ( BKTDESC ) =
BEGIN
ARGUMENT (BKTDESC,BASEADD);
MAP
BKTDESC: POINTER;
LITERAL MINHOLESIZE = 2; ! HOLE MUST BE THIS BIG
REGISTER
LOWID, ! CURRENT BASE LEVEL ID
TEMPAC, ! TEMP
MOVINGPTR: POINTER; ! USED TO SCAN THE BUCKET
LOCAL
BKTPTR: POINTER, ! PTR TO TOP OF BUCKET
HIGHID, ! CURRENT TOP OF HOLE ID
CURRENTID, ! ID OF CURRENT RECORD
ENDPTR: POINTER, ! PTR TO END OF BUCKET
FIXEDPTR: POINTER; ! PTR TO CURRENT "LOWID" RECORD
TRACE ('SHUFFLEIDS');
CHECKEXACTCOUNT;
%([ TELL HIM TO RE-ORGANIZE THE FILE ])%
SETFLAG ( FST [ FSTFLAGS ], FLGREO );
USRSTS = SU$REO; ! SET UP SUCCESS CODE
%([ SET UP SOME POINTERS ])%
BKTPTR = .BKTDESC [ BKDBKTADR ];
FIXEDPTR = .BKTPTR + BHHDRSIZE; ! POINT TO FIRST RECORD
ENDPTR = .BKTPTR + .BKTPTR [ BHNEXTBYTE ]; ! END OF BUCKET
%([ SET UP SOME ID VALUES ])%
LOWID = ZERO; ! LOWEST ID
%([ THIS IS THE MAIN LOOP. THIS WILL BE EXECUTED ONCE
FOR EACH SCAN OF THE BUCKET. ONLY IF THE FIRST RECORD
HAS AN ID WHICH IS 1 LESS THAN SOME OTHER RECORD
WILL IT BE EXECUTED MORE THAN ONCE. ])%
REPEAT %(UNTIL WE FIND A BIG ENOUGH HOLE)%
BEGIN
HIGHID = HIGHESTID+1; ! ASSUME BUCKET IS EMPTY
MOVINGPTR = .BKTPTR + BHHDRSIZE; ! START AT TOP
%([ SCAN THE BUCKET LOOP ])%
UNTIL .MOVINGPTR GEQ .ENDPTR
DO
BEGIN
LOWID = .FIXEDPTR [ DRRECORDID ] + 1; ! GET CURRENTID
CURRENTID = .MOVINGPTR [ DRRECORDID ]; ! GET THIS ONE
%([ IS THIS A SMALLER HOLE? ])%
IF ( .CURRENTID LSS .HIGHID )
AND
( .CURRENTID GEQ .LOWID )
THEN %(WE HAVE FOUND A SMALLER HOLE)%
HIGHID = .CURRENTID;
%([ BUMP THE MOVING POINTER ])%
MOVINGPTR = .MOVINGPTR + SIZEOFANYRECORD ( MOVINGPTR )
END; %(OF BUCKET SCAN)%
%([ WE HAVE NOW SCANNED THE BUCKET ONCE LOOKING FOR HOLES.
DID WE FIND ANY? ])%
LOOKAT (' HIGHID: ',HIGHID );
LOOKAT (' LOWID: ',LOWID );
IF ( .HIGHID - .LOWID ) GEQ MINHOLESIZE
THEN %(OUR HOLE IS OK)%
BEGIN
RTRACE (%STRING(' FOUND NEW HOLE',%CHAR(13),%CHAR(10)));
BKTPTR [ BHNEXTID ] = .LOWID + 1; ! STORE NEXT ID
BKTPTR [ BHLASTID ] = .HIGHID - 1;
RETURN .LOWID ! VALUE IS THIS ID
END; %(OF OUR HOLE IS BIG ENOUGH)%
RTRACE (%STRING('** HOLE IS NOT BIG ENOUGH',%CHAR(13),%CHAR(10)));
%([ BUMP THE FIXED PTR TO THE NEXT RECORD ])%
FIXEDPTR = .FIXEDPTR + SIZEOFANYRECORD ( FIXEDPTR );
%([ IS WE ARE PAST THE END OF THE BUCKET...WE HAVE PROBLEMS ])%
IF .FIXEDPTR GEQ .ENDPTR
THEN
RMSBUG ( MSGPTR )
END; %(OF REPEAT LOOP)%
RMSBUG ( MSGCANTGETHERE )
END; %(OF SHUFFLEIDS)%
! FBYRFA
! ======
!
! THIS ROUTINE WILL FIND A RECORD GIVEN ITS RFA ( THIS
! INCLUDES MAPPING THE OBJECT BUCKET).
!
! INPUT:
! RECDESC = BASE ADDRESS OF RECORD DESCRIPTOR CONTAINING RFA
! RFA = RFA TO SEARCH FOR
! BKTDESC = BASE ADDRESS OF BUCKET DESCRIPTOR (EMPTY)
! LOCKFLAG = FLAG FOR LOCKING OF BUCKET
!
! OUTPUT:
! TRUE = FOUND RECORD
! FALSE = RECORD NOT FOUND,
! CAN'T GET BUCKET
!
! ARGUMENTS MODIFIED:
! RECDESC [ RECPTR ] = ADDRESS OF RECORD
! BKTDESC = ALL FIELD VALUES WILL BE FILLED IN
!
! NOTES:
!
! 1. IF THIS ROUTINE FAILS IN ANY WAY, THE BUCKET
! WHICH WAS USED WILL BE RETURNED TO THE BUCKET
! MANAGER. THUS, IF THIS ROUTINE RETURNS "TRUE",
! THE CALLER MUST DISPOSE OF THE BUCKET, IF IT
! RETURNS "FALSE", THERE IS NO BUCKET TO DISPOSE OF.
GLOBAL ROUTINE FBYRFA ( RECDESC, BKTDESC, LOCKFLAG ) =
BEGIN
ARGUMENT (RECDESC,BASEADD); ! BASE ADDRESS OF RECORD DESCRIPTOR
ARGUMENT (BKTDESC,BASEADD); ! BASE ADDRESS OF BUCKET DESCRIPTOR
ARGUMENT (LOCKFLAG,REFERENCE); ! FLAG FOR LOCKING
LOCAL
BKTNO, ! A BUCKET NUMBER
BKTSIZE, ! A BUCKET SIZE
RFA: FORMAT; ! AN RFA
MAP
RECDESC: POINTER,
BKTDESC: POINTER;
TRACE ( 'FBYRFA' );
%([ GET THE BUCKET CONTAINING THE SPECIFIED RFA ])%
RFA = .RECDESC [ RDRFA ]; ! GET RFA
LOOKAT ( ' TRY TO FIND RFA: ' , RFA );
BKTNO = .RFA [ RFABUCKET ]; ! GET BUCKET NUMBER
BKTSIZE = .KDB [ KDBDBKZ ]; ! GET BUCKET SIZE
%([ DO A SPECIAL CHECK HERE TO INSURE BUCKET NUMBER IS
WITHIN THE SPACE OF THE FILE ])%
IF .BKTNO LSS LOWESTBKTNUM THEN RETURNSTATUS ( ER$RFA ); ! BAD RFA
%([ GET A BUFFER AND MAP BUCKET ])%
IF CALLGETBKT (%( BKTNO )% LCI ( BKTNO ),
%( BKTSIZE )% LCI ( BKTSIZE ),
%( LOCKFLAG )% RLCI ( LOCKFLAG ),
%( BKTDESC )% BPT ( BKTDESC ) ) IS FALSE
THEN
BADRETURN;
LOOKAT ( ' GOT BKT: ' , BKTNO );
%([ FIND THE RECORD(RFA) IN THE BUCKET ])%
LOOKAT ( ' START SEARCH AT: ' , RECDESC [ RDRECPTR ] );
IF CALLSDATABKT (%( RECDESC )% BPT ( RECDESC ),
%( BKTDESC )% BPT ( BKTDESC ) ) IS FALSE
THEN
BEGIN %( GIVE BUCKET BACK ON SEARCH FAILURE )%
CALLPUTBKT ( %( UPDATEFLAG )% PCI ( FALSE ),
%( BKTDESC )% BPT ( BKTDESC ) );
BADRETURN
END; %( OF GIVE BUCKET BACK ON SEARCH FAILURE )%
LOOKAT ( ' FOUND RECORD AT: ' , RECDESC [ RDRECPTR ] );
%([ DONE ])%
GOODRETURN
END; %( OF FBYRFA )%
! FBYRRV
! ======
! ROUTINE TO LOCATE A USER DATA RECORD IN AN INDEXED FILE
! THRU ITS RRV ADDRESS. IF THERE IS NO RRV RECORD
! ASSOCIATED WITH THE DATA RECORD, THEN THIS ROUTINE
! PERFORMS IDENTICALLY TO FBYRFA. HOWEVER, IF THERE
! IS A LEVEL OF INDIRECTION (I.E., THERE IS AN RRV
! RECORD), THEN THIS ROUTINE MUST LOCATE BOTH THE
! RRV AND THE DATA RECORD.
! INPUT:
! RECDESC RECORD DESCRIPTOR PACKET
! RFA RFA TO SEARCH FOR
! RECPTR <IGNORED>
!
! DATABD BUCKET DESCRIPTOR OF DATA (RETURNED)
! OUTPUT:
! TRUE: RECORD FOUND
! FALSE: ERROR
! BUCKET BUSY
! RECORD NOT FOUND
! ARGUMENTS MODIFIED:
! RECDESC:
! RECPTR ADDRESS OF DATA RECORD
! RRV RFA OF THE RRV RECORD FOUND
! NOTES:
!
! 1. IF THE DATA RECORD IS FOUND, THE RRV BUCKET WILL
! BE UNLOCKED.
!
! 2. THE BUCKET SEARCH IS ALWAYS FROM THE TOP OF THE BUCKET.
!
! 3. NOTE THAT THE RRV ADDRESS IS RETURNED IN THE RRV
! FIELD OF THE RECORD DESCRIPTOR.
GLOBAL ROUTINE FBYRRV ( RECDESC, DATABD ) =
BEGIN
ARGUMENT (RECDESC,BASEADD);
ARGUMENT (DATABD,BASEADD);
MAP
RECDESC: POINTER,
DATABD: POINTER;
LOCAL
RRVBD: FORMATS[ BDSIZE ],
SAVEDKDB, ! SAVE THE KDB ON ENTRANCE
SAVEDSTATUS; ! WE MUST REMEMBER THE STATUS
LABEL LOOP; ! USE A LOOP TO JUMP OUT OF
REGISTER
RECORDPTR: POINTER;
TRACE ('FBYRRV');
CHECKEXACTCOUNT;
LOOKAT (' TRYING TO FIND RRV: ', RECDESC [ RDRFA ] );
%([ INSURE THAT THE SEARCH WILL START AT TOP OF BUCKET ])%
RECDESC [ RDRECPTR ] = ZERO;
%([ SINCE THIS ROUTINE CAN OPERATE ONLY ON THE PRIMARY
DATA RECORDS, WE CAN SAVE THE CALLER SOME TROUBLE BY
ALWAYS USING THE PRIMARY KEY DESCRIPTOR BLOCK.
HOWEVER, THIS MEANS THAT WE MUST CREATE A DUMMY LOOP
TO EXIT FROM SO WE CAN RESTORE THE OLD KDB. ])%
SAVEDKDB = .KDB; ! SAVE THIS ONE
KDB = .FST [ FSTKDB ]; ! SET UP PRIMARY
%([ DUMMY LOOP ])%
LOOP: BEGIN
%([ TRY TO LOCATE THE DATA RECORD ])%
IF ( SAVEDSTATUS =CALLFBYRFA ( BPT ( RECDESC ),
BPT ( DATABD ),
PCI ( FALSE ) )) IS FALSE
%([ COULD WE FIND IT? ])%
THEN LEAVE LOOP WITH .SAVEDSTATUS ;
%([ WE FOUND A RECORD. WE MUST SEE IF IT IS A DATA RECORD
OR AN RRV RECORD ])%
RECORDPTR = .RECDESC [ RDRECPTR ];
%([ STORE THE ADDRESS OF THE RRV IN THE RECORD DESCRIPTOR ])%
RECDESC [ RDRRV ] = .RECDESC [ RDRFA ]; ! GET RRV ADDRESS
IF RRVFLAG ( RECORDPTR ) IS OFF
THEN %(THIS IS THE DATA RECORD)%
LEAVE LOOP WITH ( SAVEDSTATUS = TRUE );
%([ THIS IS AN RRV RECORD. WE MUST GO ONE MORE LEVEL ])%
RTRACE (%STRING(' RRV RECORD FOUND...',%CHAR(13),%CHAR(10)));
RECDESC [ RDRFA ] = .RECORDPTR [ DRRRVADDRESS ];
MOVEBKTDESC ( %(FROM)% DATABD, %(TO)% RRVBD );
RECDESC [ RDRECPTR ] = ZERO; ! START AT TOP
SAVEDSTATUS = CALLFBYRFA ( BPT ( RECDESC ),
BPT ( DATABD ),
PCI ( FALSE ) );
%([ SAVE THE CURRENT STATUS ])%
%([ RELEASE THE RRV BUCKET, REGARDLESS OF WHETHER WE MADE
AN ERROR OR NOT ])%
CALLPUTBKT ( %(NO UDATE)% PCI ( FALSE ),
%(RRV BKT)% LCT ( RRVBD ) )
END; ! OF THE DUMMY LOOP
KDB = .SAVEDKDB;
RETURN .SAVEDSTATUS
END; %(OF FBYRRV)%
! SKIPRECORD
! ==========
! ROUTINE TO ADVANCE TO THE NEXT DATA RECORD ( UDR OR SIDR )
! IN AN INDEXED FILE. THIS ROUTINE WILL NOT SKIP OVER
! DELETED RECORDS BUT WILL IGNORE EMPTY BUCKETS AND
! RRV RECORDS.
! INPUT:
! RECDESC RECORD DESCRIPTOR PACKET
! RECPTR ADDRESS OF CURRENT RECORD
!
! DATABD BUCKET DESCRIPTOR OF DATA BUCKET
! LOCKFLAG FLAG FOR LOCKING OF BUCKET
! TRUE LOCK THE BUCKET
! FALSE DONT LOCK THE BUCKET
! OUTPUT:
! TRUE: NEXT RECORD FOUND
! FALSE: COULD NOT GET NEXT RECORD
! BUCKET BUSY (BUSY FLAG WILL BE SET)
! NO NEXT BUCKET (END OF CHAIN)
! NOTES:
! 1. THIS ROUTINE WILL UNLOCK EACH BUCKET
! THAT IT PROCESSES WHEN IT MOVES TO THE
! NEXT BUCKET. HOWEVER, IT WILL ALWAYS
! RETURN A VALID BUCKET (I.E., IT WILL NEVER
! RELEASE ALL BUCKETS).
!
! INPUT ARGS MODIFIED:
! RECORD DESCRIPTOR:
! RECPTR ADDRESS OF NEW RECORD
! LASTRECPTR SAME AS RECPTR ON INPUT
GLOBAL ROUTINE SKIPRECORD ( RECDESC, DATABD, LOCKFLAG ) =
BEGIN
ARGUMENT (RECDESC,BASEADD);
ARGUMENT (DATABD,BASEADD);
ARGUMENT (LOCKFLAG,REFERENCE);
MAP
RECDESC: POINTER,
DATABD: POINTER;
LABEL LOOP;
LOCAL
NEXTBD: FORMATS[ BDSIZE ], ! BKT DESC OF NEXT BKT IN CHAIN
ENDPTR: POINTER, ! PTR TO END OF BUCKET
BKTPTR: POINTER, ! PTR TO THIS BUCKET
DATARECORDPTR: POINTER; ! PTR TO DATA RECORD
REGISTER
MOVINGPTR: POINTER,
TEMPAC;
TRACE ('SKIPRECORD');
%([ FETCH THE BEGINNING POINTER ])%
RECDESC [ RDLASTRECPTR ] = ( MOVINGPTR = .RECDESC [ RDRECPTR ] );
%([ ADVANCE TO THE NEXT RECORD...BUT FIRST, SOME
RANDOM CONSISTENCY CHECKS ])%
%IF DBUG %THEN
IF ( RRVFLAG ( MOVINGPTR ) ISON )
THEN
RMSBUG ( MSGPTR );
%FI
%([ BUMP THE POINTER PAST THIS RECORD ])%
MOVINGPTR = .MOVINGPTR + SIZEOFDATARECRD ( MOVINGPTR );
%([ WE ARE NOW AT THE RECORD PAST THE ONE WE ENTERED
WITH. WE WILL DO THIS LOOP UNTIL ONE OF THE FOLLOWING:
1. END OF CHAIN IS FOUND
2. A DATA RECORD IS FOUND
3. NEXT BUCKET IS LOCKED
])%
LOOP: BEGIN
REPEAT
BEGIN
%([ GET THE ADDRESS OF CURRENT RECORD ])%
RECDESC [ RDRECPTR ] = .MOVINGPTR; ! STORE IN CASE THIS IS END OF BKT
RTRACE (%STRING(' STARTING ITERATION...',%CHAR(13),%CHAR(10)));
BKTPTR = .DATABD [ BKDBKTADR ];
ENDPTR = .BKTPTR + .BKTPTR [ BHNEXTBYTE ];
LOOKAT (' END OF BKT AT: ', ENDPTR );
LOOKAT (' MOVINGPTR: ', MOVINGPTR );
%([ **CONSISTENCY CHECK** ])%
IF ( ( .MOVINGPTR LEQ .BKTPTR )
OR
( .MOVINGPTR GTR .ENDPTR ) )
THEN RMSBUG ( MSGPTR );
%([ NOW, DO THE BIG CHECK. ARE WE NOT AT THE END,
AND IS THIS A DATA RECORD ? ])%
IF ( ( .MOVINGPTR LSS .ENDPTR )
AND
( RRVFLAG ( MOVINGPTR ) IS OFF ) )
THEN LEAVE LOOP; ! FOUND IT
%([ WE ARE EITHER AT THE END OF THE BUCKET, OR WE
ARE AT AN RRV. CHECK TO SEE IF THERE IS ANOUTHER
BUCKET IN THE CHAIN ])%
RTRACE (%STRING(' REACHED END OF BUCKET...',%CHAR(13),%CHAR(10)));
%([ IS THIS THE END OF THE CHAIN? ])%
IF CHKFLAG ( BKTPTR [ BHFLAGS ], BHFLGEND ) ISON
THEN %(END OF CHAIN)%
BEGIN
RTRACE (%STRING(' END OF CHAIN FOUND...',%CHAR(13),%CHAR(10)));
SETPASTLASTFLAG ( RECDESC );
RETURNSTATUS ( ER$EOF ) ! RETURN ERROR CODE
END; %(OF IF END OF CHAIN)%
%([ THERE IS ANOTHER BUCKET. WE MUST LOCK IT BEFORE
WE UNLOCK THIS ONE ])%
IF CALLGTNBKT (%(THIS BKT)% BPT ( DATABD ),
%(NEXT ONE)% LCT ( NEXTBD ),
%(LOCK)% RLCI ( LOCKFLAG ) ) IS FALSE
THEN
RETURN FALSE;
%([ WE CAN NOW UNLOCK THE CURRENT BUCKET SINCE
WE HAVE GOTTEN THE NEXT BUCKET ])%
CALLPUTBKT ( %(NO)% PCI ( FALSE ),
%(BKT)% BPT ( DATABD ) );
%([ MAKE THE NEXT BUCKET OUR CURRENT BUCKET ])%
MOVEBKTDESC ( %(FROM)% NEXTBD, %(TO)% DATABD );
%([ SET THE POINTER BACK TO THE START OF THIS
BUCKET ])%
MOVINGPTR = .DATABD [ BKDBKTADR ] + BHHDRSIZE
END;
END; %(OF REPEAT LOOP)%
%([ AT THIS POINT, WE HAVE REACHED A DATA RECORD. WE NOW MUST
COMPARE THE KEY OF THIS RECORD TO THE SEARCH KEY SO AS
TO SET THE COMPARISON BITS. ALSO, WE NEED TO SET THE
DELETED FLAG IF THIS RECORD IS DELETED. ])%
%([ SET OR CLEAR THE DELETED FLAG ])%
TEMPAC = .RECDESC [ RDSTATUS ];
CLRFLAG ( TEMPAC, RDFLGDELETE );
IF ( CHKFLAG ( MOVINGPTR [ DRFLAGS ], FLGDELETE ) ISON )
THEN
SETFLAG (TEMPAC, RDFLGDELETE );
RECDESC [ RDSTATUS ] = .TEMPAC;
%([ MOVE THE RFA OF THIS RECORD INTO THE RECORD DESCRIPTOR ])%
RECDESC [ RDRFA ] = MAKERFA ( .DATABD [ BKDBKTNO ], .MOVINGPTR [ DRRECORDID ] );
%([ COMPARE THE KEYS ])%
DATARECORDPTR = .MOVINGPTR + .KDB [ KDBHSZ ]; ! USE LOCAL TO PASS IT
IF .KDB [ KDBREF ] IS REFPRIMARY
THEN
CALLCKEYKU ( %(SEARCH KEY)% BPT ( RECDESC ),
%(TARGET)% LPT ( DATARECORDPTR ) )
ELSE %(THIS IS A SECONDARY RECORD)%
CALLCKEYKK ( %(SEARCH KEY)% BPT ( RECDESC ),
%(TARGET)% LPT ( DATARECORDPTR ) );
GOODRETURN
END; %(OF SKIRECORD)%
END
ELUDOM