-- Transport Mechanism Filestore - heap file management --
-- [Indigo]<Grapevine>MS>HeapFile.mesa
-- Stolen back from [Idun]<WServices>MS>StableStorageImpl.mesa
-- Andrew Birrell 25-Oct-82 10:36:48
-- Randy Gobbel 29-Jun-82 16:38:42
-- Mark Johnson 19-May-81 13:30:37
DIRECTORY
BitMapDefs USING [Clear, Map, MapIndex, Set, Test],
HeapFileDefs USING [],
Inline USING [COPY, LowHalf],
PolicyDefs USING [AmountOfFreeHeap, GapExists],
Process USING [DisableTimeout],
VMDefs USING [FileHandle, FullAddress, MarkStartWait, Page, PageAddress,
PageIndex, PageNumber, pageSize, Release, UsePage];
HeapFile: MONITOR
IMPORTS BitMapDefs, Inline, PolicyDefs, Process, VMDefs EXPORTS HeapFileDefs =
BEGIN
segmentSize: CARDINAL = 6; -- number of pages in a segment
headerSize: CARDINAL = SIZE[LONG INTEGER] + SIZE[SegmentIndex];
segmentsPerPage: CARDINAL =
VMDefs.pageSize/SIZE[SegmentIndex] - headerSize;
SegmentIndex: TYPE = CARDINAL;
noSegment: SegmentIndex = LAST[SegmentIndex];
-- the 'written' chain is stored permanently on disk --
ChainBlock: TYPE = MACHINE DEPENDENT RECORD [
vp(0): SELECT OVERLAID * FROM
sh => [header(0): ARRAY [0..0) OF SerialAndHead],
chain =>
[next(0): ARRAY SegmentIndex [0..0) OF SegmentIndex],
ENDCASE];
SerialAndHead: TYPE = MACHINE DEPENDENT RECORD [
serialNumber(0): LONG INTEGER,
chainHead(2): SegmentIndex,
-- head of written chain, unused on all pages but first of chain file
fill(3): ARRAY [0..segmentsPerPage) OF UNSPECIFIED];
ClientObject: TYPE = RECORD [
chainHandle: VMDefs.FileHandle ← NIL,
chain: POINTER TO ChainBlock ← NIL,
lastWritten: SegmentIndex ← 0, -- last segment allocated for a writer
lastChained: SegmentIndex ← 0, -- last segment chained onto chain.written
lastPage: VMDefs.PageAddress ← NULL, -- last page used in chain.written
freeCount: CARDINAL ← 0, -- number of free segments
freeMap: BitMapDefs.Map, -- free segment bitmap
segmentCeiling: CARDINAL ← 0, -- size of segment bitmap - 1
handle: VMDefs.FileHandle ← NIL,
segmentCount: CARDINAL ← 0, -- number of segments
-- synchronisation for single-page writers - beware!
claimedPage: VMDefs.PageAddress ← NULL,
claimed: BOOLEAN ← FALSE,
unwrittenAllocation: BOOLEAN ← FALSE];
client: ClientObject;
notClaimed: CONDITION;
segmentBecomesFree: CONDITION;
Address: PROCEDURE [of: SegmentIndex] 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]
RETURNS [new: SegmentIndex] =
BEGIN OPEN client;
-- find 'nearest' free segment;
-- assumes (and checks) that bitmap entries for header words are "set".
high: BitMapDefs.MapIndex ← near;
low: BitMapDefs.MapIndex ← near;
IF freeCount = 0 THEN ERROR;
DO high ← MIN[high+1, segmentCeiling];
IF ~BitMapDefs.Test[freeMap, high] THEN {new ← high; EXIT};
IF ~BitMapDefs.Test[freeMap, low] THEN {new ← low; EXIT};
low ← MAX[low,1] - 1;
ENDLOOP;
IF new MOD VMDefs.pageSize IN [0..headerSize) THEN ERROR;
BitMapDefs.Set[freeMap, new];
freeCount ← freeCount - 1;
NotifyFreeCount[];
END;
RecordAllocation: PROCEDURE [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);
diskCopy: POINTER TO SerialAndHead =
LOOPHOLE[VMDefs.UsePage[[chainHandle, chainPage]]];
chain.header[page].serialNumber ← chain.header[page].serialNumber + 1;
Inline.COPY[from: @chain.header[page], to: diskCopy,
nwords: MIN[1+segmentCeiling-page*VMDefs.pageSize, VMDefs.pageSize] ];
VMDefs.MarkStartWait[LOOPHOLE[diskCopy]];
VMDefs.Release[LOOPHOLE[diskCopy]];
END;
FirstSegment: PUBLIC ENTRY PROCEDURE
RETURNS [VMDefs.FullAddress] =
BEGIN RETURN[Address[client.chain.header[0].chainHead]] END;
InsertFirstSegment: PUBLIC ENTRY PROCEDURE RETURNS [VMDefs.FullAddress] =
BEGIN OPEN client;
new: SegmentIndex = FindSegment[chain.header[0].chainHead];
chain.next[new] ← chain.header[0].chainHead;
IF new / VMDefs.pageSize # 0 THEN RecordAllocation[new];
chain.header[0].chainHead ← new;
RecordAllocation[0];
RETURN[Address[new]];
END;
NoMorePages: PUBLIC ERROR = CODE;
NextPage: PUBLIC ENTRY PROCEDURE [given: VMDefs.FullAddress]
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]]]
ELSE ERROR UnexpectedChaining[];
END;
END;
-- Writer page allocation --
LastPageWrong: ERROR = CODE;
NewWriterPage: PUBLIC ENTRY PROCEDURE RETURNS [new: VMDefs.FullAddress] =
BEGIN OPEN client; -- see comment beside 'FreeSegment' --
UNTIL freeCount >= 2 DO WAIT segmentBecomesFree ENDLOOP;
lastWritten ← FindSegment[lastWritten];
chain.next[lastWritten] ← noSegment;
new ← Address[lastWritten];
IF new.page.page = lastPage.page THEN ERROR LastPageWrong[];
END;
UnexpectedChaining: ERROR = CODE;
NextWriterPage: PUBLIC ENTRY PROCEDURE [given: VMDefs.FullAddress]
RETURNS [new: VMDefs.FullAddress] = {new ← InnerNextWriterPage[given]};
InnerNextWriterPage: INTERNAL PROCEDURE [given: VMDefs.FullAddress]
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];
chain.next[lastWritten] ← noSegment;
IF lastWritten / VMDefs.pageSize # current / VMDefs.pageSize
THEN RecordAllocation[lastWritten];
chain.next[current] ← lastWritten;
RecordAllocation[current];
new ← Address[lastWritten];
END;
END;
IF new.page.page = lastPage.page THEN ERROR LastPageWrong[];
END;
CommitObject: PUBLIC ENTRY PROCEDURE [start, end: VMDefs.PageAddress] =
BEGIN OPEN client;
CheckForUnwrittenAllocation[]; --beware of single-page writers--
chain.next[lastChained] ← Segment[start.page];
RecordAllocation[lastChained];
lastChained ← Segment[end.page];
lastPage ← end;
PolicyDefs.GapExists[];
END;
ObjectAbandoned: PUBLIC ENTRY PROCEDURE [start: VMDefs.PageAddress] =
BEGIN OPEN client;
head: SegmentIndex ← Segment[start.page];
WHILE head # noSegment DO
BEGIN
old: SegmentIndex = head;
head ← chain.next[head];
AddToFreeList[old];
END;
ENDLOOP;
BROADCAST segmentBecomesFree;
END;
CheckForUnwrittenAllocation: INTERNAL PROCEDURE = 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 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]].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 =
BEGIN OPEN client;
IF claimedPage.page MOD segmentSize = 0 THEN -- claimedPage was chained onto lastChained --
BEGIN
lastChained ← Segment[claimedPage.page];
RecordAllocation[lastChained];
END;
lastPage ← claimedPage;
claimed ← FALSE;
unwrittenAllocation ← FALSE;
BROADCAST notClaimed;
END;
-- management of the free list --
SegmentCorrupt: ERROR = CODE;
FreeSegment: PUBLIC ENTRY PROCEDURE [from, to: VMDefs.FullAddress] =
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];
IF head > LAST[SegmentIndex] THEN ERROR SegmentCorrupt;
END;
ENDLOOP;
CheckForUnwrittenAllocation[]; -- single-page writers --
RecordAllocation[ptr];
BROADCAST segmentBecomesFree;
END;
END;
AddToFreeList: PROCEDURE [old: SegmentIndex] =
BEGIN OPEN client;
BitMapDefs.Clear[freeMap, old];
freeCount ← freeCount + 1;
NotifyFreeCount[];
END;
NotifyFreeCount: PROC =
{ OPEN client;
PolicyDefs.AmountOfFreeHeap[
Inline.LowHalf[(LONG[freeCount]*100 + segmentCount/2)/segmentCount]] };
Process.DisableTimeout[@segmentBecomesFree];
Process.DisableTimeout[@notClaimed];
END.