Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

MODULE UDR =


BEGIN

GLOBAL BIND	UDRV = 1^24 + 1^18 + 15;	!EDIT DATE: 08-SEP-88

%([

FUNCTION:	THIS MODULE CONTAINS ROUTINES WHICH PROCESS
		USER DATA RECORDS WITHIN AN RMS-20 INDEXED FILE.
AUTHOR:	S. BLOUNT

THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) 1977, 1979, 1988 BY DIGITAL EQUIPMENT CORPORATION



**********	TABLE OF CONTENTS	**************




	ROUTINE			FUNCTION
	=======			========

	MAKEUDR			MAKE A USER DATA RECORD

	SDATABKT		SEARCH A USER DATA BUCKET

	INSRTUDR		INSERT A USER DATA RECORD

	CHKDUP			CHECK FOR DUPLICATE KEY VALUES




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	RMSUDR SPLIT INTO RMSUDR, RMSUD2, RMSSPT.
9	5-NOV-76	SB	MAKE SDATABKT RETURN EMPTY ON NON-EX BKT
10	9-NOV-76	SB	ADD IDOFRFA INSTEAD OF IDMASK
11	9-DEC-76	SB	CLEAN-UP, TAKE OUT CHECK FOR SAME BKT ON UPDATE
12	13-JAN-77	SB	FIX BUG IN SDATABKT WHERE ENTIRE RFA IS
				CHECKED FOR 0 INSTEAD OF ONLY THE ID.
13	17-FEB-77	SB	IF 3-BKT SPLIT & DUP SEEN, MARK AS 2-BKT SPLIT

*************************************************
*						*
*		NEW REVISION HISTORY		*
*						*
*************************************************

****************** Start RMS-10 V1.1 *********************
********************* TOPS-10 ONLY ***********************

PRODUCT	MODULE	 SPR
 EDIT	 EDIT	 QAR		DESCRIPTION
======	======	=====		===========

 100	  14	Dev		Make declarations for routine names
				be EXTERNAL ROUTINE so RMS will compile 
				under BLISS V4 (RMT, 10/22/85).

 124      15    10-35306	Fix UNCLUTTER/VERIFY bug.  If the key
		10-35629	being checked by ACCKEY in UTLVFY is
				NO DUPLICATES ALLOWED, CHKDUP returned
				ER$DUP which misled SIDRSCAN into thinking
				the SIDRELEMENT was found.  Between an unset
				index into the SIDR array if NO DUPS and the
				old Davenport "fix" causing random writes if
				DUPS were allowed on a key, all sorts of things
				were happening which might not be caught for
				ages.  On top of that, the wrong field was
				being checked for the RDFLGRETEX bit.  The
				RDFLGDUP bit was actually being checked and
				was always true even for plain RMS.
				Also apply edit 442 from RMS-20.
				 (SMW, 9/8/88)



	***** END OF REVISION HISTORY *****



])%



	%([ FORWARD DECLARATIONS ])%

		%(< NONE >)%

	%([ EXTERNAL DECLARATIONS ])%
	EXTERNAL ROUTINE
	    CRASH,		! DEBUGGING
	    CKEYKK,		! COMPARE CONTIGUOUS KEYS
	    MOVEKEY,	! MOVE A KEY STRING VALUE
	    SPLIT,		! SPLIT A DATA BUCKET
	    ALCRFA,		! ALLOCATE A NEW RFA FOR A BKT
	    FNDREC,
	    SKIPRECORD,	! SKIP A DATA RECORD
	    UPDRRVS,	! UPDATE RRV RECORDS AFTER A SPLIT
	    COMPRESS,	! COMPRESS A DATA BKT
	    FBYRFA,		! FIND A RECORD GIVEN ITS RFA
	    DUMPHEADER,	! DUMP A BUCKET HEADER
	    DUMPRD,		! DUMP A RECORD DESCRIPTOR
	    ALCBKT,		! ALLOCATE A NEW BUCKET
	    PUTBKT,		! RELEASE A BUCKET
	    CKEYKU,		! COMPARE KEY (KEY TO UDR)
	    DUMP;		! SAME


	%([ ERROR MESSAGES REFERENCED IN THIS MODULE ])%

	EXTERNAL
	    MSGINPUT,	! BAD INPUT VALUES
	    MSGFAILURE,	! ROUTINE FAILED
	    MSGFLAGS,	! BAD FLAG VALUES
	    MSGCOUNT,	! A BAD COUNT VALUE
	    MSGLOOP,	! WENT THROUGH LOOP TOO MANY TIMES
	    MSGCANTGETHERE;	! BAD LOGIC FLOW



REQUIRE 'RMSREQ';
EXTDECLARATIONS;

! MAKEUDR
! =======

! THIS ROUTINE CREATES A USER DATA RECORD ( UDR ) IN AN
!	INDEXED FILE. IT PERFORMS NO INDEX MODIFICATION
!	OR TRAVERSAL. IT ALSO DOES NOT MODIFY THE CONTENTS OF 
!	THE BUCKET HEADER IN ANY WAY.

! INPUT:
!	RECORD DESCRIPTOR:
!		RECPTR		ADDRESS IN BUCKET TO WRITE RECORD
!	ADDRESS OF USER DATA RECORD
!
! FIELDS WITHIN THE RST WHICH ARE USED:
!		RSZ		SIZE OF RECORD IN BYTES
!		RSZW		SIZE OF RECORD IN WORDS
!

! OUTPUT:
!	TRUE ALWAYS

! INPUT ARGUMENTS MODIFIED:
!	RECORD DESCRIPTOR:
!		RFA		RFA OF NEW RECORD
!		RRV		SET TO BE THE RRV ADDRESS (SAME AS RFA)


GLOBAL ROUTINE MAKEUDR ( RECDESC, USERRECORDPTR ): NOVALUE =
BEGIN

	ARGUMENT	(RECDESC,BASEADD);		! RECORD DESCRIPTOR
	ARGUMENT	(USERRECORDPTR,BASEADD);	! USER RECORD ADDRESS

