<> <> <> <> DIRECTORY BasicTime USING [GMT, nullGMT], Basics USING [bytesPerWord, CompareCard, Comparison, LongDiv, LongMult], BcdDefs USING [VersionStamp], FS USING [StreamOpen], IO USING [Close, EndOfStream, GetChar, GetIndex, SetLength, STREAM, UnsafeGetBlock, UnsafePutBlock, PutRope], Rope, RopeFile USING [SubstrCreate], VersionMap; VersionMapImpl: CEDAR PROGRAM IMPORTS Basics, FS, IO, Rope, RopeFile EXPORTS VersionMap SHARES VersionMap = BEGIN OPEN BasicTime, VersionMap; MyVersion: INT = 19850206; <> 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, nullGMT]; FOR each: MapList _ list, each.rest WHILE each # NIL DO map: Map _ each.first; nx: EntryIndex _ FindIndex[map, stamp]; IF nx # NullEntryIndex THEN { entry: MapEntry _ map[nx]; result.name _ IndexToFullName[map, entry.index]; result.map _ map; result.created _ entry.created; 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 entry: MapEntry _ map[x]; name: ROPE _ IndexToFullName[map, entry.index]; new: MapAndNameList _ LIST[[map, name, entry.created]]; 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 mx: CARDINAL _ map.shortNameSeq[index]; entry: MapEntry _ map[mx]; name: ROPE _ IndexToFullName[map, entry.index]; new: MapAndNameList _ LIST[[map, name, entry.created]]; 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 { <> 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 { <> 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] = { <> RETURN [IndexToShortName[map, 0]]; }; StampToHex: PUBLIC PROC [stamp: BcdDefs.VersionStamp] RETURNS [ROPE] = { <> 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; myVersion: INT _ MyVersion; IO.UnsafePutBlock[st, [LOOPHOLE[LONG[@myVersion]], 0, SIZE[INT]*bytesPerWord]]; <> IO.UnsafePutBlock[st, [LOOPHOLE[LONG[@len]], 0, SIZE[NAT]*bytesPerWord]]; <> IO.UnsafePutBlock[st, [LOOPHOLE[@map.entries[0]], 0, len*(SIZE[MapEntry]*bytesPerWord)]]; <> IO.UnsafePutBlock[st, [LOOPHOLE[@map.shortNameSeq[0]], 0, len*(SIZE[CARDINAL]*bytesPerWord)]]; <> IO.UnsafePutBlock[st, [LOOPHOLE[LONG[@namesChars]], 0, (SIZE[INT]*bytesPerWord)]]; <> IO.PutRope[st, names]; <> IO.PutRope[st, "\000\000\000"]; <> 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 { <> <> <<(this avoids copying the file names from the save file) >> st: IO.STREAM _ FS.StreamOpen[name, $read]; namesChars: INT _ 0; myVersion: 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[@myVersion]], 0, SIZE[INT]*bytesPerWord]]; IF myVersion # MyVersion THEN 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)]]; <> [] _ IO.UnsafeGetBlock[st, [LOOPHOLE[@map.shortNameSeq[0]], 0, len*(SIZE[CARDINAL]*bytesPerWord)]]; <> [] _ IO.UnsafeGetBlock[st, [LOOPHOLE[LONG[@namesChars]], 0, (SIZE[INT]*bytesPerWord)]]; <> pos _ IO.GetIndex[st]; IF assumeImmutable THEN { <> <> map.names _ RopeFile.SubstrCreate[name, pos, namesChars]; } ELSE { <> <> map.names _ names _ Rope.FromProc[namesChars, eachChar]; }; EXITS noGot => {}; }; IO.Close[st]; }; Length: PUBLIC PROC [map: Map] RETURNS [INT] = { <> RETURN [IF map = NIL THEN 0 ELSE map.len]; }; Fetch: PUBLIC PROC [map: Map, index: CARDINAL] RETURNS [stamp: VersionStamp, name: ROPE, created: GMT] = { <> <> 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]; created _ entry.created; }; }; FetchCreated: PUBLIC PROC [map: Map, index: CARDINAL] RETURNS [created: GMT _ nullGMT] = { <> <> IF map # NIL AND index IN [0..map.len) THEN { entry: MapEntry _ map[index]; created _ entry.created; }; }; FetchStamp: PUBLIC PROC [map: Map, index: CARDINAL] RETURNS [stamp: VersionStamp] = { <> <> 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] = { <> <> 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, created: GMT, 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]; created _ nullGMT} ELSE { index: CARDINAL _ range.map.shortNameSeq[range.first]; map: Map _ range.map; entry: MapEntry _ map[index]; next _ [map, range.first+1, range.len-1]; name _ IndexToFullName[map, entry.index]; stamp _ LOOPHOLE[entry.stamp]; created _ entry.created; }; }; FillInShortNames: PUBLIC PROC [map: Map] = { names: ROPE = map.names; len: CARDINAL = map.len; subLen: CARDINAL = len/32; pqa: REF ArrayOfQueue _ NEW[ArrayOfQueue _ ALL[NIL]]; dstx: CARDINAL _ 0; new: ShortNameSeq _ NEW[ShortNameSeqRep[len]]; map.shortNameSeq _ new; FOR i: CARDINAL IN [0..len) DO c: CHAR _ Rope.Fetch[names, GetFirstShortNameIndex[map, i]]; pq: Cvt _ NIL; SELECT TRUE FROM LOOPHOLE[c-'A, CARDINAL] <= ('Z-'A) => c _ c + ('a-'A); c NOT IN GoodChars => c _ FIRST[GoodChars]; ENDCASE; pq _ pqa[c]; IF pq = NIL THEN pqa[c] _ pq _ CreatePQ[map, subLen]; Insert[pq, i]; ENDLOOP; FOR c: CHAR IN GoodChars DO pq: Cvt = pqa[c]; IF pq # NIL THEN { FOR i: CARDINAL IN [0..pq.size) DO new[dstx] _ Remove[pq]; dstx _ dstx + 1; ENDLOOP; }; ENDLOOP; pqa^ _ ALL[NIL]; -- I deserve a good citizenship award for this! }; <<>> <<**** 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] = { <> names: ROPE _ map.names; pos: INT _ names.SkipTo[index, "!\n"]; RETURN [names.Substr[index, pos-index]]; }; IndexToMidName: PROC [map: Map, index: INT] RETURNS [ROPE] = { <> names: ROPE _ map.names; pos: INT _ names.Index[index, "\n"]; RETURN [names.Substr[index, pos-index]]; }; IndexToFullName: PROC [map: Map, index: INT] RETURNS [ROPE] = { <> 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: 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; <> 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; <> IF m = mt THEN GO TO found; <> 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; <> 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 EXITS found => { RETURN [k]}}; ENDLOOP; RETURN [NullEntryIndex]; }; FindIndexRange: 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 <> 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 used 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] = { <> len: CARDINAL = map.len; names: ROPE = map.names; pos1: INT _ 0; lim1: INT = Rope.Length[name]; pos2: INT _ GetFirstShortNameIndex[map, index]; DO <> 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; }; <> GoodChars: TYPE = CHAR[40C..'z]; ArrayOfQueue: TYPE = ARRAY CHAR OF Cvt; ShortNameSortPred: PROC [x1,x2: CARDINAL, map: Map] RETURNS [Comparison] = { <> len: CARDINAL = map.len; names: ROPE = map.names; pos1: INT _ GetFirstShortNameIndex[map, x1]; pos2: INT _ GetFirstShortNameIndex[map, x2]; DO <> c1: CHAR _ Rope.Fetch[names, pos1]; c2: CHAR _ Rope.Fetch[names, pos2]; IF LOOPHOLE[c1-'A, CARDINAL] <= ('Z-'A) THEN c1 _ c1 + ('a-'A); IF LOOPHOLE[c2-'A, CARDINAL] <= ('Z-'A) THEN c2 _ c2 + ('a-'A); IF c1 # c2 THEN RETURN [ Basics.CompareCard[LOOPHOLE[c1, CARDINAL], LOOPHOLE[c2, CARDINAL]]]; SELECT c1 FROM '!, '\n => RETURN [equal]; ENDCASE; pos1 _ pos1 + 1; pos2 _ pos2 + 1; ENDLOOP; }; <> 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] = { <> 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] = { <> 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 <> IF size = MaxSize THEN RETURN WITH ERROR PQover; size _ size + 1; <> 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 { <> 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 <> 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] = { <> 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; <> 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 { <> <<(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 { <> 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 [best]; }; <> TestFindIndexFailed: ERROR = CODE; SingleTestFindIndex: PROC [map: Map, i: NAT] RETURNS [index: INT] = { lo,hi: EntryIndex; entry: MapEntry _ map[i]; [lo,hi] _ FindIndexRange[map, LOOPHOLE[map[i].stamp]]; IF i NOT IN [lo..hi] THEN ERROR TestFindIndexFailed; }; TestFindIndex: PROC [map: Map] RETURNS [allProbes: INT, len: NAT] = { allProbes _ 0; len _ map.len; FOR i: NAT IN [0..len) DO [] _ SingleTestFindIndex[map, i]; ENDLOOP; }; END.