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

MODULE DELETE =


BEGIN

GLOBAL BIND	DELEV = 1^24 + 0^18 + 2;	!EDIT DATE: 6-NOV-76

%([

FUNCTION:	THIS MODULE CONTAINS ALL ROUTINES WHICH PROCESS
		THE $DELETE MACRO IN RMS-20.
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 BY DIGITAL EQUIPMENT CORPORATION



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




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

	$DELETE			DISPATCHER FOR $DELETE MACRO

	DELSQR			PROCESS $DELETE FOR SEQ/REL FILES

	DELIDX			PROCESS $DELETE FOR INDEXED FILES

	DODELIDX		PERFORM THE WORK FOR INDEXED FILES

	DELUDR			COMPRESS A PRIMARY DATA RECORD AND RRV






REVISION HISTORY:

EDIT	DATE		WHO			PURPOSE
====	====		===			========

1	6-NOV-76	SB		ADD RHDRDELETE BIT

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

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

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

 100	  2	Dev		Make declarations for CRASH, DUMP, NUMBERTORFA,
				GTBYTE, RSETUP, LOCKIT, DELSQR, DELIDX, 
				CHECKRP, DODELIDX, MSGBKT, PUTBKT, DELSIDR, 
				MOVEKEY, DELUDR, and FBYRFA be EXTERNAL 
				ROUTINE so RMS will compile under BLISS V4 
				(RMT, 10/22/86).


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




])%




	%([ EXTERNAL DECLARATIONS ])%

EXTERNAL ROUTINE
    DUMP,
    NUMBERTORFA,
    CRASH,
    GTBYTE,
    RSETUP,
    LOCKIT;

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

EXTERNAL
!   MSGUNLOCKED,		! RECORD UNLOCKED
    MSGFLAGS,		! BAD FLAGS
    MSGINPUT;		! BAD INPUT ARGUMENTS


FORWARD ROUTINE		CHECKRP: NOVALUE;



REQUIRE 'RMSREQ';
EXTDECLARATIONS;

! $DELETE
! =======

! PROCESSOR FOR $DELETE MACRO
!	THIS MACRO ALWAYS OPERATES ON THE RECORD DESIGNATED
!	BY THE "CURRENT-RECORD".THIS THE RECORD INDICATED
!	BY THE "DATARFA" FIELD IN THE
!	RST, AND RESIDING IN THE CURRENT BUCKET.
!
! FORMAT OF $DELETE MACRO:
!
!		$DELETE		<RAB-ADDRESS> [,<ERROR-ADDRESS>]
!

! RAB FIELDS WHICH ARE USED BY THE $DELETE PROCESSOR:
!
!	ISI		INTERNAL STREAM IDENTIFIER
!	ROP		RECORD OPTIONS
!		RB$FDL		FAST DELETE (INDEXED ONLY)

! RAB FIELDS WHICH ARE RETURNED BY $DELETE
!
!	STS		STATUS INFORMATION
!	STV		ADDITIONAL STATUS INFORMATION

! INPUT:
!	ADDRESS OF USER RECORD BLOCK
!	ADDRESS OF USER ERROR ROUTINE

! OUTPUT:
!	<STATUS FIELD>

! GLOBALS USED:
!	GTBYTE
!	LOCKIT


GLOBAL ROUTINE %NAME('$DELETE') ( BLOCK, ERRORRETURN ) =
BEGIN
	ARGUMENT (BLOCK,BASEADD);
	ARGUMENT (ERRORRETURN,BASEADD);

