Google
 

Trailing-Edge - PDP-10 Archives - bb-h138f-bm - 7-sources/rmsupd.b36
There are 11 other files named rmsupd.b36 in the archive. Click here to see a list.
%TITLE 'U P D A T E  -- $UPDATE processor'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE update (IDENT = '2.0'
		) =
BEGIN

GLOBAL BIND
    updtv = 3^24 + 0^18 + 616;			! Edit date: 30-Apr-86

!++
!	FUNCTION:	THIS MODULE CONTAINS ROUTINES WHICH PROCESS
!			THE $UPDATE MACRO IN RMS-20.
!
!
!	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.
!
!
!
!	AUTHOR:	S. BLOUNT/RL
!
!
!	**********	TABLE OF CONTENTS	**************
!
!
!
!
!		ROUTINE			FUNCTION
!		=======			========
!
!		$UPDATE		PROCESSOR FOR $UPDATE MACRO
!
!		UPDSQR		$UPDATE FOR SEQUENTIAL/RELATIVE FILES
!
!		UPD		$UPDATE FOR INDEXED FILES
!
!		DOUPD		PERFORM THE ACTUAL UPDATE FOR INDEXED FIES
!
!		UPDUDR		RE-WRITE THE DATA IN THE CURRENT
!				RECORD FOR INDEXED FILES
!
!-
%SBTTL 'REVISION HISTORY'
!+
!	REVISION HISTORY:
!
!	EDIT	WHO	DATE		PURPOSE
!	====	===	====		=======
!
!	1	JK	21-JUL-76	REQUIRE LIMITS.REQ
!	2	SB	29-NOV-76	ADD UPDATE FOR INDEXED FILES
!	3	SB	23-DEC-76	CHANGE ER$RSD TO ER$RSZ
!	4	SB	8-MAR-77	MAKE FAILURE FOR DELSIDR BE OK
!	5	SB	14-MAR-77	SET UP RRV FOR PUTSIDR FOR
!					LENGTH CHANGES
!
!	*************************************************
!	*						*
!	*		NEW REVISION HISTORY		*
!	*						*
!	*************************************************
!
!	****** Release of RMS 1.0 *****
!
!	PRODUCT	MODULE	 SPR
!	 EDIT	 EDIT	 QAR		DESCRIPTION
!	======	======	=====		===========
!	57	6	20-17231	Free bucket after FOLLOWPATH call
!					in DOUPDIDX. (RLUSK, 26-Jan-82)
!
!	**  Begin RMS v2 Development **
!
!	400	400	xxxxx		Clean up BLISS code (RL, 22-Apr-83)
!
!	407	-	xxxxx		Pass CKEYUU a 30-bit address for the
!					search key when in nonzero sections.
!					(RL, 24-May-83)
!
!	416		xxxxx		Pass MOVEREC a 30-bit address from
!					UPDSQR (RL, 7-Jul-83)
!
!	421		xxxxx		Allow changing record size when
!					updating a variable-length record
!					in a relative file, so long as the
!					new length is not greater than the
!					maximum record size. (RL, 20-Jul-83)
!
!	422		xxxxx		"Illegal read" occurs in a non-zero
!					section when MOVEBKTDESC is called
!					with a fetched value.  Do a BIND first
!					to the fetched value and then call
!					the macro. (RL, 25-Jul-83)
!
!       502                             Remote $Update
!
!       561                             Fix Random Remote $Update
!
!	616				Fix bad KSZ error on remote $UPDATE
!
!		***** END OF REVISION HISTORY *****
!-

REQUIRE 'rmsreq';

EXTERNAL ROUTINE
    Dap$Update;
%SBTTL '$UPDATE -- processor for $UPDATE macro'

