-- File: DBStorageImplB.mesa -- Last edited by: -- MBrown on December 3, 1982 12:05 pm -- Cattell on September 29, 1983 4:30 pm -- Willie-Sue on June 24, 1982 12:20 pm DIRECTORY Basics USING [LowHalf], DBCache USING [CacheHandle], DBCommon USING [DBPage], DBEnvironment, DBStats USING [Inc], DBSegment USING [AllocPage, FreePage, ObtainCoreLoc, ReadPage, WritePage, WriteLockedPage, UnlockPage, SegmentIDFromDBPage], DBStorage USING [FieldHandle, TuplesetHandle, MaxSystemTupleID, TupleHandle], DBStorageExtTuple USING [TupleBody], DBStorageField USING [CheckFieldHandleType, FieldOffset, NWordsInField, GroupIDOfField], DBStorageGroup USING [TIDFieldBody, TIDFieldPart, GroupList, GroupListEntry, HeadFieldPart], DBStoragePagetags USING [Tuple, SystemTuple, AssertPageIsAnyTuplePage, AssertPageIsOverflowTuplePage, OverflowTuple], DBStoragePrivate USING [TupleFromTID], DBStorageString USING [EString, IString, LString, SizeOfNullEString, SizeOfNullIString], DBStorageTID USING [TID, NullTID, TIDSlotMask, ConsTID, DecomposeTID], DBStorageTSDict USING [NEntries, TSDict, TSDictSlotIndex], DBStorageTuple USING [ConsTupleObject], DBStorageVec USING [TagOfPage, HighSlotIndexOfPage, SetTypeOfSlot, TypeOfSlot, VecOfSlot, LengthOfVec, VecPage, AllocVec, ModifyVec, FreeVec, WordsInLargestAllocableVec, InitializeVecPage], DBStorageVectags, DBTuplesConcrete USING [TupleObject], PrincOpsUtils USING [LongCOPY], Rope USING [ROPE, Fetch, Size, Text, NewText]; DBStorageImplB: PROGRAM IMPORTS Basics, DBEnvironment, DBSegment, DBStats, DBStorageField, DBStoragePagetags, DBStoragePrivate, DBStorageTID, DBStorageTSDict, DBStorageTuple, DBStorageVec, DBStorageVectags, PrincOpsUtils, Rope EXPORTS DBEnvironment, DBStorage, DBStorageGroup, DBStoragePrivate SHARES Rope = BEGIN OPEN DBCommon, DBEnvironment, DBStorageTID; -- This module exports part of DBStorage: field reading/writing, excluding groups. -- It exports low-level support procs to DBStorageGroup for group field reading/writing. -- PROBLEMS, THINGS YET TO BE DONE: -- This version allows no overflow of tuples, only strings. SizeMismatch: SIGNAL = CODE; DoChecks: BOOLEAN = TRUE; -- Type exported to DBTuplesOpaque (thence to DBStorage.) TupleObject: PUBLIC TYPE = DBTuplesConcrete.TupleObject; TupleHandle: TYPE = REF TupleObject; StoredTupleHandle: TYPE = REF TupleObject.stored; -- Public procedures: Read field ReadTupleset: PUBLIC PROC[x: TupleHandle] RETURNS[DBStorage.TuplesetHandle] = { -- Returns a tuple handle for the tuple representing x's tupleset. xs: StoredTupleHandle = NARROW[x]; tsh: TupleHandle; dbPage: DBCommon.DBPage; dbPagePtr: LONG POINTER; s: CARDINAL; systemTuple: BOOLEAN; DBStats.Inc[StorageReadTupleset]; BEGIN--read in the page containing x [dbPage, s] _ DecomposeTID[xs.tid]; -- s is now the slot index of tuple x [xs.cacheHint, dbPagePtr] _ DBSegment.ReadPage[dbPage, xs.cacheHint]; END; -- Always check the page tag before doing an access... SELECT DBStorageVec.TagOfPage[LOOPHOLE[dbPagePtr]] FROM DBStoragePagetags.Tuple => systemTuple _ FALSE; DBStoragePagetags.SystemTuple => systemTuple _ TRUE; ENDCASE => ERROR DBEnvironment.InternalError; -- [BadPageTag]; s _ DBStorageVec.TypeOfSlot[dbPagePtr, s]; -- s is now the "local tuplesetID" of tuple x BEGIN--do the lookup in the tupleset dictionary tsDict: LONG POINTER TO DBStorageTSDict.TSDict _ LOOPHOLE[DBStorageVec.VecOfSlot[dbPagePtr, DBStorageTSDict.TSDictSlotIndex]]; IF DoChecks AND s NOT IN [1..DBStorageTSDict.NEntries[tsDict]] THEN ERROR DBEnvironment.InternalError; -- [BadVecTag]; -- when indirect tuples are allowed, this must change to look in the indirect --tuple for the local tuplesetID. tsh _ IF systemTuple THEN DBStoragePrivate.TupleFromTID[tsDict.seq[s].tuplesetID] ELSE DBStorageTuple.ConsTupleObject[tid: tsDict.seq[s].tuplesetID, cacheHint: NIL]; END; DBSegment.UnlockPage[xs.cacheHint]; RETURN[tsh]; };--ReadTupleset Read1Word: PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle] RETURNS[CARDINAL] = { tupleBase: LONG POINTER TO DBStorageExtTuple.TupleBody; cacheHint: DBCache.CacheHandle; result: CARDINAL; DBStats.Inc[StorageReadField]; [tupleBase,cacheHint] _ ReadableTupleBase[x]; DBStorageField.CheckFieldHandleType[f, OneWord]; CheckFieldAccess[tupleBase, f]; result _ ReadCardinal[tupleBase + DBStorageField.FieldOffset[f]]; DBSegment.UnlockPage[cacheHint]; RETURN[result]; };--Read1Word Read2Word: PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle] RETURNS [LONG CARDINAL] = { tupleBase: LONG POINTER TO DBStorageExtTuple.TupleBody; cacheHint: DBCache.CacheHandle; result: LONG CARDINAL; DBStats.Inc[StorageReadField]; [tupleBase,cacheHint] _ ReadableTupleBase[x]; DBStorageField.CheckFieldHandleType[f, TwoWord]; CheckFieldAccess[tupleBase, f]; result _ ReadLongCardinal[tupleBase + DBStorageField.FieldOffset[f]]; DBSegment.UnlockPage[cacheHint]; RETURN[result]; };--Read2Word ReadNWord: PUBLIC PROC[ x: TupleHandle, f: DBStorage.FieldHandle, space: REF ANY] = { -- Returns an n-word record, where n is encoded in f, storing it into the locations -- space..space+n-1 (beware!). tupleBase: LONG POINTER TO DBStorageExtTuple.TupleBody; cacheHint: DBCache.CacheHandle; DBStats.Inc[StorageReadField]; [tupleBase, cacheHint] _ ReadableTupleBase[x]; DBStorageField.CheckFieldHandleType[f, NWord]; CheckFieldAccess[tupleBase, f]; ReadRecord[tupleBase+DBStorageField.FieldOffset[f], DBStorageField.NWordsInField[f], space]; DBSegment.UnlockPage[cacheHint]; };--ReadNWord GetNWordBase: PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle] RETURNS[LONG POINTER, DBCache.CacheHandle] = { -- EXPORTed to DBStoragePrivate. tupleBase: LONG POINTER TO DBStorageExtTuple.TupleBody; cacheHint: DBCache.CacheHandle; DBStats.Inc[StorageReadField]; [tupleBase,cacheHint] _ ReadableTupleBase[x]; DBStorageField.CheckFieldHandleType[f, NWord]; CheckFieldAccess[tupleBase, f]; RETURN[tupleBase + DBStorageField.FieldOffset[f], cacheHint]; };--GetNWordBase ReadVarByte: PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle] RETURNS[Rope.ROPE] = { tupleBase: LONG POINTER TO DBStorageExtTuple.TupleBody; cacheHint: DBCache.CacheHandle; dbPage: DBPage; pagePtr: LONG POINTER TO DBStorageVec.VecPage; result: Rope.ROPE; DBStats.Inc[StorageReadField]; [tupleBase,cacheHint] _ ReadableTupleBase[x]; --temporary crock [dbPage,] _ DecomposeTID[x.tid]; pagePtr _ DBSegment.ObtainCoreLoc[dbPage, cacheHint]; DBStorageField.CheckFieldHandleType[f, VarByte]; CheckFieldAccess[tupleBase, f]; result _ ReadString[pagePtr, LOOPHOLE[tupleBase + DBStorageField.FieldOffset[f]], DBStorageField.NWordsInField[f]]; DBSegment.UnlockPage[cacheHint]; RETURN[result]; };--ReadVarByte -- Public procedures: Write field Write1Word: PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle, val: CARDINAL] = { tupleBase: LONG POINTER TO DBStorageExtTuple.TupleBody; cacheHint: DBCache.CacheHandle; DBStats.Inc[StorageWriteField]; [tupleBase,cacheHint] _ ReadableTupleBase[x]; DBSegment.WriteLockedPage[cacheHint]; DBStorageField.CheckFieldHandleType[f, OneWord]; CheckFieldAccess[tupleBase, f]; WriteCardinal[tupleBase + DBStorageField.FieldOffset[f], val]; DBSegment.UnlockPage[cacheHint]; };--Write1Word Write2Word: PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle, val: LONG CARDINAL] = { tupleBase: LONG POINTER TO DBStorageExtTuple.TupleBody; cacheHint: DBCache.CacheHandle; DBStats.Inc[StorageWriteField]; [tupleBase,cacheHint] _ ReadableTupleBase[x]; DBSegment.WriteLockedPage[cacheHint]; DBStorageField.CheckFieldHandleType[f, TwoWord]; CheckFieldAccess[tupleBase, f]; WriteLongCardinal[tupleBase + DBStorageField.FieldOffset[f], val]; DBSegment.UnlockPage[cacheHint]; };--Write2Word WriteNWord: PUBLIC PROC [ x: TupleHandle, f: DBStorage.FieldHandle, val: REF ANY] = { -- Last parm points to an n-word record, where n is encoded in f. tupleBase: LONG POINTER TO DBStorageExtTuple.TupleBody; cacheHint: DBCache.CacheHandle; DBStats.Inc[StorageWriteField]; [tupleBase,cacheHint] _ ReadableTupleBase[x]; DBSegment.WriteLockedPage[cacheHint]; DBStorageField.CheckFieldHandleType[f, NWord]; CheckFieldAccess[tupleBase, f]; WriteRecord[tupleBase + DBStorageField.FieldOffset[f], DBStorageField.NWordsInField[f], val]; DBSegment.UnlockPage[cacheHint]; };--WriteNWord WriteVarByte: PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle, val: Rope.ROPE] = { tupleBase: LONG POINTER TO DBStorageExtTuple.TupleBody; cacheHint: DBCache.CacheHandle; dbPage: DBPage; slot: CARDINAL; pagePtr: LONG POINTER TO DBStorageVec.VecPage; DBStats.Inc[StorageWriteField]; [tupleBase,cacheHint] _ ReadableTupleBase[x]; --temporary crock [dbPage, slot] _ DecomposeTID[x.tid]; pagePtr _ DBSegment.ObtainCoreLoc[dbPage, cacheHint]; DBSegment.WriteLockedPage[cacheHint]; DBStorageField.CheckFieldHandleType[f, VarByte]; CheckFieldAccess[tupleBase, f]; WriteString[dbPage, pagePtr, slot, DBStorageField.FieldOffset[f], DBStorageField.NWordsInField[f], val]; DBSegment.UnlockPage[cacheHint]; };--WriteVarByte -- Primitives for the above ReadableTupleBase: PROC[x: TupleHandle] RETURNS[--tupleBase-- LONG POINTER TO DBStorageExtTuple.TupleBody, -- cacheHint-- DBCache.CacheHandle] = { -- Returns tupleBase, a pointer to the body of tuple x (in the cache, locked --readonly), and cacheHint, a CacheHandle for the page containing this pointer (so --that the page can be unlocked once data has been read from the tuple). Has --the side effect of updating the CacheHandle in x. -- Intended for use only on real tuples (checks for slot type in range). -- Called from: Read1Word, Read2Word, ReadNWord, ReadVarWord, ReadVarByte. xs: StoredTupleHandle = NARROW[x]; dbPage: DBCommon.DBPage; dbPagePtr: LONG POINTER; slotIndex: CARDINAL; slotType: CARDINAL; [dbPage, slotIndex] _ DecomposeTID[xs.tid]; [xs.cacheHint, dbPagePtr] _ DBSegment.ReadPage[dbPage, xs.cacheHint]; -- we always check the page tag before doing an access... DBStoragePagetags.AssertPageIsAnyTuplePage[dbPagePtr]; slotType _ DBStorageVec.TypeOfSlot[dbPagePtr, slotIndex]; SELECT slotType FROM IN [1..DBStorageVectags.MaxTuplesetPerPage] => BEGIN RETURN[LOOPHOLE[DBStorageVec.VecOfSlot[dbPagePtr, slotIndex]], xs.cacheHint]; END; DBStorageVectags.IndTupleType => BEGIN ERROR DBEnvironment.InternalError; -- [Unknown]; END; ENDCASE => ERROR DBEnvironment.InternalError; -- [BadVecTag]; };--ReadableTupleBase CheckFieldAccess: PROC [t: LONG POINTER TO DBStorageExtTuple.TupleBody, f: DBStorage.FieldHandle] = { -- Complains if an access to field f will extend past the end of the tuple t's field --data area. IF DBStorageField.FieldOffset[f] + DBStorageField.NWordsInField[f] > t.groupOffset THEN ERROR DBEnvironment.InternalError; -- [BadFieldHandle]; };--CheckFieldAccess ReadCardinal: PROC[p: LONG POINTER] RETURNS[CARDINAL] = --INLINE-- { RETURN[LOOPHOLE[p,LONG POINTER TO CARDINAL]^]; };--ReadCardinal WriteCardinal: PROC[p: LONG POINTER, v: CARDINAL] = --INLINE-- { LOOPHOLE[p,LONG POINTER TO CARDINAL]^ _ v; };--WriteCardinal ReadLongCardinal: PROC[p: LONG POINTER] RETURNS[LONG CARDINAL] = --INLINE-- { RETURN[LOOPHOLE[p,LONG POINTER TO LONG CARDINAL]^]; };--ReadLongCardinal WriteLongCardinal: PROC[p: LONG POINTER, v: LONG CARDINAL] = --INLINE-- { LOOPHOLE[p,LONG POINTER TO LONG CARDINAL]^ _ v; };--WriteLongCardinal ReadRecord: PROC [ p: LONG POINTER, nWords: CARDINAL, space: REF ANY] = { --IF AMTypes.TVSize[AMBridge.TVForReferent[space]]#nWords THEN SIGNAL SizeMismatch; PrincOpsUtils.LongCOPY[from: p, nwords: nWords, to: LOOPHOLE[space]]; }; WriteRecord: PROC [ p: LONG POINTER, nWords: CARDINAL, r: REF ANY] = { PrincOpsUtils.LongCOPY[from: LOOPHOLE[r], nwords: nWords, to: p]; }; WordsForString: PROC[nChars: CARDINAL] RETURNS[CARDINAL] = INLINE { RETURN[(nChars+1)/2] }; ReadString: PROC[pagePtr: LONG POINTER TO DBStorageVec.VecPage, p: LONG POINTER TO DBStorageString.IString, nWords: CARDINAL] RETURNS[Rope.ROPE] = { -- Here nWords refers to the length of the VarByte field being read result: Rope.Text; wordsForBasicsString: CARDINAL _ WordsForString[p.bytesInString]; IF DoChecks AND DBStorageString.SizeOfNullIString + wordsForBasicsString > nWords THEN ERROR DBEnvironment.InternalError;--p.bytesInString and field handle are inconsistent IF p.slotOfExtension = 0 THEN { --handle simple inline string result _ Rope.NewText[p.bytesInString]; PrincOpsUtils.LongCOPY[from: @p.words[0], nwords: wordsForBasicsString, to: LOOPHOLE[result, LONG POINTER] + SIZE[TEXT[0]]]; } ELSE {--handle "long string" -- Allocate storage for whole result and copy in the initial portion lString: LONG POINTER TO DBStorageString.LString; totalWordsForString: CARDINAL; IF DoChecks AND p.bytesInString # 2*(nWords - DBStorageString.SizeOfNullIString) THEN ERROR InternalError; -- TrashedPage, extension used only if inline space is full IF DoChecks AND DBStorageVec.TypeOfSlot[pagePtr, p.slotOfExtension] # DBStorageVectags.LString THEN ERROR InternalError; --slot type inconsistent lString _ LOOPHOLE[DBStorageVec.VecOfSlot[pagePtr, p.slotOfExtension]]; totalWordsForString _ wordsForBasicsString + WordsForString[lString.bytesInRemString]; result _ Rope.NewText[p.bytesInString + lString.bytesInRemString]; PrincOpsUtils.LongCOPY[from: @p.words[0], nwords: wordsForBasicsString, to: LOOPHOLE[result, LONG POINTER] + SIZE[TEXT[0]]]; ReadBigString[eStringID: lString.eStringID, copyTo: LOOPHOLE[result, LONG POINTER] + SIZE[TEXT[0]] + wordsForBasicsString, wordsToCopy: totalWordsForString - wordsForBasicsString]; }; RETURN[result]; }; ReadBigString: PROC[eStringID: TID, copyTo: LONG POINTER, wordsToCopy: CARDINAL] = { -- Called from: ReadString. wordsCopied: CARDINAL _ 0; WHILE eStringID # NullTID DO wordsForCurrentText: CARDINAL; sPagePtr: LONG POINTER TO DBStorageVec.VecPage; sCacheHdl: DBCache.CacheHandle; sDBPage: DBPage; slotIndex: CARDINAL; eString: LONG POINTER TO DBStorageString.EString; [sDBPage, slotIndex] _ DecomposeTID[eStringID]; [sCacheHdl, sPagePtr] _ DBSegment.ReadPage[sDBPage, NIL]; IF DBStorageVec.TypeOfSlot[sPagePtr, slotIndex] # DBStorageVectags.EString THEN ERROR DBEnvironment.InternalError; --slot type inconsistent eString _ LOOPHOLE[DBStorageVec.VecOfSlot[sPagePtr, slotIndex]]; wordsForCurrentText _ eString.header.length - DBStorageString.SizeOfNullEString; IF wordsToCopy < (wordsCopied + wordsForCurrentText) THEN ERROR DBEnvironment.InternalError; --string length inconsistent PrincOpsUtils.LongCOPY[from: @eString.words[0], nwords: wordsForCurrentText, to: copyTo + wordsCopied]; wordsCopied _ wordsCopied + wordsForCurrentText; eStringID _ eString.eStringID; DBSegment.UnlockPage[sCacheHdl]; ENDLOOP; IF wordsToCopy # wordsCopied THEN ERROR DBEnvironment.InternalError; --string length inconsistent };--ReadBigString CardinalFromLongInteger: PROC [i: LONG INTEGER] RETURNS [CARDINAL] = INLINE { IF i < 0 OR i > LAST[CARDINAL] THEN ERROR; RETURN [Basics.LowHalf[i]] }; WriteString: PROC[dbPage: DBPage, pagePtr: LONG POINTER TO DBStorageVec.VecPage, iStringSlot: CARDINAL, iStringOffset: CARDINAL, nWords: CARDINAL, s: Rope.ROPE] = { -- here nWords refers to the length of the VarByte field being written. --note that page pagePtr is write-locked in the cache. p: LONG POINTER TO DBStorageString.IString _ LOOPHOLE[DBStorageVec.VecOfSlot[pagePtr, iStringSlot] + iStringOffset]; bytesInS: CARDINAL = CardinalFromLongInteger[s.Size[]]; totalWordsForString: CARDINAL _ WordsForString[bytesInS]; -- get rid of extension, if any IF p.slotOfExtension # 0 THEN FreeBigString[pagePtr, p.slotOfExtension]; IF SIZE[DBStorageString.IString] + totalWordsForString <= nWords THEN { -- string fits into body of tuple, just copy it in p^ _ [bytesInString: bytesInS, slotOfExtension: 0, rest: ]; FOR i: CARDINAL IN [0..bytesInS) DO p.text[i] _ s.Fetch[i] ENDLOOP } ELSE { -- long string, go off and do it WriteBigString[dbPage: dbPage, pagePtr: pagePtr, iStringSlot: iStringSlot, iStringOffset: iStringOffset, iWords: nWords, from: s, nBytes: bytesInS]; };--IF };--WriteString FreeBigString: PROC[sPagePtr: LONG POINTER TO DBStorageVec.VecPage, slotIndex: CARDINAL] = { -- starting from the LString at slotIdex on the given page, free all space on all pages --associated with this string. sCacheHdl: DBCache.CacheHandle; sDBPage: DBPage; lString: LONG POINTER TO DBStorageString.LString; eStringID: TID; DBStorageVectags.AssertVecIsLString[sPagePtr, slotIndex]; lString _ LOOPHOLE[DBStorageVec.VecOfSlot[sPagePtr, slotIndex]]; eStringID _ lString.eStringID; DBStorageVec.FreeVec[sPagePtr, slotIndex]; --sPagePtr is already write-enabled WHILE eStringID # NullTID DO -- chain through pages, freeing vecs. if page becomes empty, free it, too eString: LONG POINTER TO DBStorageString.EString; [sDBPage, slotIndex] _ DecomposeTID[eStringID]; [sCacheHdl, sPagePtr] _ DBSegment.WritePage[sDBPage, NIL]; DBStoragePagetags.AssertPageIsOverflowTuplePage[sPagePtr]; DBStorageVectags.AssertVecIsEString[sPagePtr, slotIndex]; eString _ LOOPHOLE[DBStorageVec.VecOfSlot[sPagePtr, slotIndex]]; eStringID _ eString.eStringID; DBStorageVec.FreeVec[sPagePtr, slotIndex]; IF DBStorageVec.HighSlotIndexOfPage[sPagePtr] = 0 THEN { DBSegment.FreePage[DBSegment.SegmentIDFromDBPage[sDBPage], sDBPage, sCacheHdl]; } ELSE { DBSegment.UnlockPage[sCacheHdl]; }; ENDLOOP; };--FreeBigString WriteBigString: PROC[dbPage: DBPage, pagePtr: LONG POINTER TO DBStorageVec.VecPage, iStringSlot: CARDINAL, iStringOffset: CARDINAL, iWords: CARDINAL, from: Rope.ROPE, nBytes: CARDINAL] = { -- Writes a long string (longer than lengthHint). dbPage,,pagePtr is page on which --iString is located; we need dbPage to identify the segment when allocating a page. --iWords is total length of iString. iString: LONG POINTER TO DBStorageString.IString _ LOOPHOLE[DBStorageVec.VecOfSlot[pagePtr, iStringSlot] + iStringOffset]; wordsThisWrite: CARDINAL; wordsToWrite: CARDINAL _ WordsForString[nBytes]; wordsWritten: CARDINAL _ 0; lStringSlot: CARDINAL; link: LONG POINTER TO TID; linkHdl: DBCache.CacheHandle; -- Write the inline portion of iString. wordsThisWrite _ iWords - SIZE[DBStorageString.IString]; IF wordsThisWrite >= wordsToWrite THEN ERROR DBEnvironment.InternalError; --[TrashedPage]; iString.bytesInString _ 2*wordsThisWrite; FOR i: CARDINAL IN [0..2*wordsThisWrite) DO iString.text[i] _ from.Fetch[i] ENDLOOP; wordsToWrite _ wordsToWrite - wordsThisWrite; wordsWritten _ wordsWritten + wordsThisWrite; -- Allocate an LString for off-page ref, point iString to it, but store no data words in it. { success: BOOLEAN; lString: LONG POINTER TO DBStorageString.LString; [lStringSlot, success] _ DBStorageVec.AllocVec[pagePtr, SIZE[DBStorageString.LString]]; IF ~success THEN ERROR InternalError; -- PageOverflowNotImplemented DBStorageVec.SetTypeOfSlot[pagePtr, lStringSlot, DBStorageVectags.LString]; iString _ LOOPHOLE[DBStorageVec.VecOfSlot[pagePtr, iStringSlot] + iStringOffset]; iString.slotOfExtension _ lStringSlot; lString _ LOOPHOLE[DBStorageVec.VecOfSlot[pagePtr, lStringSlot]]; lString.bytesInRemString _ nBytes - 2*wordsWritten; link _ @lString.eStringID; linkHdl _ NIL; }; -- Write the rest of the string. For now, all writing goes to other pages. WHILE wordsToWrite > 0 DO -- Find a page to write on. sDBPage: DBPage; sCacheHdl: DBCache.CacheHandle; sPagePtr: LONG POINTER TO DBStorageVec.VecPage; FOR curSlot: CARDINAL DECREASING IN [1..DBStorageVec.HighSlotIndexOfPage[pagePtr]] DO -- Is this a candidate overflow page? IF (DBStorageVec.TypeOfSlot[pagePtr, curSlot] # DBStorageVectags.LString) OR (curSlot = lStringSlot) THEN LOOP; -- Will the page pointed to by this LString hold the remaining string? --Read the page and see. { lString: LONG POINTER TO DBStorageString.LString _ LOOPHOLE[DBStorageVec.VecOfSlot[pagePtr, curSlot]]; [sDBPage,] _ DecomposeTID[lString.eStringID]; [sCacheHdl, sPagePtr] _ DBSegment.ReadPage[sDBPage, NIL]; DBStoragePagetags.AssertPageIsOverflowTuplePage[sPagePtr]; IF DBStorageVec.WordsInLargestAllocableVec[sPagePtr] >= (wordsToWrite + DBStorageString.SizeOfNullEString) THEN GOTO FoundPage; DBSegment.UnlockPage[sCacheHdl]; }; REPEAT FoundPage => { DBSegment.WriteLockedPage[sCacheHdl]; }; FINISHED => { -- Remainder of string will not fit on any existing page that is an immediate descendant --of pagePtr. Allocate a new page to hold at least a prefix of the remainder. [sDBPage, sCacheHdl, sPagePtr] _ DBSegment.AllocPage[DBSegment.SegmentIDFromDBPage[dbPage]]; DBSegment.WriteLockedPage[sCacheHdl]; DBStorageVec.InitializeVecPage[sPagePtr, DBStoragePagetags.OverflowTuple]; }--FINISHED ENDLOOP; -- Here sDBPage, sCacheHdl, and sPagePtr ref the writeable page where a prefix of the remaining --string will now be stored. link points to a location on a write-locked cache page that --needs to be filled with the "TID" of this new string, and linkHdl, if # NIL, is a cache --handle that must be release once this write has been done. -- Now, write the next piece of string and update link, linkHdl. { vecLen, eStringSlot: CARDINAL; success: BOOLEAN; eString: LONG POINTER TO DBStorageString.EString; vecLen _ MIN[wordsToWrite + DBStorageString.SizeOfNullEString,--what we want-- DBStorageVec.WordsInLargestAllocableVec[sPagePtr]--the most we can get--]; IF DBStorageString.SizeOfNullEString >= vecLen THEN ERROR InternalError; -- TrashedPage wordsThisWrite _ vecLen - DBStorageString.SizeOfNullEString; [eStringSlot, success] _ DBStorageVec.AllocVec[sPagePtr, vecLen]; IF ~success THEN ERROR DBEnvironment.InternalError; --huh? DBStorageVec.SetTypeOfSlot[sPagePtr, eStringSlot, DBStorageVectags.EString]; eString _ LOOPHOLE[DBStorageVec.VecOfSlot[sPagePtr, eStringSlot]]; link^ _ DBStorageTID.ConsTID[sDBPage, eStringSlot]; IF linkHdl # NIL THEN DBSegment.UnlockPage[linkHdl]; link _ @eString.eStringID; linkHdl _ sCacheHdl; FOR i: CARDINAL IN [0..MIN[2*wordsThisWrite, nBytes-2*wordsWritten]) DO eString.text[i] _ from.Fetch[2*wordsWritten + i] ENDLOOP; wordsToWrite _ wordsToWrite - wordsThisWrite; wordsWritten _ wordsWritten + wordsThisWrite; }; ENDLOOP; -- Terminate the list of EStrings with NullTID. link^ _ NullTID; IF linkHdl # NIL THEN DBSegment.UnlockPage[linkHdl]; };--WriteBigString -- Low-level group support ReadGroupField: PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle, part: DBStorageGroup.TIDFieldPart] RETURNS[TupleHandle] = { -- returns the indicated part of x's group field f. tupleBase: LONG POINTER TO DBStorageExtTuple.TupleBody; cacheHint: DBCache.CacheHandle; p: LONG POINTER TO DBStorageGroup.TIDFieldBody; resultTID: TID; result: TupleHandle; [tupleBase,cacheHint] _ ReadableTupleBase[x]; DBStorageField.CheckFieldHandleType[f, Group]; CheckFieldAccess[tupleBase, f]; p _ LOOPHOLE[tupleBase + DBStorageField.FieldOffset[f]]; resultTID _ SELECT part FROM headTID => p.headTID, prevTID => p.prevTID, nextTID => p.nextTID, ENDCASE => ERROR; result _ IF resultTID = NullTID THEN NIL ELSE DBStorageTuple.ConsTupleObject[tid: resultTID, cacheHint: NIL]; DBSegment.UnlockPage[cacheHint]; RETURN[result]; };--ReadGroupField WriteGroupField: PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle, part: DBStorageGroup.TIDFieldPart, val: TupleHandle] = { -- writes val's TID into the indicated part of x's group field f. tupleBase: LONG POINTER TO DBStorageExtTuple.TupleBody; cacheHint: DBCache.CacheHandle; p: LONG POINTER TO DBStorageGroup.TIDFieldBody; valTID: TID; [tupleBase,cacheHint] _ ReadableTupleBase[x]; DBSegment.WriteLockedPage[cacheHint]; DBStorageField.CheckFieldHandleType[f, Group]; CheckFieldAccess[tupleBase, f]; valTID _ IF val = NIL THEN NullTID ELSE val.tid; p _ LOOPHOLE[tupleBase + DBStorageField.FieldOffset[f]]; SELECT part FROM headTID => p.headTID _ valTID; prevTID => p.prevTID _ valTID; nextTID => p.nextTID _ valTID; ENDCASE => ERROR; DBSegment.UnlockPage[cacheHint]; };--WriteGroupField ReadHeadField: PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle, part: DBStorageGroup.HeadFieldPart] RETURNS[TupleHandle] = { -- returns the indicated part of x's GroupListEntry for group field f. -- error if no such entry. result is never NIL. tupleBase: LONG POINTER TO DBStorageExtTuple.TupleBody; cacheHint: DBCache.CacheHandle; p: LONG POINTER TO DBStorageGroup.GroupListEntry; result: TupleHandle; [tupleBase,cacheHint] _ ReadableTupleBase[x]; p _ GetGroupListEntry[tupleBase, f]; result _ SELECT part FROM firstTID => DBStorageTuple.ConsTupleObject[tid: p.firstTID, cacheHint: NIL], lastTID => DBStorageTuple.ConsTupleObject[tid: p.lastTID, cacheHint: NIL], ENDCASE => ERROR; DBSegment.UnlockPage[cacheHint]; RETURN[result]; };--ReadHeadField WriteHeadField: PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle, part: DBStorageGroup.HeadFieldPart, val: TupleHandle] = { -- writes val's tid into the indicated part of x's GroupListEntry for group field f. -- error if no such entry. val is never NIL. tupleBase: LONG POINTER TO DBStorageExtTuple.TupleBody; cacheHint: DBCache.CacheHandle; p: LONG POINTER TO DBStorageGroup.GroupListEntry; [tupleBase,cacheHint] _ ReadableTupleBase[x]; DBSegment.WriteLockedPage[cacheHint]; p _ GetGroupListEntry[tupleBase, f]; SELECT part FROM firstTID => p.firstTID _ val.tid; lastTID => p.lastTID _ val.tid; ENDCASE => ERROR; DBSegment.UnlockPage[cacheHint]; };--WriteHeadField GetGroupListEntry: PROC[tupleBase: LONG POINTER TO DBStorageExtTuple.TupleBody, f: DBStorage.FieldHandle] RETURNS[LONG POINTER TO DBStorageGroup.GroupListEntry] = { -- returns long pointer to tupleBase's GroupListEntry for group field f. -- error if no such entry. used by ReadHeadField, WriteHeadField. groupList: LONG DESCRIPTOR FOR DBStorageGroup.GroupList; i: CARDINAL; DBStorageField.CheckFieldHandleType[f, Group]; groupList _ GroupListFromTupleBase[tupleBase]; FOR i IN [0..LENGTH[groupList]) DO IF groupList[i].groupID=DBStorageField.GroupIDOfField[f] THEN RETURN[@groupList[i]]; ENDLOOP; ERROR DBEnvironment.InternalError; -- GroupListEntryNotFound };--GetGroupListEntry GroupListFromTupleBase: PUBLIC PROC[p: LONG POINTER TO DBStorageExtTuple.TupleBody] RETURNS[LONG DESCRIPTOR FOR DBStorageGroup.GroupList] = { -- returns groupList of tuple p. this is the only proc that has any business --reading p.groupOffset (except CheckFieldAccess). groupListLen: INTEGER _ DBStorageVec.LengthOfVec[LOOPHOLE[p]] - p.groupOffset; IF DoChecks AND (groupListLen < 0 OR groupListLen MOD SIZE[DBStorageGroup.GroupListEntry] # 0) THEN ERROR DBEnvironment.InternalError; -- BadGroupListLength RETURN[DESCRIPTOR[ LOOPHOLE[p+p.groupOffset, LONG POINTER TO DBStorageGroup.GroupList], groupListLen/SIZE[DBStorageGroup.GroupListEntry] ]]; };--GroupListFromTupleBase GroupListFromTuple: PUBLIC PROC[x: TupleHandle] RETURNS[LONG DESCRIPTOR FOR DBStorageGroup.GroupList, DBCache.CacheHandle] = { -- Returns the BASE and LENGTH of the tuple's GroupList. The BASE is a LONG POINTER to a locked --readonly cache page, and the second result is the cache handle to be used for unlocking it. tupleBase: LONG POINTER TO DBStorageExtTuple.TupleBody; cacheHint: DBCache.CacheHandle; [tupleBase,cacheHint] _ ReadableTupleBase[x]; RETURN[GroupListFromTupleBase[tupleBase],cacheHint]; };--GroupListFromTuple CreateHeadEntry: PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle] = { -- creates a group list entry in tuple x for group field f. -- error if already such an entry tupleBase: LONG POINTER TO DBStorageExtTuple.TupleBody; cacheHint: DBCache.CacheHandle; groupList: LONG DESCRIPTOR FOR DBStorageGroup.GroupList; [tupleBase,cacheHint] _ ReadableTupleBase[x]; DBStorageField.CheckFieldHandleType[f, Group]; groupList _ GroupListFromTupleBase[tupleBase]; BEGIN -- check to make sure we don't duplicate an entry i: CARDINAL; FOR i IN [0..LENGTH[groupList]) DO IF groupList[i].groupID = DBStorageField.GroupIDOfField[f] THEN BEGIN DBSegment.UnlockPage[cacheHint]; ERROR DBEnvironment.InternalError; -- GroupListEntryAlreadyThere; END;--IF ENDLOOP; END; BEGIN -- expand the group list. this code is a crock, and WON'T work with overflow pages! xs: StoredTupleHandle = NARROW[x]; dbPage: DBCommon.DBPage; p: LONG POINTER TO DBStorageVec.VecPage; slotIndex: CARDINAL; success: BOOLEAN; [dbPage,slotIndex] _ DecomposeTID[xs.tid]; [xs.cacheHint, p] _ DBSegment.WritePage[dbPage, xs.cacheHint]; -- tag has already been checked, and the tuple must be here (no overflow pages!) success _ DBStorageVec.ModifyVec[p, slotIndex, SIZE[DBStorageGroup.GroupListEntry], TRUE]; -- for now, error on overflow. this is where the hair in handling overflow pages --will come. IF ~success THEN ERROR InternalError; -- ProbablyBadExpectedNTupleRefs; tupleBase _ LOOPHOLE[DBStorageVec.VecOfSlot[p, slotIndex]]; groupList _ GroupListFromTupleBase[tupleBase]; groupList[LENGTH[groupList]-1] _ [groupID: DBStorageField.GroupIDOfField[f], firstTID: NullTID, lastTID: NullTID]; DBSegment.UnlockPage[xs.cacheHint]; END; DBSegment.UnlockPage[cacheHint]; };--CreateHeadEntry DestroyHeadEntry: PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle] = { -- removes the group list entry in tuple x for group field f. -- error if no such entry cacheHint: DBCache.CacheHandle; tupleBase: LONG POINTER TO DBStorageExtTuple.TupleBody; groupList: LONG DESCRIPTOR FOR DBStorageGroup.GroupList; entry: CARDINAL; [tupleBase,cacheHint] _ ReadableTupleBase[x]; DBStorageField.CheckFieldHandleType[f, Group]; groupList _ GroupListFromTupleBase[tupleBase]; -- find the entry to delete, error if not found FOR entry IN [0..LENGTH[groupList]) DO IF groupList[entry].groupID = DBStorageField.GroupIDOfField[f] THEN EXIT; REPEAT FINISHED => BEGIN DBSegment.UnlockPage[cacheHint]; ERROR InternalError; -- GroupListEntryNotFound END;--FINISHED ENDLOOP; BEGIN -- move entries with index > entry down one spot (could use LongCOPY...) i: CARDINAL; FOR i IN [entry+1..LENGTH[groupList]) DO groupList[i-1] _ groupList[i] ENDLOOP; END; BEGIN -- contract the group list. this code is a crock, and WON'T work with overflow pages! xs: StoredTupleHandle = NARROW[x]; dbPage: DBCommon.DBPage; p: LONG POINTER TO DBStorageVec.VecPage; slotIndex: CARDINAL; success: BOOLEAN; [dbPage,slotIndex] _ DecomposeTID[xs.tid]; [xs.cacheHint, p] _ DBSegment.WritePage[dbPage, xs.cacheHint]; -- tag has already been checked, and the tuple must be here (no overflow pages!) success _ DBStorageVec.ModifyVec[p, slotIndex, -SIZE[DBStorageGroup.GroupListEntry], TRUE]; -- should always succeed! IF ~success THEN ERROR DBEnvironment.InternalError; DBSegment.UnlockPage[xs.cacheHint]; END; DBSegment.UnlockPage[cacheHint]; };--DestroyHeadEntry systemTupleTable: REF ARRAY [1..DBStorage.MaxSystemTupleID] OF DBStorage.TupleHandle _ NIL; -- The contents are probably not really DBStorage.TupleHandles, but we never look! These --are passed back to the tuple level as results of ReadTupleset or GetGroupIDs on --dictionary tuples. All accesses to systemTupleTable are through the following two --procedures: SetSystemTupleTable: PUBLIC PROC[sTTPtr: REF ARRAY [1..DBStorage.MaxSystemTupleID] OF DBStorage.TupleHandle] = { -- EXPORTed to DBStorage systemTupleTable _ sTTPtr; };--SetSystemTupleTable TupleFromTID: PUBLIC PROC[id: TID] RETURNS[DBStorage.TupleHandle] = { -- EXPORTed to DBStorageSystemTupleTable result: DBStorage.TupleHandle; IF DoChecks AND id NOT IN [1..DBStorage.MaxSystemTupleID] THEN ERROR DBEnvironment.InternalError; -- [BadSystemTupleID]; result _ systemTupleTable[Basics.LowHalf[id]]; IF DoChecks AND result = NIL THEN ERROR DBEnvironment.InternalError; -- [NoSystemTupleForID]; RETURN[result]; };--TupleFromTID END.--DBStorageImplB CHANGE LOG Created by MBrown on February 16, 1980 12:07 AM -- Read1Word, Read2Word, and ReadNWord were taken from earlier version, coded February --10 (no overflow page reads). Changed by MBrown on February 27, 1980 11:07 PM -- Further fleshing out, including ReadTupleset and ReadVarByte. Changed by MBrown on February 28, 1980 3:29 PM -- Complete modulo restrictions on overflow pages and out-of-line strings. Changed by MBrown on 28-Feb-80 21:51 -- Make sure that slotOfExtension is set to 0, even though no extensions are allowed. Changed by MBrown on February 29, 1980 11:10 AM -- WriteRecord/String/Array deallocated their inputs, which was supposed to be done by --the DBStorage client. Changed by MBrown on March 6, 1980 3:26 PM -- Coded interim implementation of groups. Changed by MBrown on 6-Mar-80 21:36 -- Blunder: updated group list through index i rather than nEntries. I thought the --right thing but just copied the code without implementing the thought! At same time, --noticed that a LONG POINTER into a tuple was being held across a call to ModifyVec, --which is not OK. Changed by MBrown on 6-Mar-80 22:09 -- Blunder: followed nextTID rather than prevTID in PrevInGroup. This was coded by --transforming NextInGroup, and this change was missed. Changed by MBrown on April 16, 1980 11:15 PM -- Group section has now been almost completely rewritten, and now is supposed to work --even when multiple scans are in progress, etc. Changed by MBrown on April 17, 1980 4:57 PM -- The above runs DBTest3-DBTest6 successfully. But I noted a bug in comparing tuple --handles or field handles for equality by pointer equality in group scan fixups. Also --changed GetGroupIDs to return an element of systemTupleTable when the TID is small; --this problem was noted while writing a test program that attempts to implement --dictionary tuples for both tuplesets and attributes. Changed by MBrown on April 17, 1980 10:19 PM -- Added USING clauses. Changed by MBrown on April 21, 1980 11:48 PM -- CloseScanGroup deallocated tuple handles without checking for NIL; it now checks. --Now runs StCTst1 successfully. But this test doesn't use multiple concurrent scans... Changed by MBrown on June 1, 1980 12:05 PM -- Localizing references to groupOffset in preparation for overflow page work. --Introduced GroupListFromTupleBase as a replacement for NEntriesInGroupList; this --cleaned things up a great deal. Changed by MBrown on June 8, 1980 8:40 PM -- Changes to accomodate DBStorage.FieldObject as an exported type. CopyFieldObject --and FreeFieldObject moved to DBStorageField. Changed by MBrown on June 10, 1980 10:37 PM -- Changes to accomodate DBStorage.TupleObject as an exported type. Changed by MBrown on June 17, 1980 1:25 PM -- Changes to allow moving group scan implementation elsewhere. Changed by MBrown on June 18, 1980 8:23 PM -- Made GroupListFromTupleBody public. Changed by MBrown on July 24, 1980 10:41 AM -- On WriteVarByte of a too-long string, raise Retryable[LAST[CARDINAL]]. If resumed, store --as much of the string as possible, followed by "~~". Changed by MBrown on July 24, 1980 11:16 PM -- Implemented GetNWordBase. Changed by MBrown on August 12, 1980 3:59 PM -- Starting a simple implementation of "long strings" (overflow pages). The simplicity comes in --FORCING the string onto an overflow page, instead of trying to fit it onto the same page as its --tuple. This would cause group list page overflows, which we aren't ready to handle yet. Changed by MBrown on August 21, 1980 10:17 AM -- More work on long strings. Changed by MBrown on August 22, 1980 9:15 PM -- Finished coding on long strings. Changed by MBrown on August 23, 1980 11:09 AM -- Bug found on first (single-stepping) test run: in ReadBigString, failed to follow the eStringID --link to the next EString, thus we tried to copy the same EString over and over. Caught by --check for "impossible" error. Changed by MBrown on August 23, 1980 11:23 AM -- (Later in same test run) in WriteBigString, failed Unlock a page after --it was examined to see if allocation could take place on it, and there was not enough room. Caught --by DBSegment.FreePage, which found the lock count > 1. Changed by MBrown on August 23, 1980 11:32 AM -- (Later in same test run) in FreeBigString, Unlocked a page after it had been Freed. Comment by MBrown on August 23, 1980 11:43 AM -- First test runs to completion. Needed now: cache state printer, stronger exercise for --big strings. Changed by MBrown on August 28, 1980 4:50 PM -- Bug (revealed by Eric Schmidt's first program): I was holding onto a vec pointer across a call --to AllocVec for that page. The treatment of pointers into pages needs to be cleaned up throughout --the storage level, maybe by introducing some new objects that can hold together all of the right --stuff. Changed by MBrown on September 26, 1980 3:46 PM -- Converted to new DBException. Changed by MBrown on December 7, 1980 12:30 PM -- Added DBStats calls. Changed by MBrown on February 27, 1981 9:29 PM -- Pre-Pilot conversions, alloc storage using DBHeapStorage.Node. Changed by MBrown on 20-Jun-81 14:53:44 -- Cedar conversion, tuple rep is variant record, some results are collectible. Changed by MBrown on 15-Jul-81 10:22:48 -- @.text does not do what you might expect (it gives a pointer to the maxlength --field!). Use LOOPHOLE[, LONG POINTER] + TEXTDataOffset instead. Changed by MBrown on 29-Aug-81 23:02:52 -- Was returning a REF TEXT as a Rope. Return a REF Rope.RopeRep[text] instead. Changed by Cattell on 26-Sep-81 13:58:16 -- Added TupleFromTID. Changed by Willie-Sue on June 24, 1982 12:20 pm -- Rope.Ref => Rope.ROPE Changed by Cattell on September 9, 1983 5:14 pm -- Began conversion to Cedar 5.0: ReadNWord, WriteNWord, FieldHandles must change.