EXTERNAL ROUTINE
    DELSQR,		! DELETE FOR SEQ/REL FILES
    DELIDX,			! SAME FOR INDEXED FILES
    CHECKRP;		! DO SOME ERROR CHECKING

	RMSENTRY ( $DELETE );

	%([ FETCH THE USER'S RAB AND ERROR ADDRESS ])%

	RAB = .BLOCK;				! GET RAB ADDRESS
	ERRADR = .ERRORRETURN;			! AND USER ERROR ADDRESS
	CALLRSETUP (PCI (AXDEL));		! SET UP WORLD


	%([ MAKE SURE THE FILE IS POSITIONED AND IS A DISK FILE ])%

	CALLCHECKRP;

	%([ DISPATCH TO THE PROPER ROUTINE FOR EACH FILE ORGANIZATION ])%

	CASE FILEORG FROM 0 TO 3 OF
	SET

		[0]:	%(ASCII)%		USERERROR ( ER$IOP );	! BAD OPERATION
		[1]:	%(SEQ)%		CALLDELSQR;		! SEQUENTIAL FILES
		[2]:	%(REL)%		CALLDELSQR;		! RELATIVE FILES
		%IF INDX %THEN
		[3]:	%(IDX)%		CALLDELIDX		! INDEXED FILES
		%FI

	TES;	%(END OF CASE FILEORG)%

	%([ THE $DELETE WAS PERFORMED SUCCESFULLY. ALL LOCKING OR
	   UNLOCKING WAS PERFORMED IN THE APPROPRIATE ROUTINE. ])%

	SETSUCCESS;
	USEREXIT					! ***EXIT TO USER***

END;	%(OF $DELETE)%

! DELSQR
! ======

! ROUTINE TO PROCESS THE $DELETE MACRO FOR SEQUENTIAL AND RELATIVE FILES.
!	THIS ROUTINE MUST DO THE FOLLOWING:
!
!		1.	DETERMINE ADDRESS OF CURRENT RECORD
!		2.	POSITION FILE TO THAT BYTE ADDRESS
!		3.	SET THE DELETED BIT IN THE RECORD HEADER
!		4.	UNLOCK THE CURRENT RECORD

! INPUT:
!	<NONE>

! OUTPUT:
!	<NO STATUS RETURNED>

! ROUTINES CALLED:
!	GTBYTE
!	LOCKIT
!	NUMBERTORFA

! NOTES:
!
!	1.	IF THERE IS AN ERROR DURING PROCESSING OF THE
!		$DELETE, THIS ROUTINE WILL EXIT DIRECTLY TO THE
!		USER.

GLOBAL ROUTINE DELSQR: NOVALUE  =
BEGIN

LOCAL
    TEMP,			! TEMPORARY STORAGE
    FILEPOINTER:	POINTER,	! PTR TO CURRENT RECORD
    HEADER,			! HEADER OF CURRENT RECORD
    CRP,			! CURRENT RFA
    BYTENUM;		! BYTE NUMBER OF CURRENT RECORD


	TRACE ('DELSQR');

	%([ DETERMINE THE BYTE NUMBER AT WHICH THIS RECORD BEGINS ])%

	BYTENUM =  (CRP = .RST [ RSTDATARFA ] );		! ASSUME A SEQ FILE

	%([ FOR RELATIVE FILES, WE MUST CONVERT THE RECORD NUMBER (RFA)
	   INTO THE ACTUAL BYTE NUMBER OF THE TARGET RECORD ])%

	IF RELFILE THEN				! CONVERT CRP FOR REL FILES
		BEGIN
		IF (BYTENUM = CALLNUMBERTORFA (LCI (CRP) ))
			IS FALSE THEN USERERROR (ER$RFA)
		END;	%( OF IF RELFILE )%



	%([ POSITION FILE TO DESIRED RECORD.
	   IT COULD BE OUT OF POSITION IF THE
	   RECORD SPANNED A PAGE BOUNDARY ])%

	CALLGTBYTE (	%(BYTE)%	LCI (BYTENUM),
			%(FLAG)%	PCI (FALSE));

	%([ FETCH THE POINTER TO THE RECORD IN THE FILE BUFFER ])%

	FILEPOINTER = .RST [ RSTPAGPTR ];		! GET THE FILE PAGE POINTER
	HEADER = .FILEPOINTER [ WHOLEWORD ];		! AND THE RECORD HEADER
	LOOKAT ('	RECORD HEADER=', HEADER);	! **DEBUG**

	%([ SET THE "DELETED" BIT IN THE RECORD HEADER ])%


	%IF DBUG %THEN
	IF CHKFLAG ( HEADER, RHDRDELETE ) ISON THEN RMSBUG ( MSGFLAGS );
	%FI
	FILEPOINTER [ WHOLEWORD ]  = .HEADER OR ( RHDRDELETE);	! STORE THE HEADER BACK AGAIN

	SETBFDUPD ( CBD[ BKDBFDADR ] );		! INDICATE FILE PAGE NEEDS UPDATING

	%([ UNLOCK THE CURRENT RECORD AND EXIT. NOTE THAT THE
	   "UNLOCK" MACRO ALSO CLEARS THE "DATALOCKED" BIT ])%

	IF LOCKING THEN UNLOCK (CRP);			! UNLOCK THE RECORD
	RETURN					! RETURN TO $DELETE

END;	%( OF DELSQR)%

! CHECKRP
! =======

! THIS ROUTINE IS CALLED BY BOTH THE $DELETE AND $UPDATE PROCESSORS.
!	IT'S FUNCTION IS TO MAKE SURE THAT THE FILE IS POSITIONED
!	AND THE CURRENT RECORD IS LOCKED ( IF THE FILE IS BEING SHARED )

! INPUT:
!	<NONE>

! OUTPUT:
!	<NONE>


GLOBAL ROUTINE CHECKRP: NOVALUE  =
BEGIN


	%([ FILE MUST RESIDE ON A DASD ])%

	IF NOT DASD THEN USERERROR ( ER$DEV );

	%([ CHECK THAT THE LAST OPERATION WAS A $FIND OR A $GET ])%

	IF	( .RST [ RSTLASTOPER ] ISNT C$FIND )
			AND
		( .RST [ RSTLASTOPER ] ISNT C$GET )
			THEN USERERROR ( ER$CUR );

	RETURN

END; %( OF CHECKRP )%

! DELIDX
! ======

! ROUTINE TO PROCESS THE $DELETE MACRO FOR INDEXED FILES.
!	WHEN THIS ROUTINE IS CALLED, THERE MUST BE A
!	CURRENT BUCKET SET UP AND A POINTER TO THE CURRENT
!	RECORD IS IN THE PAGPTR FIELD IN THE RST.
!	THE FUNCTION OF THIS ROUTINE IS TO DELETE ALL SIDR ENTRIES
!	FOR THIS RECORD, THEN MARK THE PRIMARY RECORD AS BEING
!	DELETED.
!
!	NOTE THAT IF THE PRIMARY KEY ALLOWS DUPLICATES, THEN THE
!	PRIMARY DATA RECORD WILL NEVER BE COMRESSED OUT OF THE
!	BUCKET. THIS IS BECAUSE IF A USER WAS POSITIONED IN THE
!	MIDDLE OF A SERIES OF DUPLICATES AND HIS "CURRENT RECORD"
!	WAS DELETED, HE WOULD HAVE NO WAY OF GETTING BACK TO HIS
!	CORRECT POSITION IN THE FILE.

! INPUT:
!	<NONE>

! OUTPUT:
!	<NO STATUS RETURNED>

! ROUTINES CALLED:
!	DODELIDX
!	PUTBKT

! NOTES:
!
!	1.	ON AN ERROR, THIS ROUTINE EXITS DIRECTLY TO THE USER.
!
!	2.	IF LOCKING IS ENABLED, THEN WE MUST LOCK THE FILE INDEX
!		ONLY IF WE NEED TO DELETE SOME SIDR POINTERS. IF NO
!		SECONDARY INDICES HAVE TO BE ACCESSED, THEN WE DON'T NEED
!		TO LOCK ANYTHING, SINCE THE CURRENT BUCKET IS ALREADY
!		LOCKED.

GLOBAL ROUTINE DELIDX: NOVALUE =
BEGIN

LOCAL
    DATABD:	FORMATS[ BDSIZE ],	! BKT DESCRIPTOR FOR CURRENT BUCKET
    RECDESC:	FORMATS[ RDSIZE ],	! RECORD DESCRIPTOR PACKET
    SAVEDSTATUS,			! SAVE THE RESULTS HERE
    UPDATEFLAG;			! FLAG FOR UPDATING BUCKET

EXTERNAL ROUTINE
    DODELIDX,			! DO THE DIRTY WORK
    MSGBKT,			! CURRENT BUCKET IS NULL
    PUTBKT;				! RELEASE THE BUCKET




	TRACE ('DELIDX');

	%([ FETCH THE CURRENT BUCKET AND MAKE SURE THERE IS ONE ])%

	FETCHCURRENTBKT ( DATABD );
	IF NULLBD ( DATABD ) THEN RMSBUG ( MSGBKT );
	SETNULLBD ( CBD );			! SET IT TO BE NULL

	%([ PERFORM THE DELETE OPERATION ])%

	%([ SET THE "HORIZONAL-SEARCH" FLAG SO WE WILL GO THRU
	   THE SECONDARY INDEX PROPERLY ])%

	RECDESC [ RDFLAGS ] = RDFLGHORIZOK;	! HORIZONTAL SEARCH IS OK
	RECDESC [ RDSTATUS ] = ZERO;		! CLEAR STATUS
	RECDESC [ RDRECPTR ] = .RST [ RSTPAGPTR ];
	KDB = .FST [ FSTKDB ];			! USE PRIMARY KEY
	SAVEDSTATUS =	CALLDODELIDX(	%(RD)%	LCT ( RECDESC ),
					%(BKT)%	LCT ( DATABD ));

	%([ WHAT HAPPENED? ])%


	%([ SHOULD WE UPDATE THE BUCKET TO THE DISK?
		IF SS=TRUE, THEN EVENTUALLY AT LEAST ])%

	IF .SAVEDSTATUS ISNT FALSE THEN SETBFDUPD(CBD[BKDBFDADR]);

	IF WRITEBEHIND OR ( .SAVEDSTATUS IS FALSE )	!DO OUTPUT NOW?
	THEN BEGIN
		UPDATEFLAG = FALSE			!NO
	END
	ELSE 	UPDATEFLAG = TRUE;			!YES, WRITE IT OUT

	%([ RELEASE THE CURRENT BUCKET ])%

	CALLPUTBKT (	%(UPDATE)%	LCI ( UPDATEFLAG ),
			%(BKT)%		LCT ( DATABD ) );

	%([ WE NOW MUST UNLOCK THE FILE IF IT WAS LOCKED ])%

	IF INDEXLOCKED
	THEN
		UNLOCKINDEX;

	IF .SAVEDSTATUS IS FALSE THEN USEREXIT;		! EXIT ON ERROR

	RETURN

END;	%(OF DELIDX)%

! DODELIDX
! ========

! ROUTINE TO PERFORM THE ACTUAL DELETION OF THE CURRENT RECORD
!	IN AN INDEXED FILE. THIS ROUTINE IS CALLED ONLY BY "DELIDX"

! INPUT:
!	RECDESC		RECORD DESCRIPTOR PACKET
!		RECPTR		ADDRESS OF CURRENT RECORD
!		FLAGS		FLGHORIZOK
!		STATUS		<NULL>
!
!	DATABD		BUCKET DESCRIPTOR OF CURRENT BUCKET
!

! OUTPUT:
!	TRUE:	DELETION WAS SUCCESSFUL
!	FALSE:	ERROR
!		COULD NOT DELETE A SIDR

! ROUTINES CALLED:
!	DELSIDR
!	DELUDR

! NOTES:
!
!	1.	THIS ROUTINE WILL NEVER RELEASE THE CURRENT BUCKET.
!
!	2.	IF ANY UNEXPECTED ERROR OCCURS (E.G., RRV WAS
!		NOT FOUND), THEN AN UNDEFINED FILE CONDITION IS
!		SET AND PROCESSING CONTINUES.
!
!	3.	ON INPUT THE KDB MUST BE SET UP FOR PRIMARY KEY.
!
!	4.	NO COMPRESSION IS DONE DURING A $DELETE. ALL COMPRESSION
!		IS DONE ON A $PUT.

GLOBAL ROUTINE DODELIDX( RECDESC, DATABD ) =
BEGIN
	ARGUMENT	(RECDESC,BASEADD);	! RECORD DESC PACKET
	ARGUMENT	(DATABD,BASEADD);	! BUCKET DESC
MAP
    RECDESC:	POINTER,
    DATABD:	POINTER;

LOCAL
    NOCOMPRESSFLAG,			! FLAG FOR COMPRESSION OF UDR
    SIZEOFCURENTRCD,			! GUESS
    PTRTODATA:	POINTER,			! PTR TO DATA PORTION OF UDR
    RFATOSEARCHFOR;				! RFA OF CURRENT RECORD

REGISTER
    RECORDPTR:	POINTER;			! PTR TO CURRENT RECORD

EXTERNAL ROUTINE
    DELSIDR,			! DELETE A SIDR
    MOVEKEY,				! MOVE A KEY STRING
    DELUDR;					! DELETE A UDR

EXTERNAL
    TBUFFER;				! BUFFER FOR KEY
   
	TRACE ('DODELIDX');

	%([ SET UP A PTR TO THE CURRENT RECORD AND ITS DATA ])%

	RECORDPTR = .RECDESC [ RDRECPTR ];
	PTRTODATA = .RECORDPTR + .KDB [ KDBHSZ ];

	%([ MAKE A CHECK TO MAKE SURE THE DELETED BIT IS OFF ])%

	IF ( CHKFLAG ( RECORDPTR [ DRFLAGS ], FLGDELETE ) ISON ) THEN RMSBUG ( MSGFLAGS );

	%([ INITIALIZE SOME FLAGS ])%

	NOCOMPRESSFLAG = FALSE;				! ASSUME NO ERRORS
	SIZEOFCURENTRCD = .RST [ RSTRSZ ];		! SET UP SIZE OF RECORD

	%([ PERFORM THIS LOOP ONCE FOR EACH SECONDARY KEY. WE
	   WILL TRY TO DELETE THE SIDR ENTRY FOR EACH KEY ])%

	RECDESC [ RDRRV ] = .RECORDPTR [ DRRRVADDRESS ];


	KDB = .KDB [ KDBNXT ];				! FIRST SECONDARY

	UNTIL .KDB IS ZERO
	DO	%(THIS LOOP)%

		BEGIN

		%([ RECORD MUST CONTAIN KEY STRING ])%

		IF .SIZEOFCURENTRCD GEQ .KDB [ KDBMINRSZ ]
		THEN
			BEGIN

			LOOKAT ('	DELETING KEY: ', KDB [ KDBREF ]);

			%([ LOCK THE FILE IF IT IS NOT ALREADY LOCKED ])%

			IF LOCKING
				AND
				NOT INDEXLOCKED
				THEN
					BEGIN
					IF LOCKINDEX ( ENQBLK, ENQEXC ) IS FALSE
					THEN
						RETURNSTATUS ( ER$EDQ )
					END; %(OF IF FILE ISNT LOCKED)%

			%([ MOVE THE KEY STRING ])%

			CALLMOVEKEY ( %(FROM RECORD)%	LPT ( PTRTODATA ),
					%(TO BUFFER)%	GCT ( TBUFFER ) );
			%([ SET UP THE ADDRESS OF THIS KEY STRING ])%

			RECDESC [ RDUSERPTR ] = TBUFFER;
			RECDESC [ RDUSERSIZE ] = .KDB [ KDBKSZ ];
			IF CALLDELSIDR (BPT ( RECDESC )) IS FALSE

			%([ IF THERE WAS AN ERROR, WE WILL SET THE
			   "NO-COMPRESS" FLAG BECAUSE WE DONT
			   KNOW WHAT WENT WRONG. ])%

			THEN
				NOCOMPRESSFLAG = TRUE

			END;	%(OF IF SIZEOFCURENTRCD GEQ MINRSZ)%

		%([ WE HAVE FINISHED PROCESSING THE CURRENT KEY...MOVE
		   TO NEXT ONE. ])%

		KDB = .KDB [ KDBNXT ]
		END;	%(OF UNTIL .KDB IS ZERO)%

	%([ WE HAVE NOW DELETED THE SIDR'S FOR THIS RECORD. WE
	   MUST DETERMINE WHAT WE ARE GOING TO ABOUT THE PRIMARY
	   DATA RECORD. IF THERE WAS ANY KIND OF ERROR DURING OUR
	   PROCESSING, OR IF DUPLICATES ARE ALLOWED ON THE PRIMARY
	   KEY, THEN WE SHOULD SET THE "NO-COMPRESS" FLAG IN THE
	   PRIMARY DATA RECORD SO THE RECORD WILL NEVER GO AWAY.
	])%

	%([ SET UP FOR PRIMARY KEY ])%

	KDB = .FST [ FSTKDB ];

	%([ SET THE DELETED BIT IN THE DATA RECORD ])%

	SETUPD (DATABD);			!INDIC THIS BKT BEING UPD

	SETFLAG ( RECORDPTR [ DRFLAGS ], FLGDELETE );

	%([ FOR DUPS IN THE PRIMARY INDEX, OR ON AN ERROR, DON'T
	   ALLOW COMPRESSION. ])%

	IF	( DUPLICATES )
			OR
		( .NOCOMPRESSFLAG ISNT FALSE )
	THEN	%(THIS RECORD CANNOT GO AWAY)%

		SETFLAG ( RECORDPTR [ DRFLAGS ], FLGNOCOMPRESS);

		%([ *** NOTE THAT AT THIS POINT, WE MUST NOT COMPLETELY
		   REMOVE THIS RECORD FROM THE FILE IF DUPS ARE
		   ALLOWED IN THE PRIMARY INDEX. HOWEVER, FOR VARIABLE-
		   LENGTH RECORDS, WE CAN SQUEEZE THE PRIMARY RECORD
		   SO THAT IT IS ONLY AS BIG AS THE PRIMARY KEY. THIS
		   MAY NOT SAVE US ANYTHING (IF THE KEY IS IN THE END
		   OF THE RECORD) OR IT MAY BE A BIG WINNER. ])%

	%([ SHOULD WE RETURN SUCCESS OR FAILURE? ])%

	IF .NOCOMPRESSFLAG ISNT FALSE
	THEN
		BADRETURN;

	GOODRETURN					! RETURN WITHOUT COMPRESSION


END;	%(OF DODELIDX)%

! DELUDR
! ======

! ROUTINE TO SQUEEZE A PRIMARY DATA RECORD AND POSSIBLY ITS
!	RRV OUT OF THE CURRENT BUCKET. THIS ROUTINE IS CALLED
!	IF UPDATE OF A SIDR MUST BE ABORTED (EG. IMPROP DUP KEY).
!	THIS ROUTINE SQUEEZES THE UDR OUT OF THE BUCKET AND TRIES TO DO THE
!	SAME FOR THE RRV (IF ANY). THERE SHOULD NOT BE ANY
!	ERRORS DURING THIS ROUTINE.
!
!	A NOTE ON THE ALGORITHM AND WHY IT WAS CHOSEN MIGHT
!	BE USEFUL AT THIS POINT. SINCE WE KNOW THE RRV'S ARE
!	ALWAYS AT THE BOTTOM OF THE BUCKET, SQUEEZING THEM AWAY
!	IS NOT A VERY PAINFUL OPERATION. HOWEVER, IT WOULD BE
!	NICE IF WE COULD AVOID THE I/O WHICH IS REQUIRED TO WRITE
!	OUT THE RRV BUCKET. OUR ONLY ALTERNATIVE IS TO SET THE
!	RRV TO BE DELETED AND LEAVE IT ALONE. HOWEVER, IT WOULD
!	THEN STILL BE POSSIBLE TO HAVE AN RRV POINTING TO A 
!	NON-EXISTENT DATA RECORD...THUS, WE MUST ALWAYS WRITE OUT
!	THE RRV BUCKET. AND SINCE THERE ARE NO INDICES WHICH POINT
!	TO THIS RRV, LEAVING IT IN THE BUCKET IS NEEDLESS WASTE
!	OF SPACE. THEREFORE, WE WILL COMPRESS IT OUT OF THE
!	BUCKET NOW.

! INPUT:
!	RECDESC		RECORD DESCRIPTOR PACKET
!		RECPTR		ADDRESS OF CURRENT RECORD
!		LENGTH		SIZE (IN WORDS) OF CURRENT RECORD (INCC. HEADER)
!
!	DATABD		BUCKET DESCRIPTOR OF CURRENT RECORD
!

! OUTPUT:
!	TRUE:	RECORD SQUEEZED OUT OF BUCKET
!	FALSE:	ERROR
!		COULD NOT FIND RRV (FILE CONSISTENCY PROBLEM)

! ROUTINES CALLED:
!	FBYRFA
!
! NOTES:
!
!	1.	THE KDB MUST BE SET UP FOR THE PRIMARY KEY.
!
!

GLOBAL ROUTINE DELUDR ( RECDESC, DATABD ) =
BEGIN
	ARGUMENT	(RECDESC,BASEADD);
	ARGUMENT	(DATABD,BASEADD);
MAP
    RECDESC:	POINTER,
    DATABD:	POINTER;

REGISTER
    RECORDPTR:	POINTER,		! PTR TO CURRENT RECORD
    TEMPAC;				! TEMP AC USED FOR BLT

EXTERNAL ROUTINE
    PUTBKT,
    FBYRFA;
LOCAL
    BUCKETPTR:	POINTER,		! PTR TO TOP OF BUCKET
    ENDPTR:	POINTER,			! PTR TO END OF BUCKET
    RRVBD:	FORMATS[ BDSIZE ],	! BUCKET DESC FOR RRV BUCKET
    AMOUNTTOMOVE,			! SIZE OF CHUNK TO MOVE
    ENDOFRECORDPTR:	POINTER,		! END OF CURRENT RECORD
    SIZEOFCURENTRCD,		! GUESS
    RRVADDRESS;			! RRV TO FIND


	TRACE ('DELUDR');

	%([ MAKE SURE THIS IS A PRIMARY KEY SET-UP ])%

	IF NOT PRIMARYKEY THEN RMSBUG ( MSGINPUT );
	%([ GET THE ADDRESS OF THE CURRENT RECORD AND SET UP
	   SOME POINTERS TO THE BUCKET ])%

	RECORDPTR = .RECDESC [ RDRECPTR ];
	BUCKETPTR = .DATABD [ BKDBKTADR ];		! TOP OF BUCKET
	ENDPTR = .BUCKETPTR + .BUCKETPTR [ BHNEXTBYTE ];

	%([ GET ADDRESS OF RRV ])%

	RRVADDRESS = .RECORDPTR [ DRRRVADDRESS ];

	%([ DO WE NEED TO SQUEEZE OUT THE RRV TOO? ])%

%IF 0 %THEN

!	THIS CODE DOES NOT WORK, BUT IS RATHER UNIMPORTANT
!	BECAUSE ITS EXERCISED ONLY WHEN A SEC KEY INSERT ABORTS
!	AND THE NEW RECORD CAUSED A BKT SPLIT. CONSEQ I'M JUST NO-OPING IT

	IF BUCKETOFRFA ( .RRVADDRESS ) IS FILEPAGE ( DATABD )
	THEN	%(THERE IS AN RRV RECORD)%
		BEGIN

		%([ WE MAY HAVE TO LOCK THE FILE HERE ])%

		IF LOCKING
			AND
			NOT INDEXLOCKED
			THEN
				BEGIN
				IF LOCKINDEX ( ENQBLK, ENQSHR ) IS FALSE
				THEN
					RETURNSTATUS ( ER$EDQ )
				END; %(OF IF FILE ISNT LOCKED)%

	 	%([ WE MUST SQUEEZE OUT THE RRV TOO ])%

	 	RTRACE (%STRING('	SQUEEZING THE RRV...',%CHAR(13),%CHAR(10)));
	 	RECDESC [ RDRFA ] = .RRVADDRESS;
	 	RECDESC [ RDRECPTR ] = ZERO;			! MAKE SURE WE START AT TOP

		IF  CALLFBYRFA (%(RD)%	BPT ( RECDESC ),
	 			%(BKT)%	LCT ( RRVBD ),
				%(NOLOCK)% PCI ( FALSE ) ) IS FALSE

		THEN
	 		BEGIN
	 		RTRACE (%STRING('***COULDN''T GET RRV...',%CHAR(13),%CHAR(10)));
	 		FILEPROBLEM ( ER$RRV );
	 		BADRETURN
	 		END;	%(OF IF WE COULN'T FIND THE RRV)%

	 	%([ GET THE ADDRESS OF THE RRV AND ITS BUCKET ])%

	 	RECORDPTR = .RECDESC [ RDRECPTR ];
	 	BUCKETPTR = .RRVBD [ BKDBKTADR ];
	 	AMOUNTTOMOVE = .BUCKETPTR + .BUCKETPTR [ BHNEXTBYTE ] - .RECORDPTR - RRVRECSIZE;

	 	LOOKAT ('	RRV BKT-PTR: ', BUCKETPTR );
	 	LOOKAT ('	AMOUNT-TO-MOVE: ', AMOUNTTOMOVE );

	 	%([ IS THE RRV AT THE BOTTOM OF THE BUCKET? ])%

		IF .AMOUNTTOMOVE ISNT ZERO
		THEN
			MOVEWORDS ( 	%(FROM)%	.RECORDPTR + RRVRECSIZE,
					%(TO)%		.RECORDPTR,
					%(SIZE)%	.AMOUNTTOMOVE );

		%([ UPDATE THE BUCKET HEADER INFO ])%

		DEC ( BUCKETPTR [ BHNEXTBYTE ], RRVRECSIZE );

		%([ RELEASE THE RRV BUCKET AND UPDATE IT ])%

		CALLPUTBKT (	%(NO UPDATE)%	PCI ( TRUE ),
				%(BUCKET)%	LCT ( RRVBD ) )
		END; %(OF IF THERE WAS AN RRV)%

%FI	!NO-OP OF RRV EXPUNGE

	%([ NOW, SQUEEZE OUT THE PRIMARY DATA RECORD ])%

	SIZEOFCURENTRCD = .RECDESC [ RDLENGTH ];
	ENDOFRECORDPTR = .RECORDPTR + .SIZEOFCURENTRCD;
	AMOUNTTOMOVE = .ENDPTR - .ENDOFRECORDPTR;
	LOOKAT ('	SQUEEZING REC AT: ', RECORDPTR );
	LOOKAT ('	AMOUNT-TO-MOVE: ', AMOUNTTOMOVE );
	LOOKAT ('	END-OF-BKT: ', ENDPTR );

	IF .AMOUNTTOMOVE ISNT ZERO
	THEN
		MOVEWORDS (	%(FROM)%	.ENDOFRECORDPTR,
				%(TO)%		.RECORDPTR,
				%(SIZE)%	.AMOUNTTOMOVE );

	%([ ADJUST THE BUCKET HEADER INFO ])%

	DEC ( BUCKETPTR [ BHNEXTBYTE ], .SIZEOFCURENTRCD );
	GOODRETURN

END;	%(OF DELUDR)%
END
ELUDOM