GLOBAL ROUTINE $update (rabblock, errorreturn) : NOVALUE =
! $UPDATE
! =======
!
! PROCESSOR FOR $UPDATE MACRO
! 	THE $UPDATE MACRO ALWAYS OPERATES ON THE CURRENT RECORD.
!
! FORMAT OF $UPDATE MACRO:
!
!		$UPDATE		<RAB-ADDRESS> [,<ERROR-ADDRESS>]
!
! RAB FIELDS USED AS INPUT TO $UPDATE:
!
!	ISI		INTERNAL STREAM IDENTIFIER
!	RBF		ADDRESS OF USER RECORD BUFFER
!	ROP		RECORD OPTIONS
!		    <NO OPTIONS CURRENTLY USED>
!	RSZ		SIZE OF UPDATED RECORD
!
! RAB FIELDS RETURNED TO USER BY $UPDATE:
!
!	STS		STATUS OF CURRENT OPERATION
!	STV		ADDITIONAL STATUS INFORMATION
!
! INPUT:
!	BLOCK		ADDRESS OF USER RECORD BLOCK
!	ERRORRETURN	ADDRESS OF USER ERROR ROUTINE
!
! OUTPUT:
!	<NO STATUS VALUE RETURNED>
!
! ROUTINES CALLED:
!	RSETUP
!	CHECKRP
!	UPDSQR
!	UPDIDX
!
    BEGIN

    LOCAL 					!			!A421
	record_length_has_changed;		! For relative files	!A421

    rmsentry ($update);
    !
    !   FETCH THE USER'S RAB AND HIS ERROR ROUTINE ADDRESS
    !
    rab = .rabblock;				! FETCH RAB ADR
    erradr = .errorreturn;			! AND USER ERROR ADDRESS
    record_length_has_changed = 0;		! Assume same reclen	!A421
    !
    !   CHECK FOR STANDARD ERRORS AND $UPDATE ACCESS TO FILE
    !
    rsetup (axupd);				! SET UP THE WORLD
    !
    !   INSURE THAT FILE IS POSITIONED AND LOCKED
    !
    checkrp ();
    !
    !   CHECK THAT THE USER'S BUFFER IS VALID, AND THAT
    !   HE IS NOT TRYING TO CHANGE THE SIZE OF THE RECORD,
    !	UNLESS IT IS A VARIABLE-LENGTH RELATIVE RECORD.			!A421
    !

    IF .rab [rabrbf, 0] LEQ minuserbuff		! CHECK USER BUFFER
    THEN
	usererror (er$rbf);

    IF .fst[fst$v_remote]			! 616
    THEN
        rst [rstrsz] = .rab[rabrsz, 0] ;

    IF .rab [rabrsz, 0] NEQ .rst [rstrsz]	! CHECK RECORD SIZES
    THEN

	IF relfile AND 				! Relative files	!A421
	    variablerlength AND 		! Variable format	!A421
	    .rab [rabrsz, 0] LEQ .fst [fstmrs]	! Record less than max	!A421
	THEN 					!			!A421
	    record_length_has_changed = 1	! Set a flag		!A421
	ELSE 					!			!A421
	    usererror (er$rsz);			! Bad record size	!M421

    IF .fst[fst$v_remote]						  !a501
    THEN                                                                  !a501
        Dap$Update (.rab, .erradr)					  !a501
    ELSE                                                                  !a501
    !+
    !    FILE IS LOCAL.
    !   DISPATCH TO THE CORRECT ROUTINE FOR THIS ORGANIZATION
    !-

    CASE fileorg FROM orgasc TO orgidx OF 	!			!M421
	SET

	[orgasc] : 				! ILLEGAL FOR ASCII FILES
	    usererror (er$iop);

	[orgseq] : 				! SEQUENTIAL		!M421
	    updsqr (0);				! 0 = No reclen change	!M421

	[orgrel] : 				! RELATIVE		!M421
	    updsqr (.record_length_has_changed);	! Check reclen	!M421

	[orgidx] : 				! INDEXED		!M421
	    updidx ();
	TES;					! END OF CASE FILEORG

    !
    !   RETURN HERE ONLY IF EVERYTHING WAS OK
    !
    setsuccess;
    usrret ()
    END;					! End $UPDATE
%SBTTL 'UPDSQR -- sequential/relative $UPDATE'

