Trailing-Edge
-
PDP-10 Archives
-
bb-h138f-bm
-
7-sources/rmsspt.b36
There are 11 other files named rmsspt.b36 in the archive. Click here to see a list.
%TITLE 'S P T -- Bucket splitting routines'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE spt (IDENT = '2.0'
) =
BEGIN
!+
!
!
!
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1977, 1986.
! ALL RIGHTS RESERVED.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND
! COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
! THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR
! ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
! AVAILABLE TO ANY OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE
! SOFTWARE IS HEREBY TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
! NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
! EQUIPMENT CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF
! ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!
!
!
! 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
!
! ALCNEWIDS ALLOCATE NEW RECORD IDS AFTER 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 SETS 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
!
! ** Begin RMS v2 Development
!
!
! 400 400 xxxxx Clean up BLISS code (RL,22-Apr-83)
!
! 460 - Q345012 (RL,12-Mar-84)
! Edit 54 (above) incorrectly checked for
! duplicates against the LASTRECPTR in the
! record descriptor. This fixed the problem
! which then existed, but if a deleted duplicate
! was NOT compressed from a bucket (as the
! last record in a bucket would not be), then
! there would be a two-way split when a
! three-way split was required. This is fixed
! by checking for duplicates against RECPTR
! rather than LASTRECPTR.
!
! ***** END OF REVISION HISTORY *****
!
!
!
!
!-
!+
! EXTERNAL DECLARATIONS
!-
! EXTERNAL
! 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
REQUIRE 'rmsreq';
!+
! ***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***
!-
%SBTTL 'SPLIT - bucket splitter'
GLOBAL ROUTINE split (recdesc, bktdesc, splitbd1, splitbd2) =
! 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).
BEGIN
LOCAL
oldbktptr, ! PTR TO ORIGINAL BUCKET
oldbucket, ! BUCKET # OF ORIGINAL BUCKET
oldmovingptr, ! TEMP PTR TO SAME
tempptr : REF BLOCK, ! 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 : REF BLOCK, ! 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 : BLOCK [1];
REGISTER
tempac;
MAP
recdesc : REF BLOCK,
bktdesc : REF BLOCK,
splitbd1 : REF BLOCK,
splitbd2 : REF BLOCK,
oldmovingptr : REF BLOCK;
MAP
split1bktptr : REF BLOCK,
split2bktptr : REF BLOCK,
split1movingptr : REF BLOCK,
oldrrvptr : REF BLOCK,
oldendptr : REF BLOCK;
MAP
insertptr : REF BLOCK,
rhighptr : REF BLOCK,
lastrhigholdptr : REF BLOCK;
MAP
oldbktptr : REF BLOCK;
LABEL
scanrecs,
sizeloop;
TRACE ('SPLIT');
!+
! LET'S LOOK AT THE RECORD DESCRIPTOR ON INPUT
!-
%IF dbug
%THEN
begindebug (dbblocks)bugout(%STRING ('RECORD DESC. 1 INPUT TO SPLIT:'));
dumprd (.recdesc);
enddebug;
%FI
!+
! PICK UP SOME POINTERS AND CLEAR SOME VARIABLES
!-
udrflag = 1; ! ASSUME ITS UDR'S
IF .kdb [kdbref] NEQ 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, 0], roploa) NEQ 0) 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 = 0);
snewinold = (snewinnew = 0);
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 = 0);
sizehigh = 0;
!+
! 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 EQL false
THEN
BEGIN
sizehigh = .oldendptr - .oldmovingptr;
LEAVE sizeloop ! EXIT FROM LOOP
END;
!+
! CHECK TO SEE IF WE HAVE REACHED THE RRV'S
!-
IF rrvflag (oldmovingptr) EQL 0
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] EQL .oldbucket
THEN ! We will need an RRV
BEGIN
lookat (' REC NEEDS RRV AT: ', oldmovingptr);
sizenewrrv = .sizenewrrv + rrvrecsize;
END
ELSE
lookat (' REC DOESNT NEED RRV AT: ', oldmovingptr);
!+
! BUMP THE POINTER TO NEXT RECORD
!-
oldmovingptr = .oldmovingptr + .sizeofthisrecrd;
END
ELSE ! This is the first RRV
BEGIN
IF .udrflag EQL 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
END;
END;
!+
! 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 ! New record fits 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);
!+
! Setup the size of the previous record (the one
! pointed to by LASTRHIGHOLDPTR), to either: 0
! for the first record in the bucket, or to the size
! of the previous record, so that if the very first
! record we see puts us over the limit, LAST-RHIGH-PTR
! will still be correct.
!-
IF .recdesc [rdrecptr] EQL .recdesc [rdlastrecptr]
THEN
sizeofthisrecrd = 0
ELSE
sizeofthisrecrd = sizeofdatarecrd (lastrhigholdptr);
!+
! LOOP UNTIL THE BUCKET MEETS THIS FILL CRITERION
!-
scanrecs :
BEGIN
UNTIL (.sum + .sizeofnewrecord) GEQ (.maxbktoffset) DO
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
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 NEQ 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);
sum = .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 NEQ false
THEN
IF .oldmovingptr [drrrvbucket] EQL .oldbucket !
THEN
sum = .sum - rrvrecsize;
lookat (' UPDATE SUM VALUE: ', sum);
oldmovingptr = .oldmovingptr + .sizeofthisrecrd;
lookat (' PTR BUMPED TO: ', oldmovingptr)
END;
END;
!+
! 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
IF (.sum + .sizeofnewrecord) GTR .maxavailable OR ! UDR
.sum EQL .maxavailable ! SIDR
THEN ! Back up one data record
BEGIN
rtrace (%STRING (' LAST RECORD TOO BIG'));
sum = .sum - .sizeofthisrecrd;
oldmovingptr = .oldmovingptr - .sizeofthisrecrd;
sizeofthisrecrd = .sizeoflastrecrd ! Adjust last record size
END;
!+
! 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
ELSE ! New record won't fit 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) NEQ 0) AND (.sizehigh NEQ 0))
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) NEQ 0) THEN clrflag (recdesc [rdstatus], rdflgidxupdate);
snewinnew = .sizeofnewrecord;
END
END;
!+
! LET'S SEE EVERYTHING
!-
%IF dbug
%THEN
begindebug (dbblocks)bugout(%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);
enddebug;
%FI
!+
! CHECK OUT ALL THESE VALUES TO SEE IF THEY ARE REASONABLE
!-
IF ((.insertptr + .shighinold + .shighinnew + .sizerrv) NEQ .oldendptr) OR ((.oldrrvptr + .sizerrv) NEQ
.oldendptr) OR (.sizehigh NEQ (.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 alcbkt (btypedata, ! Type
0, ! Flags
datalevel, ! Level
.splitbd1) EQL false ! Bucket
THEN
RETURN false;
!+
! GET THE BUCKET NUMBER
!-
split1bkt = .splitbd1 [bkdbktno];
split1bktptr = .splitbd1 [bkdbktadr];
lookat (' NEW BKT EQL 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 (splitbd1, newrecbd);
!+
! NOW, LET'S ALLOCATE ANOTHER BUCKET IF A 3-BKT SPLIT
!-
IF .twobucketsplit EQL false
THEN ! We need another bucket
BEGIN
rtrace (%STRING (' ALLOCATING ANOTHER BKT...'));
IF alcbkt (btypedata, ! Type
0, ! Flags
datalevel, ! Level
.splitbd2) EQL false ! Bucket
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 (splitbd1, ! Bucket
.bktsize); ! Size
RETURN false;
END;
!+
! REMEMBER THAT R-NEW WILL GO INTO THIS BUCKET
!-
movebktdesc (splitbd2, 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;
!+
! 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
begindebug (dblocal)bugout(%STRING ('***DUMP OF SPLIT BKT-HDR: '));
dumpheader (.split1bktptr);
IF .twobucketsplit EQL false
THEN ! Print out other bucket too
BEGIN
bugout (%STRING ('***DUMP OF 2ND BKT HEADER:'));
dumpheader (.split2bktptr);
END;
enddebug;
%FI
!+
! DOES R-NEW GO IN THE ORIGINAL BUCKET?
!-
IF .snewinold NEQ 0
THEN ! R-NEW goes in original bucket
BEGIN
!+
! REMEMBER WHICH BUCKET CONTAINS R-NEW
!-
movebktdesc (bktdesc, newrecbd);
!+
! SOME (OR ALL) OF R-HIGH MUST BE MOVED OUT
!-
rtrace (%STRING (' MOVING R-HIGH TO NEW BKT...'));
IF .shighinnew EQL 0 THEN rmsbug (msgsplit);
movewords (.insertptr + .shighinold, ! From
.split1bktptr + bhhdrsize, ! To
.shighinnew); ! Size
!+
! 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 NEQ 0
THEN ! RRVs must be moved
BEGIN
!+
! UP?
!-
IF .shighinnew GTR .sizeofnewrecord
THEN ! RRVs should go up
BEGIN
rtrace (%STRING (' MOVING RRVS UP...'));
movewords (.oldrrvptr, ! From
.insertptr + .sizeofnewrecord + .shighinold, ! To
.sizerrv); ! Size
END
ELSE ! They go down
BEGIN
rtrace (%STRING (' MOVING RRVS DOWN...'));
movedown (.oldrrvptr, ! Start
.oldendptr - 1, ! End
.sizeofnewrecord - .shighinnew); ! Size
END
END;
!+
! NOW, MOVE R-HIGH DOWN
!-
IF .shighinold NEQ 0
THEN
BEGIN
rtrace (%STRING (' MOVING R-HIGH DOWN...'));
IF .sizeofnewrecord NEQ 0 ! Could be a null SIDR
THEN
movedown (.insertptr, ! From
.insertptr + .shighinold - 1, ! To
.sizeofnewrecord); ! Size
!+
! RESET THE PTR TO NEW LAST RECORD IN BUCKET
!-
lastrhigholdptr = .lastrhigholdptr + .sizeofnewrecord;
END
ELSE ! All of R-HIGH gets moved out
lastrhigholdptr = .insertptr
END
ELSE ! R-NEW will be moved
BEGIN
!+
! DOES R-NEW GO INTO IT'S OWN BUCKET?
!-
IF .twobucketsplit
THEN
insertptr = .split1bktptr + bhhdrsize
ELSE
BEGIN ! It's a 3-bkt split
insertptr = .split2bktptr + bhhdrsize;
snewinnew = 0
END;
!+
! NOW, MOVE ALL OF R-HIGH OUT
!-
IF .shighinnew NEQ 0
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 (.rhighptr + .shighinold, ! From
.split1bktptr + bhhdrsize + .snewinnew, ! To
.shighinnew); ! Size
!+
! NOW, MOVE RRV'S UP IN THE BUCKET
!-
IF .sizerrv NEQ 0
THEN
movewords (.oldrrvptr, ! From
.oldbktptr + bhhdrsize + .sizelow, ! To
.sizerrv); ! Size
END
END;
!+
! ** 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 NEQ 0))
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 NEQ 0
THEN ! Get a new RFA
recdesc [rdrfa] = alcrfa (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) NEQ 0 THEN setflag (recdesc [rdstatus], rdflgnohikey);
%IF dbug
%THEN
begindebug (dbblocks)bugout(%STRING ('***RD AFTER SPLIT...'));
dumprd (.recdesc);
enddebug;
%FI
RETURN true
END; ! End SPLIT
%SBTTL 'COMPRESS - compress data bucket'
GLOBAL ROUTINE compress (recdesc, databd) =
! 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.
BEGIN
MAP
databd : REF BLOCK,
recdesc : REF BLOCK;
REGISTER
movingptr : REF BLOCK, ! TEMPORARY RECORD POINTER
tempac, ! TEMP AC
lngofthisrecord; ! SIZE IN WORDS OF CURRENT RECORD
LOCAL
chunkptr : REF BLOCK, ! 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 : REF BLOCK, ! PTR TO BUCKET
endptr : REF BLOCK, ! PTR TO END OF BUCKET
amounttomove, ! AMOUNT TO DATA TO MOVE UP
insertptr : REF BLOCK, ! 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 : BLOCK [maxdeletecount + 1];
!EXTERNAL
! 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 0;
!+
! CLEAR SOME VARIABLES
!-
reclaimedspace = 0;
deletecount = 0;
lngoflastrecord = 0;
lngofsaved = 0;
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) NEQ 0) OR ! Until we find an RRV
(.movingptr EQL .bktptr + .bktptr [bhnextbyte])) DO
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 EQL .lastptr !
THEN
recdesc [rdlastrecptr] = !
.recdesc [rdlastrecptr] - (.reclaimedspace + .lngoflastrecord);
IF .movingptr EQL .insertptr !
THEN
recdesc [rdrecptr] = .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 NEQ 0
THEN ! Last record was deleted
BEGIN
reclaimedspace = .reclaimedspace + .lngoflastrecord;
deletecount = .deletecount + 1;
END;
lngoflastrecord = 0; ! CLEAR FOR NEXT ITERATION
lngofthisrecord = sizeofudr (movingptr);
lookat (' LENGTH-OF-RECORD: ', lngofthisrecord);
!+
! CHECK IF THIS RECORD IS DELETED
!-
IF chkflag (movingptr [drflags], flgdelete + flgnocompress) EQL !
flgdelete
THEN ! Deleted and compressible
BEGIN
rtrace (%STRING (' RECORD EQL 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 EQL maxdeletecount
THEN ! The table has filled up
BEGIN
ourtable = full; ! REMEMBER THIS FACT
IF .movingptr LSS .lastptr !
THEN
recdesc [rdlastrecptr] = !
.recdesc [rdlastrecptr] - .reclaimedspace; !ADJ HI REC POS
IF .movingptr LSS .insertptr !
THEN
recdesc [rdrecptr] = .recdesc [rdrecptr] - .reclaimedspace; ! Adjust the record position
LEAVE scanloop ! Exit from loop
END;
!+
! 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 EQL .lastptr !
THEN
recdesc [rdlastrecptr] = .recdesc [rdlastrecptr] - .lngofsaved;
END
ELSE
lngofsaved = .lngofthisrecord; !TO BE ABLE TO PT AT REC BEFORE
!HI REC WHEN IT COMPRESSED TOO
!+
! BUMP THE TEMPORARY POINTER
!-
movingptr = .movingptr + .lngofthisrecord;
END;
END; ! End of SCANLOOP
lookat (' TOTAL RECLAIMED SPACE: ', reclaimedspace);
!+
! DID WE FIND ANY DELETED RECORDS?
!-
IF .deletecount EQL 0 THEN RETURN 0;
!+
! 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 EQL .insertptr) AND ! New rec at end of bucket?
(.ourtable NEQ full)
THEN
recdesc [rdrecptr] = .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] = 0;
!+
! 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 = 0; ! CLEAR OUR MAJOR INDEX
amountcompresed = 0; ! NO RECORDS SQUEEZED YET
!+
! DO THIS LOOP UNTIL WE SCAN THE ENTIRE TABLE. NOTE
! THAT TABLEINDEX IS UPDATED BELOW.
!-
UNTIL .tableindex GEQ .deletecount DO
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 EQL .deletecount - 1 DO
BEGIN
lookat (' I EQL: ', i);
!+
! IS THIS CHUNK CONTIGUOUS WITH THE NEXT DELETED RECORD?
!-
IF .deletetable [.i, dtaddress] + .deletetable [.i, dtlength] EQL .deletetable [.i + 1, dtaddress]
THEN ! Include new record in chunk
BEGIN
lookat (' CONTIG CHUNK AT: ', deletetable [.i + 1, dtaddress]);
chunksize = .chunksize + .deletetable [.i + 1, dtlength];
i = .i + 1;
END
ELSE ! This record is not contiguous
LEAVE innerloop
END;
END;
!+
! DID WE FIND A CHUNK TO SQUEEZE OUT?
!-
IF .chunksize NEQ 0
THEN
BEGIN ! Squeeze this chunk out
lookat (' CHUNK EQL AT: ', chunkptr);
lookat (' TOTAL CHUNK-SIZE EQL: ', chunksize);
comprrv (.deletecount, ! Count
.chunksize, ! Size
.amountcompresed, ! Hole
.tableindex, ! Index
deletetable, ! Table
.databd); ! Bucket
!+
! 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 NEQ 0
THEN
movewords (.chunkptr + .chunksize, ! From
.chunkptr, ! To
.amounttomove); ! Size
!+
! INCREMENT THE AMOUNT OF DATA ALREADY GONE
!-
amountcompresed = .amountcompresed + .chunksize;
lookat (' AMNT-COMPRESSED: ', amountcompresed);
!+
! ADJUST THE BUCKET HEADER INFORMATION
!-
bktptr [bhnextbyte] = .bktptr [bhnextbyte] - .chunksize;
END;
!+
! WE HAVE NOW COMPRESSED A SINGLE CHUNK. SO, BUMP
! OUR PRIMARY TABLE INDEX POINTER OVER THE ENTIRE CHUNK
!-
tableindex = .i + 1
END;
!+ !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) neq 0 !A54
THEN !A54
BEGIN ! Duplicate flag is on
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
IF ckeyku (.recdesc, .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
%SBTTL 'COMPRRV - compress RRVs'
GLOBAL ROUTINE comprrv (deletecount, chunksize, amountcompresed, tableindex, deletetable, databd) : NOVALUE =
! 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".
!
!
BEGIN
MAP
deletetable : REF BLOCK,
databd : REF BLOCK;
REGISTER
movingptr : REF BLOCK, ! 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 : BLOCK [bdsize], ! BKT DESCRIPTOR FOR RRV BUCKET
myrecdesc : BLOCK [rdsize], ! A TEMP RECORD DESCRIPTOR
rrvbktptr : REF BLOCK, ! PTR TO BUCKET OF RRV'S
rrvendptr : REF BLOCK, ! PTR TO END OF RRV BUCKET
rrvptr : REF BLOCK, ! 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 = 0; ! CLEAR COUNTER
!+
! WE WILL NOW SCAN THE ENTIRE CHUNK LOOKING FOR ANY
! RECORD WHICH NEEDS AN RRV
!-
UNTIL .sizecounter EQL .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 NEQ .databd [bkdbktno]
THEN
!+
! AND HAS THE RECORD BEEN PROCESSED?
!-
IF chkflag (movingptr [drflags], flgrrvupd) EQL 0
THEN
BEGIN
lookat (' SQUEEZE AN RRV AT: ', movingptr);
!+
! GET A BUCKET TO USE FOR THE RRV BUCKET
!-
IF getbkt (.rrvbucket, ! Number
.bucketsize, ! Size
nolock, ! Lock
rrvbd) EQL false ! Descriptor
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] = 0; ! START AT TOP
myrecdesc [wholeword] = 0; !****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) EQL 0
THEN
IF (.movingptr [drrrvbucket] EQL .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 sdatabkt (myrecdesc, rrvbd) EQL false
THEN
BEGIN
rtrace (%STRING ('***NOT FIND RRV..'));
usrsts = su$rrv;
LEAVE iteration
END;
!+
! GET ADDRESS OF RRV FOUND
!-
rrvptr = .myrecdesc [rdrecptr];
rrvendptr = .rrvbktptr + .rrvbktptr [bhnextbyte];
amounttomove = .rrvendptr - .rrvptr - rrvrecsize;
!+
! SQUEEZE OUT THE RRV
!-
IF .amounttomove NEQ 0
THEN
movewords (.rrvptr + rrvrecsize, ! From
.rrvptr, ! To
.amounttomove); ! Size
!+
! ADJUST THE BUCKET HEADER
!-
rrvbktptr [bhnextbyte] = !
.rrvbktptr [bhnextbyte] - rrvrecsize;
END
END;
!+
! WE HAVE FINISHED COMPRESSING ALL RRV'S
! ON THIS BUCKET..RETURN THE BUCKET
!-
putbkt (updaterrvbucket, ! Update
rrvbd) ! Descriptor
END;
!+
! NOW, BUMP THE SIZE OF THIS CHUNK
!-
sizecounter = .sizecounter + .deletetable [.tableindex, dtlength];
lookat (' SIZE-COUNTER:', sizecounter);
tableindex = .tableindex + 1; ! Bump our counter
END;
RETURN
END; ! End COMPRRV
%SBTTL 'UPDRRVS - update RRVs after split'
GLOBAL ROUTINE updrrvs (oldbkd, newbkd) =
! 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".
BEGIN
MAP
oldbkd : REF BLOCK,
newbkd : REF BLOCK;
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 : REF BLOCK, ! PTR TO A BUCKET
endptr : REF BLOCK, ! PTR TO END OF A BUCKET
recptr : REF BLOCK, ! PTR TO CURRENT RECORD IN NEWBKT
updrecptr : REF BLOCK, ! PTR TO CURRENT RECORD WHEN RRV'S ARE BEING UPDATED
rrvrecptr : REF BLOCK, ! POINTER TO RRV RECORD
newrrvptr : REF BLOCK, ! POINTER TO NEWLY CREATED RRV RECORD
updrrvrfa : BLOCK [1], ! RFA FOR RRV RECORD TO BE UPDATED
rrvrfa : BLOCK [1], ! RFA FOR RRV RECORD
recdesc : BLOCK [rdsize], ! A RECORD DESCRIPTOR ( FOR USE BY 'FBYRFA' )
updbkd : BLOCK [bdsize]; ! BUCKET DESCRIPTOR FOR UPDATING RRV RECORDS
!REGISTER
! TMPRFA: FORMAT; ! TEMP FOR AN RFA
!EXTERNAL
! ALCNEWIDS; ! ALLOCATE NEW ID'S FOR RECORDS
TRACE ('UPDRRV');
!+
! INITIALIZE SOME POINTERS
!-
keyofreference = .kdb [kdbref]; ! GET KEY OF REFER.
bh = .newbkd [bkdbktadr]; ! POINTER TO NEW BUCKET
recptr = .bh + bhhdrsize; ! 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)
!-
alcnewids (.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 EQL .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 ! Room for new RRV?
(.kdb [kdbdbkz]^b2w) !
THEN
rmsbug (msgccr); ! No, can't create RRV record
bh [bhnextbyte] = ! Allocate space for new RRV
.bh [bhnextbyte] + rrvrecsize;
newrrvptr [drflags] = defrrvflags; ! INITIALIZE RRV RECORD FLAGS
newrrvptr [drrecordid] = .rrvrfa [rfaid]; ! Initialize RRV ID
!
! Initialize RRV pointer to data record.
!
newrrvptr [drrrvaddress] = !
makerfa (.newbktno, .recptr [drrecordid]); !
lookat ('CREATED RRV AT: ', newrrvptr);
END
ELSE
IF .rrvbktno NEQ .newbktno ! EXISTING RRV RECORD?
AND chkflag (recptr [drflags], flgrrvupd) EQL 0 ! 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] = 0; ! START SEARCH FROM TOP OF BUCKET
IF getbkt (.rrvbktno, ! Bucket number
.bktsize, ! Bucket size
false, ! Lock flag
updbkd) EQL false ! Bucket
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] EQL .rrvbktno ! I.E., SAME BUCKET
THEN
BEGIN ! Update this RRV record
recdesc [rdrfa] = .updrrvrfa; ! SET RFA OF RRV RECORD
!
! Remember where we are (in case of search failure)
!
savrecptr = .recdesc [rdrecptr];
IF sdatabkt (recdesc, updbkd) EQL false
THEN
BEGIN ! Can't get RRV
errflag = true;
recdesc [rdrecptr] = .savrecptr ! RESTORE SEARCH POINTER
END
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
END;
updrecptr = .updrecptr + sizeofudr (updrecptr); ! NEXT RECORD IN NEW BUCKET
lookat (' UPD-RECPTR: ', updrecptr)
END
UNTIL .updrecptr GEQ .endptr; ! LOOP BACK FOR NEXT NEW BUCKET RECORD
!+
! RELEASE BUCKET USED FOR UPDATING RRV RECORDS
!-
putbkt (true, updbkd)
END
END;
recptr = .recptr + sizeofudr (recptr) ! NEXT RECORD IN NEW BUCKET
END;
!+
! DONE
!-
IF .errflag
THEN
RETURN false ! ** RRV NOT FOUND **
ELSE
RETURN true ! SUCCESS
END; ! End UPDRRVS
%SBTTL 'ALCNEWIDS - allocate IDs'
GLOBAL ROUTINE alcnewids (newbd) : NOVALUE =
! 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
BEGIN
MAP
newbd : REF BLOCK;
LOCAL
endptr : REF BLOCK, ! PTR TO END OF BUCKET
bktptr : REF BLOCK, ! PTR TO TOP OF BUCKET
lastid, ! LOCAL COPY OF THE LASTID FIELD
keyofreference, ! KEY OF REF
newbucket; ! BUCKET NUMBER OF NEW BUCKET
REGISTER
recordptr : REF BLOCK, ! 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
! 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 = 0;
IF .keyofreference EQL refprimary
THEN
BEGIN
clrflag (recordptr [drflags], flgrrvupd); ! CLEAR "RRVUPD" FLAG
currentrfa = .recordptr [drrrvaddress] ! GET RRV
END;
IF .currentrfa<rh> NEQ .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 rmsbug (msgcount); ! BAD COUNTER
!+
! STORE THIS ID IN THE RECORD
!-
recordptr [drrecordid] = .nextid;
nextid = .nextid + 1; ! Bump it
END;
!+
! BUMP THE POINTER TO NEXT DATA RECORD
!-
recordptr = .recordptr + sizeofdatarecrd (recordptr) ! ADVANCE TO NEXT RECORD
END;
!+
! REPLACE THE ID FIELD IN THE BUCKET HEADER
!-
bktptr [bhnextid] = .nextid;
RETURN
END; ! End ALCNEWIDS
END
ELUDOM