-- Copyright (C) 1981, 1982, 1984, 1985 by Xerox Corporation. All rights reserved.
-- HeapFile.mesa, Transport Mechanism Filestore - heap file management
-- Stolen back from [Iris]<MCH>MCHCommon>StableStorageImpl.mesa
-- HGM, 15-Sep-85 10:07:10
-- Andrew Birrell 25-Oct-82 10:36:48
-- Randy Gobbel 29-Jun-82 16:38:42
-- Mark Johnson 19-May-81 13:30:37
-- Hankins 20-Aug-84 13:28:57 comments only
DIRECTORY
BitMapDefs USING [Clear, Map, MapIndex, Set, Test],
HeapFileDefs USING [],
Inline USING [LongCOPY, 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: PUBLIC 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: LONG 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: PUBLIC 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: PUBLIC 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] =
-- not same as ours but looks like works and simpler.
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: PUBLIC PROCEDURE [seg: SegmentIndex] =
BEGIN OPEN client; -- should be INTERNAL but used by HeapRestart.
page: CARDINAL = seg / VMDefs.pageSize;
chainPage: VMDefs.PageNumber =
page * 2 + (IF chain.header[page].serialNumber MOD 2 = 0 THEN 0 ELSE 1);
diskCopy: LONG POINTER TO SerialAndHead = LOOPHOLE[VMDefs.UsePage[
[chainHandle, chainPage]]];
chain.header[page].serialNumber ← chain.header[page].serialNumber + 1;
Inline.LongCOPY[
from: @chain.header[page], to: diskCopy,
nwords: MIN[1 + segmentCeiling - page * VMDefs.pageSize, VMDefs.pageSize]];
VMDefs.MarkStartWait[LOOPHOLE[diskCopy]];
-- why doesn't this use normal WritePageToFile style stuff in PilotFileSystem?
-- this isn't a problem is it?
VMDefs.Release[LOOPHOLE[diskCopy]];
END;
FirstSegment: PUBLIC ENTRY PROCEDURE RETURNS [VMDefs.FullAddress] = {
RETURN[Address[client.chain.header[0].chainHead]]};
InsertFirstSegment: PUBLIC ENTRY PROCEDURE RETURNS [VMDefs.FullAddress] =
BEGIN OPEN client;
new: SegmentIndex = FindSegment[chain.header[0].chainHead];
IF new = noSegment THEN ERROR;
chain.next[new] ← chain.header[0].chainHead;
chain.header[0].chainHead ← new;
IF new / VMDefs.pageSize # 0 THEN RecordAllocation[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 -- reserve a page for compactor, see comment beside 'FreeSegment' --
UNTIL freeCount >= 2 DO WAIT segmentBecomesFree ENDLOOP;
lastWritten ← FindSegment[current];
chain.next[lastWritten] ← noSegment;
-- needn't record end cause don't yet know it's end (and not on chain)
chain.next[current] ← lastWritten;
RecordAllocation[current]; -- record inner seq. chaining
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[Segment[end.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;
<< WARNING: this single page stuff relies on the fact that Writer (who calls) is monitored and that no one can commit any space between a call to ClaimSinglePage and the corresponding call to CommitedSinglePage!! (else will lost data, probably not the single page writer but the other stuff)
Another tricky fact is that when ClaimSinglePage allocates a new segment, it does not fill up that segment unless no one else is putting stuff on the chain. It always takes an available page out of last segment on chain (no matter who put it there) or, if that's not available, it used to allocate a new one (somewhat wasteful since we've already allocated one segment) so we'll treat it the same as being out of room to force the caller to use the segment they already have.
>>
UseNormalPath: PUBLIC ERROR = CODE;
ClaimSinglePage: PUBLIC ENTRY PROCEDURE RETURNS [next: VMDefs.PageAddress] =
BEGIN OPEN client; -- single-page writer wants a single page --
ENABLE UNWIND => claimed ← FALSE;
newAddr: VMDefs.PageAddress ← lastPage;
WHILE claimed DO WAIT notClaimed ENDLOOP;
claimed ← TRUE;
IF newAddr.page MOD segmentSize < segmentSize - 1 THEN
newAddr.page ← newAddr.page + 1 -- have a single page to use
ELSE ERROR UseNormalPath[];
-- force to use the page it has since would have to allocate another anyway.
IF newAddr.page = lastPage.page THEN ERROR LastPageWrong[]
ELSE next ← claimedPage ← newAddr;
-- don't set "unwrittenAllocation" before here, to avoid deadlock with
-- compactor if NewWriterPage needs to wait to allocate a page
unwrittenAllocation ← TRUE;
END;
CommitedSinglePage: PUBLIC ENTRY PROCEDURE =
BEGIN OPEN client;
IF claimedPage.page MOD segmentSize = 0 THEN
BEGIN -- writing first page of newly allocated seg, must put it on chain --
-- was set to end in call to NewWriterPage above.
tempSeg: SegmentIndex ← Segment[claimedPage.page];
chain.next[lastChained] ← tempSeg;
-- record our ptr to end & chain ptr to us:
RecordAllocation[tempSeg];
RecordAllocation[client.lastChained];
lastChained ← tempSeg;
END;
lastPage ← claimedPage;
claimed ← FALSE;
unwrittenAllocation ← FALSE;
BROADCAST notClaimed;
END;
-- management of the free list --
FreeSegment: PUBLIC ENTRY PROCEDURE [from, to: VMDefs.FullAddress]
RETURNS [freed: CARDINAL ← 0] =
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
old: SegmentIndex = head;
head ← chain.next[head];
AddToFreeList[old];
IF head > LAST[SegmentIndex] THEN {
SegmentCorrupt: ERROR = CODE; ERROR SegmentCorrupt};
freed ← freed + 1;
ENDLOOP;
CheckForUnwrittenAllocation[]; -- single-page writers --
RecordAllocation[ptr];
BROADCAST segmentBecomesFree;
END;
END;
AddToFreeList: PUBLIC PROCEDURE [old: SegmentIndex] =
BEGIN OPEN client; -- should be INTERNAL but used by HeapRestart
BitMapDefs.Clear[freeMap, old];
freeCount ← freeCount + 1;
NotifyFreeCount[];
END;
NotifyFreeCount: PUBLIC PROC = {
OPEN client;
PolicyDefs.AmountOfFreeHeap[
Inline.LowHalf[(LONG[freeCount] * 100 + segmentCount / 2) / segmentCount]]};
Process.DisableTimeout[@segmentBecomesFree];
Process.DisableTimeout[@notClaimed];
END.
log:
15-Aug-84 14:26:53 - blh: made it almost the same as our StableStorageImpl (except signal for out of room).