GLOBAL ROUTINE updsqr (record_length_has_changed) : NOVALUE =
! UPDSQR
! ======
! ROUTINE TO PROCESS THE $UPDATE MACRO FOR SEQUENTIAL AND
!	RELATIVE FILES. THIS ROUTINE MUST DO THE FOLLOWING:
!
!		1) DETERMINE THE BYTE ADDRESS OF THE CURRENT RECORD
!		2) MAKE SURE THE CORRECT PAGE IS MAPPED IN THE BUFFER
!		3) CHANGE THE DATA IN THE RECORD
!
! INPUT:
!	RECORD_LENGTH_HAS_CHANGED : this is set to 1 if the length of
!		a variable-length record in a relative file has been
!		changed, 0 otherwise.
!
! OUTPUT:
!	<NO STATUS RETURNED>
!
! RST FIELDS WHICH ARE USED:
!
!	CBKD		CURRENT BUCKET DESCRIPTOR
!	PAGPTR		ABSOLUTE POINTER TO CURRENT RECORD
!	RSZ		SIZE IN BYTES OF CURRENT RECORD
!	RSZW		SIZE IN WORDS OF CURRENT RECORD
!
! NOTES:
!
!	1.	IF THERE IS ANY ERROR DURING THIS ROUTINE, IT
!		WILL EXIT DIRECTLY TO THE USER; IT WILL NOT
!		RETURN TO THE $UPDATE DISPATCHER.
!
!	2.	CURRENTLY, THIS ROUTINE ASSUMES THAT THE RECORD
!		LENGTH CANNOT BE CHANGED ON EITHER FILE ORGANIZATION.
!		IF THIS RESTRICTION IS LIFTED FOR RELATIVE FILES,
!		THEN THE CHECK MUST BE MADE ONLY FOR SEQUENTIAL FILES.
    BEGIN

    LOCAL
	temp,					! TEMPORARY LOCAL VARIABLE
	crp,					! CURRENT RECORD POINTER VALUE
	filepointer,				! POINTER TO CURRENT RECORD IN FILE BUFFER
	userpointer,				! POINTER TO USER'S DATA
	bytecount,				! SIZE OF THE RECORD IN BYTES
	bytesize,				! BYTE SIZE OF THE FILE
	bytenum;				! BYTE NUMBER OF THE START OF THE TARGET RECORD

    TRACE ('UPDSQR');
    !
    !   DETERMINE BYTE-ADDRESS OF START OF RECORD
    !
    bytenum = (crp = .rst [rstdatarfa]);	! ASSUME SEQ FILE
    !
    !   FOR RELATIVE FILES, WE MUST CONVERT THE RFA (RECORD #)
    !   INTO THE ACTUAL ADDRESS OF THE TARGET RECORD.
    !

    IF relfile
    THEN
	BEGIN					!  TO CONVERT CRP TO
						!  A RECORD ADDRESS
	bytenum = numbertorfa (.crp);

	IF .bytenum EQL false THEN usererror (er$rfa)

	END;					!  OF IF RELFILE

    !
    !   "BYTENUM" NOW CONTAINS THE ADDRESS
    !   OF THE TARGET RECORD.  WE MUST MAP
    !   THE RECORD AND RE-WRITE THE DATA PORTION OF IT
    !
    bytenum = .bytenum + headersize;		! IGNORE HEADER

%IF dbug
%THEN
    lookat ('	BYTE # TO UPDATE: ', bytenum);	! **DEBUG**
%FI

    !
    !   MAP THE RECORD (IT MAY HAVE SPANNED PAGES )
    !
    gtbyte (.bytenum, 				! BYTE NUMBER
	false);					! DON'T CHECK

    !+									!A421
    !	Update sizes if the record length has changed.			!A421
    !-									!A421

    IF .record_length_has_changed		! New length?		!A421
    THEN 					!			!A421
	BEGIN					!			!A421
	rst [rstrsz] = .rab [rabrsz, 0];	! Set up new sizes	!A421
	rst [rstrszw] = sizeinwords (.rst [rstrsz], .fst [fstbsz]);	!A421
	END;					!			!A421

    !
    !   REWRITE THE RECORD'S DATA
    !
    bytecount = .rst [rstrsz];			! FETCH THE SIZE IN BYTES
    bytesize = .fst [fstbsz];			! AND THE BYTE SIZE
    filepointer = .rst [rstpagptr];		! WHERE RECORD IS TO GO
    userpointer = .rab [rabrbf, 0];		! WHERE RECORD IS TO COME FROM

    IF .userpointer<lh> EQL 0			! Section number?	!A416
    THEN 					!			!A416
	userpointer = .userpointer OR .blksec;	! Default section	!A416

    !
    !   WE ARE NOW READY TO MOVE THE UPDATED RECORD INTO THE FILE.
    !   IF THE RECORD DOESN'T SPAN A FILE PAGE, WE CAN BLT IT
    !   DIRECTLY. IF NOT, WE MUST CALL MOVEREC TO DO ALL PAGE
    !   TURNING AND ASSORTED MACHINATIONS.
    !

    IF (.filepointer AND ofsetmask) + .rst [rstrszw] LSS pagesize
    THEN 					! WE CAN MOVE THE RECORD DIRECTLY
	BEGIN
	setbfdupd (cbd [bkdbfdadr]);		!INDIC FILE PAGE UPD

	IF .rmssec NEQ 0			!			!A407
	THEN 					!			!A407
	    xcopy (.userpointer, 		! From			!A407
		.filepointer, 			! To			!A407
		.rst [rstrszw])			! Size			!A407
	ELSE 					!			!A407
	    movewords (.userpointer, 		! From			!M407
		.filepointer, 			! To			!M407
		.rst [rstrszw]);		! Size			!M407

	END
    ELSE
	moverec (.filepointer, 			! TO
	    .userpointer, 			! FROM
	    true, 				! FLAG
	    .bytecount, 			! COUNT
	    .bytesize);				! SIZE

    !+									!A421
    !	Update the record length if necessary.				!A421
    !-									!A421

    IF .record_length_has_changed		! Is it needed?		!A421
    THEN
	BEGIN					!			!A421

	LOCAL 					!			!A421
	    record_header : REF BLOCK;		! Pointer to record	!A421

	record_header = .rst [rstpagptr] - 1;	! Point at header	!A421
	record_header [rhdrsize] = .rst [rstrsz];	! Update length	!A421
	END;					!			!A421

    !
    !   UNLOCK THE RECORD IF IT WAS LOCKED
    !

    IF datalocked THEN unlock (crp);		! UNLOCK THE RECORD

    RETURN
    END;					! End UPDSQR
%SBTTL 'UPDIDX -- $UPDATE for indexed files'

GLOBAL ROUTINE updidx : NOVALUE =
! UPDIDX
! ======
! ROUTINE TO PERFORM THE $UPDATE OPERATION FOR INDEXED FILES.
!	IN ORDER TO PROCESS AN $UPDATE FOR INDEXED FILES, THE
!	FOLLOWING LOGICAL OPERATIONS MUST BE DONE:
!
!		1 )	LOCK THE FILE (IF NECESSARY)
!		2 )	DELETE THE RECORD POINTERS FOR ALL
!			SECONDARY INDICES FOR WHICH THE KEY CHANGED
!		3 )	UPDATE THE USER DATA RECORD
!		4 )	INSERT NEW RECORD POINTERS IN THE INDEX
!			FOR EACH NEW SECONDARY KEY VALUE.
!
! INPUT:
!	<NONE>
!
! OUTPUT:
!	<NO STATUS RETURNED>
!
! ROUTINES CALLED:
!	DOUPDIDX
!	PUTBKT
!
! NOTES:
!
!	1.	THIS ROUTINE WILL NOT RETURN TO THE CALLER (UPDIDX)
!		IF AN ERROR WAS ENCOUNTERED; IT WILL EXIT DIRECTLY
!		TO THE USER.
!
!	2.	THIS CODE CURRENTLY DOES NOT SUPPORT THE MODIFICATION
!		OF THE RECORD LENGTH ON AN $UPDATE. FOR MORE INFO
!		ON HOW THIS MIGHT BE DONE, SEE THE HEADING OF "UPDUDR".
!
!	3.	IF ANY ERROR OCCURS DURING THE PROCESSING OF AN $UPDATE,
!		THE PROCESSING IS TERMINATED AND CONTROL IS RETURNED
!		TO THE USER. IN SUCH A CASE, THE STATE OF THE USER'S
!		DATA MAY BE UNDEFINED (PROPERLY STRUCTURED, BUT NOT
!		LOGICALLY CONSISTENT). FOR EXAMPLE, ONE OF THE SIDR
!		POINTERS MAY HAVE ALREADY BEEN DELETED; THUS, THE
!		USER MAY HAVE LOST AN ACCESS PATH TO THE FILE.
    BEGIN

    LOCAL
	recdesc : BLOCK [rdsize],		! USE LOCAL RECORD DESCRIPTOR
	databd : BLOCK [bdsize],		! AND BUCKET DESCRIPTOR
	savedstatus;				! STATUS RETURNED TO US

