VersionMapImpl:
CEDAR
PROGRAM
IMPORTS Basics, FS, IO, Rope, RopeFile
EXPORTS VersionMap
SHARES VersionMap
= BEGIN OPEN VersionMap;
bytesPerWord: INT = Basics.bytesPerWord;
Comparison: TYPE = Basics.Comparison;
ROPE: TYPE = Rope.ROPE;
VersionStamp: TYPE = BcdDefs.VersionStamp;
NullStamp: MyStamp ← [0, 0, 0];
MyStampAsHex: TYPE = PACKED ARRAY [0..12) OF [0..16);
EntryIndex: TYPE = CARDINAL;
NullEntryIndex: EntryIndex = LAST[CARDINAL];
EntryRef: TYPE = REF EntryRep;
EntryRep: TYPE = RECORD [next: EntryRef, name: ROPE, version: MyStamp];
**** BEGIN EXPORTED PROCEDURES **** --
VersionToName:
PUBLIC
PROC
[list: MapList, stamp: VersionStamp] RETURNS [result: MapAndName] = {
... returns a full path name (FS format) for the given version stamp. The list of maps is searched in order. For convenience on a match, the containing map is also returned. If the stamp is not found, [NIL, NIL] is returned.
result ← [NIL, NIL];
FOR each: MapList ← list, each.rest
WHILE each #
NIL
DO
map: Map ← each.first;
nx: EntryIndex ← FindIndex[map, stamp];
IF nx # NullEntryIndex
THEN {
result.name ← IndexToFullName[map, map[nx].index];
result.map ← map;
RETURN};
ENDLOOP;
};
VersionToAllNames:
PUBLIC
PROC
[list: MapList, stamp: VersionStamp] RETURNS [result: MapAndNameList] = {
... returns all of the full path names (FS format) for the given version stamp. The list of maps is searched in order. For convenience on a match, the containing map is also returned. If the stamp is not found, [NIL, NIL] is returned.
tail: MapAndNameList ← NIL;
result ← NIL;
FOR each: MapList ← list, each.rest
WHILE each #
NIL
DO
map: Map ← each.first;
lo,hi: EntryIndex;
[lo,hi] ← FindIndexRange[map, stamp];
FOR x: EntryIndex
IN [lo..hi]
DO
name: ROPE ← IndexToFullName[map, map[x].index];
new: MapAndNameList ← LIST[[map, name]];
IF tail = NIL THEN result ← new ELSE tail.rest ← new;
tail ← new;
ENDLOOP;
ENDLOOP;
};
ShortName:
PUBLIC
PROC [longName:
ROPE]
RETURNS [
ROPE] = {
... returns the short name for the given long name. This simply involves stripping off the directory and version information.
lim: INT ← Rope.Length[longName];
pos: INT ← lim;
WHILE pos > 0
DO
c: CHAR ← Rope.Fetch[longName, pos ← pos - 1];
SELECT c
FROM
'! => lim ← pos;
'], '>, '/ => {pos ← pos + 1; EXIT};
ENDCASE;
ENDLOOP;
RETURN [Rope.Flatten[longName, pos, lim-pos]];
};
ShortNameToNames:
PUBLIC
PROC
[list: MapList, shortName: ROPE] RETURNS [MapAndNameList] = {
... returns all of the full path names (FS format) for the given short name. The list of maps is searched in order. For convenience on a match, the containing map is also returned. If the stamp is not found, [NIL, NIL] is returned.
rangeList: RangeList ← ShortNameToRanges[list, shortName ← ShortName[shortName]];
head,tail: MapAndNameList ← NIL;
WHILE rangeList #
NIL
DO
range: Range ← rangeList.first;
map: Map ← range.map;
rangeList ← rangeList.rest;
FOR index:
CARDINAL
IN [range.first..range.first+range.len)
DO
name: ROPE ← FetchName[map, map.shortNameSeq[index]];
new: MapAndNameList ← LIST[[map, name]];
IF tail = NIL THEN head ← new ELSE tail.rest ← new;
tail ← new;
ENDLOOP;
ENDLOOP;
RETURN [head];
};
ShortNameToRanges:
PUBLIC
PROC
[list: MapList, shortName: ROPE] RETURNS [RangeList] = {
... returns all of the ranges that correspond to the given short name (see the comments for Range).
head,tail: RangeList ← NIL;
shortName ← ShortName[shortName];
WHILE list #
NIL
DO
map: Map ← list.first;
shorts: ShortNameSeq ← map.shortNameSeq;
list ← list.rest;
IF map #
NIL
THEN {
found: BOOL;
index: CARDINAL;
range: Range ← [map: map, first: 0, len: 0];
new: RangeList;
[index, found] ← ShortNameFind[map, shortName];
IF found
THEN {
Extend the range to encompass ALL of the matching short names.
x,y: CARDINAL ← index;
WHILE x > 0
DO
IF ShortNameFindPred[shortName, shorts[x-1], map] # equal THEN EXIT;
x ← x - 1;
ENDLOOP;
WHILE y+1 < map.len
DO
IF ShortNameFindPred[shortName, shorts[y+1], map] # equal THEN EXIT;
y ← y + 1;
ENDLOOP;
range.first ← x;
range.len ← y+1 - x;
}
ELSE {
Scan forward until we have gone beyond the short name. This allows us to find long names using simple prefixes of short names.
range.first ← index;
WHILE range.first < map.len
DO
SELECT ShortNameFindPred[shortName, shorts[range.first], map]
FROM
less => EXIT;
equal => ERROR; -- the shortNameSeq was not properly sorted!
greater => range.first ← range.first + 1;
ENDCASE;
ENDLOOP;
};
new ← LIST [range];
IF tail = NIL THEN head ← new ELSE tail.rest ← new;
tail ← new;
};
ENDLOOP;
RETURN [head];
};
GetPrefix:
PUBLIC
PROC [map: Map]
RETURNS [
ROPE] = {
returns the creating prefix for the map
RETURN [IndexToShortName[map, 0]];
};
StampToHex:
PUBLIC
PROC [stamp: BcdDefs.VersionStamp]
RETURNS [
ROPE] = {
useful little utility to turn a stamp into hex (Satterthwaite convention)
RETURN [MyStampToHex[LOOPHOLE[stamp, MyStamp]]];
};
SaveMapToFile:
PUBLIC
PROC [map: Map, name:
ROPE] =
TRUSTED {
st: IO.STREAM ← FS.StreamOpen[name, $create];
names: ROPE ← map.names;
namesChars: INT ← names.Size[];
len: NAT ← map.len;
IO.UnsafePutBlock[st,
[LOOPHOLE[LONG[@len]], 0, SIZE[NAT]*bytesPerWord]];
first, output the # of entries
IO.UnsafePutBlock[st,
[LOOPHOLE[@map.entries[0]], 0, len*(SIZE[MapEntry]*bytesPerWord)]];
next, the entries themselves
IO.UnsafePutBlock[st,
[LOOPHOLE[@map.shortNameSeq[0]], 0, len*(SIZE[CARDINAL]*bytesPerWord)]];
next, the shortNameSeq
IO.UnsafePutBlock[st,
[LOOPHOLE[LONG[@namesChars]], 0, (SIZE[INT]*bytesPerWord)]];
next, the number of characters we are about to write (not counting the end marker)
IO.PutRope[st, names];
then the names rope
IO.PutRope[st, "\000\000\000"];
marker at end to make Tioga happy
IO.SetLength[st, IO.GetIndex[st]]; -- force goddamm truncation already!!!
IO.Close[st];
};
RestoreMapFromFile:
PUBLIC
PROC
[name: ROPE, assumeImmutable: BOOL ← TRUE] RETURNS [map: Map] = TRUSTED {
restores a map from a file written by SaveMapToFile
if assumeImmutable, then the named file is assumed to not change
(this avoids copying the file names from the save file)
st: IO.STREAM ← FS.StreamOpen[name, $read];
namesChars: INT ← 0;
bytes: INT ← 0;
len: NAT ← 0;
pos: INT ← 0;
names: ROPE ← NIL;
eachChar:
PROC
RETURNS [c:
CHAR] =
TRUSTED {
c ← IO.GetChar[st]};
{
ENABLE
IO.EndOfStream => {map ← NIL; GO TO noGot};
[] ← IO.UnsafeGetBlock[st, [LOOPHOLE[LONG[@len]], 0, SIZE[NAT]*bytesPerWord]];
map ← NEW[MapRep[len]];
map.shortNameSeq ← NEW[ShortNameSeqRep[len]];
[] ←
IO.UnsafeGetBlock[st,
[LOOPHOLE[@map.entries[0]], 0, len*(SIZE[MapEntry]*bytesPerWord)]];
next, read the entries themselves
[] ←
IO.UnsafeGetBlock[st,
[LOOPHOLE[@map.shortNameSeq[0]], 0, len*(SIZE[CARDINAL]*bytesPerWord)]];
next, read the shortNameSeq
[] ←
IO.UnsafeGetBlock[st,
[LOOPHOLE[LONG[@namesChars]], 0, (SIZE[INT]*bytesPerWord)]];
next, read the number of characters we are about to read
pos ← IO.GetIndex[st];
IF assumeImmutable
THEN {
make a rope that reads from the IO
we assume that the file will not change
map.names ← RopeFile.SubstrCreate[name, pos, namesChars];
}
ELSE {
copy the chars from the file into storage
after all, the file could change!
map.names ← names ← Rope.FromProc[namesChars, eachChar];
};
EXITS noGot => {};
};
IO.Close[st];
};
Length:
PUBLIC
PROC [map: Map]
RETURNS [
INT] = {
returns the # of entries in the map
RETURN [IF map = NIL THEN 0 ELSE map.len];
};
Fetch:
PUBLIC
PROC
[map: Map, index: CARDINAL] RETURNS [stamp: VersionStamp, name: ROPE] = {
returns the stamp and name at the given index
index must be in [0..Length[map])
stamp ← LOOPHOLE[NullStamp];
name ← NIL;
IF map #
NIL
AND index
IN [0..map.len)
THEN {
entry: MapEntry ← map[index];
stamp ← LOOPHOLE[entry.stamp];
name ← IndexToFullName[map, entry.index]};
};
FetchStamp:
PUBLIC
PROC [map: Map, index:
CARDINAL]
RETURNS [stamp: VersionStamp] = {
returns the stamp at the given index
index must be in [0..Length[map])
stamp ← LOOPHOLE[NullStamp];
IF map #
NIL
AND index
IN [0..map.len)
THEN {
entry: MapEntry ← map[index];
stamp ← LOOPHOLE[entry.stamp]};
};
FetchName:
PUBLIC
PROC [map: Map, index:
CARDINAL]
RETURNS [name:
ROPE] = {
returns the name at the given index
index must be in [0..Length[map])
name ← NIL;
IF map #
NIL
AND index
IN [0..map.len)
THEN {
entry: MapEntry ← map[index];
name ← IndexToFullName[map, entry.index]};
};
RangeToEntry:
PUBLIC
PROC
[range: Range] RETURNS [name: ROPE, stamp: VersionStamp, next: Range] = {
... returns the name and stamp for the first entry in the range, also returning the next range. If an empty range is given, the name returned will be NIL, and the range returned will be empty.
IF range.len = 0
THEN {name ← NIL; next ← [range.map, 0, 0]}
ELSE {
index: CARDINAL ← range.map.shortNameSeq[range.first];
next ← [range.map, range.first+1, range.len-1];
name ← FetchName[range.map, index];
stamp ← LOOPHOLE[range.map[index].stamp];
};
};
**** END EXPORTED PROCEDURES **** --
MyStampToHex:
PROC [stamp: MyStamp]
RETURNS [
ROPE] = {
index: NAT ← 0;
each:
PROC
RETURNS [c:
CHAR] = {
x: CARDINAL [0..15] ← hex[index];
IF x IN [0..9] THEN c ← 'a + hex[index];
index ← index + 1;
};
hex: MyStampAsHex ← LOOPHOLE[stamp];
RETURN [Rope.FromProc[12, each]];
};
IndexToShortName:
PROC [map: Map, index:
INT]
RETURNS [
ROPE] = {
return the name without the prefix or version
names: ROPE ← map.names;
pos: INT ← names.SkipTo[index, "!\n"];
RETURN [names.Substr[index, pos-index]];
};
IndexToMidName:
PROC [map: Map, index:
INT]
RETURNS [
ROPE] = {
return the name without the prefix
names: ROPE ← map.names;
pos: INT ← names.Index[index, "\n"];
RETURN [names.Substr[index, pos-index]];
};
IndexToFullName:
PROC [map: Map, index:
INT]
RETURNS [
ROPE] = {
return the full path name
names: ROPE ← map.names;
pos: INT ← names.Index[index, "\n"];
name: ROPE ← names.Substr[index, pos-index];
IF
NOT Rope.Match["[*", name]
THEN {
prepos: INT ← names.Index[0, "\n"];
prefix: ROPE ← names.Substr[0, prepos];
name ← prefix.Concat[name]};
RETURN [name];
};
FindIndex:
PUBLIC
PROC
[vmap: Map, t: BcdDefs.VersionStamp]
RETURNS [index: EntryIndex] = {
mt: MyStamp ← LOOPHOLE[t];
mn: CARDINAL ← mt.num;
i,k: CARDINAL ← 0;
j: CARDINAL ← vmap.len-1;
lo,mid: CARDINAL ← vmap[i].stamp.num;
hi: CARDINAL ← vmap[j].stamp.num;
probes: NAT ← 0;
DO
SELECT mn
FROM
< lo, > hi => EXIT; -- can never find it!
= lo => k ← i; -- found it at the low point!
= hi => k ← j; -- found it at the high point!
ENDCASE =>
{
-- use interpolation for speed!
dh: CARDINAL = hi-lo;
dt: CARDINAL = mn-lo;
assert: 0 < dt < dh, i < j
TRUSTED
{k ← Basics.LongDiv[Basics.LongMult[j-i, dt], dh] + i};
mid ← vmap[k].stamp.num;
probes ← probes + 1;
SELECT mid
FROM
< mn => {lo ← vmap[i ← k + 1].stamp.num; LOOP};
> mn => {hi ← vmap[j ← k - 1].stamp.num;
LOOP};
ENDCASE};
{
-- at this point, we are in a range of stamps that have equal mid-values; also, vmap[k].stamp.num = mt; a sequential search will do just fine
km: CARDINAL ← k;
m: MyStamp ← vmap[k].stamp;
try for the quick kill first (most likely)
IF m = mt THEN GO TO found;
otherwise, first search lower in the map
WHILE km > i
DO
km ← km-1;
m ← vmap[km].stamp;
IF m = mt THEN {k ← km; GO TO found};
IF m.num # mn THEN EXIT;
ENDLOOP;
sigh, must search higher in the map
WHILE k < j
DO
k ← k+1;
m ← vmap[k].stamp;
IF m = mt THEN GO TO found;
IF m.num # mn THEN EXIT;
ENDLOOP;
EXIT; -- not found
ENDLOOP;
RETURN [NullEntryIndex];
};
FindIndexRange:
PUBLIC
PROC
[vmap: Map, t: BcdDefs.VersionStamp]
RETURNS [lo,hi: EntryIndex] = {
stamp: MyStamp ← LOOPHOLE[t];
lim: EntryIndex ← vmap.len - 1;
hi ← 0;
lo ← FindIndex[vmap, t];
IF lo = NullEntryIndex THEN RETURN;
hi ← lo;
WHILE lo > 0
DO
IF vmap[lo-1].stamp # stamp THEN EXIT;
lo ← lo-1;
ENDLOOP;
WHILE hi < lim
DO
IF vmap[hi+1].stamp # stamp THEN EXIT;
hi ← hi + 1;
ENDLOOP;
};
GetFirstShortNameIndex:
PROC [map: Map, index:
CARDINAL]
RETURNS [
INT] = {
len: CARDINAL = map.len;
names: ROPE = map.names;
pos: INT ← (IF index+1 >= len THEN Rope.Length[names] ELSE map[index+1].index)-1;
DO
Scan backwards until a character before a short name is found.
c: CHAR = Rope.Fetch[names, pos ← pos - 1];
SELECT c
FROM
'\n, '/, '>, '] => RETURN [pos+1];
ENDCASE;
ENDLOOP;
};
ShortNameFind:
PROC
[map: Map, name: ROPE] RETURNS [index: CARDINAL, found: BOOL ← TRUE] = {
... finds the given short name in the index, using the given predicate, which must be consistent with the predicate sued to build the index.
mapIndex: ShortNameSeq = map.shortNameSeq;
lo: CARDINAL ← 0;
hi: CARDINAL ← mapIndex.len-1;
name ← Rope.Flatten[name]; -- to speed comparisons
WHILE lo <= hi
DO
index ← (lo+hi)/2;
SELECT ShortNameFindPred[name, mapIndex[index], map]
FROM
less => {
IF lo = index THEN EXIT;
hi ← index - 1;
};
greater => {
IF hi = index THEN EXIT;
lo ← index + 1;
};
equal => RETURN;
ENDCASE => ERROR;
ENDLOOP;
found ← FALSE;
};
ShortNameFindPred:
PROC
[name: ROPE, index: CARDINAL, map: Map] RETURNS [Comparison] = {
In this module we take advantage of the fact that all names of entries completely contain the short names of interest, and that all names of entries are bound by CRs ('\n). The given name is already presumed to be short.
len: CARDINAL = map.len;
names: ROPE = map.names;
pos1: INT ← 0;
lim1: INT = Rope.Length[name];
pos2: INT ← GetFirstShortNameIndex[map, index];
DO
Scan through the two names comparing characters (case ignored).
c1: CHAR ← IF pos1 = lim1 THEN '\n ELSE Rope.Fetch[name, pos1];
c2: CHAR ← Rope.Fetch[names, pos2];
IF LOOPHOLE[c1-'A, CARDINAL] <= ('Z-'A) THEN c1 ← c1 + ('a-'A);
SELECT
TRUE
FROM
c2 = '! => c2 ← '\n;
LOOPHOLE[c2-'A, CARDINAL] <= ('Z-'A) => c2 ← c2 + ('a-'A);
ENDCASE;
IF c1 # c2
THEN
RETURN [
Basics.CompareCard[LOOPHOLE[c1, CARDINAL], LOOPHOLE[c2, CARDINAL]]];
IF c1 = '\n THEN RETURN [equal];
pos1 ← pos1 + 1;
pos2 ← pos2 + 1;
ENDLOOP;
};
Special clone of PriorityQueue intended for shuffling indexes.
PQempty: PUBLIC ERROR = CODE;
PQover: PUBLIC ERROR = CODE;
MaxSize: INT = LAST[CARDINAL];
Seq: TYPE = REF SeqRep;
SeqRep: TYPE = RECORD [elements: SEQUENCE space: CARDINAL OF CARDINAL];
Cvt: TYPE = REF Rep;
Rep:
TYPE =
RECORD [
map: Map,
size: CARDINAL,
seq: Seq];
CreatePQ:
PROC [map: Map, size:
INT ← 0]
RETURNS [pq: Cvt] = {
create a priority queue object, initially empty
IF size > MaxSize THEN ERROR PQover;
IF size <= 0 THEN size ← 4 ELSE size ← size + 1;
pq ← NEW[Rep ← [map, 0, NEW[SeqRep[size]]]];
};
Insert:
PROC [pq: Cvt, item:
CARDINAL] = {
insert a new item into the queue
size: CARDINAL ← pq.size; -- figure out new size
a: Seq ← pq.seq; -- grab the descriptor
space: CARDINAL ← IF a = NIL THEN 0 ELSE a.space;
maxCard: CARDINAL = MaxSize; -- to aid the poor little compiler
overflow check - unfortunately, we can't get more than LAST[CARDINAL] words!
IF size = MaxSize THEN RETURN WITH ERROR PQover;
size ← size + 1;
Must first check for room in array. If there is not enough room, then allocate new storage, copy, and free the old storage.
IF size >= space
THEN {
seq: Seq ← NIL;
IF space = 0 THEN space ← 1;
SELECT space
FROM
< 2048 => space ← space + space;
< maxCard-1024 => space ← space + 1024;
ENDCASE => space ← MaxSize;
seq ← NEW[SeqRep[space]];
FOR i:
CARDINAL
IN [1..size)
DO
seq[i] ← a[i];
ENDLOOP;
pq.seq ← a ← seq;
};
IF size = 1
THEN a[1] ← item
ELSE {
Insert item by shuffling items down until invariant holds (assuming that a[son] will hold item).
son: CARDINAL ← size;
dad: CARDINAL ← son/2;
map: Map = pq.map;
dadItem: CARDINAL;
WHILE dad > 0
AND ShortNameSortPred[item, dadItem ← a[dad], map] = less
DO
item is better than a[dad], so shuffle a[dad] down
a[son] ← dadItem;
son ← dad;
dad ← son/2;
ENDLOOP;
a[son] ← item; -- finally insert the new item
};
pq.size ← size; -- also update the size
};
Remove:
PROC [pq: Cvt]
RETURNS [
CARDINAL] = {
remove the "best" item in the queue
size: CARDINAL ← pq.size; -- current size of pq
a: Seq ← pq.seq; -- desc to real stuff
best: CARDINAL; -- holder for best item
item: CARDINAL; -- holder for moving item
IF size = 0 THEN ERROR PQempty;
Remove top item from the array and prepare to move bottom item
best ← a[1]; -- remember best item
item ← a[size]; -- get moving item
size ← size - 1; -- new size of pq
pq.size ← size; -- also update size in pq
IF size # 0
THEN {
Restore the invariant by moving the item down
(better items move up)
dad: CARDINAL ← 1; -- current index for moving item
maxdad: CARDINAL ← size / 2; -- highest index for father item
map: Map = pq.map;
WHILE dad <= maxdad
DO
son: CARDINAL ← dad + dad;
sonItem: CARDINAL ← a[son];
IF son < size
THEN {
must find better of the two sons
nson: CARDINAL ← son + 1;
nsonItem: CARDINAL ← a[nson];
IF ShortNameSortPred[nsonItem, sonItem, map] = less
THEN {
son ← nson;
sonItem ← nsonItem;
};
};
IF ShortNameSortPred[item, sonItem, map] = less THEN EXIT;
a[dad] ← sonItem;
dad ← son;
ENDLOOP;
a[dad] ← item;
};
Return the saved best item
RETURN [best];