Google
 

Trailing-Edge - PDP-10 Archives - tops20-v7-ft-dist1-clock - 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