Google
 

Trailing-Edge - PDP-10 Archives - bb-bt99s-bb - 10,7/rms10/rmssrc/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/SYNONYM ISON = EQL -1>
!<BLF/SYNONYM ISNT = NEQ>
!<BLF/SYNONYM IS = EQL>
!<BLF/LOWERCASE_USER>
!<BLF/UPPERCASE_KEY>
MODULE update (IDENT = 'V1.0'
		) =
BEGIN

GLOBAL BIND
    updtv = 1^24 + 0^18 + 8;			!EDIT DATE: 14-SEP-88

!++
!	FUNCTION:	THIS MODULE CONTAINS ROUTINES WHICH PROCESS
!			THE $UPDATE MACRO IN RMS-20.
!
!	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, 1982 BY DIGITAL EQUIPMENT CORPORATION
!
!
!	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)
!
!****************** Start RMS-10 V1.1 *********************
!********************* TOPS-10 ONLY ***********************
!
!PRODUCT	MODULE	 SPR
! EDIT	 EDIT	 QAR		DESCRIPTION
!======	======	=====		===========
!
! 100	  7	Dev		Make declarations for routine names
!				be EXTERNAL ROUTINE so RMS will compile 
!				under BLISS V4 (RMT, 10/22/86).
!
! 124	  8	10-35306	Add size to movewords call in DOUPDIDX
!		10-35629	(SMW, 9/14/88)
!
!		***** END OF REVISION HISTORY *****
!
!
!
!
!-
%SBTTL 'EXTERNAL DECLARATIONS'
!
!   EXTERNAL DECLARATIONS
!

EXTERNAL ROUTINE
    crash,
    checkrp,
    dump,
    numbertorfa,
    gtbyte,
    lockit,
    moverec,
    rsetup,
!
!  ERROR CODES USED WITHIN THIS MODULE
!
!    msgpgone,					! FILE PAGE GONE
    msgcantgethere,				! RMS HAS REALLY SCREWED UP
    msgflags,					! BAD FLAG VALUES
    msgfailure,					! A ROUTINE FAILED
    msgbkt;					! BAD BUCKET DESCRIPTOR

!    msgunlocked;				! RECORD UNLOCKED, BUT SHOULD BE LOCKED

REQUIRE 'rmsreq';

extdeclarations;
%SBTTL '$UPDATE -- processor for $UPDATE macro'
! $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
!

GLOBAL ROUTINE $update (BLOCK, errorreturn) : NOVALUE =
    BEGIN
    argument (BLOCK, baseadd);
    argument (errorreturn, baseadd);

    EXTERNAL ROUTINE
		updsqr,					! $UPDATE FOR SEQUENTIAL AND RELATIVE FILES
		updidx;					! $UPDATE FOR INDEXED FILES
	
	    rmsentry ($update);
	    !
	    !   FETCH THE USER'S RAB AND HIS ERROR ROUTINE ADDRESS
	    !
	    rab = .BLOCK;				! FETCH RAB ADR
	    erradr = .errorreturn;			! AND USER ERROR ADDRESS
	    !
	    !   CHECK FOR STANDARD ERRORS AND $UPDATE ACCESS TO FILE
	    !
	    callrsetup (pci (axupd));			! SET UP THE WORLD
	    !
	    !   INSURE THAT FILE IS POSITIONED AND LOCKED
	    !
	    callcheckrp;
	    !
	    !   CHECK THAT THE USER'S BUFFER IS VALID, AND THAT
	    !   HE IS NOT TRYING TO CHANGE THE SIZE OF THE RECORD.
	    !
	
	    IF .rab [rabrbf] LEQ minuserbuff		! CHECK USER BUFFER
	    THEN
		usererror (er$rbf);
	
	    IF .rab [rabrsz] isnt .rst [rstrsz]		! CHECK RECORD SIZES
	    THEN
		usererror (er$rsz);
	
	    !
	    !   DISPATCH TO THE CORRECT ROUTINE FOR THIS ORGANIZATION
	    !
	
	    CASE fileorg FROM 0 TO 3 OF
		SET
	
		[0] : 					! ILLEGAL FOR ASCII FILES
		    usererror (er$iop);
	
		[1] : 					! SEQUENTIAL
		    callupdsqr;
	
		[2] : 					! RELATIVE
		    callupdsqr;
	
	%IF indx
	%THEN
	
		[3] : 					! INDEXED
		    callupdidx;
	%FI
	
		TES;					! END OF CASE FILEORG
	
	    !
	    !   RETURN HERE ONLY IF EVERYTHING WAS OK
	    !
	    setsuccess;
	    userexit
	    END;					! OF $UPDATE
	
	