REGISTER
    RECORDPTR,					! POINTER TO THE DATA RECORD
    RECORDRFA;					! RFA OF NEW RECORD

MAP
    RECDESC:	POINTER,
    USERRECORDPTR:	POINTER,
    RECORDPTR:	POINTER;


	TRACE ('MAKEUDR' );

	%([ SET UP SOME MISCELLANEOUS STUFF ])%

	RECORDPTR = .RECDESC [ RDRECPTR ];		! FETCH ADDRESS OF RECORD

	%([ STORE FLAGS INTO DATA RECORD ])%
	RECORDPTR [ DRFLAGS ] = DEFDRFLAGS;		! USE DEFAULT FLAGS

	%([ SET UP THE RFA AND THE ID VALUE IN THE RECORD ])%

	RECORDRFA = .RECDESC [ RDRFA ];			! GET IT FROM REC DESC
	RECORDPTR [ DRRRVADDRESS ] = .RECORDRFA;	! STORE IN RECORD
	RECDESC [ RDRRV ] = .RECORDRFA;			! PUT BACK IN RRV ADDRESS
	RECORDPTR [ DRRECORDID ] = .RECORDRFA < LH >;	! 'LH' CORRESPONDS TO RFAID

	IF NOT FIXEDLENGTH %(RECORDS)%
	THEN %( WE MUST STORE THE SIZE OF THIS RECORD )%

		BEGIN
		RECORDPTR [ DRRECSIZE ] = .RST [ RSTRSZ ];
		RECORDPTR [ DRRESERVED ] = ZERO;	! JUST FOR SAFETY
		INC ( RECORDPTR, 1 )			! BUMP TO DATA
		END; %(OF IF NOT FIXEDLENGTH)%

	%([ MOVE POINTER TO THE RECORD DATA ])%

	RECORDPTR = .RECORDPTR + FIXHDRSIZE;

	%([ MOVE THE USER RECORD INTO THE FILE ])%

	MOVEWORDS ( 	%(FROM)%	.USERRECORDPTR,
			%(TO)%		.RECORDPTR,
			%(SIZE)%	.RST [ RSTRSZW ] );

	RETURN

END; %( OF MAKEUDR )%

! SDATABKT
! ========

! ROUTINE TO SEARCH A USER DATA BUCKET.
!	THIS ROUTINE WILL SEARCH A USER DATA BUCKET FOR
!	TWO CONDITIONS:
!		1.	MATCHING KEY VALUE
!		2.	MATCHING ID VALUE
!
!	FOR KEY SEARCHES, THE ROUTINE WILL STOP WHEN A
!	RECORD KEY VALUE IS FOUND WHICH IS GEQ TO THE
!	SEARCH KEY VALUE, AND THE STATUS FLAGS IN THE
!	RECORD DESCRIPTOR WILL BE SET ACCORDINGLY.
!	FOR KEY SEARCHES, THE SEARCH WILL TERMINATE IF AN
!	RRV RECORD IS FOUND.
!
!	FOR ID SEARCHES, THE ROUTINE WILL STOP WHEN AN
!	EXACT MATCH IS FOUND, OR WHEN THE END OF THE
!	BUCKET IS REACHED. FOR ID SEARCHES, THE SEARCH WILL
!	NOT TERMINATE WHEN AN RRV RECORD IS FOUND.


! INPUT:
!	RECORD DESCRIPTOR
!		RECPTR		PLACE TO START THE SEARCH
!				.GTR. 0 ==> ADDRESS TO START SEARCH
!				.EQL. 0 ==> START SEARCH AT TOP OF BKT
!				.LSS. 0 ==> SEARCH ONLY FIRST RECORD
!		USERPTR		ADDRESS OF USER DATA RECORD/KEY STRING
!		USERSIZE	SIZE OF DATA RECORD/KEY STRING
!		RFA		CONTAINS THE ID TO SEARCH FOR, OR 0 FOR KEY SEARCH
!		FLAGS
!			<NONE>
!
!	BUCKET DESCRIPTOR OF BUCKET

! OUTPUT STATUS:
!	TRUE:		SEARCH TERMINATED NORMALLY
!			FLGLSS MAY BE SET IF MATCH WAS .LSS.
!	FALSE:		SEARCH TERMINATED ABNORMALLY
!			(I.E. RECORD NOT FOUND)

! INPUT ARGUMENTS MODIFIED:
!	RECORD DESCRIPTOR
!		RECPTR		ADDRESS OF SEARCH TERMINATION
!		LASTRECPTR	ADDRESS OF RECORD BEFORE CURRENT ONE
!		STATUS		FLAGPST
!				FLAGLSS

! NOTES ON INPUT ARGUMENTS:
!
!	1.	IF RECPTR IS LESS THAN 0, IT MEANS THAT THIS
!		ROUTINE IS TO SEARCH ONLY THE FIRST RECORD IN
!		THE NEXT BUCKET. THIS OCCURS WHEN AN INDEX
!		TREE ERROR IS DETECTED (THE INDEX RECORD KEY IS
!		GREATER THAN THE KEY OF THE LAST RECORD IN THE
!		BUCKET WHICH IT POINTS TO). BY CHECKING ONLY THE
!		FIRST RECORD IN THE NEXT BUCKET, WE CAN DETERMINE
!		THE CORRECT POSITIONING FOR THE OPERATION.
!
!NOTE ON OUTPUT ARGUMENTS:
!	1)  IF FLGPASTLAST IS SET ON RETURN, RECPTR WILL POINT
!	TO THE RECORD POSITION FOLLOWING THE LAST DATA RECORD (EITHER
!	END OF BUCKET OR 1ST RRV ) ON KEY SEARCHES. ON ID SEARCHES,
!	THE SEARCH TERMINATION WILL ONLY BE AT THE END OF BUCKET.
!
!	2 )  IF THE SEARCH TERMINATES AT THE FIRST RECORD, THEN
!	LASTRECPTR WILL POINT TO THE FIRST RECORD (AS WILL RECPTR).