!    EXTERNAL
!	putbkt,					! RELEASE A BUCKET
!	doupdidx;				! DO THE DIRTY WORK
    TRACE ('UPDIDX');

    !+
    !   FIRST, WE WILL SET UP THE RECORD DESCRIPTOR PACKET.
    !   THE FOLLOWING FIELDS MUST BE INITIALIZED:
    !
    !		FLAGS	= NULL
    !		STATUS	= NULL
    !		RECPTR	= ADDRESS OF CURRENT RECORD
    !-

    recdesc [rdflags] = 0;			! CLEAR FLAGS
    recdesc [rdstatus] = 0;			! CLEAR STATUS
    recdesc [rdrecptr] = .rst [rstpagptr];

    !+
    !   FETCH THE CURRENT BUCKET DESCRIPTOR FROM THE RST.
    !   NOTE THAT THERE MUST BE A CURRENT BUCKET OR SOMETHING
    !   HAS BEEN MESSED UP.
    !-

    fetchcurrentbkt (databd);

    IF nullbd (databd) THEN rmsbug (msgbkt);

    !
    !   PERFORM THE ACTUAL WORK OF THE $UPDATE
    !   AND  SAVE THE RESULTS THAT WE GOT
    !
    savedstatus = doupdidx (recdesc, 		! RD
	databd);				! BKT
    !
    !   RELEASE THE CURRENT BUCKET (NOTE THAT WE ARE
    !   RELEASING THE BUCKET AS IT IS STORED IN THE RST
    !   BECAUSE THIS WILL ALSO SET THE RST CURRENT BUCKET
    !   TO BE NULL)
    !
    releascurentbkt;
    !
    !   UNLOCK THE FILE IF ONE OF THE ROUTINES WE CALLED LOCKED IT
    !

    IF indexlocked THEN unlockindex;

    IF .savedstatus EQL false THEN usrerr ();	! HAD AN ERROR

    !
    !   EVERYTHING WENT OK...CHECK FOR INDEX ERROR OR DUPLICATES
    !

    IF samekeyflag (recdesc) NEQ 0 THEN usrsts = su$dup;

    IF idxerrorflag (recdesc) NEQ 0 THEN usrsts = su$idx;

    RETURN
    END;					! End UPDIDX
%SBTTL 'DOUPDIDX -- perform actual indexed update'

