<> <> DIRECTORY Convert USING [Value, ValueToRope], FileIO USING [Open], Inline USING [LongDiv, LongMult], IO USING [Close, GetChar, GetIndex, PutChar, SetLength, STREAM, UnsafeGetBlock, UnsafePutBlock], Rope USING [Concat, Fetch, FromProc, Index, Match, ROPE, Size, SkipTo, Substr], SafeStorage USING [NewZone], Time USING [Current], TimeStamp USING [Stamp], VersionMap USING [Map, MapList, MapRep, MapEntry, NameMapIndex, MyStamp, MapAndName, MapAndNameList]; VersionMapImpl: CEDAR MONITOR IMPORTS Convert, FileIO, Inline, IO, Rope, SafeStorage, Time EXPORTS VersionMap SHARES VersionMap = BEGIN OPEN Rope, VersionMap; XMyStamp: TYPE = MACHINE DEPENDENT RECORD [lo,num,hi: CARDINAL]; <> <> <> NullStamp: MyStamp _ [0, 0, 0]; MyStampAsHex: TYPE = PACKED ARRAY [0..12) OF [0..16); XMap: TYPE = REF MapRep; XMapList: TYPE = LIST OF Map; XMapRep: PUBLIC TYPE = RECORD [names: ROPE _ NIL, prefix: NameMapIndex _ 0, -- place to find factored prefix entries: SEQUENCE len: CARDINAL OF MapEntry]; <> <> XMapEntry: TYPE = RECORD [stamp: MyStamp, index: NameMapIndex]; XNameMapIndex: TYPE = INT; -- byte index of name in map NullNameIndex: NameMapIndex = LAST[NameMapIndex]; EntryIndex: TYPE = CARDINAL; NullEntryIndex: EntryIndex = LAST[CARDINAL]; EntryRef: TYPE = REF EntryRep; EntryRep: TYPE = RECORD [next: EntryRef, name: ROPE, version: MyStamp]; pz: ZONE _ SafeStorage.NewZone[prefixed]; qz: ZONE _ SafeStorage.NewZone[quantized]; lastMap: Map _ NIL; -- last map produced (useful for debugging) -- **** BEGIN EXPORTED PROCEDURES **** -- VersionToName: PUBLIC PROC [list: MapList, stamp: TimeStamp.Stamp] RETURNS [result: MapAndName] = { <> 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: TimeStamp.Stamp] RETURNS [result: MapAndNameList] = { <> <> 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 _ qz.LIST[[map, name]]; IF tail = NIL THEN result _ new ELSE tail.rest _ new; tail _ new; ENDLOOP; ENDLOOP; }; GetPrefix: PUBLIC PROC [map: Map] RETURNS [ROPE] = { <> RETURN [IndexToShortName[map, 0]]; }; StampToHex: PUBLIC PROC [stamp: TimeStamp.Stamp] RETURNS [ROPE] = { <> RETURN [MyStampToHex[LOOPHOLE[stamp, MyStamp]]]}; BytesForEntries: PROC [n: INT] RETURNS [INT] = { words: INT _ SIZE[MapEntry]*n + SIZE[MapRep[0]] - SIZE[ROPE]; RETURN [words+words]}; SaveMapToFile: PUBLIC PROC [map: Map, name: ROPE] = TRUSTED { st: IO.STREAM _ FileIO.Open[name, overwrite]; names: ROPE _ map.names; namesChars: INT _ names.Size[]; len: NAT _ map.len; bytes: INT _ BytesForEntries[len]; IO.UnsafePutBlock[st, [@len, 0, SIZE[NAT]*2]]; -- first, output the # of bytes IO.UnsafePutBlock[st, [@map.prefix, 0, bytes]]; -- next, the table IO.UnsafePutBlock[st, [@namesChars, 0, SIZE[INT]*2]]; -- next, the number of chars MyPut[st, names]; -- and the names rope MyPut[st, "\000\000"]; -- marker at end IO.SetLength[st, IO.GetIndex[st]]; -- force goddamm truncation already!!! IO.Close[st]; }; substrCreator: PROC [name: ROPE, start: INT, len: INT] RETURNS [rope: ROPE] _ NIL; RestoreMapFromFile: PUBLIC PROC [name: ROPE, assumeImmutable: BOOL _ FALSE] RETURNS [map: Map] = TRUSTED { <> <> <<(this avoids copying the file names from the save file) >> st: IO.STREAM _ FileIO.Open[name, read]; namesChars: INT _ 0; bytes: INT _ 0; len: NAT _ 0; names: ROPE _ NIL; eachChar: PROC RETURNS [c: CHAR] = TRUSTED { c _ IO.GetChar[st]}; [] _ IO.UnsafeGetBlock[st, [@len, 0, SIZE[NAT]*2]]; map _ pz.NEW[MapRep[len]]; bytes _ BytesForEntries[len]; [] _ IO.UnsafeGetBlock[st, [@map.prefix, 0, bytes]]; [] _ IO.UnsafeGetBlock[st, [@namesChars, 0, SIZE[INT]*2]]; IF assumeImmutable AND substrCreator # NIL THEN { <> <> offset: INT _ IO.GetIndex[st]; map.names _ substrCreator[name, offset, namesChars]; } ELSE { <> <> map.names _ names _ Rope.FromProc[namesChars, eachChar]; }; IO.Close[st]; lastMap _ map; }; Length: PUBLIC PROC [map: Map] RETURNS [INT] = { <> RETURN [IF map = NIL THEN 0 ELSE map.len]; }; Fetch: PUBLIC PROC [map: Map, index: INT] RETURNS [stamp: TimeStamp.Stamp, name: ROPE] = { <> <> 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: INT] RETURNS [stamp: TimeStamp.Stamp] = { <> <> 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: INT] RETURNS [name: ROPE] = { <> <> name _ NIL; IF map # NIL AND index IN [0..map.len) THEN { entry: MapEntry _ map[index]; name _ IndexToFullName[map, entry.index]}; }; -- **** END EXPORTED PROCEDURES **** -- CurrentTime: PROC RETURNS [ROPE] = TRUSTED { RETURN [Convert.ValueToRope[[time[Time.Current[]]]]]; }; 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: NameMapIndex] RETURNS [ROPE] = { <> names: ROPE _ map.names; pos: INT _ names.SkipTo[index, "!\n"]; RETURN [names.Substr[index, pos-index]]; }; IndexToMidName: PROC [map: Map, index: NameMapIndex] RETURNS [ROPE] = { <> names: ROPE _ map.names; pos: INT _ names.Index[index, "\n"]; RETURN [names.Substr[index, pos-index]]; }; IndexToFullName: PROC [map: Map, index: NameMapIndex] 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]; }; lastProbes: INT _ 0; totalProbes: INT _ 0; totalTries: INT _ 0; totalFinds: INT _ 0; lastEntry: MapEntry; GetStats: PROC RETURNS [lastProbes, totalProbes, totalTries, totalFinds: INT] = { RETURN [lastProbes, totalProbes, totalTries, totalFinds]; }; FindIndex: PUBLIC PROC [vmap: Map, t: TimeStamp.Stamp] 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; totalTries _ totalTries + 1; 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 _ Inline.LongDiv[Inline.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 => { lastProbes _ probes; totalProbes _ totalProbes + probes; totalFinds _ totalFinds + 1; lastEntry _ vmap[k]; RETURN [k]}}; ENDLOOP; lastProbes _ probes; totalProbes _ totalProbes + probes; RETURN [NullEntryIndex]; }; FindIndexRange: PUBLIC PROC [vmap: Map, t: TimeStamp.Stamp] 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; }; SingleTestFindIndex: PROC [map: Map, i: NAT] RETURNS [index: NameMapIndex] = { lo,hi: EntryIndex; entry: MapEntry _ map[i]; [lo,hi] _ FindIndexRange[map, LOOPHOLE[map[i].stamp]]; IF i NOT IN [lo..hi] THEN ERROR TestFindIndexFailed; }; TestFindIndexFailed: ERROR = CODE; TestFindIndex: PROC [map: Map] RETURNS [allProbes: INT, len: NAT] = { allProbes _ 0; len _ map.len; FOR i: NAT IN [0..len) DO [] _ SingleTestFindIndex[map, i]; allProbes _ allProbes + lastProbes; ENDLOOP; }; MyPut: PROC [st: IO.STREAM, r: ROPE] = { FOR i: INT IN [0..r.Size[]) DO IO.PutChar[st, r.Fetch[i]]; ENDLOOP; }; END.