-- Transport Mechanism Filestore - heap file management --
-- [Idun]<WServices>MS>StableStorageImpl.mesa
-- Andrew Birrell 10-Jun-81 10:18:09
-- Randy Gobbel 29-Jun-82 16:38:42
-- Mark Johnson 19-May-81 13:30:37
DIRECTORY
Bitmap USING [Clear, MapIndex, Set, Test],
Inline USING [LowHalf],
ObjectDir,
ObjectDirInternal,
Policy USING [AmountOfFreeHeap, GapExists],
Process USING [DisableTimeout],
StableStorage,
VMDefs USING [FileHandle, FullAddress, MarkStartWait, Page, PageAddress,
PageIndex, PageNumber, pageSize, RemapPage];
StableStorageImpl: MONITOR
IMPORTS Bitmap, Inline, Policy, Process, VMDefs EXPORTS ObjectDir--.Client--,
StableStorage =
BEGIN OPEN ObjectDirInternal, StableStorage;
Client: TYPE = ObjectDirInternal.Client;
ClientObject: PUBLIC TYPE = ObjectDirInternal.ClientObject;
notClaimed: CONDITION;
segmentBecomesFree: CONDITION;
-- Variables for use in debugger
debugClient: Client;
debugSeg: SegmentIndex;
debugPage: VMDefs.PageNumber;
Address: PROCEDURE [of: SegmentIndex, client: Client] RETURNS [VMDefs.FullAddress] =
BEGIN OPEN client;
RETURN[[
page: [
file: handle,
page: (of - ((of+VMDefs.pageSize)/VMDefs.pageSize)*headerSize)*segmentSize],
word: FIRST[VMDefs.PageIndex]]];
END;
Segment: PROCEDURE [page: VMDefs.PageNumber]
RETURNS [seg: SegmentIndex] =
{segmentOrdinal: CARDINAL = Inline.LowHalf[page / segmentSize];
seg ←
segmentOrdinal +
((segmentOrdinal+segmentsPerPage)/segmentsPerPage)*headerSize};
FindSegment: INTERNAL PROCEDURE [near: SegmentIndex, client: Client]
RETURNS [new: SegmentIndex] =
BEGIN OPEN client;
-- find 'nearest' free segment;
high: Bitmap.MapIndex ← MIN[
near+(IF near+1 MOD VMDefs.pageSize = 0 THEN headerSize ELSE 1),
segmentCeiling];
low: Bitmap.MapIndex ←
(IF near > headerSize+1 THEN
near - (IF (near-headerSize) MOD VMDefs.pageSize = 0 THEN headerSize+1 ELSE 1)
ELSE headerSize+1);
DO
IF ~Bitmap.Test[freeMap, high] THEN {new ← high; EXIT};
IF ~Bitmap.Test[freeMap, low] THEN {new ← low; EXIT};
high ← MIN[
high + (IF high+1 MOD VMDefs.pageSize = 0 THEN headerSize ELSE 1),
segmentCeiling];
low ←
(IF low > headerSize+1 THEN
low -
(IF (low-headerSize) MOD VMDefs.pageSize = 0 THEN headerSize+1 ELSE 1)
ELSE headerSize+1);
ENDLOOP;
Bitmap.Set[freeMap, new];
freeCount ← freeCount - 1;
Policy.AmountOfFreeHeap[(freeCount*100 + segmentCount/2)/segmentCount];
END;
RecordAllocation: INTERNAL PROCEDURE [client: Client, seg: SegmentIndex] =
BEGIN OPEN client;
page: CARDINAL = seg/VMDefs.pageSize;
chainPage: VMDefs.PageNumber =
page*2 + (IF chain.header[page].serialNumber MOD 2 = 0 THEN 0 ELSE 1);
chain.header[page].serialNumber ← chain.header[page].serialNumber + 1;
VMDefs.RemapPage[
LOOPHOLE[@chain.header[page], VMDefs.Page],
[chainHandle, chainPage]];
VMDefs.MarkStartWait[LOOPHOLE[@chain.header[page], VMDefs.Page]];
END;
FirstSegment: PUBLIC ENTRY PROCEDURE [client: Client]
RETURNS [VMDefs.FullAddress] =
BEGIN RETURN[Address[client.chain.header[0].chainHead, client]] END;
InsertFirstSegment: PUBLIC ENTRY PROCEDURE [client: Client]
RETURNS [VMDefs.FullAddress] =
BEGIN OPEN client;
new: SegmentIndex = FindSegment[chain.header[0].chainHead, client];
chain.next[new] ← chain.header[0].chainHead;
RecordAllocation[client, new];
chain.header[0].chainHead ← new;
RecordAllocation[client, 0];
RETURN[Address[new, client]];
END;
NoMorePages: PUBLIC ERROR = CODE;
NextPage: PUBLIC ENTRY PROCEDURE [given: VMDefs.FullAddress, client: Client]
RETURNS [VMDefs.FullAddress] =
BEGIN OPEN client;
ENABLE UNWIND => NULL;
IF given.page.page = lastPage.page THEN ERROR NoMorePages[]
ELSE
IF given.page.page MOD segmentSize < segmentSize - 1 THEN
BEGIN
given.page.page ← given.page.page + 1;
given.word ← FIRST[VMDefs.PageIndex];
RETURN[given]
END
ELSE
BEGIN
seg: SegmentIndex = Segment[given.page.page];
IF chain.next[seg] # noSegment THEN RETURN[Address[chain.next[seg], client]]
ELSE ERROR UnexpectedChaining[];
END;
END;
-- Writer page allocation --
LastPageWrong: ERROR = CODE;
NewWriterPage: PUBLIC ENTRY PROCEDURE [client: Client]
RETURNS [new: VMDefs.FullAddress] =
BEGIN OPEN client; -- see comment beside 'FreeSegment' --
UNTIL freeCount >= 2 DO WAIT segmentBecomesFree ENDLOOP;
lastWritten ← FindSegment[lastWritten, client];
chain.next[lastWritten] ← noSegment;
new ← Address[lastWritten, client];
IF new.page.page = lastPage.page THEN ERROR LastPageWrong[];
END;
UnexpectedChaining: ERROR = CODE;
NextWriterPage: PUBLIC ENTRY PROCEDURE [given: VMDefs.FullAddress, client: Client]
RETURNS [new: VMDefs.FullAddress] = {new ← InnerNextWriterPage[given, client]};
InnerNextWriterPage: INTERNAL PROCEDURE [given: VMDefs.FullAddress, client: Client]
RETURNS [new: VMDefs.FullAddress] =
BEGIN OPEN client;
ENABLE UNWIND => NULL;
IF given.page.page MOD segmentSize < segmentSize - 1 THEN
BEGIN
given.page.page ← given.page.page + 1;
given.word ← FIRST[VMDefs.PageIndex];
new ← given;
END
ELSE
BEGIN
current: SegmentIndex = Segment[given.page.page];
IF chain.next[current] # noSegment THEN ERROR UnexpectedChaining[]
ELSE
BEGIN -- see comment beside 'FreeSegment' --
UNTIL freeCount >= 2 DO WAIT segmentBecomesFree ENDLOOP;
lastWritten ← FindSegment[current, client];
chain.next[lastWritten] ← noSegment;
chain.next[current] ← lastWritten;
RecordAllocation[client, current];
new ← Address[lastWritten, client];
END;
END;
IF new.page.page = lastPage.page THEN ERROR LastPageWrong[];
END;
CommitObject: PUBLIC ENTRY PROCEDURE
[start, end: VMDefs.PageAddress, client: Client] =
BEGIN OPEN client;
CheckForUnwrittenAllocation[client]; --beware of single-page writers--
chain.next[lastChained] ← Segment[start.page];
RecordAllocation[client, lastChained];
lastChained ← Segment[end.page];
lastPage ← end;
Policy.GapExists[];
END;
ObjectAbandoned: PUBLIC ENTRY PROCEDURE
[start: VMDefs.PageAddress, client: Client] =
BEGIN OPEN client;
head: SegmentIndex ← Segment[start.page];
WHILE head # noSegment DO
BEGIN
old: SegmentIndex = head;
head ← chain.next[head];
AddToFreeList[old, client];
END;
ENDLOOP;
BROADCAST segmentBecomesFree;
END;
CheckForUnwrittenAllocation: INTERNAL PROCEDURE [client: Client] = INLINE
BEGIN OPEN client;
-- wait if single-page writer hasn't put its data into the single page --
WHILE unwrittenAllocation DO WAIT notClaimed ENDLOOP;
END;
ClaimSinglePage: PUBLIC ENTRY PROCEDURE [client: Client]
RETURNS [next: VMDefs.PageAddress] =
BEGIN OPEN client;
-- single-page writer wants a single page --
WHILE claimed DO WAIT notClaimed ENDLOOP;
claimed ← TRUE;
next ← claimedPage ← InnerNextWriterPage[[page: lastPage, word: 0], client].page;
-- don't set "unwrittenAllocation" before here, to avoid deadlock with
-- compactor if InnerNextWriterPage needs to wait to allocate a page
unwrittenAllocation ← TRUE;
END;
CommitedSinglePage: PUBLIC ENTRY PROCEDURE [client: Client] =
BEGIN OPEN client;
IF claimedPage.page MOD segmentSize = 0 THEN -- claimedPage was chained onto lastChained --
BEGIN
lastChained ← Segment[claimedPage.page];
RecordAllocation[client, lastChained];
END;
lastPage ← claimedPage;
claimed ← FALSE;
unwrittenAllocation ← FALSE;
BROADCAST notClaimed;
END;
-- management of the free list --
FreeSegment: PUBLIC ENTRY PROCEDURE
[from, to: VMDefs.FullAddress, client: Client] =
BEGIN OPEN client;
-- For the correctness of the compactor, it is necessary that its
-- reading and writing pointers should always be on separate pages.
-- This would imply that we can free a segment if 'from' and 'to' would
-- be separated by at least a page after removal of the segment.
-- However, if at the end of a cycle of the compactor there is a gap of
-- less than one segment between the reading and writing pointers, and
-- there is only one segment on the free list, and the writer is waiting
-- for a segment (the writer can never use the last free segment, since
-- this would stop the next cycle of the compactor starting), then it is
-- possible that at the end of the next cycle of the compactor no
-- segment would have been placed in the free list and so neither the
-- compactor nor the writer could ever run again. Accordingly, we must
-- ensure that the reading and writing pointers are always at least one
-- segment apart. Note that under such circumstances, the writer might
-- wait for a long time for a segment to become available for it. --
fromSegment: SegmentIndex = Segment[from.page.page];
toSegment: SegmentIndex = Segment[to.page.page];
IF fromSegment # toSegment AND chain.next[fromSegment] # toSegment THEN
BEGIN
ptr: SegmentIndex =
IF from.page.page MOD segmentSize < to.page.page MOD segmentSize
OR
(from.page.page MOD segmentSize = to.page.page MOD segmentSize
AND from.word <= to.word) THEN fromSegment
ELSE chain.next[fromSegment];
head: SegmentIndex ← chain.next[ptr];
chain.next[ptr] ← toSegment;
WHILE head # toSegment DO
BEGIN
old: SegmentIndex = head;
head ← chain.next[head];
AddToFreeList[old, client];
IF head > LAST[SegmentIndex] THEN
BEGIN SegmentCorrupt: ERROR = CODE; ERROR SegmentCorrupt END;
END;
ENDLOOP;
CheckForUnwrittenAllocation[client]; -- single-page writers --
RecordAllocation[client, ptr];
BROADCAST segmentBecomesFree;
END;
END;
AddToFreeList: PROCEDURE [old: SegmentIndex, client: Client] =
BEGIN OPEN client;
Bitmap.Clear[freeMap, old];
freeCount ← freeCount + 1;
Policy.AmountOfFreeHeap[(freeCount*100 + segmentCount/2)/segmentCount];
END;
Process.DisableTimeout[@segmentBecomesFree];
Process.DisableTimeout[@notClaimed];
debugClient ← NIL; debugSeg ← noSegment; debugPage ← 0;
END.