GLOBAL ROUTINE doupdidx (recdesc, databd) =
! DOUPDIDX
! ========
! ROUTINE TO ACTUALLY PERFORM THE $UPDATE MACRO PROCESSING FOR
!	AN INDEXED FILE. THIS ROUTINE MUST PERFORM THE FOLLOWING OPERATINS:
!
!		1 )	CHECK FOR CHANGES IN ALL KEYS
!		2 )	DELETE OLD KEY VALUES FROM SECONDARY INDEX
!		3 )	CAL UPDUDR TO UPDATE AND WRITE OUT THE
!			PRIMARY DATA RECORD
!		4 )	ADD NEW SIDR ENTRIES FOR THE NEW KEY VALUES
!
! INPUT:
!	RECDESC		RECORD DESCRIPTOR PACKET
!		RECPTR		ADDRESS OF CURRENT RECORD IN BUFFER
!		FLAGS		PROCESSING FLAGS
!			RDFLGHORIZOK
!
!	DATABD		BUCKET DESCRIPTOR OF CURRENT BUCKET
!		<THIS BUCKET DESCRIPTOR MUST NOT BE EMPTY>
!
!
! OUTPUT:
!	TRUE:	OK...$UPDATE WAS PERFORMED
!	FALSE:	ERROR
!		FILE IS FULL (FOR RECORD LENGTH MODIFICATION)
!
! NOTES:
!
!	1.	ON ERROR, THE ERROR CODE WILL BE PUT INTO USRSTS.
!
!	2.	THIS ROUTINE NEVER RELEASES THE BUCKET WHICH IS
!		PASSED TO IT. THIS MUST DO DONE BY "UPDIDX".
!
!	3.	ON ANY ERROR CONDITION, THE STATE OF THE USER'S FILE
!		IS INDETERMINATE. THIS DOES NOT MEAN THAT IT IS
!		"SCREWED UP" IN SOME PHYSICAL WAY, BUT SIMPLY THAT
!		SOME ACCESS PATHS (SIDR RECORDS) MAY HAVE BEEN LOST,ETC.
!
!	4.	THIS ROUTINE WILL NOT ALLOW THE SIZE OF THE RECORD TO
!		BE CHANGED ON AN $UPDATE. HOWEVER, COMMENTS ARE MADE
!		THRUOUT THIS ROUTINE WHICH EXPLAINS WHAT HAS TO BE
!		DONE IF THIS FACILITY IS EVER IMPLEMENTED. ALL
!		COMMENTS ENCLOSED IN ANGLE BRACKETS ( "<,>") REFER
!		TO THIS FACILITY.
!
!	5.	THIS ROUTINE USES THE "FLGDIDCHANGE" BIT IN THE
!		KDB TO KEEP TRACK OF WHETHER THE CORRESPONDING
!		SECONDARY KEY VALUE CHANGED. THIS IS NECESSARY
!		BECAUSE ONCE THE DATA RECORD IS WRITTEN OUT,
!		THE OLD VALUE OF THE KEY IS (OBVIOUSLY) NOT
!		AVAILABLE.
    BEGIN

    MAP
	recdesc : REF BLOCK,
	databd : REF BLOCK;

    LOCAL
	tempbd : BLOCK [bdsize],
	temprd : BLOCK [rdsize],
	oldrecordptr : REF BLOCK,		! PTR TO CURRENT RECORD IN FILE
	newrecordptr : REF BLOCK,		! PTR TO USER'S NEW UPDATED RECORD
	keyofreference,				! CURRENT KEY NUMBER
	newrecordsize,				! SIZE OF NEW RECORD
	oldrecordsize,				! SIZE OF OLD RECORD
	maxrecordsize,				! MAX SIZE OF A NEW RECORD
	ptrtodata : REF BLOCK;			! PTR TO THE DATA PORTION OF CURRENT RECORD

    EXTERNAL
!	delsidr,				! DELETE A SECONDARY KEY
!	ckeyuu,					! COMPARE USER KEY TO USER KEY
	tbuffer;				! TEMP BUFFER FOR KEY STORAGE

!	updudr,					! UPDATE PRIMARY DATA RECORD
!	movekey,				! MOVE A KEY STRING
!	putsidr,				! INSERT A NEW SECONDARY KEY
!	lockit;					! LOCK THE FILE
    TRACE ('DOUPDIDX');
    !
    !   FIRST, SET UP THE PRIMARY KDB ADDRESS
    !
    kdb = .fst [fstkdb];
    !
    !   SET UP POINTERS TO BOTH THE OLD AND THE NEW RECORDS,
    !   AND <GET THE SIZE OF BOTH RECORDS>
    !
    oldrecordptr = .recdesc [rdrecptr];		! OLD RECORD IN FILE
    ptrtodata = .oldrecordptr + .kdb [kdbhsz];
    newrecordptr = .rab [rabrbf, 0];		! USER'S NEW RECORD

    IF .rmssec NEQ 0 AND 			! Extended addressing?	!A407
	.newrecordptr<lh> EQL 0			! User gave 18-bits?	!A407
    THEN 					!			!A407
	newrecordptr = .newrecordptr OR .blksec;	! Make global	!A407

    oldrecordsize = .rst [rstrsz];		! Size of old record
    newrecordsize = .rab [rabrsz, 0];		! Size of new record

%IF 0
%THEN

    !+
    !   <NOW, LET'S PERFORM SOME CHECKS ON THE SIZE OF THE
    !   NEW RECORD>
    !-

    maxrecordsize = 				! Record not bigger than this
    .kdb [kdbdbkz]^b2w;
    maxrecordsize = .maxrecordsize - (bhhdrsize + .kdb [kdbhsz]);

    IF (.newrecordsize LSS .kdb [kdbminrsz]) OR 	!
	(sizeinwords (.newrecordsize, .fst [fstbsz]) GTR 	!
	.maxrecordsize)
    THEN 					! Record too short or too long
	returnstatus (er$rsz);

