<> <> <> <> <SoS>SoSTNTImpl.mesa _ SoSTNTImpl.mesa>> <> <> DIRECTORY Basics USING [CompareLC, Comparison], BasicTime USING [GMT, Now, Period], CD USING [Instance, Object, Orientation, Position], CDOps USING [Info], CDOrient USING [DecomposeOrient], Checksum USING [ComputeChecksum], Core USING [Wire], CoreOps USING [GetShortWireName], HashTable USING [Create, Delete, EachPairAction, Erase, Fetch, GetSize, Insert, Key, Pairs, SeqIndex, Table, Value], IO, -- debugging only PrincOpsUtils USING [], SoSTNT USING [], ViewerIO USING [CreateViewerStreams], ViewerTools USING [FindExistingViewer, Viewer]; SoSTNTImpl: CEDAR PROGRAM IMPORTS Basics, BasicTime, CDOps, CDOrient, Checksum, CoreOps, HashTable, IO, ViewerIO, ViewerTools EXPORTS SoSTNT ~ BEGIN <> TNT: PUBLIC TYPE = REF TNTRep; -- The Neighbourhood Table TNTRep: PUBLIC TYPE = RECORD [table: HashTable.Table, lastSweep: BasicTime.GMT]; TNTkey: TYPE = REF TNTkeyRep; TNTkeyRep: TYPE = RECORD [cell1, cell2: CD.Object, relOrient: CD.Orientation, dist: CD.Position]; <> TNTdata: TYPE = REF TNTdataRep; TNTdataRep: TYPE = RECORD [access: REF BOOL, actual1, actual2: Core.Wire]; TNTrecord: TYPE = RECORD [k: TNTkey, d: TNTdata]; TNTsize: HashTable.SeqIndex = 2973; TNThighWaterMark: HashTable.SeqIndex = TNTsize / 3 * 2; -- optimization sweepInterval: INT = 120; -- in seconds accessed: REF BOOL = NEW [BOOL _ TRUE]; neverAccessed: REF BOOL = NEW [BOOL _ FALSE]; debug: BOOL _ FALSE; dLog: IO.STREAM _ IO.noWhereStream; -- re-assign with interpreter Hash: PROC [k: HashTable.Key] RETURNS [CARDINAL] ~ BEGIN <> TRUSTED BEGIN RETURN [Checksum.ComputeChecksum [0, SIZE [TNTkeyRep], LOOPHOLE [k]]] END END; -- Hash Match: PROC [a, b: HashTable.Key] RETURNS [BOOL] ~ BEGIN <> k1: TNTkey = NARROW [a, TNTkey]; k2: TNTkey = NARROW [b, TNTkey]; RETURN [(k1.cell1 = k2.cell1) AND (k1.cell2 = k2.cell2) AND (k1.relOrient = k2.relOrient) AND (k1.dist.x = k2.dist.x) AND (k1.dist.y = k2.dist.y)] END; -- Match InitTNT: PUBLIC PROC RETURNS [t: TNT] ~ BEGIN <> t _ NEW [TNTRep _ [table: HashTable.Create [TNTsize, Match, Hash], lastSweep: BasicTime.Now []]]; END; -- InitTNT BlowTNT: PUBLIC PROC [t: TNT] ~ BEGIN <> HashTable.Erase [t.table]; t _ NIL END; -- BlowTNT BuildTNTrecord: PROC [i1, i2: CD.Instance, a1, a2: Core.Wire] RETURNS [rec: TNTrecord] ~ BEGIN <> order: Basics.Comparison; rec.k _ NEW [TNTkeyRep]; rec.d _ NEW [TNTdataRep]; TRUSTED {order _ Basics.CompareLC [LOOPHOLE[i1.ob], LOOPHOLE[i2.ob]]}; IF order = greater THEN BEGIN iZ: CD.Instance = i1; aZ: Core.Wire = a1; i1 _ i2; i2 _ iZ; a1 _ a2; a2 _ aZ END; rec.k.cell1 _ i1.ob; rec.k.cell2 _ i2.ob; rec.k.relOrient _ CDOrient.DecomposeOrient [i1.orientation, i2.orientation]; rec.k.dist.x _ i2.location.x - i1.location.x; rec.k.dist.y _ i2.location.y - i1.location.y; rec.d.access _ neverAccessed; rec.d.actual1 _ a1; rec.d.actual2 _ a2 END; -- BuildTNTrecord RememberTNT: PUBLIC PROC [t: TNT, inst1, inst2: CD.Instance, actual1, actual2: Core.Wire] ~ BEGIN <> rec: TNTrecord = BuildTNTrecord [inst1, inst2, actual1, actual2]; [] _ HashTable.Insert [t.table, rec.k, rec.d] END; -- Remember InTNT: PUBLIC PROC [t: TNT, inst1, inst2: CD.Instance, actual1, actual2: Core.Wire] RETURNS [BOOL] ~ BEGIN <> rec: TNTrecord = BuildTNTrecord [inst1, inst2, actual1, actual2]; isThere: BOOL; rawData: HashTable.Value; data: TNTdata; SameSignals: PROC RETURNS [BOOL] ~ INLINE BEGIN IF (data.actual1.size # rec.d.actual1.size) OR (data.actual2.size # rec.d.actual2.size) THEN RETURN [FALSE]; FOR i: NAT IN [0 .. rec.d.actual1.size) DO IF (rec.d.actual1[i] # data.actual1[i]) THEN RETURN [FALSE] ENDLOOP; FOR i: NAT IN [0 .. rec.d.actual2.size) DO IF (rec.d.actual2[i] # data.actual2[i]) THEN RETURN [FALSE] ENDLOOP; RETURN [TRUE] END; -- SameSignals [found: isThere, value: rawData] _ HashTable.Fetch [t.table, rec.k]; data _ NARROW [rawData, TNTdata]; IF debug AND isThere AND NOT SameSignals [] THEN BEGIN IO.Put1 [dLog, IO.rope["Same key, but different signals:\n"]]; [] _ PrintEltLong [rec.k, rec.d]; [] _ PrintEltLong [rec.k, data] END; isThere _ isThere AND SameSignals []; IF isThere THEN data.access _ accessed; RETURN [isThere] END; -- InTNT SweepTNT: PUBLIC PROC [t: TNT] ~ BEGIN <> RemoveCadavers: HashTable.EachPairAction ~ BEGIN <> IF NARROW [value, TNTdata].access = neverAccessed THEN [] _ HashTable.Delete [t.table, key] END; -- RemoveCadavers IF (BasicTime.Period[t.lastSweep,BasicTime.Now[]] > sweepInterval) AND (HashTable.GetSize[t.table] > TNThighWaterMark) THEN BEGIN [] _ HashTable.Pairs [t.table, RemoveCadavers]; t.lastSweep _ BasicTime.Now [] END END; -- SweepTNT <> Debug: PROC ~ BEGIN <> viewer: ViewerTools.Viewer; dummy: IO.STREAM; debug _ TRUE; viewer _ ViewerTools.FindExistingViewer ["SoS debug"]; [in: dummy, out: dLog] _ ViewerIO.CreateViewerStreams ["SoS debug", viewer] END; -- Debug PrintWire: PROC [w: Core.Wire] ~ BEGIN <> dLog.PutF ["%g %g %g\n", IO.rope [CoreOps.GetShortWireName[w]], IO.card [LOOPHOLE[w]], IO.refAny [w]]; FOR i: NAT IN [0 .. w.size) DO dLog.PutF ["\t(%g) %g %g %g\n", IO.card [i], IO.rope [CoreOps.GetShortWireName[w[i]]], IO.card [LOOPHOLE[w[i]]], IO.refAny [w[i]]] ENDLOOP END; -- PrintWire PrintEltShort: HashTable.EachPairAction ~ BEGIN <<[key: Key, value: Value] RETURNS [quit: BOOLEAN _ FALSE]>> k: TNTkey = NARROW [key, TNTkey]; data: TNTdata = NARROW [value, TNTdata]; IO.PutF [dLog, "Key: %g, %g; %g, (%g, %g).\n", IO.card[LOOPHOLE[k.cell1]], IO.card[LOOPHOLE[k.cell2]], IO.int[k.relOrient], IO.int[k.dist.x], IO.int[k.dist.y]]; FOR i: NAT IN [0 .. data.actual1.size) DO IO.Put [dLog, IO.card[LOOPHOLE[data.actual1[i]]], IO.char[' ]] ENDLOOP; IO.Put [dLog, IO.char['\n]]; FOR i: NAT IN [0 .. data.actual2.size) DO IO.Put [dLog, IO.card[LOOPHOLE[data.actual2[i]]], IO.char[' ]] ENDLOOP; IO.Put [dLog, IO.char['\n]] END; -- PrintEltShort PrintEltLong: HashTable.EachPairAction ~ BEGIN <<[key: Key, value: Value] RETURNS [quit: BOOLEAN _ FALSE]>> k: TNTkey = NARROW [key, TNTkey]; data: TNTdata = NARROW [value, TNTdata]; IO.PutF [dLog, "Key: %g, %g; %g, (%g, %g) ", IO.card[LOOPHOLE[k.cell1]], IO.card[LOOPHOLE[k.cell2]], IO.int[k.relOrient], IO.int[k.dist.x], IO.int[k.dist.y]]; IO.PutF [dLog, "[CD objects: <%g>, <%g>].\n", IO.rope[CDOps.Info[k.cell1]], IO.rope[CDOps.Info[k.cell2]]]; PrintWire [data.actual1]; PrintWire [data.actual2]; IO.Put [dLog, IO.char['\n]] END; -- PrintEltLong PrintTNTLong: PROC [t: TNT] ~ BEGIN <> IO.Put1 [dLog, IO.rope["\nNeighbourhood Table:\n"]]; [] _ HashTable.Pairs [t.table, PrintEltLong] END; -- PrintTNT IF debug THEN Debug [] END.