%SBTTL 'UPDSQR -- sequential/relative $UPDATE'
	! 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:
	!	<NONE>
	!
	! 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.
	
	GLOBAL ROUTINE updsqr : NOVALUE =
	    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 = callnumbertorfa (lci (crp));
	
		IF .bytenum is false THEN error (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 )
	    !
	    callgtbyte (lci (bytenum), 			! BYTE NUMBER
		pci (false));				! DON'T CHECK
	    !
	    !   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];		! WHERE RECORD IS TO COME FROM
	    !
	    !   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
		movewords (.userpointer, 		! FROM
		    .filepointer, 			! TO
		    .rst [rstrszw])			! SIZE
		END
	    ELSE
		callmoverec (lci (filepointer), 	! TO
		    lci (userpointer), 			! FROM
		    pci (true), 			! FLAG
		    lci (bytecount), 			! COUNT
		    lci (bytesize));			! SIZE
	
	    !
	    !   UNLOCK THE RECORD IF IT WAS LOCKED
	    !
	
	    IF datalocked THEN unlock (crp);		! UNLOCK THE RECORD
	
	    RETURN
	    END;					! OF UPDSQR
	
	
%SBTTL 'UPDIDX -- $UPDATE for indexed files'
	! 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.
	
	GLOBAL ROUTINE updidx : NOVALUE =
	    BEGIN
	
	%IF indx
	%THEN
	
	    LOCAL
		recdesc : formats [rdsize],		! USE LOCAL RECORD DESCRIPTOR
		databd : formats [bdsize],		! AND BUCKET DESCRIPTOR
		savedstatus;				! STATUS RETURNED TO US
	
	    EXTERNAL ROUTINE
	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] = zero;			! CLEAR FLAGS
    recdesc [rdstatus] = zero;			! 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 = calldoupdidx (lct (recdesc), 	! RD
	lct (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 is false THEN usexiterr;	! HAD AN ERROR

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

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

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

    RETURN
%FI

    END;					! OF UPDIDX

%SBTTL 'DOUPIDX -- perform actual indexed update'
! 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.

GLOBAL ROUTINE doupdidx (recdesc, databd) =
    BEGIN

%IF indx
%THEN
    argument (recdesc, baseadd);		! RECORD DESC PACKET
    argument (databd, baseadd);			! CURRENT BUCKET DESC

    MAP
	recdesc : pointer,
	databd : pointer;

    LOCAL
	tempbd : formats [bdsize],
	temprd : formats [rdsize],
	oldrecordptr : pointer,			! PTR TO CURRENT RECORD IN FILE
	newrecordptr : pointer,			! 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 : pointer;			! PTR TO THE DATA PORTION OF CURRENT RECORD

    EXTERNAL ROUTINE
	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];		! USER'S NEW RECORD
    oldrecordsize = .rst [rstrsz];		! SIZE OF OLD RECORD
    newrecordsize = .rab [rabrsz];		! SIZE OF NEW RECORD
    !
    !   <NOW, LET'S PERFORM SOME CHECKS ON THE SIZE OF THE
    !   NEW RECORD>
    !
!  	MAXRECORDSIZE = .KDB [ KDBDBKZ ] ^ B2W;	! RECORD CANT BE BIGGER THAN THIS
!  	DEC ( MAXRECORDSIZE, BHHDRSIZE + .KDB [ KDBHSZ ] );
!  	IF	( .NEWRECORDSIZE LSS .KDB [ KDBMINRSZ ] )
!  			OR
!  		( SIZEINWORDS ( .NEWRECORDSIZE, .FST [ FSTBSZ ]) GTR .MAXRECORDSIZE)
!  	THEN	%THE RECORD IS EITHER TOO SHORT OR TOO LONG%
!
! 		RETURNSTATUS ( ER$RSZ );
    !
    !   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 = zero;

    UNTIL .kdb is zero 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 callckeyuu (			!
		    bpt (recdesc), 		! OLD PTR
		    lpt (newrecordptr)		! NEW PTR
		) is false OR 			!
		(lssflag (recdesc) ison )
		!
		!   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) is off
		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) is off
		THEN
		    BEGIN
		    !
		    !   MAKE A COPY OF BD
		    !
		    movebktdesc (bpt (databd), 	! FROM
			lct (tempbd));		! TO
		    !
		    !   MAKE A COPY OF RDP
		    !
		    movewords (bpt (recdesc), 	! FROM
			lct (temprd),		! TO
			rdsize);		![124] SIZE
		    !
		    !   MOVE KEY TO TEMP BUFFER
		    !
		    callmovekey (lpt (newrecordptr), 	! FROM
			gct (tbuffer));		! TO
		    temprd [wholeword] = 0;
		    temprd [rduserptr] = tbuffer;
		    temprd [rdusersize] = .kdb [kdbksz];

		    IF callfollowpath (lct (temprd), lct (tempbd)) is false	!
		    THEN
			BEGIN
			!					       !A57
			!   Free the bucket without update	       !A57
			!					       !A57
			callputbkt (pci (false), lct (tempbd));	!A57
			RETURN false;
			END;

		    IF callchkdup (		! DUPLICATE?
			    lct (temprd), 	! RECDES
			    lct (tempbd)	! BKTD
			) is false
		    THEN
			BEGIN
			!					       !A57
			!   Free the bucket without update	       !A57
			!					       !A57
			callputbkt (pci (false), lct (tempbd));	!A57
			returnstatus (er$dup);
			END;

		    !                                                  !A57
		    !   Free the bucket without update                 !A57
		    !						       !A57
		    callputbkt (pci (false), lct (tempbd));	!A57
		    END;

		!
		!   *	END OF CHECK FOR DUPLICATES	**
		!
		END				! OF IF KEY CHANGED
	    END;				! OF IF RSZ GTR MINRSZ

	!
	!   WE HAVE FINISHED CHECKING THIS KEY..MOVE TO NEXT ONE
	!
	kdb = .kdb [kdbnxt];			! GET NEXT KDB
	inc (keyofreference, 1)			! BUMP KEY NUMBER
	END;					! OF UNTIL .KDB IS ZERO

    !+
    !   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 is zero 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) ison )
	THEN
	    BEGIN
	    lookat ('	DELETING KEY #', keyofreference);
	    callmovekey (lpt (ptrtodata), 	! FROM
		gct (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
			) is false
		    THEN
			returnstatus (er$edq)

		    END;			! OF IF WE NEED TO LOCK THE FILE

	    !
	    !   AT THIS POINT, THE FILE IS LOCKED (IF NECESSARY)
	    !   SO WE CAN DELETE THE OLD SIDR ENTRY
	    !
	    calldelsidr (bpt (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;				! OF IF CHANGEFLAG ISNT FALSE

	kdb = .kdb [kdbnxt]			! GO TO NEXT KDB
	END;					! OF UNTIL .KDB IS ZERO

    !+
    !   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 callupdudr (				!
	    bpt (recdesc), 			! RD
	    bpt (databd)			! BKT
	) is 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;					! OF IF UPDUDR FAILED

    !
    !   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 is zero DO 			! THIS LOOP
	BEGIN
	!
	!   DID THIS KEY VALUE CHANGE?
	!
	!   THE SIZE OF THE NEW RECORD MUST INCLUDE THIS KEY STRING
	!

	IF %((.NEWRECORDSIZE GEQ .KDB[ KDBMINRSZ] ))%	!
	%(AND)%					!
	    (chkflag (kdb [kdbflags], flgdidchange) ison )
	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) is off	!
	    THEN
		rmsbug (msgflags);

%FI

	    IF locking
	    THEN

		IF NOT indexlocked
		THEN
		    BEGIN

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

		    END;			! OF IF WE NEED TO LOCK THE FILE

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

	    IF callputsidr (bpt (recdesc)) is false
	    THEN
		BEGIN
		usrstv = er$udf;		! INDICATE UNDEFINED RECORD
		badreturn
		END;				! OF IF WE COULN'T INSERT NEW SIDR

	    END;				! OF IF .NEWRECORDSIZE GEQ MINRSZ

	!
	!   GO TO NEXT SECONDARY KEY
	!
	kdb = .kdb [kdbnxt]
	END;					! OF UNTIL .KDB IS ZERO

    !
    !   AT THIS POINT, THE UPDATE WAS SUCCESSFUL.
    !
    goodreturn
%FI

    END;					! OF DOUPDIDX

%SBTTL 'UPDUDR -- Update current record, indexed'
! 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.

GLOBAL ROUTINE updudr (recdesc, databd) =
    BEGIN

%IF indx
%THEN
    argument (recdesc, baseadd);		! RECORD DESCRIPTOR
    argument (databd, baseadd);			! BUCKET DESCRIPTOR

    MAP
	recdesc : pointer,
	databd : pointer;

    LOCAL
	newrecordptr : pointer,			! PTR TO USER'S NEW UPDATED RECORD
	oldrecordptr : pointer;			! 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];		! GET USER'S BUFFER ADDRES
    oldrecordptr = .recdesc [rdrecptr] + .kdb [kdbhsz];
    !
    !   MOVE THE RECORD DATA
    !
    movewords (.newrecordptr, 			! FROM
	.oldrecordptr, 				! TO
	.rst [rstrszw]);			! SIZE
    !
    !   WRITE OUT THE CURRENT BUCKET TO THE FILE
    !

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

    goodreturn
%FI

    END;					! OF UPDUDR

END

ELUDOM