%FI

    !+
    !   GET THE RRV ADDRESS OF THE CURRENT RECORD
    !-

    recdesc [rdrrv] = .oldrecordptr [drrrvaddress];

    !+
    !   WE MUST NOW CYCLE THRU EACH KEY TO SEE IF IT CHANGED.
    !   THE PRIMARY KEY CAN BE TREATED JUST LIKE A SECONDARY
    !   KEY SINCE IT HAD TO BE DEFINED WITH THE "NO CHANGE"
    !   ATTRIBUTE. IN ORDER TO SAVE TIME LATER (BECAUSE WE WON'T
    !   HAVE TO COMPARE THE KEY STRINGS TWICE), WE WILL SET A
    !   FLAG IN THE KDB WHICH WILL INDICATE WHETHER A PARTICULAR
    !   KEY VALUE CHANGED OR NOT.  THEN LATER, WE ONLY HAVE TO
    !   CHECK THE BIT INSTEAD OF COMPARING THE KEYS AGAIN.
    !-

    !

    !   SET UP THE ADDRESS OF THE DATA PORTION OF THE RECORD
    !
    recdesc [rduserptr] = .ptrtodata;
    !
    !   PROCESS THIS LOOP ONCE FOR EACH KEY
    !
    keyofreference = 0;

    UNTIL .kdb EQL 0 DO 			! THIS LOOP
	BEGIN
	!
	!   ASSUME THE KEY DIDNT CHANGE
	!
	clrflag (kdb [kdbflags], flgdidchange);	! CLEAR THE FLAG

	!+
	!   CHECK IF THE KEY VALUE CHANGED. THIS CHECK IS
	!   DONE ONLY IF THE OLD RECORD WAS BIG ENOUGH TO
	!   HOLD THE ENTIRE KEY STRING, <AND THE NEW RECORD
	!   IS ALSO BIG ENOUGH>
	!-

	IF .oldrecordsize GEQ .kdb [kdbminrsz]	!
	    %(AND)%				!
	    %(.NEWRECORDSIZE GEQ .KDB [ KDBMINRSZ ] )%	!
	THEN 					! WE CAN COMPARE THE KEYS
	    BEGIN
	    lookat ('	CHECKING KEY #: ', keyofreference);

	    IF ckeyuu (.recdesc, 		! OLD PTR
		    .newrecordptr		! NEW PTR
		) EQL false OR 			!
		(lssflag (recdesc) NEQ 0)
		!
		!   IF THIS KEY CHANGED, WE MUST SET THE CORRESPONDING
		!   FLAG BIT IN THE KDB. NOTE THAT THE KEY
		!   DIDNT CHANGE IF CKEYUU RETURNED TRUE WITH THE
		!   LSSFLAG NOT ON
		!
	    THEN 				! THE KEY CHANGED
		BEGIN
		rtrace ('	KEY HAS CHANGED...');
		!
		!   IS THIS KEY ALLOWED TO CHANGE?
		!

		IF chkflag (kdb [kdbflags], flgchange) EQL 0
		THEN
		    BEGIN
		    usrstv = .keyofreference;	!INDIC WHICH KEY CHANGED
		    returnstatus (er$chg);
		    END;

		setflag (kdb [kdbflags], flgdidchange);

		!+
		!   *****
		!   IF DUPLICATES ARE NOT ALLOWED
		!   THEN CHECK FOR DUPLICATES
		!   ******
		!-

		IF chkflag (kdb [kdbflags], flgdup) EQL 0
		THEN
		    BEGIN

		    BIND 			! 			!A422
			frombd = .databd : BLOCK;	! Prevent bug	!A422

		    !
		    !   MAKE A COPY OF BD
		    !
		    movebktdesc (frombd, 	! FROM			!M422
			tempbd);		! TO
		    !
		    !   MAKE A COPY OF RDP
		    !
		    movewords (.recdesc, 	! FROM
			temprd);		! TO
		    !
		    !   MOVE KEY TO TEMP BUFFER
		    !
		    movekey (.newrecordptr, 	! FROM
			tbuffer);		! TO
		    temprd [wholeword] = 0;
		    temprd [rduserptr] = tbuffer;
		    temprd [rdusersize] = .kdb [kdbksz];

		    IF followpath (temprd, tempbd) EQL false	!
		    THEN
			BEGIN
			!					       !A57
			!   Free the bucket without update	       !A57
			!					       !A57
			putbkt (false, tempbd);	!A57
			RETURN false;
			END;

		    IF chkdup (			! DUPLICATE?
			    temprd, 		! RECDES
			    tempbd		! BKTD
			) EQL false
		    THEN
			BEGIN
			!					       !A57
			!   Free the bucket without update	       !A57
			!					       !A57
			putbkt (false, tempbd);	!A57
			returnstatus (er$dup);
			END;

		    !                                                  !A57
		    !   Free the bucket without update                 !A57
		    !						       !A57
		    putbkt (false, tempbd);	!A57
		    END;

		!
		!   *	END OF CHECK FOR DUPLICATES	**
		!
		END

	    END;

	!
	!   WE HAVE FINISHED CHECKING THIS KEY..MOVE TO NEXT ONE
	!
	kdb = .kdb [kdbnxt];			! GET NEXT KDB
	keyofreference = .keyofreference + 1;	! Bump key number
	END;

    !+
    !   WE NOW KNOW THAT THE NEW RECORD IS OK. WE MUST
    !   REMOVE THE OLD SIDR ENTRIES FOR EACH KEY VALUE WHICH
    !   HAS CHANGED.
    !-

    kdb = .fst [fstkdb];			! RESET TO PRIMARY KEY
    kdb = .kdb [kdbnxt];			! MOVE TO FIRST SECONDARY
    !
    !   DELETE SIDR POINTERS
    !

    UNTIL .kdb EQL 0 DO 			! THIS LOOP
	BEGIN
	keyofreference = .kdb [kdbref];

	!+
	!   NOW, IF THE KEY CHANGED, WE MUST DELETE THE OLD SIDR
	!   ENTRY. FIRST, WE WILL MOVE THE KEY VALUE OF THIS
	!   KEY INTO THE TEMPORARY KEY BUFFER (WE COULD USE THE
	!   BOTTOM HALF OF THE RST KEY BUFFER)
	!
	!   NOTE THAT IF RECORD-LENGTH MODIFICATION IS
	!   SUPPORTED, THERE MUST ALSO BE A CHECK HERE TO SEE
	!   IF THE OLD RECORD CONTAINED THE KEY VALUE, BUT THE
	!   NEW RECORD DIDNT (SINCE IN THIS CASE THE DIDCHANGE
	!   BIT WOULD NOT BE ON)
	!-

	IF (chkflag (kdb [kdbflags], flgdidchange) NEQ 0)
	THEN
	    BEGIN
	    lookat ('	DELETING KEY #', keyofreference);
	    movekey (.ptrtodata, 		! FROM
		tbuffer);			! TO
	    !
	    !   SET UP THE RECORD DESCRIPTOR PACKET
	    !
	    recdesc [rdusersize] = .kdb [kdbksz];	! USE FULL KEY SIZE
	    recdesc [rduserptr] = tbuffer;	! USE GLOBAL TBUFFER
	    !
	    !   IF THE FILE HASN'T BEEN LOCKED, WE MUST LOCK IT
	    !

	    IF locking
	    THEN

		IF NOT indexlocked
		THEN
		    BEGIN

		    IF lockindex (		!
			    enqblk, 		! WAIT
			    enqexc		! EXCLUSIVE
			) EQL false
		    THEN
			returnstatus (er$edq)

		    END;

	    !
	    !   AT THIS POINT, THE FILE IS LOCKED (IF NECESSARY)
	    !   SO WE CAN DELETE THE OLD SIDR ENTRY
	    !
	    delsidr (.recdesc)
	    !
	    !   ***NOTE THAT IF DELSIDR FAILS, THERE IS NO
	    !   CHECK HERE FOR THAT CONDITION. THIS IS BECAUSE
	    !   AN EARLIER CRASH MAY HAVE CAUSED THE KEY TO
	    !   NOT BE CORRECTLY INSERTED INTO ALL SECONDARY
	    !   INDICES. ***
	    !
	    END;

	kdb = .kdb [kdbnxt]			! GO TO NEXT KDB
	END;

    !+
    !   AT THIS POINT, ALL OLD SIDR ENTRIES HAVE BEEN DELETED.
    !   ALSO, THE FILE MAY STILL BE LOCKED. WE MUST NOW PERFORM
    !   THE ACTUAL UPDATE OF THE USER DATA RECORD. WE WILL PASS
    !   A FLAG TO "UPDUDR" INDICATING WHETHER THE FILE IS CURRENTLY
    !   LOCKED OR NOT, AND THAT ROUTINE CAN THEN ALTER THE FLAG
    !   IF IT HAS TO LOCK THE FILE.
    !-

    recdesc [rdrecptr] = .oldrecordptr;		! PTR TO FILE RECORD
    kdb = .fst [fstkdb];			! START WITH PRIMARY

    IF updudr (					!
	    .recdesc, 				! RD
	    .databd				! BKT
	) EQL false
	!
	!   IT IS CURRENTLY IMPOSSIBLE FOR UPDUDR TO FAIL...HERE
	!   IS THE CODE TO HANDLE AN ERROR WHEN RECORD-LENGTH
	!   MODIFICATION IS SUPPORTED:
	!
    THEN
	BEGIN
	rmsbug (msgcantgethere);		! **** REMOVE WHEN IMPLEMENTED
