Trailing-Edge
-
PDP-10 Archives
-
BB-JF18A-BM
-
sources/rms/rmsdel.b36
There are 6 other files named rmsdel.b36 in the archive. Click here to see a list.
%TITLE 'D E L E T E -- $DELETE processor'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE delete (IDENT = '3.0'
) =
BEGIN
!
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1984, 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.
!
!++
! FACILITY: RMS
!
! ABSTRACT:
!
! DELETE contains all routines which
! process the $DELETE macro in RMS-20.
!
! ENVIRONMENT: User mode, interrupts deferred until JSYS return.
!
! AUTHOR: Ron Lusk , CREATION DATE: 16-Mar-83
!
! MODIFIED BY:
!
! , : VERSION
! 01 - Remote $Delete code
!--
!
! TABLE OF CONTENTS
!
!
! $DELETE - Dispatcher for $DELETE macro
! DELSQR - Process $DELETE for SEQ/REL files
! CHECKRP - Check file position, record locking
! DELIDX - Process $DELETE for indexed files
! DODELIDX - Perform the work for indexed files
! DELUDR - Compress a primary data record and RRV
!
!
! INCLUDE FILES:
!
REQUIRE 'rmsreq';
!
! MACROS:
!
! None.
!
! EQUATED SYMBOLS:
!
GLOBAL BIND
delev = 2^24 + 0^18 + 400; ! Module version number
!
! OWN STORAGE:
!
! None.
!
! EXTERNAL REFERENCES:
EXTERNAL ROUTINE
Dap$Delete;
%SBTTL '$DELETE - record deletion dispatcher'
GLOBAL ROUTINE $delete (rabblock, errorreturn) =
!++
! FUNCTIONAL DESCRIPTION:
!
! $DELETE always operates on the record designated by
! the CURRENT-RECORD. This is the record indicated by
! the DATARFA field in the Record Status Table, and
! residing in the current bucket.
!
! FORMAL PARAMETERS
!
! RABLOCK - User's Record Access Block
! ISI - Internal Stream Identifier, points
! to Record Status Table
! ROP - Record Options
! FDL - Fast Delete (indexed files only)
! STS - Status information (returned)
! STV - Additional status information
!
! ERRORRETURN - Address of user's error routine
!
! IMPLICIT INPUTS
!
! ?
!
! ROUTINE VALUE:
!
! None, yet not NOVALUE.
!
! SIDE EFFECTS:
!
! ?
!
!--
BEGIN
rmsentry ($delete);
!
! Fetch the user's RAB and error address.
!
rab = .rabblock; ! Get RAB address
erradr = .errorreturn; ! And user error address
rsetup (axdel); ! Set up world
IF .Fst[Fst$v_Remote]
THEN
BEGIN
Dap$Delete( .Rab, .erradr );
UsrRet();
END;
!
! Make sure the file is positioned and is a disk file.
!
checkrp ();
!+
! Dispatch to the proper routine for each file organization.
!-
CASE fileorg FROM 0 TO 3 OF
SET
[orgasc] :
usererror (er$iop); ! ASCII - Bad operation
[orgseq] :
delsqr (); ! Sequential files
[orgrel] :
delsqr (); ! Relative files
[orgidx] :
delidx (); ! Indexed files
TES;
!
! The $DELETE was performed successfully. All locking or
! unlocking was performed in the appropriate routine.
!
setsuccess;
usrret () ! ***Exit to user***
END; ! End of $DELETE
%SBTTL 'DELSQR -- delete SEQ/REL record'
GLOBAL ROUTINE delsqr : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! 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
!
! FORMAL PARAMETERS
!
! None.
!
! IMPLICIT INPUTS
!
! ?
!
! ROUTINE VALUE:
!
! None: (if there is an error during processing of
! the $DELETE, this routine will exit directly
! to the user).
!
! SIDE EFFECTS:
!
! None.
!
!--
BEGIN
LOCAL
temp, ! Temporary storage
filepointer : REF BLOCK, ! Pointer 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 = numbertorfa (.crp)) EQL false THEN usererror (er$rfa)
END;
!
! Position file to desired record. It could
! be out of position if the record
! spanned a page boundary.
!
gtbyte (.bytenum, ! Byte
false); ! Flag
!
! 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) NEQ 0 THEN rmsbug (msgflags);
%FI
filepointer [wholeword] = ! Store the header back again
.header OR (rhdrdelete);
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; ! End of DELSQR
%SBTTL 'CHECKRP -- Check file and record'
GLOBAL ROUTINE checkrp : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! CHECKRP is called by both the $DELETE and $UPDATE
! processors. Its function is to make sure that the
! file is positioned and the current record is locked
! (if the file is being shared).
!
! FORMAL PARAMETERS
!
! None.
!
! IMPLICIT INPUTS
!
! ?
!
! ROUTINE VALUE:
!
! None.
!
! SIDE EFFECTS:
!
! ?
!
!--
BEGIN
!+
! File must reside on a DASD (disk device).
!-
IF NOT dasd THEN usererror (er$dev);
!+
! Check that the last operation was a $FIND or a $GET.
!-
IF (.rst [rstlastoper] NEQ c$find) AND !
(.rst [rstlastoper] NEQ c$get) !
THEN
usererror (er$cur);
RETURN
END; ! End of CHECKRP
%SBTTL 'DELIDX -- delete indexed record'
GLOBAL ROUTINE delidx : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! DELIDX processes 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 must be in the PAGPTR field in the Record
! Status Table. 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 compressed 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.
!
! On an error, this routine exits directly to the
! user.
!
! 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.
!
! FORMAL PARAMETERS
!
! None.
!
! IMPLICIT INPUTS
!
! ?
!
! ROUTINE VALUE:
!
! None.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
LOCAL
databd : BLOCK [bdsize], ! Descriptor for current bucket
recdesc : BLOCK [rdsize], ! Record descriptor packet
savedstatus, ! Save the results here
updateflag; ! Flag for updating 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 "horizontal-search" flag so we will
! go through the secondary index properly.
!
recdesc [rdflags] = rdflghorizok; ! Horizontal search is OK
recdesc [rdstatus] = 0; ! Clear status
recdesc [rdrecptr] = .rst [rstpagptr];
kdb = .fst [fstkdb]; ! Use primary key
savedstatus = dodelidx (recdesc, ! Record descriptor
databd); ! Bucket descriptor
!+
! If SAVEDSTATUS is true, then we will
! eventually update the bucket to disk.
!-
IF .savedstatus NEQ false ! Delete OK so far
THEN
setbfdupd (cbd [bkdbfdadr]);
IF writebehind OR (.savedstatus EQL false) ! Do output now?
THEN
updateflag = false ! No
ELSE
updateflag = true; ! Yes, write it out
!
! Release the current bucket.
!
putbkt (.updateflag, databd);
!+
! We now must unlock the file if it was locked.
!-
IF indexlocked !
THEN
unlockindex;
IF .savedstatus EQL false THEN usrret (); ! Exit on error
RETURN
END; ! End of DELIDX
%SBTTL 'DODELIDX -- delete indexed record'
GLOBAL ROUTINE dodelidx (recdesc : REF BLOCK, databd : REF BLOCK) =
!++
! FUNCTIONAL DESCRIPTION:
!
! DODELIDX performs the actual deletion of the current
! record in an indexed file. This routine is called
! only by DELIDX.
!
! This routine will never release the current bucket.
!
! If any unexpected error occurs (e.g., RRV was not
! found), then an undefined file condition is set and
! processing continues.
!
! On input the KDB must be set up for primary key.
!
! No compression is done during a $DELETE. All
! compression is done on a $PUT.
!
! FORMAL PARAMETERS
!
! RECDESC - Record descriptor packet
! RECPTR - address of current record
! FLAGS - FLGHORIZOK is referenced
! STATUS - <null>
!
! DATABD - Bucket descriptor of current bucket.
!
! IMPLICIT INPUTS
!
! None.
!
! ROUTINE VALUE:
!
! TRUE - Deletion was successful
! FALSE - Error
! Could not delete a SIDR
!
! SIDE EFFECTS:
!
! NONE.
!
!--
BEGIN
LOCAL
nocompressflag, ! Flag for compression of UDR
sizeofcurentrcd, ! Current record size
ptrtodata : REF BLOCK, ! Data portion of UDR
rfatosearchfor; ! RFA of current record
REGISTER
recordptr : REF BLOCK; ! Current record pointer
EXTERNAL
tbuffer; ! Buffer for key
TRACE ('DODELIDX');
!
! Set up a pointer 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) NEQ 0) !
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 key
UNTIL .kdb EQL 0 DO
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) EQL false !
THEN
returnstatus (er$edq)
END;
!
! Move the key string.
!
movekey (.ptrtodata, ! From record
tbuffer); ! To buffer
!
! Set up the address of this key string.
!
recdesc [rduserptr] = tbuffer;
recdesc [rdusersize] = .kdb [kdbksz];
!+
! If there was an error, we will set the
! "no-compress" flag because we don't
! know what went wrong.
!-
IF delsidr (.recdesc) EQL false !
THEN
nocompressflag = true
END;
!
! We have finished processing the current
! key...move to next one.
!
kdb = .kdb [kdbnxt]
END;
!+
! We have now deleted the SIDRs 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.
!-
kdb = .fst [fstkdb]; ! Set up for primary key.
!
! Set the deleted bit in the data record.
!
setupd (databd); ! Indicate that this bucket
! is being updated.
setflag (recordptr [drflags], flgdelete);
!+
! For duplicates in the primary index, or on an
! error, don't allow compression.
!-
IF (duplicates) OR (.nocompressflag NEQ 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 duplicates
! 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.
! [This is not done as of March 83 -- RL]
!-
!+
! Should we return success or failure?
!-
IF .nocompressflag NEQ false THEN RETURN false;
RETURN true; ! Return without compression
END; ! End of DODELIDX
%SBTTL 'DELUDR -- squeeze UDR and its RRV'
GLOBAL ROUTINE deludr (recdesc : REF BLOCK, databd : REF BLOCK) =
!++
! FUNCTIONAL DESCRIPTION:
!
! DELUDR squeezes 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 (e.g.,
! improperly duplicated 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 not on the algorithm and why it was chosen migh be
! useful at this point. Since we know the RRVs 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 ther are no indices which point to
! this RRV, leaving it in the bucket is needless waste
! of space. Therfore, we will compress it out of the
! bucket now. [From original source -- RL, March '83]
!
! The KDB must be set up for the primary key.
!
! FORMAL PARAMETERS
!
! RECDESC - Record descriptor packet
! RECPTR - address of current record
! LENGTH - size (in words) of current record
! (including header)
! DATABD - Bucket descriptor of current record.
!
! IMPLICIT INPUTS
!
! ?
!
! ROUTINE VALUE:
!
! TRUE - Record squeezed out of bucket.
! FALSE - Error
! Could not find RRV (file consistency
! problem)
!
! SIDE EFFECTS:
!
! ?
!
!--
BEGIN
REGISTER
recordptr : REF BLOCK, ! Pointer to current record
tempac; ! AC used for BLT
LOCAL
bucketptr : REF BLOCK, ! Pointer to top of bucket
endptr : REF BLOCK, ! Pointer to end of bucket
rrvbd : BLOCK [bdsize], ! Descriptor for RRV bucket
amounttomove, ! Size of chunk to move
endofrecordptr : REF BLOCK, ! End of current record
sizeofcurentrcd, ! Current record size
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 it is exercised only when a secondary key insert
! aborts and the new record caused a bucket split.
! Consequently, I'm no-oping it.
!
! [This note came from some developer of ages past --
! there is indeed a need for code of this nature, since a
! fairly serious bug appeared when a secondary key insert
! aborted and a bucket split had already occurred. But as
! of March 1983, this code was still "conditioned" out.
! - RL]
!--
IF bucketofrfa (.rrvaddress) EQL 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) EQL false THEN returnstatus (er$edq)
END;
!+
! We must squeeze out the RRV too.
!-
rtrace (%STRING (' Squeezing the RRV...', %CHAR (13, 10)));
recdesc [rdrfa] = .rrvaddress;
recdesc [rdrecptr] = 0; ! Make sure we start at top
IF fbyrfa (.recdesc, ! Record descriptor
rrvbd, ! Bucket descriptor
false) EQL false ! Nolock
THEN
BEGIN ! We couldn't find the RRV
rtrace (%STRING ('***Couldn''t get RRV...', %CHAR (13, 10)));
fileproblem (er$rrv);
RETURN false;
END;
!+
! Get the address of the RRV and its bucket.
!-
recordptr = .recdesc [rdrecptr];
bucketptr = .rrvbd [bkdbktadr];
amounttomove = !
.bucketptr + .bucketptr [bhnextbyte] !
- .recordptr - rrvrecsize; !
lookat (' RRV bucket-pointer: ', bucketptr);
lookat (' Amount to move: ', amounttomove);
!+
! Is the RRV at the bottom of the bucket?
!-
IF .amounttomove NEQ 0
THEN
movewords ( !
.recordptr + rrvrecsize, ! From
.recordptr, ! To
.amounttomove); ! Size
!
! Update the bucket header information.
!
bucketptr [bhnextbyte] = .bucketptr [bhnextbyte] - rrvrecsize;
!
! Release the RRV bucket and update it.
!
putbkt (true, ! No update
rrvbd) ! Bucket
END;
%FI ! End removed code
!+
! Now, squeeze out the primary data record.
!-
sizeofcurentrcd = .recdesc [rdlength];
endofrecordptr = .recordptr + .sizeofcurentrcd;
amounttomove = .endptr - .endofrecordptr;
lookat (' Squeezing record at: ', recordptr);
lookat (' Amount to move: ', amounttomove);
lookat (' End of bucket: ', endptr);
IF .amounttomove NEQ 0
THEN
movewords (.endofrecordptr, ! From
.recordptr, ! To
.amounttomove); ! Size
!
! Adjust the bucket header information.
!
bucketptr [bhnextbyte] = .bucketptr [bhnextbyte] - .sizeofcurentrcd;
RETURN true;
END; ! End of DELUDR
END ! End of Module DELETE
ELUDOM