<> <> <> <> <> <> <> <> DIRECTORY Basics USING [LowHalf], DBCommon USING [InternalError, CacheHandle, DBPage, TupleObject, TID, NullTID, TIDSlotMask, ConsTID, DecomposeTID], DBStats USING [Inc], DBSegment USING [AllocPage, FreePage, ObtainCoreLoc, ReadPage, WritePage, WriteLockedPage, UnlockPage, SegmentIDFromDBPage], DBStorage USING [FieldHandle, TuplesetHandle, MaxSystemTupleID, TupleHandle], DBStorageField USING [CheckFieldHandleType, FieldOffset, NWordsInField, GroupIDOfField], DBStorageGroup USING [TIDFieldBody, TIDFieldPart, GroupList, GroupListEntry, HeadFieldPart], DBStoragePage, DBStoragePrivate USING [TupleFromTID], DBStorageTuple USING [ConsTupleObject], PrincOpsUtils USING [LongCopy], Rope USING [ROPE, Fetch, Size, Text, NewText]; DBStorageImplB: CEDAR PROGRAM IMPORTS Basics, DBCommon, DBSegment, DBStats, DBStorageField, DBStoragePage, DBStoragePrivate, DBStorageTuple, PrincOpsUtils, Rope EXPORTS DBStorage, DBStorageGroup, DBStoragePrivate SHARES Rope = BEGIN OPEN DBCommon; <> <> <> <> SizeMismatch: SIGNAL = CODE; DoChecks: BOOLEAN = TRUE; <> TupleObject: PUBLIC TYPE = DBCommon.TupleObject; TupleHandle: TYPE = REF TupleObject; <> ReadTupleset: PUBLIC PROC[x: TupleHandle] RETURNS[DBStorage.TuplesetHandle] = TRUSTED { <> xs: TupleHandle = 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]; <> [xs.cacheHint, dbPagePtr] _ DBSegment.ReadPage[dbPage, xs.cacheHint]; END; <> SELECT DBStoragePage.TagOfPage[LOOPHOLE[dbPagePtr]] FROM DBStoragePage.Tuple => systemTuple _ FALSE; DBStoragePage.SystemTuple => systemTuple _ TRUE; ENDCASE => ERROR DBCommon.InternalError; -- [BadPageTag]; s _ DBStoragePage.TypeOfSlot[dbPagePtr, s]; <> BEGIN--do the lookup in the tupleset dictionary tsDict: LONG POINTER TO DBStoragePage.TSDict _ LOOPHOLE[DBStoragePage.VecOfSlot[dbPagePtr, DBStoragePage.TSDictSlotIndex]]; IF DoChecks AND s NOT IN [1..DBStoragePage.NEntries[tsDict]] THEN ERROR DBCommon.InternalError; -- [BadVecTag]; <> 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] = TRUSTED { tupleBase: LONG POINTER TO DBStoragePage.TupleBody; cacheHint: DBCommon.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] = TRUSTED { tupleBase: LONG POINTER TO DBStoragePage.TupleBody; cacheHint: DBCommon.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] = TRUSTED { <> <> tupleBase: LONG POINTER TO DBStoragePage.TupleBody; cacheHint: DBCommon.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, DBCommon.CacheHandle] = TRUSTED { <> tupleBase: LONG POINTER TO DBStoragePage.TupleBody; cacheHint: DBCommon.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] = TRUSTED { tupleBase: LONG POINTER TO DBStoragePage.TupleBody; cacheHint: DBCommon.CacheHandle; dbPage: DBPage; pagePtr: LONG POINTER TO DBStoragePage.VecPage; result: Rope.ROPE; DBStats.Inc[StorageReadField]; [tupleBase,cacheHint] _ ReadableTupleBase[x]; <> [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 <> Write1Word: PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle, val: CARDINAL] = TRUSTED { tupleBase: LONG POINTER TO DBStoragePage.TupleBody; cacheHint: DBCommon.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] = TRUSTED { tupleBase: LONG POINTER TO DBStoragePage.TupleBody; cacheHint: DBCommon.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] = TRUSTED { <> tupleBase: LONG POINTER TO DBStoragePage.TupleBody; cacheHint: DBCommon.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] = TRUSTED { tupleBase: LONG POINTER TO DBStoragePage.TupleBody; cacheHint: DBCommon.CacheHandle; dbPage: DBPage; slot: CARDINAL; pagePtr: LONG POINTER TO DBStoragePage.VecPage; DBStats.Inc[StorageWriteField]; [tupleBase,cacheHint] _ ReadableTupleBase[x]; <> [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 <> ReadableTupleBase: PROC[x: TupleHandle]RETURNS[--tupleBase-- LONG POINTER TO DBStoragePage.TupleBody,-- cacheHint-- DBCommon.CacheHandle] = TRUSTED { <> <> xs: TupleHandle = 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]; <> DBStoragePage.AssertPageIsAnyTuplePage[dbPagePtr]; slotType _ DBStoragePage.TypeOfSlot[dbPagePtr, slotIndex]; SELECT slotType FROM IN [1..DBStoragePage.MaxTuplesetPerPage] => BEGIN RETURN[LOOPHOLE[DBStoragePage.VecOfSlot[dbPagePtr, slotIndex]], xs.cacheHint]; END; DBStoragePage.IndTupleType => BEGIN ERROR DBCommon.InternalError; -- [Unknown]; END; ENDCASE => ERROR DBCommon.InternalError; -- [BadVecTag]; };--ReadableTupleBase CheckFieldAccess: PROC[t: LONG POINTER TO DBStoragePage.TupleBody, f: DBStorage.FieldHandle] = TRUSTED { <> <> IF DBStorageField.FieldOffset[f] + DBStorageField.NWordsInField[f] > t.groupOffset THEN ERROR DBCommon.InternalError; -- [BadFieldHandle]; };--CheckFieldAccess ReadCardinal: PROC[p: LONG POINTER] RETURNS[CARDINAL] = --INLINE-- TRUSTED { RETURN[LOOPHOLE[p,LONG POINTER TO CARDINAL]^]; };--ReadCardinal WriteCardinal: PROC[p: LONG POINTER, v: CARDINAL] = --INLINE-- TRUSTED { LOOPHOLE[p,LONG POINTER TO CARDINAL]^ _ v; };--WriteCardinal ReadLongCardinal: PROC[p: LONG POINTER] RETURNS[LONG CARDINAL] = --INLINE-- TRUSTED { RETURN[LOOPHOLE[p, LONG POINTER TO LONG CARDINAL]^]; };--ReadLongCardinal WriteLongCardinal: PROC[p: LONG POINTER, v: LONG CARDINAL] = --INLINE-- TRUSTED { LOOPHOLE[p,LONG POINTER TO LONG CARDINAL]^ _ v; };--WriteLongCardinal ReadRecord: PROC [ p: LONG POINTER, nWords: CARDINAL, space: REF ANY] = TRUSTED { <> PrincOpsUtils.LongCopy[from: p, nwords: nWords, to: LOOPHOLE[space]]; }; WriteRecord: PROC [p: LONG POINTER, nWords: CARDINAL, r: REF ANY] = TRUSTED { PrincOpsUtils.LongCopy[from: LOOPHOLE[r], nwords: nWords, to: p]; }; WordsForString: PROC[nChars: CARDINAL] RETURNS[CARDINAL] = TRUSTED INLINE { RETURN[(nChars+1)/2] }; ReadString: PROC[pagePtr: LONG POINTER TO DBStoragePage.VecPage, p: LONG POINTER TO DBStoragePage.IString, nWords: CARDINAL] RETURNS[Rope.ROPE] = TRUSTED { <> result: Rope.Text; wordsForBasicsString: CARDINAL _ WordsForString[p.bytesInString]; IF DoChecks AND DBStoragePage.SizeOfNullIString + wordsForBasicsString > nWords THEN ERROR DBCommon.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" <> lString: LONG POINTER TO DBStoragePage.LString; totalWordsForString: CARDINAL; IF DoChecks AND p.bytesInString # 2*(nWords - DBStoragePage.SizeOfNullIString) THEN ERROR DBCommon.InternalError; -- TrashedPage, extension used only if inline space is full IF DoChecks AND DBStoragePage.TypeOfSlot[pagePtr, p.slotOfExtension] # DBStoragePage.LStringType THEN ERROR DBCommon.InternalError; --slot type inconsistent lString _ LOOPHOLE[DBStoragePage.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] = TRUSTED { <> wordsCopied: CARDINAL _ 0; WHILE eStringID # NullTID DO wordsForCurrentText: CARDINAL; sPagePtr: LONG POINTER TO DBStoragePage.VecPage; sCacheHdl: DBCommon.CacheHandle; sDBPage: DBPage; slotIndex: CARDINAL; eString: LONG POINTER TO DBStoragePage.EString; [sDBPage, slotIndex] _ DecomposeTID[eStringID]; [sCacheHdl, sPagePtr] _ DBSegment.ReadPage[sDBPage, NIL]; IF DBStoragePage.TypeOfSlot[sPagePtr, slotIndex] # DBStoragePage.EStringType THEN ERROR DBCommon.InternalError; --slot type inconsistent eString _ LOOPHOLE[DBStoragePage.VecOfSlot[sPagePtr, slotIndex]]; wordsForCurrentText _ eString.header.length - DBStoragePage.SizeOfNullEString; IF wordsToCopy < (wordsCopied + wordsForCurrentText) THEN ERROR DBCommon.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 DBCommon.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 DBStoragePage.VecPage, iStringSlot: CARDINAL, iStringOffset: CARDINAL, nWords: CARDINAL, s: Rope.ROPE] = TRUSTED { <> <> p: LONG POINTER TO DBStoragePage.IString _ LOOPHOLE[DBStoragePage.VecOfSlot[pagePtr, iStringSlot] + iStringOffset]; bytesInS: CARDINAL = CardinalFromLongInteger[s.Size[]]; totalWordsForString: CARDINAL _ WordsForString[bytesInS]; <> IF p.slotOfExtension # 0 THEN FreeBigString[pagePtr, p.slotOfExtension]; IF SIZE[DBStoragePage.IString] + totalWordsForString <= nWords THEN { <> p^ _ [bytesInString: bytesInS, slotOfExtension: 0, rest: ]; FOR i: CARDINAL IN [0..bytesInS) DO p.text[i] _ s.Fetch[i] ENDLOOP } ELSE { <> WriteBigString[dbPage: dbPage, pagePtr: pagePtr, iStringSlot: iStringSlot, iStringOffset: iStringOffset, iWords: nWords, from: s, nBytes: bytesInS]; };--IF };--WriteString FreeBigString: PROC[sPagePtr: LONG POINTER TO DBStoragePage.VecPage, slotIndex: CARDINAL] = TRUSTED { <> <> sCacheHdl: DBCommon.CacheHandle; sDBPage: DBPage; lString: LONG POINTER TO DBStoragePage.LString; eStringID: TID; DBStoragePage.AssertVecIsLString[sPagePtr, slotIndex]; lString _ LOOPHOLE[DBStoragePage.VecOfSlot[sPagePtr, slotIndex]]; eStringID _ lString.eStringID; DBStoragePage.FreeVec[sPagePtr, slotIndex]; --sPagePtr is already write-enabled WHILE eStringID # NullTID DO <> eString: LONG POINTER TO DBStoragePage.EString; [sDBPage, slotIndex] _ DecomposeTID[eStringID]; [sCacheHdl, sPagePtr] _ DBSegment.WritePage[sDBPage, NIL]; DBStoragePage.AssertPageIsOverflowTuplePage[sPagePtr]; DBStoragePage.AssertVecIsEString[sPagePtr, slotIndex]; eString _ LOOPHOLE[DBStoragePage.VecOfSlot[sPagePtr, slotIndex]]; eStringID _ eString.eStringID; DBStoragePage.FreeVec[sPagePtr, slotIndex]; IF DBStoragePage.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 DBStoragePage.VecPage, iStringSlot: CARDINAL, iStringOffset: CARDINAL, iWords: CARDINAL, from: Rope.ROPE, nBytes: CARDINAL] = TRUSTED { <> <> <> iString: LONG POINTER TO DBStoragePage.IString _ LOOPHOLE[DBStoragePage.VecOfSlot[pagePtr, iStringSlot] + iStringOffset]; wordsThisWrite: CARDINAL; wordsToWrite: CARDINAL _ WordsForString[nBytes]; wordsWritten: CARDINAL _ 0; lStringSlot: CARDINAL; link: LONG POINTER TO TID; linkHdl: DBCommon.CacheHandle; <> wordsThisWrite _ iWords - SIZE[DBStoragePage.IString]; IF wordsThisWrite >= wordsToWrite THEN ERROR DBCommon.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; <> { success: BOOLEAN; lString: LONG POINTER TO DBStoragePage.LString; [lStringSlot, success] _ DBStoragePage.AllocVec[pagePtr, SIZE[DBStoragePage.LString]]; IF ~success THEN ERROR DBCommon.InternalError; -- PageOverflowNotImplemented DBStoragePage.SetTypeOfSlot[pagePtr, lStringSlot, DBStoragePage.LStringType]; iString _ LOOPHOLE[DBStoragePage.VecOfSlot[pagePtr, iStringSlot] + iStringOffset]; iString.slotOfExtension _ lStringSlot; lString _ LOOPHOLE[DBStoragePage.VecOfSlot[pagePtr, lStringSlot]]; lString.bytesInRemString _ nBytes - 2*wordsWritten; link _ @lString.eStringID; linkHdl _ NIL; }; <> WHILE wordsToWrite > 0 DO <> sDBPage: DBPage; sCacheHdl: DBCommon.CacheHandle; sPagePtr: LONG POINTER TO DBStoragePage.VecPage; FOR curSlot: CARDINAL DECREASING IN [1..DBStoragePage.HighSlotIndexOfPage[pagePtr]] DO <> IF (DBStoragePage.TypeOfSlot[pagePtr, curSlot] # DBStoragePage.LStringType) OR (curSlot = lStringSlot) THEN LOOP; <> <> { lString: LONG POINTER TO DBStoragePage.LString _ LOOPHOLE[DBStoragePage.VecOfSlot[pagePtr, curSlot]]; [sDBPage,] _ DecomposeTID[lString.eStringID]; [sCacheHdl, sPagePtr] _ DBSegment.ReadPage[sDBPage, NIL]; DBStoragePage.AssertPageIsOverflowTuplePage[sPagePtr]; IF DBStoragePage.WordsInLargestAllocableVec[sPagePtr] >= (wordsToWrite + DBStoragePage.SizeOfNullEString) THEN GOTO FoundPage; DBSegment.UnlockPage[sCacheHdl]; }; REPEAT FoundPage => { DBSegment.WriteLockedPage[sCacheHdl]; }; FINISHED => { <> [sDBPage, sCacheHdl, sPagePtr] _ DBSegment.AllocPage[DBSegment.SegmentIDFromDBPage[dbPage]]; DBSegment.WriteLockedPage[sCacheHdl]; DBStoragePage.InitializeVecPage[sPagePtr, DBStoragePage.OverflowTuple]; }--FINISHED ENDLOOP; <> { vecLen, eStringSlot: CARDINAL; success: BOOLEAN; eString: LONG POINTER TO DBStoragePage.EString; vecLen _ MIN[wordsToWrite + DBStoragePage.SizeOfNullEString,--what we want-- DBStoragePage.WordsInLargestAllocableVec[sPagePtr]--the most we can get--]; IF DBStoragePage.SizeOfNullEString >= vecLen THEN ERROR DBCommon.InternalError; -- TrashedPage wordsThisWrite _ vecLen - DBStoragePage.SizeOfNullEString; [eStringSlot, success] _ DBStoragePage.AllocVec[sPagePtr, vecLen]; IF ~success THEN ERROR DBCommon.InternalError; --huh? DBStoragePage.SetTypeOfSlot[sPagePtr, eStringSlot, DBStoragePage.EStringType]; eString _ LOOPHOLE[DBStoragePage.VecOfSlot[sPagePtr, eStringSlot]]; link^ _ DBCommon.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; <> link^ _ NullTID; IF linkHdl # NIL THEN DBSegment.UnlockPage[linkHdl]; };--WriteBigString <> ReadGroupField: PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle, part: DBStorageGroup.TIDFieldPart] RETURNS[TupleHandle] = TRUSTED { <> tupleBase: LONG POINTER TO DBStoragePage.TupleBody; cacheHint: DBCommon.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] = TRUSTED { <> tupleBase: LONG POINTER TO DBStoragePage.TupleBody; cacheHint: DBCommon.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] = TRUSTED { <> <> tupleBase: LONG POINTER TO DBStoragePage.TupleBody; cacheHint: DBCommon.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] = TRUSTED { <> <> tupleBase: LONG POINTER TO DBStoragePage.TupleBody; cacheHint: DBCommon.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 DBCommon.InternalError; DBSegment.UnlockPage[cacheHint]; };--WriteHeadField GetGroupListEntry: PROC[tupleBase: LONG POINTER TO DBStoragePage.TupleBody, f: DBStorage.FieldHandle] RETURNS[LONG POINTER TO DBStorageGroup.GroupListEntry] = TRUSTED { <> 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 DBCommon.InternalError; -- GroupListEntryNotFound };--GetGroupListEntry GroupListFromTupleBase: PUBLIC PROC[p: LONG POINTER TO DBStoragePage.TupleBody] RETURNS[LONG DESCRIPTOR FOR DBStorageGroup.GroupList] = TRUSTED { <> groupListLen: INTEGER _ DBStoragePage.LengthOfVec[LOOPHOLE[p]] - p.groupOffset; IF DoChecks AND (groupListLen < 0 OR groupListLen MOD SIZE[DBStorageGroup.GroupListEntry] # 0) THEN ERROR DBCommon.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, DBCommon.CacheHandle] = { <> tupleBase: LONG POINTER TO DBStoragePage.TupleBody; cacheHint: DBCommon.CacheHandle; [tupleBase,cacheHint] _ ReadableTupleBase[x]; RETURN[GroupListFromTupleBase[tupleBase],cacheHint]; };--GroupListFromTuple CreateHeadEntry: PUBLIC PROC[x: TupleHandle, f: DBStorage.FieldHandle] = TRUSTED { <> <> tupleBase: LONG POINTER TO DBStoragePage.TupleBody; cacheHint: DBCommon.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 DBCommon.InternalError; -- GroupListEntryAlreadyThere; END;--IF ENDLOOP; END; BEGIN -- expand the group list. this code is a crock, and WON'T work with overflow pages! xs: TupleHandle = NARROW[x]; dbPage: DBCommon.DBPage; p: LONG POINTER TO DBStoragePage.VecPage; slotIndex: CARDINAL; success: BOOLEAN; [dbPage,slotIndex] _ DecomposeTID[xs.tid]; [xs.cacheHint, p] _ DBSegment.WritePage[dbPage, xs.cacheHint]; <> success _ DBStoragePage.ModifyVec[p, slotIndex, SIZE[DBStorageGroup.GroupListEntry], TRUE]; <> <> IF ~success THEN ERROR DBCommon.InternalError; -- ProbablyBadExpectedNTupleRefs; tupleBase _ LOOPHOLE[DBStoragePage.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] = TRUSTED { <> <> cacheHint: DBCommon.CacheHandle; tupleBase: LONG POINTER TO DBStoragePage.TupleBody; groupList: LONG DESCRIPTOR FOR DBStorageGroup.GroupList; entry: CARDINAL; [tupleBase,cacheHint] _ ReadableTupleBase[x]; DBStorageField.CheckFieldHandleType[f, Group]; groupList _ GroupListFromTupleBase[tupleBase]; <> FOR entry IN [0..LENGTH[groupList]) DO IF groupList[entry].groupID = DBStorageField.GroupIDOfField[f] THEN EXIT; REPEAT FINISHED => BEGIN DBSegment.UnlockPage[cacheHint]; ERROR DBCommon.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: TupleHandle = NARROW[x]; dbPage: DBCommon.DBPage; p: LONG POINTER TO DBStoragePage.VecPage; slotIndex: CARDINAL; success: BOOLEAN; [dbPage,slotIndex] _ DecomposeTID[xs.tid]; [xs.cacheHint, p] _ DBSegment.WritePage[dbPage, xs.cacheHint]; <> success _ DBStoragePage.ModifyVec[p, slotIndex, -SIZE[DBStorageGroup.GroupListEntry], TRUE]; <> IF ~success THEN ERROR DBCommon.InternalError; DBSegment.UnlockPage[xs.cacheHint]; END; DBSegment.UnlockPage[cacheHint]; };--DestroyHeadEntry systemTupleTable: REF ARRAY [1..DBStorage.MaxSystemTupleID] OF DBStorage.TupleHandle _ NIL; <> SetSystemTupleTable: PUBLIC PROC[sTTPtr: REF ARRAY [1..DBStorage.MaxSystemTupleID] OF DBStorage.TupleHandle] = { <> systemTupleTable _ sTTPtr; };--SetSystemTupleTable TupleFromTID: PUBLIC PROC[id: TID] RETURNS[DBStorage.TupleHandle] = { <> result: DBStorage.TupleHandle; IF DoChecks AND id NOT IN [1..DBStorage.MaxSystemTupleID] THEN ERROR DBCommon.InternalError; -- [BadSystemTupleID]; result _ systemTupleTable[Basics.LowHalf[id]]; IF DoChecks AND result = NIL THEN ERROR DBCommon.InternalError; -- [NoSystemTupleForID]; RETURN[result]; };--TupleFromTID END.--DBStorageImplB CHANGE LOG Created by MBrown on February 16, 1980 12:07 AM <> <<10 (no overflow page reads).>> Changed by MBrown on February 27, 1980 11:07 PM <> Changed by MBrown on February 28, 1980 3:29 PM <> Changed by MBrown on 28-Feb-80 21:51 <> Changed by MBrown on February 29, 1980 11:10 AM <> <> Changed by MBrown on March 6, 1980 3:26 PM <> Changed by MBrown on 6-Mar-80 21:36 <> <> <> <> Changed by MBrown on 6-Mar-80 22:09 <> <> Changed by MBrown on April 16, 1980 11:15 PM <> <> Changed by MBrown on April 17, 1980 4:57 PM <> <> <> <> <> Changed by MBrown on April 17, 1980 10:19 PM <> Changed by MBrown on April 21, 1980 11:48 PM <> <> Changed by MBrown on June 1, 1980 12:05 PM <> <> <> Changed by MBrown on June 8, 1980 8:40 PM <> <> Changed by MBrown on June 10, 1980 10:37 PM <> Changed by MBrown on June 17, 1980 1:25 PM <> Changed by MBrown on June 18, 1980 8:23 PM <> Changed by MBrown on July 24, 1980 10:41 AM <> <> Changed by MBrown on July 24, 1980 11:16 PM <> Changed by MBrown on August 12, 1980 3:59 PM <> <> <> Changed by MBrown on August 21, 1980 10:17 AM <> Changed by MBrown on August 22, 1980 9:15 PM <> Changed by MBrown on August 23, 1980 11:09 AM <> <> <> Changed by MBrown on August 23, 1980 11:23 AM <<(Later in same test run) in WriteBigString, failed Unlock a page after>> <> < 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 <> <> Changed by MBrown on August 28, 1980 4:50 PM <> <> <> <> Changed by MBrown on September 26, 1980 3:46 PM <> Changed by MBrown on December 7, 1980 12:30 PM <> Changed by MBrown on February 27, 1981 9:29 PM <> Changed by MBrown on 20-Jun-81 14:53:44 <> 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>> <, LONG POINTER] + TEXTDataOffset instead.>> Changed by MBrown on 29-Aug-81 23:02:52 <> Changed by Cattell on 26-Sep-81 13:58:16 <> Changed by Willie-Sue on June 24, 1982 12:20 pm < Rope.ROPE>> Changed by Cattell on September 9, 1983 5:14 pm <> Changed by Willie-Sue on February 15, 1985 <>