! 		USRSTV = ER$UDF;		! INDICATE UNDEFINED RECORD
!  		BADRETURN
	END;

    !
    !   NOW, PERFORM THIS LOOP ONCE FOR EACH SECONDARY KEY.
    !   WE MUST NOW INSERT THE NEW VALUES OF THE SECONDARY
    !   KEYS INTO THE CORRESPONDING INDEX.
    !
    kdb = .kdb [kdbnxt];			! MOVE TO FIRST SECONDARY

    UNTIL .kdb EQL 0 DO 			! THIS LOOP
	BEGIN
	!
	!   DID THIS KEY VALUE CHANGE?
	!
	!   THE SIZE OF THE NEW RECORD MUST INCLUDE THIS KEY STRING
	!

	IF (chkflag (kdb [kdbflags], flgdidchange) NEQ 0)	!
	    %(AND)%				!
	    %((.NEWRECORDSIZE GEQ .KDB[ KDBMINRSZ] ))%
	THEN 					! WE MUST INSERT THIS NEW KEY VALUE
	    BEGIN
	    !
	    !   <WE MAY NEED TO LOCK THE FILE AT THIS POINT.
	    !   THIS WOULD BE NECESSARY ONLY IF RECORD LENGTH
	    !   MODIFICATION IS SUPPORTED. THUS, IF THE OLD
	    !   RECORD LENGTH WAS NOT BIG ENOUGH FOR ANY KEYS,
	    !   AND THE PRIMARY DATA BUCKET DIDN'T SPLIT, AND
	    !   THE NEW RECORD SIZE IS BIG ENOUGH FOR A SECONDARY
	    !   KEY, THEN WE NEED TO LOCK THE FILE>
	    !

%IF dbug
%THEN

	    IF chkflag (kdb [kdbflags], flgchange) EQL 0	!
	    THEN
		rmsbug (msgflags);

