Trailing-Edge
-
PDP-10 Archives
-
cuspbinsrc_2of2_bb-fp63b-sb
-
10,7/rms10/rmssrc/rmsspt.b36
There are 11 other files named rmsspt.b36 in the archive. Click here to see a list.
MODULE SPT =
BEGIN
%([
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, 1981 BY DIGITAL EQUIPMENT CORPORATION
PURPOSE: ROUTINES ASSOCIATED WITH SPLITTING A DATA BUCKET.
AUTHOR: S. BLOUNT /EGM/RL
********** TABLE OF CONTENTS **************
ROUTINE FUNCTION
======= ========
SPLIT SPLIT A DATA BUCKET
COMPRESS COMPRESS A DATA BUCKET
COMPRRV COMPRESS RRV'S DURING BUCKET COMPRESSION
UPDRRVS UPDATE RRV RECORDS AFTER A SPLIT
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 3-SEP-76 JK CHECK BUSYFLAG CORRECTLY IN 'UPDRRVS'.
10 8-SEP-76 JK 'UPDRRVS' NO LONGER USES 'FBYRFA' (REPLACED BY 'SDATABKT').
11 1-OCT-76 SB MAKE SPLIT WORK ON SIDR'S
12 3-OCT-76 SB CHANGE RDLENGTH INPUT TO SPLIT,...
13 1-NOV-76 SB TAKE OUT FPROBLEM
14 11-NOV-76 SB ID'S NOT ALLOCATED IN SIDR BKT, CLEAR TMPRFA
15 6-JAN-77 SB UPDRRV'S DOESNT SET UPDRRV FLAG PROPERLY
16 1-FEB-77 SB MAKE SPLIT WORK ON 1/2 OF RECORD SPACE,
NOT 1/2 OF SIZE OF BUCKET.
17 4-FEB-77 SB FIX SPLIT TO ADJUST LASTRHIGHPTR CORRECTLY
IF THE LAST REC IS TOO BIG.
18 17-FEB-77 SB SPLIT INTO 3 BKTS IF A DUP WONT FIT IN ORIGINAL BKT
19 28-FEB-77 SB FIX BUG IF ALL DUPS ARE INSERTED (GAVE A 3-BKT)
20 8-MAR-77 SB REMOVE FILEPROBLEM IN UPDRRVS
21 5-MAY-77 SB FIX SPLIT SO THAT IF DUPS IN PRIMARY, SPLIT
IS ALWAYS BEFORE OR AFTER NEW RECORD.
*************************************************
* *
* NEW REVISION HISTORY *
* *
*************************************************
PRODUCT MODULE SPR
EDIT EDIT QAR DESCRIPTION
====== ====== ===== ===========
12 22 11439 SPLIT IS SETTING UP THE LAST RECORD PTR INCORRECTLY
WHEN SCANRECS FALLS THRU ON THE FIRST TEST. THE
POINTER ENDS UP AT THE CURRENT RECORD, NOT THE
PREVIOUS ONE, BECAUSE RECORDSIZE IS INITIALIZED TO
ZERO, NOT THE SIZE OF THE PREVIOUS RECORD.
15 23 11982 DURING A PUT TO AN INDEXED FILE WITH ALTERNATES
WITH DUPLICATES, SPLIT FAILS TO MOVE THE LAST
SIDR ARRAY FROM THE 1ST BUCKET TO THE 2ND WHEN
THE LAST ARRAY IS GREATER THAN HALF THE SIZE OF
THE BUCKET. THIS PRODUCES AN EMPTY BUCKET, AND
CAUSES DOSIDR TO OVERWRITE 1 WORD OF WHATEVER
FOLLOWS THE ORIGINAL BUCKET. ALSO, THE
RECORDSIZE USED BY SCANRECS MUST BE INITIALIZED
TO 0 IF THE CURRENT RECORD IS THE FIRST RECORD
IN THE BUCKET.
******** Release of Version 1.0 *******
PRODUCT MODULE SPR
EDIT EDIT QAR DESCRIPTION
====== ====== ===== ===========
54 24 20-17022 If a record is deleted and then rewritten
with a greater length, RMS will try to insert
the new record immediately after the old one
and the DUPLICATES flag in the record
descriptor will be set. If the bucket is
compressed, the deleted record will no longer
exist but the DUPLICATES flag will not be
updated. This can cause a 3-way split with no
index to the new record. This is fixed by
checking for duplicates before
leaving COMPRESS. RLUSK 24-DEC-81
****************** Start RMS-10 V1.1 *********************
********************* TOPS-10 ONLY ***********************
PRODUCT MODULE SPR
EDIT EDIT QAR DESCRIPTION
====== ====== ===== ===========
100 25 Dev Make declarations for routine names
be EXTERNAL ROUTINE so RMS will compile
under BLISS V4 (RMT, 10/22/85).
117 26 10-35371 (asp, 10/7/86) Edit 54 (in COMPRESS) does
not correctly check for duplicates as was
intended. Apply RL fix M460 12-Mar-84.
***** END OF REVISION HISTORY *****
])%
%([ FORWARD DECLARATIONS ])%
%(< NONE >)%
%([ EXTERNAL DECLARATIONS ])%
EXTERNAL ROUTINE
CRASH, ! DEBUGGING
FBYRFA, ! FIND A RECORD GIVEN ITS RFA
MOVEKEY, ! MOVE A DATA KEY
SDATABKT, ! SEARCH A DATA BUCKET
GETBKT, ! GET A BUFFER AND MAP A BUCKET
PUTBKT, ! RELEASE A BUCKET
ALCBKT, ! ALLOCATE A BUCKET
DUMPRD, ! DUMP A RECORD DESCRIPTOR
DUMPHEADER, ! DUMP A BUCKET HEADER
ALCRFA, ! ALLOCATE AN RFA IN A BUCKET
SHUFFLEIDS, ! FIND A HOLE OF ID'S IN A BUCKET
DUMP; ! SAME
%([ ERROR MESSAGES REFERENCED IN THIS MODULE ])%
EXTERNAL
MSGINPUT, ! BAD INPUT VALUES
MSGCOUNT, ! BAD COUNTER VALUE
MSGFAILURE, ! ROUTINE FAILED
MSGKDB, ! BAD KDB VALUES
MSGRRV, ! RRV FOUND IN SIDR BUCKET
MSGDUP, ! DUPLICATE FOUND IN PRIMARY INDEX
MSGPTR, ! SOMETHING WRONG IN PTR
! MSGUFPGS, ! CANT UPDATE FILE PAGES
MSGSPLIT, ! BAD SPLIT VALUES
MSGCCR; ! CAN'T CREATE AN RRV (NO ROOM IN BKT )
REQUIRE 'RMSREQ';
EXTDECLARATIONS;
! SPLIT
! =====
! ROUTINE TO SPLIT A DATA BUCKET ON RECORD INSERTION.
! THIS ROUTINE WILL NOT DO THE ACTUAL RECORD INSERTION
! BUT WILL DO THE MODIFICATION OF ALL BUCKET OVERHEAD.
! THIS ROUTINE WILL ALSO NOT DO ANY INDEX
! MODIFICATION OR RRV UPDATE OF ANY KIND.
!
! WHEN THE ORIGINAL BUCKET IS SPLIT, ROOM FOR THE NEW
! RECORD WILL BE LEFT IN THE CORRECT LOCATION FOR THE
! INSERTION. THUS, THE "HOLE" WILL BE BUILT FOR THE
! NEW RECORD. ALSO, AN RFA WILL BE ALLOCATED FOR THE
! RECORD UNLESS THE SIZE OF THE HOLE IS ZERO (THIS IS
! TRUE FOR A FULL SIDR BUCKET WHICH SPLITS SO A NEW
! RECORD POINTER IS TO BE ADDED).
! INPUT:
! RECDESC RECORD DESCRIPTOR PACKET
! RECPTR ADDRESS TO INSERT NEW RECORD
! LASTRECPTR ADDRESS OF LAST RECORD IN R-LOW
! LENGTH SIZE OF HOLE TO LEAVE FOR NEW RECORD
! (INCLUDING RECORD HEADER)
!
! BKTDESC BKT DESCRIPTOR OF DATA BUCKET TO SPLIT
! SPLITBD1 BKT DESCRIPTOR OF NEW BUCKET (RETURNED)
! SPLITBD2 BKT DESCRIPTOR OF 2ND NEW BUCKET (RETURNED)
! OUTPUT:
! TRUE: EVERYTHING WAS OK AND BUCKET IS SPLIT
! FALSE: ERROR
! NO MORE FREE PAGES
! FILE FULL
!
! NOTE:
! 1. USRSTS WILL CONTAIN THE ERROR CODE ON ERROR RETURN.
!
! 2. IF AN ERROR RETURN IS TAKEN, NO RECORDS HAVE BEEN
! MOVED AROUND. THE CALLER SHOULD UNLOCK THE ORIGINAL
! DATA BUCKET BUT NOT WRITE IT OUT TO THE FILE.
!
! 3. IF RDLENGTH = 0 ON INPUT, THEN WE ARE NOT INSERTING
! A NEW RECORD (EITHER PRIMARY OR SECONDARY). INSTEAD,
! WE ARE SPLITTING A SIDR BUCKET IN ORDER TO ADD ONE
! RECORD-POINTER ONTO THE END OF AN EXISTING SIDR ARRAY.
!
! ARGUMENTS RETURNED TO CALLER:
! RECORD DESCRIPTOR:
! RECPTR ADDRESS WHERE RECORD IS TO GO
! LASTRECPTR NEW HIGH KEY DATA RECORD IN ORIGINAL BUCKET
! (IF NEW HIGH KEY RECORD IS BEYOND R-NEW)
! RFA RFA OF NEW RECORD
! STATUS
! FLGIDXUPDATE IS SET (UNLESS DUP SEEN)
! FLGNOHIKEY IS SET IF THE ORIGINAL BKT IS
! NOW FILLED ONLY WITH RRV'S.
! ROUTINES CALLED:
! ALCBKT
! GETBKT
!
! TERMINOLOGY USED IN THIS ROUTINE:
!
! R-NEW THE RECORD TO BE INSERTED
! R-LOW THE SET OF RECORDS WITH KEYS .LSS. R-NEW
! R-HIGH THE SET OF RECORDS WITH KEYS .GTR. R-NEW
! S-RRV SIZE OF CURRENT RRV'S IN BUCKET
! S-NRRV SIZE REQUIRED FOR NEW RRV'S WHICH MUST BE
! CREATED FOR THE RECORDS WHICH ARE GOING TO MOVE.
! THE BASIC ALGORITHM USED BY THIS ROUTINE IS AS FOLLOWS:
!
! 1 ) IF R-NEW WILL FIT IN THE ORIGINAL BUCKET WITH R-LOW,
! , AS MUCH OF R-HIGH AS POSSIBLE IS
! KEPT IN ORIGINAL BUCKET AND THE REST IS MOVED OUT.
! HOWEVER, IF A PRIMARY DATA BUCKET IS BEING SPLIT, AND
! DUPS ARE ALLOWED, THEN WE MUST INSURE THAT A SERIES
! OF DUP RECORDS IS NOT SPLIT UP ACROSS BUCKETS. THEREFORE,
! IN THIS CASE, IF R-NEW WILL FIT WITH R-LOW, THEN ALL
! OF R-HIGH IS MOVED OUT TO THE NEW BUCKET.
!
! 2 ) IF R-NEW WON'T FIT, IT IS MOVED INTO SPLIT-BKT #1 IF
! IT WILL FIT WITH R-HIGH. IN THIS CASE, THE NEW RECORD WILL
! BE POSITIONED AT THE TOP OF THE NEW BUCKET. HOWEVER, IF A
! PRIMARY BUCKET IS BEING SPLIT AND DUPS ARE ALLOWED, THEN
! R-NEW MUST GET ITS OWN BUCKET SO AS TO NOT MIX A DUP RECORD
! WITH OTHER RECORDS.
!
! 3 ) IF R-NEW WON'T FIT WITH EITHER R-LOW OR R-HIGH, OR IF
! A PRIMARY BUCKET WITH DUPS ALLOWED IS BEING SPLIT, R-NEW IS
! MOVED INTO SPLIT-BKT #2 BY ITSELF. NOTE THAT THIS SITUATION IS
! VERY RARE--IT IS POSSIBLE ONLY IF THE NEW RECORD
! IS VERY LARGE (BECAUSE IF IT WEREN'T VERY LARGE, IT
! WOULD BE ABLE TO FIT IN A SINGLE BUCKET WITH
! EITHER R-LOW OR R-HIGH).
GLOBAL ROUTINE SPLIT ( RECDESC, BKTDESC, SPLITBD1, SPLITBD2 ) =
BEGIN
ARGUMENT (RECDESC,BASEADD); ! RECORD DESCRIPTOR
ARGUMENT (BKTDESC,BASEADD); ! ORIGINAL BUCKET
ARGUMENT (SPLITBD1,BASEADD); ! 1ST NEW BKT
ARGUMENT (SPLITBD2,BASEADD); ! 2ND NEW BKT
LOCAL
OLDBKTPTR, ! PTR TO ORIGINAL BUCKET
OLDBUCKET, ! BUCKET # OF ORIGINAL BUCKET
OLDMOVINGPTR, ! TEMP PTR TO SAME
TEMPPTR: POINTER, ! TEMPORARY POINTER
SPLIT1BKT, ! BKT # OF FIRST NEW BUCKET
SPLIT1BKTPTR, ! PTR TO SAME
SPLIT1MOVINGPTR, ! TEMP PTR TO SAME
SPLIT2BKT, ! BKT # OF 2ND NEW BUCKET
SPLIT2BKTPTR, ! PTR TO SECOND NEW BUCKET
OLDRRVPTR, ! PTR TO START OF OLD RRV'S
OLDENDPTR, ! PTR TO END OF ORIGINAL BUCKET
INSERTPTR, ! PTR TO PLACE TO INSERT NEW RECORD
RHIGHPTR, ! PTR TO START OF R-HIGH
SIZERRV, ! SIZE OF OLD RRV'S
SIZENEWRRV, ! SIZE OF NEW RRV'S WHICH HAVE TO BE CREATED
SIZELOW, ! SIZE OF R-LOW
SIZEHIGH, ! SIZE OF R-HIGH
UDRFLAG, ! ON IF THIS IS A UDR BUCKET
SUM, ! TEMP
BKTSIZE, ! SIZE OF DATA BUCKET
SIZEOFLASTRECRD, ! SIZE OF THE LAST RECORD WE SCANNED
SIZEOFTHISRECRD, ! SIZE OF CURRENT RECORD
MAXDATASIZE, ! AMOUNT OF SPACE LEFT IN BUCKET
MAXAVAILABLE, ! AMOUNT OF SPACE WHICH CAN BE USED (DIFFERS
! FROM MAXDATASIZE ONLY IF FILL PERCENTS ARE USED
SIZEOFNEWRECORD, ! GUESS
SHIGHINOLD, ! AMOUNT OF R-HIGH TO STAY IN OLD BKT
SHIGHINNEW, ! AMOUNT OF R-HIGH TO GO TO NEW BKT
SNEWINOLD, ! IF NON-ZERO, R-NEW STAYS IN ORIGINAL BKT
SNEWINNEW, ! IF NON-ZERO, R-NEW GOES TO NEW BKT
TWOBUCKETSPLIT, ! FLAG: TRUE=2-BKT SPLIT, FALSE=3-BKT SPLIT
LASTRHIGHOLDPTR: POINTER, ! PTR TO LAST RECORD IN R-HIGH TO STAY
MAXBKTOFFSET, ! FILL PERCENT OFFSET FOR DATA BUCKET
NEWRECBD: VECTOR[ BDSIZE ]; ! BKT DESC FOR NEW RECORD BUCKET
MAP
NEWRECBD: FORMAT;
REGISTER
TEMPAC;
MAP
RECDESC: POINTER,
BKTDESC: POINTER,
SPLITBD1: POINTER,
SPLITBD2: POINTER,
OLDMOVINGPTR: POINTER;
MAP
SPLIT1BKTPTR: POINTER,
SPLIT2BKTPTR: POINTER,
SPLIT1MOVINGPTR: POINTER,
OLDRRVPTR: POINTER,
OLDENDPTR: POINTER;
MAP
INSERTPTR: POINTER,
RHIGHPTR: POINTER,
LASTRHIGHOLDPTR: POINTER;
MAP
OLDBKTPTR: POINTER;
LABEL SCANRECS,SIZELOOP;
TRACE ('SPLIT');
CHECKEXACTCOUNT;
%([ LET'S LOOK AT THE RECORD DESCRIPTOR ON INPUT ])%
%IF DBUG %THEN
TYPE (%STRING('RECORD DESC. ON INPUT TO SPLIT:'));
CALLDUMPRD ( BPT ( RECDESC ) );
%FI
%([ PICK UP SOME POINTERS AND CLEAR SOME VARIABLES ])%
UDRFLAG = 1; ! ASSUME ITS UDR'S
IF .KDB [ KDBREF ] ISNT REFPRIMARY THEN UDRFLAG = FALSE;
RHIGHPTR = ( INSERTPTR = .RECDESC [ RDRECPTR ] ); ! GET PLACE FOR NEW RECORD
OLDBUCKET = .BKTDESC [ BKDBKTNO ];
OLDBKTPTR = .BKTDESC [ BKDBKTADR ];
OLDENDPTR = .OLDBKTPTR + .OLDBKTPTR [ BHNEXTBYTE ];
BKTSIZE = .KDB [ KDBDBKZ ]; ! GET BUCKE SIZE
MAXDATASIZE = ( .BKTSIZE ^ B2W ) - BHHDRSIZE; ! COMPUTE MAX SPACE
MAXAVAILABLE = .MAXDATASIZE; ! ASSUME SAME
IF ( CHKFLAG ( RAB [ RABROP ], ROPLOA ) ISON )
THEN
MAXAVAILABLE = .KDB [ KDBDFLOFFSET ] - BHHDRSIZE;
LOOKAT (' MAX-DATA-SIZE: ', MAXDATASIZE);
LOOKAT (' MAX-AVAIL: ', MAXAVAILABLE );
%([ ASSUME THAT R-NEW AND R-HIGH WILL BE MOVED, SO
SET UP THE PTR TO THE LAST RECORD IN THE BUCKET ])%
LASTRHIGHOLDPTR = .RECDESC [ RDLASTRECPTR ];
%([ CLEAR ALL OUR SPLIT-DESCRIPTOR VALUES ])%
SHIGHINOLD = ( SHIGHINNEW = ZERO );
SNEWINOLD = ( SNEWINNEW = ZERO );
TWOBUCKETSPLIT = TRUE; ! ASSUME SIMPLE
%([ SET THE FLAG TO INDICATE THAT AN INDEX UPDATE IS REQUIRED ])%
SETIDXUPDATFLAG ( RECDESC );
%([ INDICATE THAT IT WAS A SIMPLE (2-BUCKET) SPLIT ])%
RECDESC [ RDCOUNT ] = 1;
%([ FIND THE SIZE OF ALL RECORDS IN R-LOW ])%
SIZELOW = .INSERTPTR - .OLDBKTPTR - BHHDRSIZE;
LOOKAT (' SIZE OF R-LOW: ', SIZELOW );
%([ WE MUST NOW PASS OVER R-HIGH AND COMPUTE VARIOUS SIZES ])%
SIZENEWRRV = ( SIZERRV = ZERO );
SIZEHIGH = ZERO ;
%([ INIT A SCANNING POINTER ])%
OLDMOVINGPTR = .INSERTPTR;
%([ SET THE RRV POINTER TO THE END OF BUCKET. ACTUALLY,
THIS IS DONE TO AVOID THE BUG HALT IF THERE ARE NO
RRV RECORDS IN THE BUCKET ])%
OLDRRVPTR = .OLDENDPTR;
%([ LOOP OVER ALL RECORDS FROM HERE TO BOTTOM OF BUCKET
AND COMPUTE SEVERAL VARIOUS VALUES ])%
SIZELOOP:BEGIN
UNTIL .OLDMOVINGPTR GEQ .OLDENDPTR DO
BEGIN
%([ IF THIS IS A SIDR BUCKET, THEN WE DONT HAVE TO
SCAN IT BECAUSE THERE WILL NOT BE ANY RRV'S.
THEREFORE, WE CAN COMPUTE DIRECTLY THE SIZE OF
R-HIGH AND R-LOW ])%
IF .UDRFLAG IS FALSE
THEN
BEGIN
SIZEHIGH = .OLDENDPTR - .OLDMOVINGPTR;
LEAVE SIZELOOP ! EXIT FROM LOOP
END; %(OF IF THIS IS A SIDR BUCKET)%
%([ CHECK TO SEE IF WE HAVE REACHED THE RRV'S ])%
IF RRVFLAG ( OLDMOVINGPTR ) IS OFF
THEN %(THIS IS STILL A DATA RECORD)%
BEGIN
SIZEOFTHISRECRD = SIZEOFUDR ( OLDMOVINGPTR );
SIZEHIGH = .SIZEHIGH + .SIZEOFTHISRECRD;
%([ CHECK IF WE NEED AN RRV FOR THIS RECORD ])%
IF .OLDMOVINGPTR [ DRRRVBUCKET ] IS .OLDBUCKET
THEN %(WE WILL NEED AN RRV)%
BEGIN
LOOKAT (' REC NEEDS RRV AT: ', OLDMOVINGPTR );
INC ( SIZENEWRRV, RRVRECSIZE )
END %(OF WE NEED AN RRV)%
ELSE
LOOKAT (' REC DOESNT NEED RRV AT: ', OLDMOVINGPTR );
%([ BUMP THE POINTER TO NEXT RECORD ])%
INC ( OLDMOVINGPTR, .SIZEOFTHISRECRD )
END %(OF IF THIS IS STILL A DATA RECORD)%
ELSE %(THIS IS AN RRV (THE FIRST ONE))%
BEGIN
IF .UDRFLAG IS FALSE THEN RMSBUG ( MSGRRV );
%([ REMEMBER WHERE FIRST RRV WAS ])%
OLDRRVPTR = .OLDMOVINGPTR;
%([ COMPUTE SIZE OF ALL CURRENT RRV'S ])%
SIZERRV = .OLDENDPTR - .OLDMOVINGPTR;
LOOKAT (' 1ST RRV AT: ',OLDRRVPTR );
LOOKAT (' SIZE OF RRVS: ',SIZERRV);
LEAVE SIZELOOP;
END %(OF ELSE THIS IS AN RRV)%
END; %(OF WHILE LOOP)%
END; %(OF SIZELOOP)%
%([ WE HAVE NOW SCANNED ALL OF R-HIGH AND COMPUTED THE SIZE
OF R-HIGH AND ALL THE RRV'S IN THE BUCKET. WE NEED TO NOW
FIGURE OUT HOW MUCH SPACE WE ABSOLUTELY REQUIRE IN THIS
BUCKET SO WE CAN THEN DETERMINE HOW MUCH DATA WE CAN MOVE OUT. ])%
SUM = .SIZELOW + .SIZERRV + .SIZENEWRRV;
LOOKAT (' SUM: ', SUM );
%([ "SUM" NOW REPRESENTS THE MINIMUM AMOUNT WHICH MUST REMAIN
IN THIS BUCKET IF WE SPLIT AT THE CURRENT RECORD ])%
%([ CHECK TO SEE IF NEW RECORD CAN FIT HERE ])%
SIZEOFNEWRECORD = .RECDESC [ RDLENGTH ] ;
LOOKAT (' SIZE OF HOLE TO LEAVE: ',SIZEOFNEWRECORD);
%([ CHECK TO SEE THAT SPLIT SHOULD HAVE BEEN CALLED ])%
IF .SIZEOFNEWRECORD GTR .MAXDATASIZE THEN RMSBUG ( MSGINPUT );
%([ CAN R-NEW FIT? ])%
IF ( .SUM + .SIZEOFNEWRECORD ) LEQ .MAXAVAILABLE
THEN %(THE NEW RECORD WILL FIT IN THIS BUCKET)%
BEGIN
RTRACE (%STRING(' R-NEW WILL FIT IN THIS BKT'));
%([ MAYBE SOME RECORDS IN R-HIGH WILL FIT ALSO ])%
RTRACE (%STRING(' SCANNING RHIGH...'));
OLDMOVINGPTR = .INSERTPTR; ! GET TEMP PTR
%([ DETERMINE THE POINT AT WHICH WE WANT TO CONSIDER
THE BUCKET AS BEING FULL ])%
MAXBKTOFFSET = .OLDBKTPTR [ BHNEXTBYTE ] ^ DIVIDEBY2LSH;
%([ LET'S LOOK AT THE MAX BUCKET OFFSET ])%
LOOKAT (' MAXBKTOFFSET: ', MAXBKTOFFSET );
!** [15] ROUTINE:SPLIT AT LINE 7370, EGM, 26-JUL-78
%([15])% %([ SETUP THE SIZE OF THE PREVIOUS RECORD ( THE ONE )%
%([15])% %( POINTED TO BY LASTRHIGHOLDPTR), TO EITHER: 0 )%
%([15])% %( FOR THE FIRST RECORD IN THE BUCKET, OR TO THE SIZE )%
%([15])% %( OF THE PREVIOUS RECORD, SO THAT IF THE VERY FIRST )%
%([15])% %( RECORD WE SEE PUTS US OVER THE LIMIT, LAST-RHIGH-PTR )%
%([15])% %( WILL STILL BE CORRECT ])%
%([15])%
%([15])% IF .RECDESC [ RDRECPTR ] EQL .RECDESC [ RDLASTRECPTR ]
%([15])% THEN
%([15])% SIZEOFTHISRECRD = ZERO
%([15])% ELSE
%([15])% SIZEOFTHISRECRD = SIZEOFDATARECRD ( LASTRHIGHOLDPTR );
%([ LOOP UNTIL THE BUCKET MEETS THIS FILL CRITERION ])%
SCANRECS: BEGIN
UNTIL ( .SUM + .SIZEOFNEWRECORD )
GEQ
( .MAXBKTOFFSET )
DO %(THIS LOOP)%
BEGIN
%([ REMEMBER THE SIZE OF THE LAST RECORD. THIS IS
BECAUSE IF THE LAST RECORD WE SCAN IS TOO BIG,
WE MUST REMEMBER THE SIZE OF THE RECORD BEFORE IT ])%
!** [12] ROUTINE:SPLIT AT LINE 7388, EGM, 5-APR-78
%([12])% SIZEOFLASTRECRD = .SIZEOFTHISRECRD;
%([ IF WE ARE SPLITTING A PRIMARY DATA BUCKET, AND IF
DUPS ARE ALLOWED, THEN WE MUST INSURE THAT
THE SPLIT OCCURS EITHER BEFORE OR AFTER THE NEW
RECORD. I.E., WE DON'T WANT TO DISTRIBUTE THE
OTHER DUPS ACROSS BUCKETS WITH OTHER RECORDS.
THEREFORE, WE WILL CHECK HERE AND IF THESE CONDITIONS HOLD,
WE WILL PUT THE NEW RECORD ON THIS BUCKET AND
MOVE EVERYTHING ELSE OUT. ])%
IF ( .UDRFLAG ISNT FALSE ) ! PRIMARY DATA RECORDS
THEN IF DUPLICATES ! AND DUPS ALLOWED
THEN
LEAVE SCANRECS; ! THEN EXIT NOW
%([ CONSISTENCY CHECK ])%
IF .OLDMOVINGPTR GEQ .OLDENDPTR THEN rmsbug (MSGPTR);
SIZEOFTHISRECRD = SIZEOFDATARECRD ( OLDMOVINGPTR );
INC ( SUM, .SIZEOFTHISRECRD );
%([ HOWEVER, IF WE ORIGINALLY CALCULATED THAT THIS
RECORD WAS TO BE MOVED, WE MUST SUBTRACE THE
SIZE OF THE RRV WHICH WE INCLUDED IN "SUM" ])%
IF .UDRFLAG ISNT FALSE
THEN IF .OLDMOVINGPTR [ DRRRVBUCKET ] IS .OLDBUCKET
THEN
DEC ( SUM, RRVRECSIZE );
LOOKAT (' UPDATE SUM VALUE: ',SUM);
INC ( OLDMOVINGPTR, .SIZEOFTHISRECRD );
LOOKAT (' PTR BUMPED TO: ', OLDMOVINGPTR )
END; %(OF UNTIL BUCKET IS FULL)%
END; %( OF SCANRECS LOOP )%
%([ HOWEVER, WE MAY HAVE ALSO GONE OVER A FULL BUCKET
IF THE LAST RECORD WAS A REALLY BIG ONE. SO, CHECK
IF THIS LAST RECORD HAS PUT US OVER A FULL BUCKET ])%
!** [15] ROUTINE:SPLIT, AT LINE 7428, EGM, 26-JUL-78
%([15])% IF ( .SUM + .SIZEOFNEWRECORD ) GTR .MAXAVAILABLE %(UDR)%
%([15])% OR
%([15])% .SUM EQL .MAXAVAILABLE %(SIDR)%
THEN %(WE MUST BACK UP ONE DATA RECORD)%
BEGIN
RTRACE (%STRING(' LAST RECORD TOO BIG'));
DEC ( SUM, .SIZEOFTHISRECRD );
DEC ( OLDMOVINGPTR, .SIZEOFTHISRECRD );
SIZEOFTHISRECRD = .SIZEOFLASTRECRD ! ADJUST LAST RECORD SIZE
END; %(OF WE MUST BACK UP ONE RECORD)%
%([ WE NOW HAVE GONE OVER HALF A FULL BUCKET. ])%
LASTRHIGHOLDPTR = .OLDMOVINGPTR - .SIZEOFTHISRECRD;
LOOKAT (' LAST R-HIGH IN OLD: ', LASTRHIGHOLDPTR );
%([ WE NOW KNOW HOW TO SPLIT THE BUCKET ])%
SNEWINOLD = .SIZEOFNEWRECORD; ! R-NEW GOES HERE
SHIGHINOLD = .OLDMOVINGPTR - .INSERTPTR;
SHIGHINNEW = .SIZEHIGH - .SHIGHINOLD; ! THIS MUCH GOES
END %(OF IF SUM + SIZEOFNEWRECORD LEQ MAXSIZE)%
ELSE %(THE NEW RECORD CANNOT FIT IN THIS BUCKET)%
BEGIN
%([ EITHER IT WILL FIT ENTIRELY IN WITH R-HIGH, OR IT
MUST GO IN ITS OWN BUCKET ])%
SHIGHINNEW = .SIZEHIGH; ! ALL OF R-HGH MOVES
%([ IF THE NEW RECORD PLUS THE SIZE OF R-HIGH IS TOO
BIG FOR THE BUCKET, OR IF THE NEW RECORD IS A DUPLICATE,
THEN WE NEED TO HAVE A THREE BUCKET SPLIT. IN THE
LATTER CASE, WE WON'T ENTER THE BUCKET CONTAINING
THE NEW RECORD INTO THE INDEX BECAUSE IT IS MERELY
AN EXTENSION OF THE ORIGINAL BUCKET CONTAINING THE
OTHER DUPLICATES. ])%
IF ( ( ( .SIZEOFNEWRECORD + .SIZEHIGH ) GTR .MAXDATASIZE )
OR
( DUPLICATEFLAG ( RECDESC ) ISON ) AND ( .SIZEHIGH ISNT ZERO ) )
THEN %(THIS IS A 3-BKT SPLIT)%
BEGIN
RTRACE (%STRING('*******A 3-BKT SPLIT'));
RECDESC [ RDCOUNT ] = 2; ! SIGNAL IT
TWOBUCKETSPLIT = FALSE; ! REMEMBER THAT
END
ELSE %(THIS IS A NORMAL 2-BKT SPLIT)%
BEGIN
RTRACE (%STRING(' R-NEW WILL GO INTO NEW BKT'));
%([ IF R-NEW WILL GO INTO A BUCKET BY ITSELF (I.E,
IF S-HIGH=0), AND A DUPLICATE HAS BEEN SEEN, THEN
WE DONT WANT TO UPDATE THE INDEX BECAUSE THIS
DUPLICATE RECORD (R-NEW) WILL GO INTO A HORIZONTAL
BUCKET BY ITSELF ])%
IF ( DUPLICATEFLAG ( RECDESC ) ISON )
THEN CLRFLAG ( RECDESC [ RDSTATUS ], RDFLGIDXUPDATE );
SNEWINNEW = .SIZEOFNEWRECORD;
END %(OF ELSE R-NEW GOES IN WITH R-HIGH)%
END; %(OF ELSE WE MUST MOVE THE NEW RECORD)%
%([ LET'S SEE EVERYTHING ])%
%IF DBUG %THEN
TYPE (%STRING('***SPLIT DESCRIPTOR:'));
PRINTVALUE (' S-NEW-IN-OLD: ',SNEWINOLD);
PRINTVALUE (' S-NEW-IN-NEW: ',SNEWINNEW);
PRINTVALUE (' S-HIGH TO STAY: ', SHIGHINOLD );
PRINTVALUE (' S-HIGH TO MOVE: ', SHIGHINNEW );
PRINTVALUE(' 2-BKT FLAG: ', TWOBUCKETSPLIT);
PRINTVALUE (' SIZE OF RRVS: ', SIZERRV );
%FI
%([ CHECK OUT ALL THESE VALUES TO SEE IF THEY ARE REASONABLE ])%
IF ( ( .INSERTPTR + .SHIGHINOLD + .SHIGHINNEW + .SIZERRV )
ISNT .OLDENDPTR )
OR
( ( .OLDRRVPTR + .SIZERRV ) ISNT .OLDENDPTR )
OR
( .SIZEHIGH ISNT ( .SHIGHINOLD + .SHIGHINNEW ) )
THEN
RMSBUG ( MSGSPLIT );
%([ HERE IS A BRIEF SUMMARY OF SOME OF OUR CURRENT VALUES:
INSERTPTR PLACE IN OLD BUCKET TO PUT RECORD
OLDRRVPTR PTR TO START OF RRV'S
OLDENDPTR PTR TO END OF OLD BUCKET
])%
%([ ALLOCATE A FIRST NEW BUCKET ])%
IF CALLALCBKT (%(TYPE)% PCI ( BTYPEDATA),
%(FLAGS)% PCI ( ZERO ),
%(LEVEL)% PCI ( DATALEVEL ),
%(BD)% BPT ( SPLITBD1 )) IS FALSE
THEN
RETURN FALSE;
%([ GET THE BUCKET NUMBER )%
SPLIT1BKT = .SPLITBD1 [ BKDBKTNO ];
SPLIT1BKTPTR = .SPLITBD1 [ BKDBKTADR ];
LOOKAT (' NEW BKT IS AT: ', SPLIT1BKTPTR );
%([ LINK ALL THESE BUCKETS TOGETHER ])%
SPLIT1BKTPTR [ BHNEXTBKT ] = .OLDBKTPTR [ BHNEXTBKT ];
OLDBKTPTR [ BHNEXTBKT ] = .SPLIT1BKT;
SPLIT1BKTPTR [ BHFLAGS ] = .OLDBKTPTR [ BHFLAGS ] AND BHFLGEND;
%([ CLEAR THE FLAGS IN THE ORIGINAL DATA BUCKET (FLGEND BIT) ])%
CLRFLAG ( OLDBKTPTR [ BHFLAGS ], BHFLGEND );
%([ REMEMBER WHICH BUCKET R-NEW WILL GO INTO )%
MOVEBKTDESC ( %(FROM)% SPLITBD1, %(TO)% NEWRECBD );
%([ NOW, LET'S ALLOCATE ANOTHER BUCKET IF A 3-BKT SPLIT ])%
IF .TWOBUCKETSPLIT IS FALSE
THEN %(WE NEED ANOTHER BUCKET)%
BEGIN
RTRACE (%STRING(' ALLOCATING ANOTHER BKT...'));
IF CALLALCBKT (%(TYPE)% PCI ( BTYPEDATA ),
%(FLAGS)% PCI ( ZERO ),
%(LEVEL)% PCI ( DATALEVEL),
%(BD)% BPT ( SPLITBD2 ) ) IS FALSE
THEN
BEGIN
RTRACE (%STRING(' ALCBKT FAILED**'));
%([ WE MUST NOW GIVE BACK THE BUCKET THAT WE JUST GOT.
FOR NOW, THE "DEALLOCATING" OF A FILE BUCKET CANNOT
BE DONE. IN THE FUTURE, IT WILL BE PUT ONTO A LINKED
LIST OF SPARE BUCKETS ])%
DEALLOCBUCKET ( %(BUCKET)% SPLITBD1,
%(SIZE)% .BKTSIZE );
BADRETURN;
END; %(OF CANT GET A SECOND BUCKET)%
%([ REMEMBER THAT R-NEW WILL GO INTO THIS BUCKET ])%
MOVEBKTDESC ( %(FROM)% SPLITBD2, %(TO)% NEWRECBD );
%([ SET UP SOME POINTERS TO THE 2ND BUCKET AND FILL IN THE HEADER ])%
SPLIT2BKTPTR = .SPLITBD2 [ BKDBKTADR ];
SPLIT2BKTPTR [ BHNEXTBKT ] = .SPLIT1BKT; ! PUT THIS BKT INTO CHAIN
OLDBKTPTR [ BHNEXTBKT ] = .SPLITBD2 [ BKDBKTNO ]; ! MAKE OLD POINT TO THIS ONE
SPLIT2BKTPTR [ BHNEXTBYTE ] = .SIZEOFNEWRECORD + BHHDRSIZE
END; %(OF IF 2BUCKETFLAG IS FALSE)%
%([ WE NOW HAVE ADJUSTED ALL THE HEADER INFO (EXCEPT FOR NEXTBYTE) AND PLACED THE
BUCKET FLAGS (ACTUALLY JUST THE "END" FLAG BIT ) INTO THE
NEW BUCKET. LET'S SEE EVERYTHING ])%
%IF DBUG %THEN
TYPE (%STRING('***DUMP OF SPLIT BKT-HDR: '));
CALLDUMPHEADER ( LPT ( SPLIT1BKTPTR ) );
IF .TWOBUCKETSPLIT IS FALSE
THEN %(WE SHOULD PRINT OUT THE OTHER BUCKET TOO)%
BEGIN
TYPE (%STRING('***DUMP OF 2ND BKT HEADER:'));
CALLDUMPHEADER ( LPT ( SPLIT2BKTPTR ) );
END;
%FI
%([ DOES R-NEW GO IN THE ORIGINAL BUCKET? ])%
IF .SNEWINOLD ISNT ZERO
THEN %(R-NEW GOES IN ORIGINAL BUCKET)%
BEGIN
%([ REMEMBER WHICH BUCKET CONTAINS R-NEW ])%
MOVEBKTDESC ( %(FROM)% BKTDESC, %(TO)% NEWRECBD );
%([ SOME (OR ALL) OF R-HIGH MUST BE MOVED OUT ])%
RTRACE (%STRING(' MOVING R-HIGH TO NEW BKT...'));
IF .SHIGHINNEW IS ZERO THEN RMSBUG ( MSGSPLIT );
MOVEWORDS ( %(FROM)% .INSERTPTR + .SHIGHINOLD,
%(TO)% .SPLIT1BKTPTR + BHHDRSIZE,
%(SIZE)% .SHIGHINNEW );
%([ CHECK TO SEE IF WE NEED TO MOVE THE RRV'S DOWN OR
UP IN THE BUCKET. THEY WILL BE MOVED UP IF THE RECORDS
IN R-HIGH WE ARE MOVING OUT ARE BIGGER THAN R-NEW.
THEY WILL BE MOVED DOWN IF THE OPPOSITE IS TRUE ])%
IF .SIZERRV ISNT ZERO
THEN %(RRV'S MUST BE MOVED)%
BEGIN
%([ UP? ])%
IF .SHIGHINNEW GTR .SIZEOFNEWRECORD
THEN %(RRV'S SHOULD GO UP)%
BEGIN
RTRACE (%STRING(' MOVING RRVS UP...'));
MOVEWORDS ( %(FROM)% .OLDRRVPTR,
%(TO)% .INSERTPTR+.SIZEOFNEWRECORD
+ .SHIGHINOLD,
%(SIZE)% .SIZERRV );
END %(OF RRV'S GO UP)%
ELSE %(THEY GO DOWN)%
BEGIN
RTRACE (%STRING(' MOVING RRVS DOWN...'));
MOVEDOWN ( %(START)% .OLDRRVPTR,
%(END)% .OLDENDPTR - 1,
%(SIZE)% .SIZEOFNEWRECORD
- .SHIGHINNEW );
END %(OF MOVING RRV'S DOWN)%
END; %(OF IF SIZERRV ISNT ZERO)%
%([ NOW, MOVE R-HIGH DOWN ])%
IF .SHIGHINOLD ISNT ZERO
THEN
BEGIN
RTRACE (%STRING(' MOVING R-HIGH DOWN...'));
IF .SIZEOFNEWRECORD ISNT ZERO %(COULD BE A NULL SIDR)%
THEN
MOVEDOWN ( %(FROM)% .INSERTPTR,
%(TO)% .INSERTPTR + .SHIGHINOLD -1,
%(SIZE)% .SIZEOFNEWRECORD );
%([ RESET THE PTR TO NEW LAST RECORD IN BUCKET ])%
INC ( LASTRHIGHOLDPTR ,.SIZEOFNEWRECORD);
END %(OF IF SHIGHINOLD ISNT ZERO)%
ELSE %(ALL OF R-HIGH GETS MOVED OUT)%
LASTRHIGHOLDPTR = .INSERTPTR
END %(OF IF R-NEW GOES IN ORIGINAL BUCKET)%
ELSE %(R-NEW WILL BE MOVED)%
BEGIN
%([ DOES R-NEW GO INTO IT'S OWN BUCKET? ])%
IF .TWOBUCKETSPLIT
THEN
INSERTPTR = .SPLIT1BKTPTR + BHHDRSIZE
ELSE
%(IT'S A 3-BKT SPLIT)%
BEGIN
INSERTPTR = .SPLIT2BKTPTR + BHHDRSIZE;
SNEWINNEW = ZERO
END; %(OF ELSE A 3-BKT SPLIT)%
%([ NOW, MOVE ALL OF R-HIGH OUT ])%
IF .SHIGHINNEW ISNT ZERO
THEN
BEGIN
%([ NOTE THAT THE SOURCE ADDRESS OF THIS OPERATION
IS THE START OF R-HIGH PLUS THE SIZE OF R-HIGH
WHICH WILL STAY IN THIS BUCKET. FOR USER DATA
RECORDS, THIS INCREMENT IS ALWAYS ZERO. FOR
SIDR RECORDS, IT MAY BE NON-NULL IF WE ARE
ONLY SPLITTING THE BUCKET WITHOUT INSERTING
A NEW RECORD (I.E., ADDING A PTR TO AN ARRAY) ])%
MOVEWORDS ( %(FROM)% .RHIGHPTR + .SHIGHINOLD,
%(TO)% .SPLIT1BKTPTR + BHHDRSIZE + .SNEWINNEW,
%(SIZE)% .SHIGHINNEW );
%([ NOW, MOVE RRV'S UP IN THE BUCKET ])%
IF .SIZERRV ISNT ZERO
THEN
MOVEWORDS ( %(FROM)% .OLDRRVPTR,
%(TO)% .OLDBKTPTR+BHHDRSIZE+.SIZELOW,
%(SIZE)% .SIZERRV);
END %(OF IF SHIGHINNEW ISNT ZERO)%
END; %(OF R-NEW GOES INTO SEPARATE BUCKET)%
%([** FIX. REMEMBER THAT R-NEW GOES INTO NEW BUCKET ON SEQ ACCESS. THIS **])%
%([** CONDITION IS INDICATED BY THE FLAG FLGNEWINNEW IN RECDESC. **])%
IF (SEQADR AND .TWOBUCKETSPLIT AND ( .SNEWINNEW ISNT ZERO ))
THEN ![%51] PUT . ON SNEWINNEW ABOVE
SETNEWINNEWFLG ( RECDESC );
%([** END OF FIX. **])%
%([ NOW, SET UP NEXT-BYTE POINTER FOR BOTH BUCKETS ])%
OLDBKTPTR [ BHNEXTBYTE ] = .OLDBKTPTR [ BHNEXTBYTE ] - .SHIGHINNEW + .SNEWINOLD;
SPLIT1BKTPTR [ BHNEXTBYTE ] = BHHDRSIZE + .SNEWINNEW + .SHIGHINNEW;
%([ THE NEW RECORD CAN NOW BE INSERTED AT "INSERTPTR" ])%
RECDESC [ RDRECPTR ] = .INSERTPTR;
%([ ALLOCATE A NEW RFA FOR THIS RECORD, UNLESS THIS IS
A BUCKET INTO WHICH A NEW RECORD IS NOT TO BE INSERTED ])%
IF .SIZEOFNEWRECORD ISNT ZERO
THEN %(GET A NEW RFA)%
RECDESC [ RDRFA ] = CALLALCRFA ( LCT ( NEWRECBD ) );
%([ SET UP THE PTR TO THE LAST RECORD IN THE ORIGINAL
BUCKET, AND FIGURE OUT IF THERE ARE SOME DATA RECORDS
IN THAT BUCKET (IT MAY BE FULL OF RRV'S) ])%
RECDESC [ RDLASTRECPTR ] = .LASTRHIGHOLDPTR;
IF RRVFLAG ( LASTRHIGHOLDPTR ) ISON
THEN
SETFLAG ( RECDESC [ RDSTATUS ], RDFLGNOHIKEY );
%IF DBUG %THEN
TYPE (%STRING('***RD AFTER SPLIT...'));
CALLDUMPRD ( BPT ( RECDESC ) );
%FI
GOODRETURN
END; %(OF SPLIT)%
! COMPRESS
! ========
! ROUTINE TO COMPRESS A USER DATA BUCKET WHEN A NEW RECORD WILL
! NOT FIT. THIS ROUTINE ATTEMPTS TO SQUEEZE THE BUCKET
! AND REMOVE DELETED RECORDS IN ORDER TO MAKE ROOM FOR THE
! THE NEW RECORD WHICH IS TO BE INSERTED.
!
! THIS ROUTINE IS CALLED ONLY ON RECORD INSERTION ($PUT).
! THE $DELETE OPERATION DOES NO BUCKET COMPRESSION AT ALL
! BECAUSE THE CURRENT FILE POSITION IS NOT LOCKED WHEN
! THE $DELETE IS DONE.
! INPUT:
! RECDESC RECORD DESCRIPTOR PACKET
! RECPTR ADDRESS OF INSERTION POSITION
! LASTRECPTR ADDR OF HI REC FOR ORIG BKT, IF SPLIT
!
! DATABD BUCKET DESCRIPTOR OF CURRENT BUCKET
! OUTPUT:
! AMOUNT OF SPACE RECLAIMED BY COMPRESSION
! INPUT ARGS MODIFIED:
!
! RECORD DESCRIPTOR:
! RECPTR NEW INSERTION POINT
! LASTRECPTR NEW HI REC FOR SPLIT
! NOTES:
!
! 1. WHEN THIS ROUTINE IS CALLED, IT IS ASSUMED THAT
! ALL SECONDARY INDEX RECORDS (SIDR'S) FOR EACH DELETED
! RECORD HAVE ALREADY BEEN DELETED OR OTHERWISE TAKEN
! CARE OF. THUS, WE ONLY MUST COMPRESS THE PRIMARY
! DATA RECORD.
!
! 2. IF THIS IS A NEW FILE (IT IS CURRENTLY BEING CREATED)
! OR IF THERE ARE DUPLICATES ALLOWED IN THE PRIMARY INDEX,
! THEN WE WILL DO NO COMPRESSION AT ALL. THIS ALGORITHM
! IS NON-OPTIMAL IF $DELETES ARE DONE DURING THE CREATION
! OF THE FILE, BUT THIS IS ALMOST GUARENTEED TO BE A VERY
! RARE OCCURANCE AND WE DON'T WANT TO PAY THE OVERHEAD
! OF ATTEMPTING A COMPRESSION ON A BUCKET WHICH WILL NOT
! HAVE ANY DELETED RECORDS IN IT. IF DUPLICATES ARE ALLOWED,
! COMPRESSION IS NOT DONE BECAUSE IT MAY CAUSE THE
! CURRENT RECORD POSITION OF A USER TO BE LOST.
!
! 3. THERE ARE TWO PRIMARY OPTIMIZATIONS USED BY THIS ROUTINE:
! A) CONTIGUOUS DELETED RECORDS ARE COMPRESSED AS A UNIT
! B) RRV'S ARE COMPRESSED A BUCKET AT A TIME.
!
! 4. THIS ROUTINE USES A LOCAL DATA STRUCTURE TO SPEED UP
! THE PROCESSING OF THE DELETED RECORDS (CALLED THE
! "DELETETABLE"). IT HAS TWO FIELDS, THE ADDRESS OF THE
! DELETED RECORD AND ITS LENGTH IN WORDS. THIS TABLE
! IS FILLED IN BY SCANNING ALL RECORDS IN THE BUCKET
! BEFORE ANY COMPRESSION IS DONE. THEN, THE TABLE
! IS SCANNED AGAIN AND CONTIGUOUS RECORD CHUNKS ARE
! COMPRESSED AS A UNIT. IF THE TABLE IS NOT BIG ENOUGH
! TO HOLD ALL THE DELETED RECORDS IN THE BUCKET, THEN
! THE ALGORITHM WILL STOP AND PROCESS ONLY THOSE RECORDS
! IN THE TABLE. THE FORMAT OF THE DELETED-RECORD TABLE IS AS FOLLOWS:
!
! !-------------------------------------!
! ! ADDRESS OF ! LENGTH OF !
! ! DELETED RECORD-1! DELETED RECORD-1!
! !-------------------------------------!
! ! . !
! ! . !
! !
!
! NOTE THAT THE "DTADDRESS" FIELD IN THIS TABLE
! CONTAINS THE ABSOLUTE ADDRESS OF THE DELETED RECORD
! WHEN THE BUCKET WAS FIRST SCANNED. HOWEVER, AS RECORDS
! ARE COMPRESSED OUT OF THE BUCKET, THESE ADDRESSES MUST
! BE MODIFIED BY THE AMOUNT OF DATA COMPRESSED OUT UP
! TO THAT RECORD. SO, PLEASE NOTE THE USE BELOW OF
! "AMOUNTCOMPRESED" WHICH CONTAINS THE SIZE OF ALL RECORDS
! SQUEEZED OUT OF THE BUCKET PREVIOUSLY.
!
!
! 5. THIS ROUTINE DOES NOT COMPRESS THE LAST DATA RECORD
! IN THE BUCKET IF IT IS DELETED. THIS TECHNIQUE IS USED
! BECAUSE IF THE LAST RECORD WERE COMPRESSED, THEN THE
! HIGH-KEY VALUE IN THE INDEX RECORD WOULD NOT BE CORRECT,
! AND LATER SEARCHES TO THE BUCKET MIGHT HAVE TO GO
! TO THE NEXT BUCKET IN ORDER TO FIND THE CORRECT POSITION.
!
! 6. AS EACH DELETED RECORD IS SCANNED, THE "RRVUPD" BIT
! IS CLEARED. THIS IS DONE SO THAT "COMPRRV" WILL HAVE
! SOME MEANS OF KNOWING IF THE RRV FOR A PARTICULAR
! RECORD HAS ALREADY BEEN UPDATED.
!
! 7. **** WITH THE ARRIVAL OF EXTENDED ADDRESSING...***
! THIS ROUTINE WILL HAVE TO BE CHECKED FOR USE OF
! SECTIONS NUMBERS. FOR EXAMPLE, THE ADDRESS WHICH
! ARE KEPT IN THE DELETED-RECORD TABLE ARE ABSOLUTE
! 18-BIT ADDRESSES AND HENCE ARE RELATIVE TO THE
! RMS DATA SECTION.
%([ ***DEFINITION OF SPECIAL DELETED-RECORD TABLE*** ])%
MACRO DTADDRESS = LH %, ! ADDRESS OF THIS DELETED RECORD
DTLENGTH = RH %; ! LENGTH OF THIS DELETED RECORD
%([ ***END OF DEFINITION OF DELETED-RECORD TABLE*** ])%
GLOBAL ROUTINE COMPRESS ( RECDESC, DATABD ) =
BEGIN
ARGUMENT (RECDESC,BASEADD); ! RECORD DESC PACKET
ARGUMENT (DATABD,BASEADD); ! BUCKET
MAP
DATABD: POINTER,
RECDESC: POINTER;
REGISTER
MOVINGPTR: POINTER, ! TEMPORARY RECORD POINTER
TEMPAC, ! TEMP AC
LNGOFTHISRECORD; ! SIZE IN WORDS OF CURRENT RECORD
LOCAL
CHUNKPTR: POINTER, ! PTR TO START OF CURRENT CHUNK OF RECORDS
I, ! USED FOR LOOPING
CHUNKSIZE, ! SIZE OF THE CHUNK
DELETECOUNT, ! # OF DELETED RECORDS IN TABLE
RECLAIMEDSPACE, ! AMOUNT OF SPACE COMPRESSED
AMOUNTCOMPRESED, ! AMOUNT OF DATA ALREADY COMPRESSED
LNGOFLASTRECORD, ! SIZE OF LAST RECORD SCANNED
LNGOFSAVED, ! SIZE OF LAST UNDELETED REC
BKTPTR: POINTER, ! PTR TO BUCKET
ENDPTR: POINTER, ! PTR TO END OF BUCKET
AMOUNTTOMOVE, ! AMOUNT TO DATA TO MOVE UP
INSERTPTR: POINTER, ! PLACE WHERE NEW RECORD IS TO GO
LASTPTR, ! PTR TO HIGH RECORD, FOR SPLIT
OURTABLE, ! FLAG WHICH IS SET IF TABLE IS TOO SMALL
TABLEINDEX, ! USED TO INDEX DELETE TABLE
RRVBUCKET; ! BUCKET NUMBER OF RRV
LITERAL EMPTY = 0, ! VALUES USED FOR "TABLE" FLAG
FULL = 1;
%([ DEFINITION OF THE DELETED-RECORD TABLE. NOTE THAT IT CONTAINS
1 MORE WORD THAN THE MAX NUMBER OF DELETED RECORD. THIS IS SO
THE LAST WORD OF THE TABLE CAN BE ZEROED SO WE WON'T HAVE TO
WORRY ABOUT CHECKING IF THE TABLE IS BIG ENOUGH, ETC... ])%
LITERAL MAXDELETECOUNT = 200; ! MAX OF 200 RECORDS CAN BE COMPRESSED
LOCAL
DELETETABLE: FORMATS[ MAXDELETECOUNT + 1 ];
EXTERNAL ROUTINE
COMPRRV;
LABEL SCANLOOP,INNERLOOP;
TRACE ('COMPRESS');
%IF DBUG %THEN
IF NOT PRIMARYKEY THEN RMSBUG ( MSGKDB );
%FI
%([ IF THIS IS A NEW FILE, OR IF DUPLICATES ARE ALLOWED IN
THE PRIMARY KEY, THEN WE CAN EXIT IMMEDIATELY. ])%
IF ( DUPLICATES ) OR ( NEWFILE ) THEN RETURN ZERO;
%([ CLEAR SOME VARIABLES ])%
RECLAIMEDSPACE = ZERO;
DELETECOUNT = ZERO;
LNGOFLASTRECORD = ZERO;
LNGOFSAVED = ZERO;
OURTABLE = EMPTY; ! ASSUME THE TABLE IS BIG ENOUGH
%([ FETCH ADDR OF HI REC (FOR SPLIT), AND
THE ADDRESS WHERE THE NEW RECORD IS TO GO ])%
LASTPTR = .RECDESC [ RDLASTRECPTR ];
INSERTPTR = .RECDESC [ RDRECPTR ];
%([ ***NEXT STATEMENT MUST BE ADJUSTED TO USE SECTION NUMBER***])%
BKTPTR = .DATABD [ BKDBKTADR ]; ! ADDRESS OF BUCKET
MOVINGPTR = .BKTPTR + BHHDRSIZE; ! SCANNING PTR
%([ WE MUST NOW SCAN ALL RECORDS IN THE BUCKET AND SET UP
THE TABLE OF DELETED RECORDS. NOTE THAT THIS LOOP IS
SOMEWHAT INVERTED...IT CHECKS RECORD-N BEFORE IT ADDS
THE LENGTH OF RECORD-(N-1) INTO THE TOTAL COMPRESSED SPACE.
THIS IS DONE SO THE LAST RECORD WILL NEVER BE COMPRESSED OUT.
NOTICE THAT WE CHECK FIRST TO SEE IF WE ARE AT THE END OF THE
BUCKET. IF NOT, THEN WE ADD THE LENGTH OF THE LAST RECORD (IF IT
WAS DELETED). THIS ALGORITHM IS STRAIGHTFORWARD EXCEPT THAT
IT REQUIRES A FINAL CHECK AFTER THE LOOP TO SEE IF THE NEW
RECORD POSITION IS AT THE END OF THE BUCKET.
NOTE THAT IF THE DELETE-TABLE FILLS UP (VERY RARE), THEN
WE MUST EXIT FROM THE LOOP. BUT FIRST, WE MUST CHECK TO
MAKE SURE THAT THE NEW RECORD POSITION HAS BEEN UPDATED
PROPERLY. ])%
SCANLOOP: BEGIN
UNTIL ( ( RRVFLAG ( MOVINGPTR ) ISON ) ! UNTIL WE FIND AN RRV
OR
( .MOVINGPTR IS .BKTPTR + .BKTPTR [ BHNEXTBYTE ] ) )
DO %(THIS LOOP)%
BEGIN
%([ IF WE ARE NOW AT THE HIGH REC POSITION OR
THE RECORD POSITION WHERE THE
NEW RECORD IS TO BE INSERTED, WE MUST ADJUST THE RESPECTIVE
POINTER TO ACCOUNT FOR THE RECORDS WHICH ARE GOING TO
BE SQUEEZED OUT. ])%
IF .MOVINGPTR IS .LASTPTR
THEN
DEC ( RECDESC [ RDLASTRECPTR ], (.RECLAIMEDSPACE + .LNGOFLASTRECORD) );
IF .MOVINGPTR IS .INSERTPTR
THEN
DEC ( RECDESC [ RDRECPTR ], (.RECLAIMEDSPACE + .LNGOFLASTRECORD) );
LOOKAT (' CHECKING REC AT: ', MOVINGPTR );
%([ WE CAN NOW ADD IN THE LENGTH OF THE LAST RECORD IF
IT WAS DELETED... ])%
LOOKAT (' LENGTH-OF-LAST: ', LNGOFLASTRECORD );
IF .LNGOFLASTRECORD ISNT ZERO
THEN %(LAST RECORD WAS DELETED)%
BEGIN
INC ( RECLAIMEDSPACE, .LNGOFLASTRECORD );
INC ( DELETECOUNT, 1 )
END; %(OF IF .LENGTHOFLAST ISNT ZERO)%
LNGOFLASTRECORD = ZERO; ! CLEAR FOR NEXT ITERATION
LNGOFTHISRECORD = SIZEOFUDR ( MOVINGPTR );
LOOKAT (' LENGTH-OF-RECORD: ', LNGOFTHISRECORD );
%([ CHECK IF THIS RECORD IS DELETED ])%
IF CHKFLAG ( MOVINGPTR [ DRFLAGS ], FLGDELETE+FLGNOCOMPRESS)
IS
FLGDELETE
THEN %(RECORD IS DELETED AND COMPRESSABLE)%
BEGIN
RTRACE (%STRING(' RECORD IS DELETED..'));
%([ IF OUR TABLE IS NOT BIG ENOUGH TO HOLD
ANY MORE RECORDS, LET'S FORGET THE WHOLE
THING AND NOT SEARCH ANY MORE RECORDS ])%
IF .DELETECOUNT IS MAXDELETECOUNT
THEN %(THE TABLE HAS FILLED UP)%
BEGIN
OURTABLE = FULL; ! REMEMBER THIS FACT
IF .MOVINGPTR LSS .LASTPTR
THEN DEC (RECDESC [RDLASTRECPTR], .RECLAIMEDSPACE);
!ADJ HI REC POS
IF .MOVINGPTR LSS .INSERTPTR
THEN DEC ( RECDESC [ RDRECPTR ], .RECLAIMEDSPACE );
!ADJUST THE RECORD POS
LEAVE SCANLOOP ! EXIT FROM LOOP
END; %(OF IF TABLE IS FILLED UP)%
%([ SAVE THE DELETED RECORD INFO ])%
%([ ***NOTE NO SECTION NUMBERS ARE SAVED***])%
DELETETABLE [ .DELETECOUNT, DTADDRESS ] = .MOVINGPTR;
DELETETABLE [ .DELETECOUNT, DTLENGTH ] = .LNGOFTHISRECORD;
%([ SAVE THE LENGTH OF THIS RECORD FOR NEXT ITERATION ])%
LNGOFLASTRECORD = .LNGOFTHISRECORD;
%([ WE NOW MUST CLEAR THE "RRVUPD" FLAG BIT IN
THIS RECORD. THIS IS DONE SO THAT WE CAN LATER
DETERMINE IF WE HAVE SQUEEZED OUT THE RRV FOR
THIS RECORD. ])%
CLRFLAG ( MOVINGPTR [ DRFLAGS ], FLGRRVUPD );
!SEE IF THIS REC NEEDED BY SPLIT FOR IDX UPDATE
!IF YES, BACK UP HI PTR TO ACCT FOR COMPRESSING THIS REC
IF .MOVINGPTR IS .LASTPTR
THEN DEC (RECDESC[RDLASTRECPTR], .LNGOFSAVED);
END %(OF IF THIS RECORD IS DELETED)%
ELSE LNGOFSAVED = .LNGOFTHISRECORD;
!TO BE ABLE TO PT AT REC BEFORE
!HI REC WHEN IT COMPRESSED TOO
%([ BUMP THE TEMPORARY POINTER ])%
INC ( MOVINGPTR, .LNGOFTHISRECORD )
END; %(OF UNTIL WE HAVE SCANNED THE ENTIRE BUCKET)%
END; %( OF SCANLOOP )%
LOOKAT (' TOTAL RECLAIMED SPACE: ', RECLAIMEDSPACE );
%([ DID WE FIND ANY DELETED RECORDS? ])%
IF .DELETECOUNT IS ZERO THEN RETURN ZERO;
%([ WE NOW MUST MAKE 1 FINAL CHECK TO SEE IF THE NEW RECORD
IS TO GO AT THE END OF THE BUCKET. IF SO, THEN WE HAVE
NOT ADJUSTED THE POINTER BECAUSE WE LEFT THE LOOP ABOVE
WHEN WE HIT THE BUCKET END. NOTE ALSO THAT THE TABLE MUST
NOT BE FULL. IF THE TABLE FILLED UP, THEN THE CONTENTS
OF MOVINGPTR AND INSERTPTR WOULD BE THE SAME, BUT THE
CORRECT VALUE HAS ALREADY BEEN SUBTRACTED FROM INSERTPTR. ])%
IF ( .MOVINGPTR %(AT THE END OF THE BUCKET)%
IS
.INSERTPTR ) %(POSITION OF NEW RECORD)%
AND
( .OURTABLE ISNT FULL )
THEN
DEC ( RECDESC [ RDRECPTR ], .RECLAIMEDSPACE );
%([ WE WILL NOW CLEAR THE LAST ENTRY IN OUR DELETE-TABLE
SO THAT WE CAN USE IT LATER FOR COMPARISONS. WE
DON'T HAVE TO CHECK FOR THE END OF THE TABLE BECAUSE
OF THE EXTRA WORD WE ALLOCATED ABOVE. ])%
DELETETABLE [ .DELETECOUNT, DTADDRESS ] = ZERO;
%([ WE ARE NOW READY TO SCAN THE LIST OF DELETED RECORDS
AND COMPRESS THEM OUT. THE BASIC APPROACH
IS TO SCAN THE LIST UNTIL WE FIND A DELETED RECORD
WHICH IS NOT CONTIGUOUS WITH THE OTHER DELETED RECORDS.
WE THEN CAN SQUEEZE THE ENTIRE CHUNK WHICH WE HAVE COMPUTED
UP TO THAT RECORD. WE WILL ALSO SCAN THE LIST TO MAKE SURE
THAT WE SQUEEZE ALL RRV'S IN THE SAME BUCKET AT THE SAME
TIME (ACTUALLY, THIS IS DONE IN "COMPRRV"). ])%
TABLEINDEX = ZERO; ! CLEAR OUR MAJOR INDEX
AMOUNTCOMPRESED = ZERO; ! NO RECORDS SQUEEZED YET
%([ DO THIS LOOP UNTIL WE SCAN THE ENTIRE TABLE. NOTE
THAT TABLEINDEX IS UPDATED BELOW. ])%
UNTIL .TABLEINDEX GEQ .DELETECOUNT
DO %(THIS LOOP)%
BEGIN
LOOKAT (' NEW INDEX: ', TABLEINDEX );
%([ GET THE ADDRESS AND SIZE OF THE CURRENT DELETED RECORD ])%
%([ ***SET UP SECTION NUMBERS HERE***])%
%([ NOTE THAT WE MUST ADJUST THE ADDRESS OF THIS RECORD
BY THE AMOUNT OF DATA WHICH HAS BEEN COMPRESSED ALREADY. ])%
CHUNKPTR = .DELETETABLE [ .TABLEINDEX, DTADDRESS ] - .AMOUNTCOMPRESED;
MOVINGPTR = .CHUNKPTR;
CHUNKSIZE = .DELETETABLE [ .TABLEINDEX, DTLENGTH ];
%([ WE WILL NOW SCAN FROM THIS RECORD TO THE END
OF THE TABLE LOOKING FOR A CONTIGUOUS SET
OF DELETED RECORDS ])%
I= .TABLEINDEX; ! SCAN REST OF TABLE
INNERLOOP: BEGIN
UNTIL .I IS .DELETECOUNT - 1
DO
BEGIN
LOOKAT (' I IS: ', I );
%([ IS THIS CHUNK CONTIGUOUS WITH THE NEXT DELETED RECORD? ])%
IF .DELETETABLE [ .I, DTADDRESS ] + .DELETETABLE [ .I, DTLENGTH ]
IS
.DELETETABLE [ .I+1, DTADDRESS ]
THEN %(WE CAN INCLUDE NEW RECORD IN CHUNK)%
BEGIN
LOOKAT (' CONTIG CHUNK AT: ', DELETETABLE [ .I+1,DTADDRESS]);
INC ( CHUNKSIZE, .DELETETABLE[.I+1,DTLENGTH]);
INC ( I, 1 )
END %(OF IF NEXT RECORD IS CONTIGUOUS)%
ELSE %(THIS RECORD IS NOT CONTIGUOUS)%
LEAVE INNERLOOP
END; %(OF UNTIL WE SCAN REST OF TABLE)%
END; %( OF INNERLOOP )%
%([ DID WE FIND A CHUNK TO SQUEEZE OUT? ])%
IF .CHUNKSIZE ISNT ZERO
THEN
BEGIN %(TO SQUEEZE THIS CHUNK OUT)%
LOOKAT (' CHUNK IS AT: ', CHUNKPTR );
LOOKAT (' TOTAL CHUNK-SIZE IS: ', CHUNKSIZE);
CALLCOMPRRV ( %(COUNT)% LCI ( DELETECOUNT ),
%(SIZE)% LCI ( CHUNKSIZE ),
%(HOLE)% LCI ( AMOUNTCOMPRESED ),
%(INDEX)% LCI ( TABLEINDEX ),
%(TABL)% LCT ( DELETETABLE ),
%(BKT)% BPT ( DATABD ) );
%([ NOW, SQUEEZE OUT THIS CHUNK. IT STARTS AT
"CHUNKPTR" AND EXTENDS FOR "CHUNKSIZE" WORDS ])%
ENDPTR = .BKTPTR + .BKTPTR [ BHNEXTBYTE ];
AMOUNTTOMOVE = .ENDPTR - .CHUNKPTR - .CHUNKSIZE;
LOOKAT (' AMOUNT-TO-MOVE:', AMOUNTTOMOVE );
IF .AMOUNTTOMOVE ISNT ZERO
THEN
MOVEWORDS ( %(FROM)% .CHUNKPTR+.CHUNKSIZE,
%(TO)% .CHUNKPTR,
%(SIZE)% .AMOUNTTOMOVE );
%([ INCREMENT THE AMOUNT OF DATA ALREADY GONE ])%
INC ( AMOUNTCOMPRESED, .CHUNKSIZE );
LOOKAT ( ' AMNT-COMPRESSED: ', AMOUNTCOMPRESED);
%([ ADJUST THE BUCKET HEADER INFORMATION ])%
DEC ( BKTPTR [ BHNEXTBYTE ], .CHUNKSIZE )
END; %(OF IF CHUNKSIZE ISNT ZERO)%
%([ WE HAVE NOW COMPRESSED A SINGLE CHUNK. SO, BUMP
OUR PRIMARY TABLE INDEX POINTER OVER THE ENTIRE CHUNK ])%
TABLEINDEX = .I + 1
END; %(OF UNTIL .TABLEINDEX IS DELETECOUNT)%
!+ !A54
! Before leaving, check to make sure the record !A54
! descriptor still has the correct attributes flagged; !A54
! if the record was a duplicate of a deleted record, we !A54
! could have squeezed out the deleted record and the !A54
! duplicate flag should be cleared. !A54
!- !A54
!A54
IF duplicateflag (recdesc) ison !A54
THEN !A54
! Duplicate flag is on !A54
BEGIN !A54
LOCAL !A54
data_pointer; !A54
! Point at the data in the last record, which was a duplicate !A54
data_pointer = .recdesc [rdrecptr] + .kdb [kdbhsz]; !A54!M460
!data_pointer = .recdesc [rdlastrecptr] + .kdb [kdbhsz]; !A54
IF callckeyku (bpt (recdesc), lpt (data_pointer)) NEQ true !A54
THEN !A54
! Record is no longer a duplicate, turn off dup flag !A54
clrflag (recdesc [rdstatus], rdflgdup); !A54
END; !A54
! We are finally through
LOOKAT (' VALUE RETURNED FROM COMPRESS: ', RECLAIMEDSPACE );
RETURN .RECLAIMEDSPACE
END; ! of COMPRESS
! COMPRRV
! =======
! ROUTINE TO COMPRESS OUT RRV RECORDS WHEN A BUCKET OF PRIMARY
! DATA RECORDS IS BEING COMPRESSED. THIS ROUTINE IS NOT A
! GENERAL-PURPOSE ONE IN THAT IT CANNOT BE CALLED BY ANY
! ROUTINE OTHER THAN "COMPRESS".
! THIS ROUTINE WILL SEARCH ONLY THE CURRENT CHUNK OF DELETED
! RECORDS TO SEE IF ANY OF THEM NEED AN RRV SQUEEZED OUT. THE
! BASIC ALGORITHM FOLLOWED BY THIS ROUTINE IS:
!
! A ) SEARCH EACH DELETED RECORD IN CHUNK TO SEE
! IF ANY HAVE RRV'S TO BE COMPRESSED.
!
! B ) IF THERE IS ONE, SEARCH ENTIRE REST OF TABLE FOR
! OTHER RECORDS WHICH HAVE RRV'S ON THAT BUCKET. IF
! FOUND, COMPRESS THE RRV AND MARK THE RECORD AND BEING
! DONE.
!
!
! THIS ROUTINE CURRENTLY SQUEEZES OUT THE RRV RECORDS COMPLETELY.
! IT MAY BE DESIREABLE IN THE FUTURE TO MERELY INDICATE THAT THE
! RRV'S ARE DELETED, THUS SAVING THE FAIRLY EXPENSIVE MOVING OPERATIONS.
!
! THIS ROUTINE ATTEMPTS TO OPTIMIZE ACCESS TO THE RRV'S BY
! SQUEEZING OUT ALL RRV'S IN THE SAME BUCKET AT THE SAME TIME.
! INPUT:
! DELETECOUNT # OF DELETED RECORDS IN THE TABLE
! CHUNKSIZE SIZE OF CURRENT CHUNK OF DELETED RECORDS
! AMOUNTCOMPRESED SIZE OF RECORDS ALREADY SQUEEZED FROM BUCKET
! TABLEINDEX INDEX INTO TABLE OF CURRENT DELETED RECORD
! DELETETABLE TABLE OF DELETED RECORDS (SEE COMPRESS FOR FORMAT)
! DATABD BUCKET DESCRIPTOR OF DATA RECORD BUCKET
! OUTPUT:
! <NO STATUS RETURNED>
! INPUT ARGS MODIFIED:
! <NONE>
! ROUTINES CALLED:
! GETBKT
! SDATABKT
! NOTES:
!
! 1. THIS ROUTINE ASSUMES THAT THE RRV'S ARE ALWAYS
! POSITIONED ON THE BUCKET IN THE SAME RELATIVE
! ORDER AS THE PRIMARY DATA RECORDS. THIS ASSUMPTION
! IS VALID BECAUSE RRV'S ARE ALWAYS CREATED BY
! SCANNING THE DATA RECORDS SEQUENTIALLY FROM TOP
! TO BOTTOM OF THE BUCKET. THIS ALGORITHM IS IMPLEMENTED
! IN "UPDRRV".
!
!
GLOBAL ROUTINE COMPRRV ( DELETECOUNT, CHUNKSIZE, AMOUNTCOMPRESED, TABLEINDEX, DELETETABLE, DATABD ) : NOVALUE=
BEGIN
ARGUMENT (DELETECOUNT,VALUE);
ARGUMENT (CHUNKSIZE,VALUE);
ARGUMENT (AMOUNTCOMPRESED,VALUE);
ARGUMENT (TABLEINDEX,VALUE);
ARGUMENT (DELETETABLE,BASEADD);
ARGUMENT (DATABD,BASEADD);
MAP
DELETETABLE: POINTER,
DATABD: POINTER;
REGISTER
MOVINGPTR: POINTER, ! TEMPORARY RECORD POINTER
TEMPAC; ! TEMPORARY AC
LABEL ITERATION; ! LABEL USED FOR LEAVING
LOCAL
SIZECOUNTER, ! SIZE OF CHUNK ALREADY SCANNED
RRVBUCKET, ! BUCKET NUMBER OF BUCKET WITH RRV
BUCKETSIZE, ! SIZE OF DATA BUCKET
RRVBD: FORMATS[ BDSIZE ], ! BKT DESCRIPTOR FOR RRV BUCKET
MYRECDESC: FORMATS[ RDSIZE ], ! A TEMP RECORD DESCRIPTOR
RRVBKTPTR: POINTER, ! PTR TO BUCKET OF RRV'S
RRVENDPTR: POINTER, ! PTR TO END OF RRV BUCKET
RRVPTR: POINTER, ! PTR TO ACTUAL RRV
AMOUNTTOMOVE; ! AMOUNT OF DATA TO MOVE UP
LITERAL NOLOCK = FALSE; ! SYMBOL USED FOR LOCKING
LITERAL UPDATERRVBUCKET = TRUE; ! SYMBOL USED TO DETERMINE IF THE
! BUCKET OF RRV'S IS WRITTEN IMMEDIATELY
! TO DISK
TRACE ('COMPRRV');
%([ GET SIZE OF EACH DATA BUCKET ])%
BUCKETSIZE = .KDB [ KDBDBKZ ]; ! GET BUCKET SIZE
SIZECOUNTER = ZERO; ! CLEAR COUNTER
%([ WE WILL NOW SCAN THE ENTIRE CHUNK LOOKING FOR ANY
RECORD WHICH NEEDS AN RRV ])%
UNTIL .SIZECOUNTER IS .CHUNKSIZE
DO
BEGIN
IF .SIZECOUNTER GTR .CHUNKSIZE THEN RMSBUG ( MSGCOUNT );
%([ GET THE ADDRESS OF THIS DELETED RECORD AND ADJUST
IT BY THE AMOUNT OF DATA WHICH HAS ALREADY BEEN
COMPRESSED OUT OF THE BUCKET ])%
MOVINGPTR = .DELETETABLE [ .TABLEINDEX, DTADDRESS ] -.AMOUNTCOMPRESED;
%([ DOES THIS RECORD HAVE AN RRV? ])%
RRVBUCKET = .MOVINGPTR [ DRRRVBUCKET ];
IF .RRVBUCKET ISNT .DATABD [ BKDBKTNO ]
THEN
%([ AND HAS THE RECORD BEEN PROCESSED? ])%
IF CHKFLAG ( MOVINGPTR [ DRFLAGS ], FLGRRVUPD ) IS OFF
THEN
BEGIN
LOOKAT (' SQUEEZE AN RRV AT: ', MOVINGPTR );
%([ GET A BUCKET TO USE FOR THE RRV BUCKET ])%
IF CALLGETBKT ( %(NUMBER)% LCI ( RRVBUCKET ),
%(SIZE)% LCI ( BUCKETSIZE ),
%(LOCK)% PCI ( NOLOCK ),
%(DESC)% LCT ( RRVBD ) ) IS FALSE
THEN
RETURN RMSBUG ( MSGFAILURE );
%([ GET POINTER TO TOP OF BUCKET ])%
RRVBKTPTR = .RRVBD [ BKDBKTADR ];
%([ WE NOW HAVE A BUCKET TO USE FOR THE RRV'S. LET'S
SCAN FROM THIS POINT ON DOWN IN THE TABLE
LOOKING FOR ANY RECORD WHICH HAS NOT BEEN CHECKED,
BUT WHICH ALSO HAS AN RRV ON THIS BUCKET. ])%
MYRECDESC [ RDRECPTR ] = ZERO; ! START AT TOP
MYRECDESC [ WHOLEWORD ] = ZERO; !****CLEAR FLAGS,STATUS
INCR J FROM .TABLEINDEX TO .DELETECOUNT -1
DO
ITERATION: BEGIN
%([ GET THE ADDRESS OF THIS RECORD. NOTE THAT
THIS CHECK IS REPEATED FOR THE FIRST RECORD
IN THE CHUNK. THIS ALLOWS THE LOOP TO BE
MADE SIMPLER. ])%
MOVINGPTR = .DELETETABLE [ .J,DTADDRESS ] -.AMOUNTCOMPRESED;
%([ HAS IT BEEN CHECKED, AND DOES IT HAVE AN
RRV ON THIS BUCKET? ])%
IF CHKFLAG ( MOVINGPTR [ DRFLAGS],FLGRRVUPD ) IS OFF
THEN IF ( .MOVINGPTR [ DRRRVBUCKET ]
IS
.RRVBUCKET )
THEN
BEGIN
%([ SET THIS RECORD AS BEING DONE ])%
SETFLAG ( MOVINGPTR [DRFLAGS],FLGRRVUPD);
LOOKAT (' REC ALSO NEEDS RRV AT:',MOVINGPTR);
MYRECDESC [ RDRFA ] = .MOVINGPTR[DRRRVADDRESS];
%([ LOCATE THE RRV ])%
IF CALLSDATABKT (LCT ( MYRECDESC ),
LCT ( RRVBD ) ) IS FALSE
THEN
BEGIN
RTRACE (%STRING('***NOT FIND RRV..'));
USRSTS = SU$RRV;
LEAVE ITERATION
END; %(OF NOT FOUND RRV)%
%([ GET ADDRESS OF RRV FOUND ])%
RRVPTR = .MYRECDESC [ RDRECPTR ];
RRVENDPTR = .RRVBKTPTR+ .RRVBKTPTR[BHNEXTBYTE];
AMOUNTTOMOVE = .RRVENDPTR-.RRVPTR - RRVRECSIZE;
%([ SQUEEZE OUT THE RRV ])%
IF .AMOUNTTOMOVE ISNT ZERO
THEN
MOVEWORDS ( %(FROM)% .RRVPTR+RRVRECSIZE,
%(TO)% .RRVPTR,
%(SIZE)% .AMOUNTTOMOVE);
%([ ADJUST THE BUCKET HEADER ])%
DEC ( RRVBKTPTR [ BHNEXTBYTE], RRVRECSIZE)
END %(OF IF THIS RECORD HAS AN RRV)%
END; %(OF INCR J LOOP)%
%([ WE HAVE FINISHED COMPRESSING ALL RRV'S
ON THIS BUCKET..RETURN THE BUCKET ])%
CALLPUTBKT ( %(UPDATE)% PCI (UPDATERRVBUCKET),
%(DESC)% LCT ( RRVBD ) )
END; %(OF OF THIS RECORD HAS AN RRV)%
%([ NOW, BUMP THE SIZE OF THIS CHUNK ])%
INC ( SIZECOUNTER, .DELETETABLE[.TABLEINDEX, DTLENGTH ] );
LOOKAT (' SIZE-COUNTER:', SIZECOUNTER);
INC ( TABLEINDEX, 1 ) ! BUMP OUR COUNTER
END; %(OF UNTIL SIZECOUNTER IS CHUNKSIZE)%
RETURN
END; %(OF COMPRRV)%
! UPDRRVS
! =======
!
! THIS ROUTINE PERFORMS UPDATING OF RRV RECORDS WHEN A DATA BUCKET
! SPLITS DUE TO A RECORD INSERTION. THIS INCLUDES ASSIGNING NEW
! ID'S TO ALL RECORDS WHICH WERE MOVED. IF A RECORD WAS MOVED FOR
! THE FIRST TIME, THEN AN RRV RECORD IS CREATED IN THE ORIGINAL
! BUCKET. IF A RECORD WAS MOVED PREVIOUSLY, THEN THE RRV RECORD
! IN THE ORIGINAL BUCKET IS UPDATED.
!
! INPUT:
! OLDBKD = BASE ADDRESS OF OLD BUCKET DESCRIPTOR
! NEWBKD = BASE ADDRESS OF NEW BUCKET DESCRIPTOR
!
! OUTPUT:
! TRUE = SUCCESSFUL OPERATION
! FALSE = RRV RECORD NOT FOUND
!
! ROUTINES CALLED:
! ALCRFA
! FBYRFA
! PUTBKT
!
! NOTES:1) THIS ROUTINE ATTEMPTS TO OPTIMIZE THE UPDATING PROCESS BY
! UPDATING ALL RRV RECORDS THAT ARE IN THE SAME BUCKET AT THE
! SAME TIME. 'FLGRRVUPD' WILL BE SET FOR EACH RECORD WHOSE RRV
! RECORDS HAVE BEEN UPDATED. IT IS POSSIBLE THAT THIS FLAG BIT
! MAY BE WRITTEN OUT TO THE FILE. THIS WOULD BE CAUSED BY
! A SYSTEM CRASH IN THE MIDDLE OF THE UPDATE PROCESS.
! THEREFORE, THESE FLAG BITS MUST BE CLEARED BEFORE ANY RRV
! RECORD UPDATING IS ATTEMPTED.
!
! 2) IT IS ALSO ASSUMED THAT IF A SET OF RECORDS IN THE NEW BUCKET
! HAVE RRV RECORDS IN A COMMON BUCKET THAT THE RRV RECORDS
! WILL BE IN THE SAME ORDER AS THE DATA RECORDS. THIS SPEEDS
! UP THE SEARCH FOR RRV RECORDS BECAUSE THE SEARCH FOR THE NEXT
! RRV RECORD TO UPDATE CAN CONTINUE FROM WHERE THE LAST RRV
! RECORD WAS FOUND. THIS ASSUMPTION IS SATISFIED BECAUSE THIS ROUTINE
! ALWAYS CREATES RRV'S BY SCANNING THE DATA RECORDS FROM
! THE TOP OF THE BUCKET DOWNWARDS. NOTE THAT IF THIS
! ALGORITHM EVER CHANGES (FOR SOME UNKNOWN REASON), SOME
! CHANGES MUST BE MADE ALSO TO "COMPRRV".
!
! 3) THIS ROUTINE CAN ALSO PROCESS SIDR RECORDS. HOWEVER,
! THE ONLY FUNCTION WHICH MUST BE PERFORMED FOR SIDR'S
! IS THAT NEW ID'S MUST BE ALLOCATED FOR EACH SIDR WHICH
! MOVED IN THE SPLIT. NOTE ALSO THAT THE NEW BUCKET IS
! NOT WRITTEN TO DISK IF IT IS A SECONDARY BUCKET...THIS
! IS DONE BY "INSRTSIDR".
GLOBAL ROUTINE UPDRRVS ( OLDBKD, NEWBKD ) =
BEGIN
ARGUMENT (OLDBKD,BASEADD); ! BASE ADR OF OLD BUCKET DESCRIPTOR
ARGUMENT (NEWBKD,BASEADD); ! BASE ADR OF NEW BUCKET DESCRIPTOR
MAP
OLDBKD: POINTER,
NEWBKD: POINTER;
LOCAL
OLDBKTNO, ! NO. OF OLD BUCKET
NEWBKTNO, ! NO. OF NEW BUCKET
RRVBKTNO, ! NO. OF BUCKET WITH RRV RECORD TO BE UPDATED
BKTSIZE, ! BUCKET SIZE FOR CALL TO 'GETBKT'
KEYOFREFERENCE, ! USD TO TELL IF SIDR BUCKET
ERRFLAG, ! FALSE IF AN RRV RECORD WAS NOT FOUND
SAVRECPTR, ! PTR TO LAST RRV RECORD WE FOUND
BH: POINTER, ! PTR TO A BUCKET
ENDPTR: POINTER, ! PTR TO END OF A BUCKET
RECPTR: POINTER, ! PTR TO CURRENT RECORD IN NEWBKT
UPDRECPTR: POINTER, ! PTR TO CURRENT RECORD WHEN RRV'S ARE BEING UPDATED
RRVRECPTR: POINTER, ! POINTER TO RRV RECORD
NEWRRVPTR: POINTER, ! POINTER TO NEWLY CREATED RRV RECORD
UPDRRVRFA: FORMAT, ! RFA FOR RRV RECORD TO BE UPDATED
RRVRFA: FORMAT, ! RFA FOR RRV RECORD
RECDESC: FORMATS[ RDSIZE ], ! A RECORD DESCRIPTOR ( FOR USE BY 'FBYRFA' )
UPDBKD: FORMATS[ BDSIZE ]; ! BUCKET DESCRIPTOR FOR UPDATING RRV RECORDS
!REGISTER
! TMPRFA: FORMAT; ! TEMP FOR AN RFA
EXTERNAL ROUTINE
ALCNEWIDS; ! ALLOCATE NEW ID'S FOR RECORDS
TRACE ( 'UPDRRV' );
CHECKEXACTCOUNT; ! MUST HAVE EXACT NO. ARGS
%([ INITIALIZE SOME POINTERS ])%
KEYOFREFERENCE = .KDB [ KDBREF ]; ! GET KEY OF REFER.
BH = .NEWBKD [ BKDBKTADR ]; ! POINTER TO NEW BUCKET
RECPTR = .BH + BHHDRSIZE; ! POINTER TO CURRENT RECORD IN NEWBKT
ENDPTR = .BH + .BH [BHNEXTBYTE ]; ! POINTER TO END OF NEWBKT
OLDBKTNO = .OLDBKD [ BKDBKTNO ]; ! BUCKET NO. OF OLD BUCKET
NEWBKTNO = .NEWBKD [ BKDBKTNO ]; ! BUCKET NO. OF NEW BUCKET
%([ ALLOCATE NEW ID'S FOR ALL RECORDS IN THE NEW BUCKET
WHICH NEED ONE (I.E., THE NEW RECORD MIGHT NOT NEED ONE) ])%
CALLALCNEWIDS ( BPT ( NEWBKD ) );
%([ UPDATE THE NEW BUCKET TO PUT NEWLY ASSIGNED ID'S IN THE FILE ])%
UPDATEBUCKET ( NEWBKD ); ! UPDATE THE NEW BUCKET
BKTSIZE = .KDB [ KDBDBKZ ]; ! GET BUCKET SIZE
%([ MAIN LOOP -- PROCESS ALL RECORDS IN NEW BUCKET ])%
ERRFLAG = FALSE; ! START WITH NO "RRV RECORDS NOT FOUND"
RECPTR = .BH + BHHDRSIZE; ! INIT POINTER TO FIRST RECORD
UNTIL .RECPTR GEQ .ENDPTR
DO
BEGIN %( PROCESS THIS RECORD )%
RRVRFA = .RECPTR [ DRRRVADDRESS ];
RRVBKTNO = .RRVRFA [ RFABUCKET ];
LOOKAT ( 'RECORD ID: ' , RRVRFA [ RFAID ] );
%([ DECIDE WHETHER TO UPDATE/CREATE RRV RECORD ])%
IF .RRVBKTNO IS .OLDBKTNO ! FIRST TIME RECORD MOVED?
THEN
BEGIN %( CREATE RRV RECORD FOR RECORD WHICH WAS MOVED FOR THE FIRST TIME )%
BH = .OLDBKD [ BKDBKTADR ]; ! POINT TO OLD BUCKET
NEWRRVPTR = .BH + .BH [ BHNEXTBYTE ]; ! POINT TO WHERE NEW RRV RECORD WILL GO
IF (.NEWRRVPTR - .BH ) GTR (.KDB [ KDBDBKZ ] ^ B2W) ! ROOM IN BKT FOR NEW RRV?
THEN
RMSBUG ( MSGCCR ); ! NO, ** CAN'T CREATE RRV RECORD **
INC ( BH [ BHNEXTBYTE ] , RRVRECSIZE ); ! ALLOCATE SPACE FOR NEW RRV RECORD
NEWRRVPTR [ DRFLAGS ] = DEFRRVFLAGS; ! INITIALIZE RRV RECORD FLAGS
NEWRRVPTR [ DRRECORDID ] = .RRVRFA [ RFAID ]; ! INITIALIZE RRV RECORD ID
NEWRRVPTR [ DRRRVADDRESS ] =
MAKERFA ( .NEWBKTNO , .RECPTR [ DRRECORDID ] ); ! INITIALIZE RRV RECORD POINTER (POINTS TO DATA RECORD)
LOOKAT ( 'CREATED RRV AT: ' , NEWRRVPTR );
END %( OF CREATE RRV )%
ELSE IF .RRVBKTNO ISNT .NEWBKTNO ! EXISTING RRV RECORD?
AND
CHKFLAG ( RECPTR [ DRFLAGS ] , FLGRRVUPD ) IS OFF ! AND ITS RRV RECORDS HAVEN'T BEEN UPDATED?
THEN
BEGIN %( UPDATE EXISTING RRV RECORDS ])%
UPDRECPTR = .RECPTR; ! INIT PTR TO RECORD TO UPDATE RRV
RECDESC [ RDRECPTR ] = ZERO; ! START SEARCH FROM TOP OF BUCKET
IF CALLGETBKT (%( BKTNO )% LCI ( RRVBKTNO ),
%( BKTSIZE )% LCI ( BKTSIZE ),
%( LOCKFLAG )% PCI ( FALSE ),
%( BKTDESC )% LCT ( UPDBKD ) ) IS FALSE
THEN
ERRFLAG = TRUE ! REMEMBER THAT BUCKET WAS UNAVAILABLE
ELSE
BEGIN %( LOOP FOR REST OF DATA RECORDS UPDATING
ALL RRV RECORDS THAT ARE IN THE SAME BUCKET )%
DO
BEGIN %( POSSIBLY UPDATE THIS RRV RECORD )%
UPDRRVRFA = .UPDRECPTR [ DRRRVADDRESS ]; ! GET RFA OF RRV RECORD
IF .UPDRRVRFA [ RFABUCKET ] IS .RRVBKTNO ! I.E., SAME BUCKET
THEN
BEGIN %( UPDATE THIS RRV RECORD )%
RECDESC [ RDRFA ] = .UPDRRVRFA; ! SET RFA OF RRV RECORD
SAVRECPTR = .RECDESC [ RDRECPTR ]; ! REMEMBER WHERE WE ARE (IN CASE OF SEARCH FAILURE)
IF CALLSDATABKT (%( RECDESC )% LCT ( RECDESC ),
%( BKTDESC )% LCT ( UPDBKD ) ) IS FALSE
THEN
BEGIN %( CAN'T GET RRV )%
ERRFLAG = TRUE;
RECDESC [ RDRECPTR ] = .SAVRECPTR ! RESTORE SEARCH POINTER
END %( OF CAN'T GET RRV RFA )%
ELSE
BEGIN %( UPDATE RRV RECORD )%
RRVRECPTR = .RECDESC [ RDRECPTR ]; ! POINT TO RRV RECORD
RRVRECPTR [ DRRRVADDRESS ] =
MAKERFA ( .NEWBKTNO , .UPDRECPTR [ DRRECORDID ] ); ! UPDATE RRV TO POINT TO NEW DATA RECORD POSITION
SETFLAG ( UPDRECPTR [ DRFLAGS ] , FLGRRVUPD ); ! FLAG THAT RRV RECORD HAS BEEN UPDATED
LOOKAT ( 'UPDATED RRV AT RFA: ' , UPDRRVRFA );
END %( OF UPDATE RRV RECORD )%
END; %( OF UPDATE THIS RRV RECORD )%
UPDRECPTR = .UPDRECPTR + SIZEOFUDR ( UPDRECPTR ); ! NEXT RECORD IN NEW BUCKET
LOOKAT (' UPD-RECPTR: ',UPDRECPTR )
END %( OF POSSIBLY UPDATE THIS RRV RECORD )%
UNTIL .UPDRECPTR GEQ .ENDPTR; ! LOOP BACK FOR NEXT NEW BUCKET RECORD
%([ RELEASE BUCKET USED FOR UPDATING RRV RECORDS ])%
CALLPUTBKT ( %( UPDATE FLAG )% PCI ( TRUE ),
%( BKTDESC )% LCT ( UPDBKD ) )
END %( OF LOOP FOR REST OF RECORDS IN BUCKET... )%
END; %( OF UPDATE EXISTING RRV RECORDS )%
RECPTR = .RECPTR + SIZEOFUDR ( RECPTR ) ! NEXT RECORD IN NEW BUCKET
END; %( OF PROCESS THIS RECORD FROM NEW BUCKET )%
%([ DONE ])%
IF .ERRFLAG
THEN
BADRETURN ! ** RRV NOT FOUND **
ELSE
GOODRETURN ! SUCCESS
END; %( OF UPDRRVS )%
! ALCNEWIDS
! =========
! ROUTINE TO ALLOCATE NEW ID'S FOR ALL RECORDS IN A NEW BUCKET
! AFTER A DATA BUCKET SPLIT. THIS ROUTINE IS CALLED FOR
! BOTH A PRIMARY AND A SECONDARY DATA BUCKET SPLIT. FOR
! PRIMARY DATA RECORDS, THIS ROUTINE MUST CHECK TO SEE IF
! A NEW ID IS NECESSARY (IT MIGHT NOT BE FOR THE NEW RECORD).
! FOR SECONDARY DATA RECORDS, A NEW ID IS ALWAYS REQUIRED.
!
! THIS ROUTINE ATTEMPTS TO OPTIMIZE ITS OPERATION BY NOT CALLING
! "ALCRFA" UNLESS ABSOLUTELY NECESSARY. THAT IS, IT WILL MAINTAIN
! ITS OWN LOCAL COPIES OF THE "LASTID" AND "NEXTID" FIELDS IN
! THE BUCKET HEADER AND CALL ALCRFA ONLY WHEN NEXTID IS GREATER
! THAN LASTID.
! INPUT:
! NEWBD BUCKET DESCRIPTOR OF THE NEW BUCKET
! OUTPUT:
! <NO STATUS RETURNED>
! ROUTINES CALLED:
! ALCRFA
GLOBAL ROUTINE ALCNEWIDS ( NEWBD ):NOVALUE =
BEGIN
ARGUMENT (NEWBD,BASEADD);
MAP
NEWBD: POINTER;
LOCAL
ENDPTR: POINTER, ! PTR TO END OF BUCKET
BKTPTR: POINTER, ! PTR TO TOP OF BUCKET
LASTID, ! LOCAL COPY OF THE LASTID FIELD
KEYOFREFERENCE, ! KEY OF REF
NEWBUCKET; ! BUCKET NUMBER OF NEW BUCKET
REGISTER
RECORDPTR: POINTER, ! POINTER TO CURRENT RECORD IN BUCKET
! CURRENTRFA: FORMAT, ! RFA OF CURRENT RECORD
CURRENTRFA, ! RFA OF CURRENT RECORD.PREVIOUS DECL.INVALID IN B36
NEXTID; ! NEXT ID TO BE ALLOCATED
EXTERNAL ROUTINE
ALCRFA;
TRACE ('ALCNEWIDS');
%([ SET UP SOME BUCKET POINTERS, AND SOME MISC. STUFF ])%
BKTPTR = .NEWBD [ BKDBKTADR ]; ! BKT POINTER
ENDPTR = .BKTPTR + .BKTPTR [ BHNEXTBYTE ];
NEWBUCKET = .NEWBD [ BKDBKTNO ]; ! NUMBER OF BUCKET
RECORDPTR = .BKTPTR + BHHDRSIZE; ! INIT RECORD POINTER
%([ FETCH THE CURRENT CONTENTS OF THE ID FIELDS ])%
NEXTID = .BKTPTR [ BHNEXTID ];
LASTID = .BKTPTR [ BHLASTID ];
%([ IS THIS A PRIMARY OR SECONDARY BUCKET? ])%
KEYOFREFERENCE = .KDB [ KDBREF ];
%([ LOOP OVER ALL RECORDS IN THE BUCKET. FOR PRIMARY
RECORDS, CLEAR THE "UPDRRV" BIT SO UPDRRVS WILL KNOW
IF IT HAS UPDATED THE RRV FOR THAT RECORD. ])%
UNTIL .RECORDPTR GEQ .ENDPTR
DO
BEGIN
%([ CLEAR THIS SO WE WILL ALWAYS ALLOCATE ID FOR SEC BUCKETS ])%
CURRENTRFA = ZERO;
IF .KEYOFREFERENCE IS REFPRIMARY
THEN
BEGIN
CLRFLAG ( RECORDPTR [ DRFLAGS ] , FLGRRVUPD ); ! CLEAR "RRVUPD" FLAG
CURRENTRFA = .RECORDPTR [ DRRRVADDRESS ] ! GET RRV
END; %( OF IF THIS IS A PRIMARY DATA RECORD)%
IF .CURRENTRFA < RH > ISNT .NEWBUCKET ! 'RH' replaces 'RFABUCKET'
THEN %(WE MUST ALLOCATE A NEW ID)%
BEGIN
%([ WE KNOW THAT WE CAN ALWAYS USE THE LOCAL COPIES
OF THE LASTID AND NEXTID, SINCE THE BUCKET IS
NEW. THUS, IT WAS JUST INITIALIZED AND THE
NEXTID STARTED OUT AT 1. ])%
IF .NEXTID GTR .LASTID
THEN %(THERE IS SOMETHING WRONG)%
RMSBUG ( MSGCOUNT ); ! BAD COUNTER
%([ STORE THIS ID IN THE RECORD ])%
RECORDPTR [ DRRECORDID ] = .NEXTID;
INC ( NEXTID, 1 ) ! BUMP IT
END; %(OF CURRENTRFA ISNT NEWBUCKET)%
%([ BUMP THE POINTER TO NEXT DATA RECORD ])%
RECORDPTR = .RECORDPTR + SIZEOFDATARECRD ( RECORDPTR ) ! ADVANCE TO NEXT RECORD
END; %(OF UNTIL RECORDPTR GEQ ENDPTR)%
%([ REPLACE THE ID FIELD IN THE BUCKET HEADER ])%
BKTPTR [ BHNEXTID ] = .NEXTID;
RETURN
END; %(OF ALCNEWIDS)%
END
ELUDOM