! ROUTINES CALLED:
!	CKEYUU
!	CKEYUI

GLOBAL ROUTINE SDATABKT ( RECDESC, BKTDESC ) =
BEGIN
	ARGUMENT	(RECDESC,BASEADD);		! RECORD DESCRIPTOR
	ARGUMENT	(BKTDESC,BASEADD);		! BUCKET DESCRIPTOR

MAP
    RECDESC:	POINTER,
    BKTDESC:	POINTER;

REGISTER
    MOVINGPTR:	POINTER,
    SEARCHID,				! ID OF RFA TO SEARCH FOR
    SEARCHRFA,				! ENTIRE RFA TO SEARCH FOR
    TEMPAC;

LOCAL
    ENDPTR:	POINTER,				! ADDR OF END OF BUCKET
    HEADERSIZE,				! SIZE OF RECORD HEADER
    STOPATFIRSTFLAG,			! FLAG FOR SEARCH
    SIDRFLAG,				! ON IF SCANNING SIDR'S
    DUMMY,					! DUMMY LOCAL VARIABLE
    SAVESTATUS,
    DATAPTR:	POINTER;			! PTR TO DATA RECORD

	TRACE ( 'SDATABKT' );

	%([ SET UP FOR BUCKET SEARCH ])%

	SIDRFLAG = ( STOPATFIRSTFLAG = FALSE);
	IF .KDB [ KDBREF ] ISNT REFPRIMARY THEN SIDRFLAG = TRUE;
	CLRFLAG ( RECDESC [ RDSTATUS ], RDFLGLSS+RDFLGEMPTY+RDFLGPST+RDFLGDELETE);
	ENDPTR = .BKTDESC [ BKDBKTADR ];		! BEGIN TO COMPUTE END

	%([ IF THIS IS NOT A DATA BUCKET, THEN EITHER THERE IS
	   A BUG, OR THE USER IS DOING RFA ACCESS WITH A BAD
	   RFA, BUT WE CAN'T TELL WHICH ])%

	IF .ENDPTR [ BHBTYPE ] ISNT BTYPEDATA THEN BADRETURN;
	IF ( MOVINGPTR = .RECDESC [ RDRECPTR ] ) LEQ ZERO
	THEN %(WE SHOULD START AT TOP OF BUCKET)%
		BEGIN
		IF .MOVINGPTR LSS ZERO THEN STOPATFIRSTFLAG = TRUE;
		MOVINGPTR = .ENDPTR + BHHDRSIZE;
		RECDESC [ RDRECPTR ] = (RECDESC [ RDLASTRECPTR ]  = .MOVINGPTR)
		END; %(OF START AT TOP OF BUCKET)%

	%([ CHECK FOR EMPTY OR NON-EXISTENT BUCKET ])%

	IF ( TEMPAC = .ENDPTR [ BHNEXTBYTE ] ) LEQ BHHDRSIZE
	THEN %(WE HAVE AN EMPTY BUCKET)%
		BEGIN
		SETFLAG ( RECDESC [ RDSTATUS ], RDFLGEMPTY + RDFLGPST );
		BADRETURN
		END;

	%([ NOW, RESET THE END POINTER TO THE END OF DATA ])%

	ENDPTR = .ENDPTR + .TEMPAC;			! FIND NEXT FREE BYTE


	%([ FETCH THE SEARCH ID AND DETERMINE IF THIS IS AN ID SEARCH ])%

	SEARCHRFA = .RECDESC [ RDRFA ];			! GET WHOLE RFA
	SEARCHID = IDOFRFA ( .SEARCHRFA );		! EXTRACT ID FROM RFA
	HEADERSIZE = .KDB [ KDBHSZ ];			! ABD SIZE OF HEADER

	%([ CHECK IF THE STARTING ADDRESS IS PAST THE ENDING ADDRESS ])%

	IF .MOVINGPTR GEQ .ENDPTR
	THEN %(WE MUST SET SOME STATUS BITS AND EXIT)%

		BEGIN
		IF .MOVINGPTR GTR .ENDPTR THEN RMSBUG ( MSGINPUT );
		SETPASTLASTFLAG ( RECDESC );
		BADRETURN
		END; %(OF IF MOVINGPTR GTR ENDPTR)%

	%([ THIS IS MAIN SEARCH LOOP ])%

	WHILE .MOVINGPTR LSS .ENDPTR
	DO

		BEGIN
		RECDESC [ RDRECPTR ] = .MOVINGPTR;	! SET UP FINAL PTR NOW
		IF .SEARCHRFA ISNT NULLID
		THEN %(THIS IS AN ID SEARCH)%

			BEGIN

			%([ IS THIS THE RIGHT ID? ])%

			IF .SEARCHID IS .MOVINGPTR [ DRRECORDID ]
			THEN %(WE FOUND IT)%
				BEGIN
				LOOKAT ( '	ID MATCH FOUND AT: ',MOVINGPTR );
				IF CHKFLAG ( MOVINGPTR [ DRFLAGS ],FLGDELETE) ISON 
					THEN SETFLAG (RECDESC[RDSTATUS],RDFLGDELETE);
				GOODRETURN
				END %(OF IF ID'S MATCH)%

			END %(OF IF THIS WAS AN ID SEARCH)%

		ELSE %(THIS IS A KEY SEARCH)%

			BEGIN

			%([ IGNORE RRV RECORDS ])%

			IF CHKFLAG ( MOVINGPTR [ DRFLAGS ], FLGRRV ) ISON
			THEN	BEGIN	%(EXIT BECAUSE WE DIDNT FIND THE KEY)%
				SETPASTLASTFLAG ( RECDESC );
				BADRETURN;
			END;
			DATAPTR = .MOVINGPTR + .HEADERSIZE;

			%([ COMPARE THE KEY VALUES, DEPENDING ON 
			   WHETHER THE DATA RECORD IS A USER
			   DATE RECORD OR A SECONDARY DATA RECORD ])%

			SAVESTATUS = 	(IF .SIDRFLAG ISON
					THEN %(IT IS A SIDR)%
						CALLCKEYKK (	BPT ( RECDESC ),
								LPT ( DATAPTR ) )
					ELSE %(IT IS USER DATA RECORD)%
						CALLCKEYKU (	BPT ( RECDESC ),
								LPT ( DATAPTR ) ) );

			%([ SHOULD WE GO ON? ])%
			IF .SAVESTATUS IS TRUE
			THEN %(WE WILL CHECK FOR DELETED RECORDS..THEN EXIT)%
				BEGIN
				IF CHKFLAG ( MOVINGPTR [ DRFLAGS ],FLGDELETE) ISON 
					THEN SETFLAG (RECDESC[RDSTATUS],RDFLGDELETE);
				GOODRETURN
				END; %(OF IF WE FOUND THE RECORD)%

			%([ EXIT FOR FIRST-ONLY SEARCH ])%

			IF .STOPATFIRSTFLAG ISNT FALSE THEN RETURN .SAVESTATUS

			END; %(OF ELSE THIS WAS A KEY SEARCH)%

		%([ WE DIDN'T FIND THE RECORD, SKIP OVER IT ])%

		RECDESC [ RDLASTRECPTR ] = .MOVINGPTR;		! SAVE LAST RECORD
		MOVINGPTR = .MOVINGPTR + SIZEOFANYRECORD (  MOVINGPTR )
		END; %(OF WHILE MOVINGPTR LSS ENDPTR)%

	%([ WE DID NOT FIND THE RECORD ])%

	RECDESC [ RDRECPTR ] = .MOVINGPTR;			! RESTORE POINTER
	SETPASTLASTFLAG ( RECDESC );			! REMEMBER WE WENT TOO FAR
	BADRETURN
END; %(OF SDATABKT)%

! INSRTUDR
! =========

! ROUTINE TO INSERT A USER DATA RECORD INTO A DATA BUCKET
!	THIS ROUTINE DOES ALL MOVING OF RECORDS AND SPLITS.
!	HOWEVER, NO INDEX MODIFICATION AT ALL IS DONE BY
!	THIS ROUTINE OR ANY ROUTINE BELOW THIS ROUTINE.

! INPUT:
!	RECDESC		RECORD DESCRIPTOR PACKET
!		RECPTR		ADDRESS TO INSERT RECORD
!		LENGTH		LENGTH (IN WORDS) OR RECORD TO INSERT
!
!	USERRECORDPTR	ADDRESS OF USER DATA RECORD
!	DATABD		BUCKET DESC OF CURRENT BUCKET
!	SPLITBD1	BUCKET DESC OF 1ST SPLIT BUCKET (RETURNED)
!	SPLITBD2	BUCKET DESC OF 2ND SPLIT BUCKET (RETURNED)
!
! OTHER FIELDS USED:
!	RSZW IN RST = SIZE IN WORDS OF USER RECORD

! OUTPUT:
!	TRUE:	RECORD INSERTED
!	FALSE:	ERROR
!		NO MORE BUCKETS
!		NO MORE CORE
!
! ON ERROR, USRSTS WILL BE SET TO THE APPROPRIATE ERROR CODE

! ARGUMENTS MODIFIED:
!	RECORD DESCRIPTOR
!		RECPTR		ADDRESS OF INSERTED RECORD
!		RFA		RFA OF NEW RECORD
!		LASTRECPTR	ADDRESS OF NEW HIGH RECORD FOR
!				ORIGINAL BUCKET, IF SPLIT
!		RRV		RFA OF RRV RECORD (SAME AS RFA)
!		STATUS		STATUS VALUE OF OPERATION
!			IDXUPDATE	INDEX UPDATE REQUIRED

! ROUTINES CALLED:
!	ALCRFA
!	MAKEUDR
!	SPLIT
!	COMPRESS
!	

! NOTES:
!
!	1.	ON OUTPUT, ALL BUCKETS (ORIGINAL AND SPLIT BUCKETS)
!		HAVE BEEN UPDATED TO THE FILE. ALSO, THE NEW BUCKETS,
!		IF ANY, ARE UNLOCKED. HOWEVER, THE ORIGINAL DATA 
!		BUCKET REMAINS LOCKED. IT IS THE CALLER'S RESPONSIBILITY
!		TO EXPLICITLY UNLOCK THE DATA BUCKET.
!
!	2.	IF A 3-BUCKET SPLIT OCCURS (ONLY POSSIBLE IF A VERY
!		LARGE RECORD IS INSERTED), THEN 1ST SPLIT BUCKET
!		DESCRIPTOR WILL REPRESENT THE BUCKET CONTAINING THE
!		R(HIGH) RECORD SET AND R(NEW) WILL BE IN SPLITBD2.

GLOBAL ROUTINE INSRTUDR ( RECDESC, USERRECORDPTR, DATABD, SPLITBD1, SPLITBD2 ) =
BEGIN
	ARGUMENT	(RECDESC,BASEADD);		! RECORD DESC
	ARGUMENT	(USERRECORDPTR,BASEADD);	! USER RECORD ADDRESS
	ARGUMENT	(DATABD,BASEADD);		! PRIMARY BUCKET
	ARGUMENT	(SPLITBD1,BASEADD);		! NEW BKT-1
	ARGUMENT	(SPLITBD2,BASEADD);

MAP
    RECDESC:	POINTER,
    USERRECORDPTR:	POINTER,
    DATABD:	POINTER,
    SPLITBD1:	POINTER,
    SPLITBD2:	POINTER;

LOCAL
    AREANUMBER,			! AREA NUMBER OF THE DATA AREA
    FREESPACE,			! AMOUNT OF FREE SPACE LEFT IN DATA BUCKET
    BUCKETSIZE,			! BUCKET SIZE OF DATA BUCKET
    NEXTFREEWORD,			! NEXT WORD IN BUCKET WHICH IS AVAILABLE
    NEWRECORDSIZE,			! SIZE OF RECORD TO BE INSERTED
    AMOUNTTOMOVE,			! AMOUNT OF DATA TO BE MOVED FOR NEW RECORD
    RETURNEDSPACE,			! AMOUNT OF NEW SPACE AFTER BUCKET COMPRESSION
    MINFREESPACE,			! USED TO COMPUTE USER FREE SPACE
    EXITFLAG,			! USED TO GET US OUT OF LOOP
    LOOPCOUNT,			! BINARY SWITCH FOR # OF TIMES THRU LOOP
    INSERTPTR,			! ADDRESS WHERE RECORD IS TO GO
    LASTRECORDPTR:	POINTER,		! PTR TO LAST RECORD IN ORIGINAL BKT
    TEMPPTR:	POINTER,		! TEMPORARY PTR VARIABLE
    WINDOWPAGE;
	

REGISTER
    BKTPTR:	POINTER;

	TRACE ('INSRTUDR');

	%([ CHECK INPUT VALUES ])%

	CHECKEXACTCOUNT;

	EXITFLAG = FALSE;			! INIT VALUES
	LOOPCOUNT = ZERO;
	NEWRECORDSIZE = .RECDESC [ RDLENGTH ] + .KDB [ KDBHSZ ];



	%([ THIS IS THE MAIN LOOP OF THIS ROUTINE. IF THE RECORD
	   WILL FIT INTO THE BUCKET, THEN A RETURN IS DONE FROM
	   THE MIDDLE OF THE LOOP. IF THE RECORD CANNOT FIT INTO
	   THE BUCKET, THEN THE BUCKET IS COMPRESSED. IF THE
	   RECORD WILL NOW FIT, THE LOOP IS EXECUTED AGAIN EXACTLY
	   AS IF THE RECORD WOULD INITIALLY FIT INTO THE BUCKET.
	   HOWEVER, IF THE RECORD STILL WONT FIT, CONTROL FALLS
	   THRU THE LOOP AND A BUCKET SPLIT OCCURS.	])%


	WHILE .EXITFLAG IS FALSE
	DO %(THIS LOOP)%

		BEGIN

		%([ GET THE ADDRESS WHERE WE WILL INSERT THE NEW RECORD.
		   NOTE THAT THIS ADDRESS MAY BE CHANGED BY "COMPRESS",
		   THUS, WE MUST RE-FETCH IT WITHIN THIS LOOP. ])%

		INSERTPTR = .RECDESC [ RDRECPTR ];	! GET FIRST POINTER
		BKTPTR = .DATABD [ BKDBKTADR ];
		BUCKETSIZE = .KDB [ KDBDBKZ ];

		%([ COMPUTE FREE SPACE IN THIS BUCKET ])%

		FREESPACE = ( .BUCKETSIZE ^ B2W ) - .BKTPTR [ BHNEXTBYTE ];

		%([ CHECK TO SEE IF THE USER WANTED THE BUCKET TO
		   HAVE A LOAD-FILL PERCENTAGE ])%

		IF CHKFLAG ( RAB [ RABROP ], ROPLOA ) ISON
		THEN	%(CHECK IF WE HAVE "FILLED" THE BUCKET )%
			BEGIN
			MINFREESPACE = ( .BUCKETSIZE ^ B2W ) - .KDB [ KDBDFLOFFSET ];
			IF .MINFREESPACE GEQ .FREESPACE
			THEN
				FREESPACE = ZERO;		! FORCE A SPLIT
			END; %(OF IF THE LOA BIT IS ON)%

		%([ LET'S SEE THESE VALUES ])%

		LOOKAT ('	BKTPTR: ',BKTPTR);
		LOOKAT ('	FREESPACE: ',FREESPACE);

	
		%([ CHECK TO SEE IF IT'LL FIT ])%
	
		IF .NEWRECORDSIZE LEQ .FREESPACE
		THEN
			BEGIN	%( TO INSERT THE RECORD )%
			RTRACE ( %STRING('	RECORD CAN FIT... ',%CHAR(13),%CHAR(10)) );
			NEXTFREEWORD = .BKTPTR + .BKTPTR [ BHNEXTBYTE ];
			AMOUNTTOMOVE = .NEXTFREEWORD - .INSERTPTR;	! COMPUTE DATA TO MOVE DOWN
			LOOKAT ( '	NEXTFREEWORD:', NEXTFREEWORD);
			LOOKAT ( '	AMMTTOMOVE:', AMOUNTTOMOVE );
			IF .AMOUNTTOMOVE LSS ZERO THEN RMSBUG ( MSGCOUNT );

			%([ IF THIS ISNT THE LAST RECORD IN THE BUCKET
			   THEN WE NEED TO MOVE SOME RECORDS DOWN ])%

			IF .AMOUNTTOMOVE ISNT ZERO
			THEN
				BEGIN	%( TO MOVE RECORDS DOWN )%
				RTRACE ( %STRING('	MOVING RECORDS DOWN ',%CHAR(13),%CHAR(10)) );
	
				MOVEDOWN(	%( START )%	.INSERTPTR,
						  %( END )%	.NEXTFREEWORD - 1,
						  %( SIZE )%	.NEWRECORDSIZE );
				END; %(OF IF AMOUNT TO MOVE ISNT ZERO)%


			%([ ALLOCATE A NEW RFA FOR THIS RECORD ])%

			RECDESC [ RDRFA ] =CALLALCRFA ( BPT ( DATABD ) );

			%([ CREATE THE RECORD ])%

			CALLMAKEUDR (	%(REC DESC)%	BPT ( RECDESC ),
					%(UDR PTR)%	BPT ( USERRECORDPTR ) );

			%([ RESET THE BUCKET HEADER DATA ])%

			BKTPTR [ BHNEXTBYTE ] = .BKTPTR [ BHNEXTBYTE ] + .NEWRECORDSIZE;
			%([ WRITE THE DATA PAGE OUT TO THE DISK ])%

			IF ( NOT WRITEBEHIND )
			THEN UPDATEBUCKET ( DATABD )		! BUCKET UPDATE
			ELSE SETBFDUPD(DATABD[BKDBFDADR]);	!SET WRITE FLAG
			GOODRETURN

			END; %(OF IF NEWRECORDSIZE LEQ FREESPACE)%


		%([ AT THIS POINT, THE RECORD WON'T FIT, WE MUST SPLIT ])%
		RTRACE ( %STRING('	**RECORD WONT FIT**',%CHAR(13),%CHAR(10)) );
	
		%([ INITIALIZE THE AMOUNT OF COMPRESSED SPACE TO ZERO ])%
		RETURNEDSPACE = ZERO;				! CLEAR LOCAL
	
		%([ IF THIS IS OUR FIRST TIME THRU THE LOOP, WE
		   MUST TRY TO COMPRESS TO BUCKET. IF THIS IS
		   OUR SECOND TIME THRU THE LOOP, THEN WE ALREADY
		   COMPRESSED THE BUCKET AND RECOVERED ENOUGH
		   SPACE FOR THE RECORD TO FIT. BUT, SOMEHOW
		   OUR INITIAL COMPUTATION CONCLUDED THAT THE
		   RECORD WOULD NOT FIT...THUS, WE HAVE A BUG SOMEWHERE ])%
	
		IF .LOOPCOUNT IS ZERO
		THEN
			BEGIN
			%([ COMPRESS THE BUCKET ])%
		
			RETURNEDSPACE = CALLCOMPRESS ( BPT ( RECDESC ), BPT (DATABD) );
	
			%([ BUMP OUR LOOP CONTROL FLAG ])%
			LOOPCOUNT = .LOOPCOUNT+1;
	
			%([ DID WE GET BACK ENOUGH SPACE TO INSERT THE RECORD?? ])%
			LOOKAT ( '	SPACE RETURNED:', RETURNEDSPACE );
	
			IF ( .RETURNEDSPACE + .FREESPACE ) LSS .NEWRECORDSIZE
			THEN
				EXITFLAG = TRUE;
			END %( OF IF LOOPCOUNT IS ZERO )%
		ELSE
			RMSBUG ( MSGLOOP );		! WE WENT THRU LOOP TWICE
		
		END; %( OF DO WHILE EXITFLAG IS FALSE )%
		
	%([ WE MUST NOW SPLIT THE BUCKET ])%

	%([ SET UP ARGS FOR SPLIT ROUTINE: ])%

	RECDESC [ RDLENGTH ] = .NEWRECORDSIZE;		! SIZE OF HOLE

	IF CALLSPLIT ( %( REC-DESC )%		BPT (RECDESC),
		       %( OLD DATABD )%		BPT (DATABD),
		       %( USED FOR SPLIT )%	BPT (SPLITBD1),
		       %( 3-BKT SPLIT )%	BPT (SPLITBD2) ) IS FALSE
	THEN %(SOMETHING VERY BAD HAS HAPPENED)%
		RETURN FALSE;
	
	%([ THE BUCKET HAS NOW BEEN SPLIT AND RECPTR
	   POINTS TO WHERE WE SHOULD WRITE THE NEW RECORD ])%


	%([ WE WILL NOW CREATE THE USER DATA RECORD ])%

	CALLMAKEUDR (	%( REC-DESC )%	BPT (RECDESC),
			%(USER RECORD)%	BPT ( USERRECORDPTR ) );


	%([ NOTE THAT LASTRECPTR NOW POINTS TO THE HIGHEST RECORD
	   IN THE OLD BUCKET ])%

	%([ THERE IS ONE LAST THING WE MUST DO...WE MUST MOVE
	   THE NEW HIGH-KEY VALUE OF THE HIGHEST RECORD IN THE
	   OLD BUCKET INTO A TEMPORARY KEY BUFFER. WE MUST DO
	   THIS BECAUSE THE KEY VALUE IS UNAVAILABLE AFTER THE
	   BUCKET HAS BEEN RELEASED (BECAUSE IF THE BUFFER CAME
	   FROM FREE CORE, IT WILL BE DESTROYED AFTER USE).
	   THEREFORE, WE WILL MOVE THIS KEY VALUE INTO THE
	   BOTTOM HALF OF THE RST KEY BUFFER ])%

	TEMPPTR = .RST [ RSTKEYBUFF ] + ( .FST [ FSTKBFSIZE ] / 2 );
	LASTRECORDPTR = .RECDESC [ RDLASTRECPTR ] + .KDB [ KDBHSZ ];
	CALLMOVEKEY (	%(FROM UDR)%	LPT ( LASTRECORDPTR ),
			%(TO BUFFER)%	LPT ( TEMPPTR ) );


	%([ WE WILL NOW UPDATE THE FILE BUCKETS WHICH WE PROCESSED.
	   NOTE THAT THESE BUCKETS MUST BE UPDATED IN REVERSE ORDER
	   OF THEIR LINKAGES IN THE BUCKET CHAIN IN ORDER TO AVOID
	   THE PROBLEM OF A BUCKET WHICH POINTS TO A NON-EXISTENT
	   BUCKET. ])%

	%([ UPDATE THE THIRD BUCKET IF THERE WAS ONE ])%

	IF .RECDESC [ RDCOUNT ] GTR 1 THEN UPDATEBUCKET ( SPLITBD2 );

	%([ UPDATE THE RRV'S IN THE NEW BUCKET ])%

	IF CALLUPDRRVS (%(OLD BKT)%	BPT ( DATABD ),
			%(NEW BKT)%	BPT ( SPLITBD1 ) ) IS FALSE

	%([ IF WE COULDN'T DO IT, TELL THE USER BUT GO ON ])%

	THEN USRSTS = SU$RRV;

	%([ UPDATE DATA BUCKET  ])%

	UPDATEBUCKET ( DATABD );

	%([ *****NOTE THAT WE HAVE NOW UPDATED THE PRIMARY DATA
	   BUCKET TO DISK, BUT WE HAVE NOT RELEASED IT YET*** ])%

	%([ FLUSH ALL SPLIT BUCKETS ])%

%([** FLUSH OLD BUCKET IF R-NEW GOES INTO NEW BUCKET AND RECORDS ARE **])%
%([** ACCESSED SEQUENTIALLY. ELSE FLUSH THE NEW BUCKET. THIS FIX HAS TO DO **])%
%([** WITH THE PROBLEM OF FLUSHING THE INCORRECT DATA BUCKET ON A SPLIT  **])%
%([** WHEN RECORDS ARE INSERTED SEQUENTIALLY. SO THE FOLLOWING CHECK	**])%
%([** MAKES SURE THE PROPER BUCKET IS FLUSHED. PREVIOUSLY THE SPLIT  **])%
%([** BUCKET WAS BEING FLUSHED ALWAYS EVEN THOUGH THE OLD BUCKET WAS   **])%
%([** NEVER REQUIRED. THIS RESULTED IN THE ER$SEQ ERROR CODE.          **])%


	TEMPPTR = ( IF FLUSHORIGBD ( RECDESC ) ISON
		    THEN
			.DATABD
		    ELSE
			.SPLITBD1 );


%([**		END OF THE FIX. NOTE: ON THE CALL PUTBKT BELOW 		**])%
%([**		'LPT ( TEMPPTR )'IS USED INSTEAD OF 'BPT ( SPLITBD1 )'  **])%

	CALLPUTBKT (	%(NO UPDATE)%	PCI ( FALSE),
			%(BKT)%		LPT ( TEMPPTR ) );

	%([ WAS THIS A 3-BKT SPLIT? ])%

	IF .RECDESC [ RDCOUNT ] GTR 1 
	THEN
		BEGIN
		CALLPUTBKT (	%(NO UPDATE)%	PCI ( FALSE ),
				%(BKT)%		BPT ( SPLITBD2 ) );

		%([ THIS 3-BUCKET SPLIT COULD HAVE BEEN CAUSED BY TWO
		   THINGS....A VERY BIG NEW RECORD OR A DUP WHICH COULDN'T
		   FIT IN THE ORIGINAL BUCKET SO A NEW ONE WAS ALLOCATED
		   JUST FOR THE DUP. IN THE LATTER CASE, WE DON'T WANT THE
		   DUP BUCKET TO BE ENTERED INTO THE INDEX, SO WE WILL FLAG
		   THAT ONLY A TWO-BUCKET SPLIT OCCURRED. ])%

		IF ( DUPLICATEFLAG ( RECDESC ) ISON )
		THEN	%(RESET SPLIT COUNT TO 1)%
			RECDESC [ RDCOUNT ] = 1
		END;	%(OF IF THIS WAS A 3-BKT SPLIT)%


	GOODRETURN
END; %(OF INSRTUDR)%

! CHKDUP
! ======

! ROUTINE TO CHECK FOR DUPLICATE RECORDS. THIS ROUTINE
!	WILL CHECK IF DUPLICATES ARE ALLOWED, AND IF SO,
!	WHETHER ANY DUPLICATE RECORDS EXIST IN THE FILE.
!

! INPUT:
!	RECDESC		RECORD DESCRIPTOR PACKET
!		RECPTR		ADDRESS OF CURRENT DATA RECORD
!		USERPTR		ADDRESS OF SEARCH KEY STRING
!		USERSIZE	SIZE OF SEARCH KEY STRING
!
!	BKTDESC		BKT DESCRIPTOR OF DATA BUCKET

! OUTPUT:
!	TRUE:	DUPLICATE NOT SEEN, OR DUPLICATES ALLOWED.
!		IF ENTRY WITH DUP KEY SEEN, RDFLGDUP SET.
!		IF ENTRY REPRESENTS EXISTING REC, RDFLGSAME ALSO SET.
!	FALSE:	A DUPLICATE WAS SEEN AND IS NOT ALLOWED.

! INPUT ARGUMENTS MODIFIED:
!
!	RECORD DESCRIPTOR
!		RECPTR		ADDRESS OF RECORD WHICH FOLLOWS
!				LAST RECORD IN THE DUPLICATE SERIES
! ROUTINES CALLED:
!	FNDREC
!
! NOTES:
!
!	1.	THERE IS A MINOR OPTIMIZATION WHICH COULD BE DONE TO
!		THIS ROUTINE*******************.
!		THIS OCCURS WHEN WE ARE SKIPPING SECONDARY DATA RECORDS.
!		BECAUSE SIDR'S ALWAYS EXPAND TO FILL THE BUCKET, UNLESS
!		THE END OF THE SIDR IS THE LAST WORD IN THE BUCKET, THEN
!		WE KNOW THAT THERE IS NOT A DUPLICATE OF THIS KEY.
!		IN SUCH A CASE, THIS ROUTINE WILL READ IN THE NEXT BUCKET
!		AND CHECK THE KEY OF THE NEXT SIDR, EVEN THOUGH WE KNOW
!		THAT IT CAN'T BE THE SAME KEY. THUS, THE FOLLOWING 
!		OPTIMIZATION:
!
!			WHEN WE GET READY TO SKIP A RECORD, CHECK TO SEE
!			IF ITS A SECONDARY KEY AND IF THE CURRENT RECORD
!			DOES NOT TOUCH THE END OF THE BUCKET. IF NOT,
!			THEN SET LASTRECPTR AND EXIT.

GLOBAL ROUTINE CHKDUP ( RECDESC, BKTDESC ) =
BEGIN
	ARGUMENT	(RECDESC,BASEADD);		! RECORD DESC	
	ARGUMENT	(BKTDESC,BASEADD);		! DATA BUCKET

LOCAL RRV;				!SET FROM RDRRV, CALLER'S RRV
LOCAL I;				!LOOP INDEX FOR SIDR ARRAY

MAP
    RECDESC:	POINTER,
    BKTDESC:	POINTER;
REGISTER
    TEMPAC;

REGISTER
    MOVINGPTR:	POINTER;			! PTR TO SCAN DATA RECORDS


	TRACE ('CHKDUP');
	CHECKEXACTCOUNT;

	RRV = .RECDESC[RDRRV];			!(SEE SIDR ARRAY LOOP)

	%([ DID WE FIND AN EXACT MATCH? ])%

	TEMPAC = .RECDESC [ RDSTATUS ];			! GET STATUS FLAGS
	IF ( CHKFLAG ( TEMPAC, (RDFLGLSS+RDFLGPST) ) ISON ) !Not a match? ![124]A442
!		AND					    !		  ![124]D442
!	  ( CHKFLAG ( TEMPAC, RDFLGDELETE ) IS OFF )	    !		  ![124]D442
	THEN %(WE DIDN'T EVEN SEE AN EXACT MATCH..SO EXIT)%
		GOODRETURN;

	%([ REMEMBER WE FOUND ANOTHER BKT ENTRY WITH SAME KEY ])%

	SETDUPLICATFLAG ( RECDESC );

	%([ WE MUST NOW POSITION OURSELVES TO THE END OF THE
	   LIST OF DUPS ])%

	UNTIL ( CHKFLAG ( RECDESC [ RDSTATUS ], (RDFLGLSS + RDFLGPST ) ) ISON )
	DO	%(THIS LOOP)%

		BEGIN

		%([ IF THE "DELETE" FLAG IS OFF AT THIS POINT, IT
		   MEANS THAT WE HAVE SEEN A TRUE DUPLICATE WHICH
		   WAS NOT DELETED. IN SUCH A CASE, WE MUST REMEMBER
		   THAT WE HAVE SEEN IT, AND CHECK TO SEE IF DUPLICATES
		   ARE ALLOWED. ])%

		IF chkflag (recdesc[rdflags], rdflgretex) IS OFF  ![124]
		THEN					      ![124]Not RMSUTL
		IF CHKFLAG ( RECDESC [ RDSTATUS ], RDFLGDELETE ) IS OFF
		THEN	%(ARE THEY ALLOWED?)%
			BEGIN

			RTRACE (%STRING('	A DUP WAS FOUND',%CHAR(13),%CHAR(10)));

			%([ REMEMBER WE FOUND A RECORD WITH SAME KEY ])%

			SETSAMEKEYFLAG ( RECDESC );

			%([ ARE THEY ALLOWED? ])%

			IF CHKFLAG ( KDB [ KDBFLAGS ], FLGDUP ) IS OFF
			THEN	%(NO DUPS ARE ALLOWED)%
				RETURNSTATUS ( ER$DUP )
			END;	%(OF IF NON-DELETED RECORD WAS FOUND)%

		! SCAN SIDR ARRAY TO SEE IF RDRRV ALREADY THERE

		MOVINGPTR = .RECDESC [ RDRECPTR ];	! GET PTR TO CURR ENTRY

		IF .KDB[KDBREF] NEQ 0
		THEN BEGIN
		INCR I FROM SIDRHDRSIZE+.KDB[KDBKSZW]
			TO .MOVINGPTR[SIDRRECSIZE]+SIDRHDRSIZE-1
		DO BEGIN
			IF .MOVINGPTR[.I,WRD] EQL .RRV	! CURR UDR ALR THERE?
![124]wrong field	THEN	IF CHKFLAG (RECDESC[RDSTATUS], RDFLGRETEX) ISON
			THEN	IF CHKFLAG (RECDESC[RDflags], RDFLGRETEX) ISON  ![124]right field
				THEN BEGIN		! RMSUTL CALL
				    RECDESC[RDSIDRELEMENT]=.I;
							! TELL WHERE AT
				    BADRETURN;		! INDIC THAT IT HAPPENED
				END
				ELSE BEGIN		! ALW OPEN FOR WRITE
				    MOVINGPTR[.I,WRD] = 0;
							!ZAP ENTRY THAT WASNT DELETED BECAUSE OF CRASH PROBABLY
				    SETUPD (BKTDESC);	! INSURE IT WRITTEN OUT
				END
							!END IF RRV MATCH
		END;					!END SIDR ARRAY LOOP
		END;					!END 2NDARY KEY

		%([ SKIP A DATA RECORD ])%

		RECDESC [ RDLASTRECPTR ] = .MOVINGPTR;	! STORE AS LAST PTR
		RECDESC [ RDRECPTR ] = .MOVINGPTR + SIZEOFDATARECRD (  MOVINGPTR );

		%([ WE HAVE NOW BUMPED TO THE NEXT DATA RECORD. WE
		   MUST COMPARE THE KEYS AND POSITION OURSELVES
		   CORRECTLY. ])%

		IF CALLFNDREC (%(RD)%		BPT ( RECDESC ),
				%(START)%	BPT ( BKTDESC ),
				%(END)%		BPT ( BKTDESC ) ) IS FALSE

		THEN
			RMSBUG ( MSGFAILURE )

	END; 	%(OF UNTIL LSSFLAG OR PASTLASTFLAG IS ON)%

	GOODRETURN

END; %(OF CHKDUP)%
END
ELUDOM