%FI

	    IF locking
	    THEN

		IF NOT indexlocked
		THEN
		    BEGIN

		    IF lockindex (		!
			    enqblk, 		! WAIT
			    enqexc		! EXCL
			) EQL false
		    THEN
			returnstatus (er$edq)

		    END;

	    !
	    !   INSERT THE NEW SECONDARY KEY VALUE
	    !
	    lookat ('	INSERTING SIDR FOR KEY: ', kdb [kdbref]);

	    IF putsidr (.recdesc) EQL false
	    THEN
		BEGIN
		usrstv = er$udf;		! INDICATE UNDEFINED RECORD
		RETURN false
		END;

	    END;

	!
	!   GO TO NEXT SECONDARY KEY
	!
	kdb = .kdb [kdbnxt]
	END;

    !
    !   AT THIS POINT, THE UPDATE WAS SUCCESSFUL.
    !
    RETURN true
    END;					! End DOUPDIDX
%SBTTL 'UPDUDR -- Update current record, indexed'

GLOBAL ROUTINE updudr (recdesc, databd) =
! UPDUDR
! ======
! ROUTINE TO UPDATE THE CONTENTS OF THE CURRENT RECORD FOR AN INDEXED FILE.
!	THIS ROUTINE CURRENTLY IS TRIVIAL BECAUSE IT IS NOT POSSIBLE
!	TO CHANGE THE LENGTH OF THE RECORD ON AN $UPDATE OPERATION.
!	HOWEVER, IF THIS CODE IS CHANGED TO ALLOW RECORD LENGTH
!	MODIFICATION, THEN THE FOLLOWING MUST BE DONE:
!
!		1 )	DETERMINE IF THE NEW RECORD WILL FIT IN THE
!			CURRENT BUCKET.
!
!		2 )	IF SO, SQUEEZE THE OLD ONE OUT (WITH SOME
!			OPTIMIZATION) AND INSERT THE NEW ONE WITHOUT
!			ASSIGNING A NEW ID FOR IT.
!
!		3 )	IF NOT, SPLIT THE BUCKET AND CONTINUE AS IF
!			THIS WERE A NORMAL $PUT OPERATION. HOWEVER,
!			NOTE THAT SINCE WE MAY NOT HAVE TRAVERSED THE
!			INDEX TO GET HERE, THE ENTIRE INDEX MAY HAVE TO
!			BE SEARCHED AGAIN SIMPLY TO SET UP THE "PATH"
!			ARRAY.  IF THE LAST OPERATION USED KEY ACCESS,
!			THEN "PATH" IS ALREADY SET UP AND DOES NOT HAVE
!			TO BE RE-INITIALIZED.
!
!
! INPUT:
!	RECDESC		RECORD DESCRIPTOR PACKET
!		RECPTR		ADDRESS OF OLD RECORD (IN CURRENT BUFFER)
!
!	DATABD		CURRENT BUCKET DESCRIPTOR (MUST NOT BE NULL)
!
!
! OUTPUT:
!	TRUE:	OK, RECORD HAS BEEN UPDATED
!	FALSE:	ERROR
!		ENQ/DEQ ERROR
!		COULD NOT INSERT NEW RECORD
!
! INPUT ARGUMENTS MODIFIED:
!	RECORD DESCRIPTOR
!		RECPTR		ADDRESS OF RECORD (MAY HAVE MOVED)
!
! ROUTINES CALLED:
!	<NONE CURRENTLY>
!
! NOTES:
!
!	1.	FILEISLOCKED IS RETURNED TO THE CALLER BECAUSE THIS
!		ROUTINE MAY HAVE TO LOCK THE FILE ON ITS OWN.
    BEGIN

    MAP
	recdesc : REF BLOCK,
	databd : REF BLOCK;

    LOCAL
	newrecordptr : REF BLOCK,		! PTR TO USER'S NEW UPDATED RECORD
	oldrecordptr : REF BLOCK;		! PTR TO OLD RECORD IN BUFFER

    TRACE ('UPDUDR');
    !
    !   FOR NOW, WE SIMPLY HAVE TO MOVE THE NEW RECORD (IN THE
    !   USER'S RECORD BUFFER) INTO THE OLD EXISTING RECORD
    !   (POINTED TO BY THE RECPTR FIELD). NOTE THAT THE SIZE OF
    !   OLD RECORD IS KEPT IN THE RST SO WE DON'T HAVE TO RE-COMPUTE IT.
    !
    newrecordptr = .rab [rabrbf, 0];		! Get user's buffer	!M407

    IF .rmssec NEQ 0 AND 			! Extended addressing?	!A407
	.newrecordptr<lh> EQL 0			! User gave 18-bits?	!A407
    THEN 					!			!A407
	newrecordptr = .newrecordptr OR .blksec;	! Make global	!A407

    oldrecordptr = .recdesc [rdrecptr] + .kdb [kdbhsz];
    !
    !   MOVE THE RECORD DATA
    !

    IF .rmssec NEQ 0				!			!A407
    THEN 					!			!A407
	xcopy (.newrecordptr, 			! From			!A407
	    .oldrecordptr, 			! To			!A407
	    .rst [rstrszw])			! Size			!A407
    ELSE 					!			!A407
	movewords (.newrecordptr, 		! From			!M407
	    .oldrecordptr, 			! To			!M407
	    .rst [rstrszw]);			! Size			!M407

    						!
    !   WRITE OUT THE CURRENT BUCKET TO THE FILE
    !

    IF NOT writebehind				!
    THEN
	updatebucket (databd)			!
    ELSE
	setbfdupd (databd [bkdbfdadr]);		!SET WRITE FLAG

    RETURN true
    END;					! End UPDUDR

END

ELUDOM