Trailing-Edge
-
PDP-10 Archives
-
BB-H138F-BM_1988
-
7-sources/rmsudr.b36
There are 11 other files named rmsudr.b36 in the archive. Click here to see a list.
%TITLE 'U D R -- User Data Record routines'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE udr (IDENT = '2.0'
) =
BEGIN
GLOBAL BIND
udrv = 2^24 + 0^18 + 442; ! Edit date: 13-Dec-83
!+
!
!
! FUNCTION: THIS MODULE CONTAINS ROUTINES WHICH PROCESS
! USER DATA RECORDS WITHIN AN RMS-20 INDEXED FILE.
! AUTHOR: S. BLOUNT
!
!
! 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.
!
!
!
!
! ********** 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 *
! * *
! *************************************************
!
! PRODUCT MODULE SPR
! EDIT EDIT QAR DESCRIPTION
! ====== ====== ===== ===========
!
!
! ***** END OF REVISION HISTORY *****
!
! ***** BEGIN VERSION 2 DEVELOPMENT *****
!
!
! PRODUCT MODULE SPR
! EDIT EDIT QAR DESCRIPTION
! ====== ====== ===== ===========
!
! 301 300 XXXXX SUPPORT EXTENDED ADDRESSING.
!
! 400 400 xxxxx Clean up BLISS code (RL,22-Apr-83)
!
! 442 - 345002 When RMS attempts to write a
! record immediately before a deleted
! record with a different key, CHKDUP
! may erroneously set the duplicate
! flag in the record descriptor, thus
! initiating all manner of spurious
! processing (done on the assumption
! that this is really a duplicate of
! the deleted record).
! This bug appeared in a three-way
! split where SPLIT assumed that the
! new record was a duplicate of an
! existing record, and so did not
! create an index entry for the new
! bucket.
!
!
!-
REQUIRE 'rmsreq';
%SBTTL 'MAKEUDR - create UDR'
GLOBAL ROUTINE makeudr (recdesc, userrecordptr) : NOVALUE =
! 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)
BEGIN
REGISTER
recordptr, ! POINTER TO THE DATA RECORD
recordrfa; ! RFA OF NEW RECORD
MAP
recdesc : REF BLOCK,
userrecordptr : REF BLOCK,
recordptr : REF BLOCK;
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
THEN ! Store size of this record
BEGIN
recordptr [drrecsize] = .rst [rstrsz];
recordptr [drreserved] = 0; ! Just for safety
recordptr = .recordptr + 1; ! Bump to data
END;
!+
! Move pointer to the record data
!-
recordptr = .recordptr + fixhdrsize;
!+
! Move the user record into the file
!-
IF .rmssec NEQ 0
THEN
xcopy (.userrecordptr, ! From
.recordptr, ! To
.rst [rstrszw]) ! Size
ELSE
movewords (.userrecordptr, ! From
.recordptr, ! To
.rst [rstrszw]); ! Size
RETURN
END; ! End MAKEUDR
%SBTTL 'SDATABKT - search user data bucket'
GLOBAL ROUTINE sdatabkt (recdesc, bktdesc) =
! 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 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
BEGIN
MAP
recdesc : REF BLOCK,
bktdesc : REF BLOCK;
REGISTER
movingptr : REF BLOCK,
searchid, ! ID OF RFA TO SEARCH FOR
searchrfa, ! ENTIRE RFA TO SEARCH FOR
tempac;
LOCAL
endptr : REF BLOCK, ! 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 : REF BLOCK; ! PTR TO DATA RECORD
TRACE ('SDATABKT');
!+
! SET UP FOR BUCKET SEARCH
!-
sidrflag = (stopatfirstflag = false);
IF .kdb [kdbref] NEQ 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] NEQ btypedata THEN RETURN false;
IF (movingptr = .recdesc [rdrecptr]) LEQ 0
THEN ! Start at top of bucket
BEGIN
IF .movingptr LSS 0 THEN stopatfirstflag = true;
movingptr = .endptr + bhhdrsize;
recdesc [rdrecptr] = (recdesc [rdlastrecptr] = .movingptr)
END;
!+
! 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);
RETURN false
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 ! Set some status bits and exit
BEGIN
IF .movingptr GTR .endptr THEN rmsbug (msginput);
setpastlastflag (recdesc);
RETURN false
END;
!+
! THIS IS MAIN SEARCH LOOP
!-
WHILE .movingptr LSS .endptr DO
BEGIN
recdesc [rdrecptr] = .movingptr; ! SET UP FINAL PTR NOW
IF .searchrfa NEQ nullid
THEN ! This is an ID search
BEGIN
!+
! IS THIS THE RIGHT ID?
!-
IF .searchid EQL .movingptr [drrecordid]
THEN ! Found it
BEGIN
lookat (' ID MATCH FOUND AT: ', movingptr);
IF chkflag (movingptr [drflags], flgdelete) NEQ 0
THEN
setflag (recdesc [rdstatus],
rdflgdelete);
RETURN true
END
END
ELSE ! This is a key search
BEGIN
!+
! IGNORE RRV RECORDS
!-
IF chkflag (movingptr [drflags], flgrrv) NEQ 0
THEN
BEGIN ! Exit because key not found
setpastlastflag (recdesc);
RETURN false;
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 NEQ 0 THEN ! It is a SIDR
ckeykk (.recdesc, .dataptr) ELSE ! It is user data record
ckeyku (.recdesc, .dataptr));
!+
! SHOULD WE GO ON?
!-
IF .savestatus EQL true
THEN
BEGIN ! Check for deleted records
! ...then exit
IF chkflag (movingptr [drflags], flgdelete) NEQ 0
THEN
setflag (recdesc [rdstatus],
rdflgdelete);
RETURN true
END;
!+
! EXIT FOR FIRST-ONLY SEARCH
!-
IF .stopatfirstflag NEQ false THEN RETURN .savestatus
END;
!+
! WE DIDN'T FIND THE RECORD, SKIP OVER IT
!-
recdesc [rdlastrecptr] = .movingptr; ! SAVE LAST RECORD
movingptr = .movingptr + sizeofanyrecord (movingptr)
END;
!+
! WE DID NOT FIND THE RECORD
!-
recdesc [rdrecptr] = .movingptr; ! RESTORE POINTER
setpastlastflag (recdesc); ! REMEMBER WE WENT TOO FAR
RETURN false
END; ! End SDATABKT
%SBTTL 'INSRTUDR - insert UDR into bucket'
GLOBAL ROUTINE insrtudr ( !
recdesc : REF BLOCK, !
userrecordptr : REF BLOCK, !
databd : REF BLOCK, !
splitbd1 : REF BLOCK, !
splitbd2 : REF BLOCK) = !
! 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.
!
BEGIN
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 : REF BLOCK, ! PTR TO LAST RECORD IN ORIGINAL BKT
tempptr : REF BLOCK, ! TEMPORARY PTR VARIABLE
windowpage;
REGISTER
bktptr : REF BLOCK;
TRACE ('INSRTUDR');
!+
! CHECK INPUT VALUES
!-
exitflag = false; ! INIT VALUES
loopcount = 0;
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 EQL false DO
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, 0], roploa) NEQ 0
THEN ! Check if bucket is "filled"
BEGIN
minfreespace = (.bucketsize^b2w) - .kdb [kdbdfloffset];
IF .minfreespace GEQ .freespace THEN freespace = 0; ! FORCE A SPLIT
END;
!+
! LET'S SEE THESE VALUES
!-
lookat (' BKTPTR: ', bktptr);
lookat (' FREESPACE: ', freespace);
!+
! CHECK TO SEE IF IT'LL FIT
!-
IF .newrecordsize LEQ .freespace
THEN
BEGIN ! 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 0 THEN rmsbug (msgcount);
!+
! IF THIS ISNT THE LAST RECORD IN THE BUCKET
! THEN WE NEED TO MOVE SOME RECORDS DOWN
!-
IF .amounttomove NEQ 0
THEN
BEGIN ! Move records down
rtrace (%STRING (' MOVING RECORDS DOWN ', %CHAR (13), %CHAR (10)));
movedown (.insertptr, ! Start
.nextfreeword - 1, ! End
.newrecordsize); ! Size
END;
!+
! ALLOCATE A NEW RFA FOR THIS RECORD
!-
recdesc [rdrfa] = alcrfa (.databd);
!+
! CREATE THE RECORD
!-
makeudr (.recdesc, ! Rec desc
.userrecordptr); ! UDR ptr
!+
! 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
RETURN true
END;
!+
! 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 = 0; ! 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 EQL 0
THEN
BEGIN
!+
! COMPRESS THE BUCKET
!-
returnedspace = compress (.recdesc, .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
ELSE
rmsbug (msgloop); ! WE WENT THRU LOOP TWICE
END;
!+
! WE MUST NOW SPLIT THE BUCKET
!-
!+
! SET UP ARGS FOR SPLIT ROUTINE:
!-
recdesc [rdlength] = .newrecordsize; ! SIZE OF HOLE
IF split (.recdesc, ! Rec-desc
.databd, ! Old databd
.splitbd1, ! Used for split
.splitbd2) EQL false ! 3-bkt split
THEN ! Something very bad 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
!-
makeudr (.recdesc, ! Rec-desc
.userrecordptr); ! User record
!+
! 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];
movekey (.lastrecordptr, ! From UDR
.tempptr); ! To buffer
!+
! 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 updrrvs (.databd, ! Old bucket
.splitbd1) EQL false ! New bucket
!+
! 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) NEQ 0 THEN .databd ELSE .splitbd1);
!+
! ** END OF THE FIX. NOTE: ON THE CALL PUTBKT BELOW **
! ** '.TEMPPTR'IS USED INSTEAD OF '.SPLITBD1' **
!-
putbkt (false, ! No update
.tempptr); ! Bucket
!+
! WAS THIS A 3-BKT SPLIT?
!-
IF .recdesc [rdcount] GTR 1
THEN
BEGIN
putbkt (false, ! No update
.splitbd2); ! Bucket
!+
! 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) NEQ 0)
THEN ! Reset split count to 1
recdesc [rdcount] = 1
END;
RETURN true
END; ! End INSRTUDR
%SBTTL 'CHKDUP - check for duplicate records'
GLOBAL ROUTINE chkdup (recdesc, bktdesc) =
! 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.
!
BEGIN
LOCAL
rrv; ! SET FROM RDRRV, CALLER'S RRV
LOCAL
i; ! LOOP INDEX FOR SIDR ARRAY
MAP
recdesc : REF BLOCK,
bktdesc : REF BLOCK;
REGISTER
tempac;
REGISTER
movingptr : REF BLOCK; ! PTR TO SCAN DATA RECORDS
TRACE ('CHKDUP');
rrv = .recdesc [rdrrv]; !(SEE SIDR ARRAY LOOP)
!+
! DID WE FIND AN EXACT MATCH?
!-
tempac = .recdesc [rdstatus]; ! GET STATUS FLAGS
IF (chkflag (tempac, (rdflglss + rdflgpst)) NEQ 0) ! Not a match? !A442
! AND (chkflag (tempac, rdflgdelete) EQL 0) ! !D442
THEN ! No exact match..so exit
RETURN true;
!+
! 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)) NEQ 0) DO
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 [rdstatus], rdflgdelete) EQL 0
THEN
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) EQL 0
THEN ! No dups are allowed
returnstatus (er$dup)
END;
! 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?
THEN
IF chkflag (recdesc [rdstatus], rdflgretex) NEQ 0
THEN
BEGIN ! RMSUTL CALL
recdesc [rdsidrelement] = .i; ! TELL WHERE AT
RETURN false; ! 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 fndrec (.recdesc, ! Record
.bktdesc, ! Start
.bktdesc) EQL false ! End
THEN
rmsbug (msgfailure)
END;
RETURN true
END; ! End CHKDUP
END
ELUDOM