DIRECTORY AbSets, Basics, BiRels, Buttons, Containers, FS, Icons, IntStuff, IO, LichenDataOps, LichenDataStructure, LichenFromExtPrivate, List, PieViewers, Process, ProcessProps, RefText, Rope, RopeHash, SetBasics, ViewerOps, ViewerTools; LichenFromExtImpl1: CEDAR MONITOR LOCKS dr USING dr: DesignReading IMPORTS AbSets, BiRels, Buttons, Containers, FS, Icons, IO, LichenDataOps, LichenDataStructure, LichenFromExtPrivate, List, PieViewers, Process, ProcessProps, RefText, Rope, RopeHash, SetBasics, ViewerOps, ViewerTools EXPORTS LichenFromExtPrivate = BEGIN OPEN LichenDataOps, LichenDataStructure, LichenFromExtPrivate, Sets:AbSets, IS:IntStuff; readers: Fn _ BiRels.CreateHashDictionary[TRUE]; pacifierIcon: Icons.IconFlavor _ Icons.NewIconFromFile["Lichen.icons", 0]; pacifyPeriod: Process.Milliseconds _ 2500; labelHeight: INTEGER _ 27; pauseWidth: INTEGER _ 60; pieDiameter: INTEGER _ 50; ReadDesign: PROC [rootCellFileName: ROPE, oldDR: DesignReading _ NIL] RETURNS [dr: DesignReading] = BEGIN Doit: PROC = { dr.stack _ NIL; [] _ ReadCellType[dr.d, rootCellFileName, dr]}; IF oldDR = NIL THEN { cp: FS.ComponentPositions; fullFName, designName: ROPE; [fullFName, cp, ] _ FS.ExpandName[rootCellFileName]; designName _ fullFName.Substr[start: cp.base.start, len: cp.base.length]; {d: Design ~ CreateDesign[OneRope[designName]]; dr _ NEW [DesignReadingRep _ [ d: d, wDir: fullFName.Substr[len: cp.base.start], fetTypes: BiRels.CreateHashTable[[fetSpace, SetBasics.refs]], unkosherArrays: Sets.CreateHashSet[], toMerge: BiRels.CreateHashTable[[paths, SetBasics.refs]], arraySpecs: BiRels.CreateHashTable[[d.eSpace, SetBasics.refs]], buffer: RefText.New[200], pacifier: Containers.Create[info: [name: designName.Cat[" pacifier"], icon: pacifierIcon]], pie: NIL, label: NIL, pause: NIL ]]; TRUSTED { Process.InitializeCondition[@dr.change, Process.SecondsToTicks[60]]; Process.EnableAborts[@dr.change]}; dr.pause _ Buttons.Create[info: [name: "Pause", parent: dr.pacifier, wx: 0, wy: 0, ww: pauseWidth, wh: labelHeight], proc: TogglePause, clientData: dr]; dr.label _ ViewerTools.MakeNewTextViewer[info: [parent: dr.pacifier, wx: dr.pause.wx+dr.pause.ww, wy: 0, ww: 100, wh: labelHeight]]; Containers.ChildXBound[container: dr.pacifier, child: dr.label]; dr.pie _ PieViewers.Create[parent: dr.pacifier, x: 0, y: dr.label.wy+dr.label.wh, diameter: pieDiameter, total: 1.0, divisions: 100]; Containers.ChildXBound[container: dr.pacifier, child: dr.pie]; Containers.ChildYBound[container: dr.pacifier, child: dr.pie]; ViewerOps.SetOpenHeight[dr.pacifier, dr.pie.wy+dr.pie.wh]; TRUSTED {Process.Detach[FORK Pacify[dr]]}; }} ELSE { dr _ oldDR; }; ProcessProps.PushPropList[List.PutAssoc[$WorkingDirectory, dr.wDir, NIL], Doit]; END; Wait: ENTRY PROC [dr: DesignReading] = { ENABLE UNWIND => NULL; WHILE dr.stop DO WAIT dr.change ENDLOOP}; Pacify: PROC [dr: DesignReading] = { lastStack: SourceList _ NIL; lastIndex: INT _ 0; ViewerOps.OpenIcon[icon: dr.pacifier, bottom: FALSE]; WHILE NOT dr.pacifier.destroyed DO WithLock: ENTRY PROC [dr: DesignReading] = { ENABLE UNWIND => NULL; IF dr.stack = NIL THEN { IF dr.stack # lastStack THEN { lastStack _ dr.stack; ViewerTools.SetContents[dr.label, "Idle"]; PieViewers.Set[dr.pie, 0]; }; } ELSE { index: INT = dr.stack.first.stream.GetIndex[]; IF dr.stack # lastStack OR index # lastIndex THEN { lastStack _ dr.stack; lastIndex _ index; ViewerTools.SetContents[dr.label, IO.PutFR["%g%g%g[%g]", [rope[dr.prefix]], [rope[dr.curCellTypeName]], [rope[IF dr.curArray THEN ".aext" ELSE ""]], [integer[index]]]]; PieViewers.Set[dr.pie, index/dr.curCellFileLength]; }; }; }; Process.Pause[Process.MsecToTicks[pacifyPeriod]]; WithLock[dr]; ENDLOOP; RETURN}; TogglePause: Buttons.ButtonProc = { dr: DesignReading = NARROW[clientData]; Flip: ENTRY PROC [dr: DesignReading] = { ENABLE UNWIND => NULL; dr.stop _ NOT dr.stop; BROADCAST dr.change}; Flip[dr]; Buttons.ReLabel[dr.pause, IF dr.stop THEN "Continue" ELSE "Pause"]; }; DoPushed: PROC [dr: DesignReading, cellTypeName: ROPE, array: BOOL, s: Source, Proc: PROC [Source]] = { cooler: SourceList = dr.stack; oldCellTypeName: ROPE = dr.curCellTypeName; oldArray: BOOL = dr.curArray; oldPrefix: ROPE = dr.prefix; oldCellFileLength: REAL = dr.curCellFileLength; newPrefix: ROPE = FmtStack[cooler]; newCellFileLength: INT = MAX[s.stream.GetLength[], 1]; Push: ENTRY PROC [dr: DesignReading] = { ENABLE UNWIND => NULL; dr.stack _ CONS[s, dr.stack]; dr.curCellTypeName _ cellTypeName; dr.curArray _ array; dr.prefix _ newPrefix; dr.curCellFileLength _ newCellFileLength; }; Pop: ENTRY PROC [dr: DesignReading] = { ENABLE UNWIND => NULL; dr.stack _ cooler; dr.curCellTypeName _ oldCellTypeName; dr.curArray _ oldArray; dr.prefix _ oldPrefix; dr.curCellFileLength _ oldCellFileLength; }; Push[dr]; Proc[s !UNWIND => Pop[dr]]; Pop[dr]; }; ReadCellType: PUBLIC PROC [d: Design, cellFileName: ROPE, dr: DesignReading] RETURNS [ct: CellType] = { cp: FS.ComponentPositions; fullFName, cellTypeName: ROPE; from: IO.STREAM; s: Source; cr: CellReading; Pushed: PROC [s: Source] = {PushedRead[dr, cr, s, FALSE]}; [fullFName, cp] _ ExtendName[cellFileName, "ext"]; cellTypeName _ fullFName.Substr[start: cp.base.start, len: cp.base.length]; ct _ CreateCellType[d, unorganized, OneRope[cellTypeName]]; cr _ NEW[CellReadingRep _ [dr: dr, ct: ct, name: cellTypeName, newArrays: Sets.CreateHashSet[]]]; s _ [from _ FS.StreamOpen[fullFName], fullFName]; DoPushed[dr, cellTypeName, FALSE, s, Pushed]; from.Close[]; RETURN}; TryArrayFile: PUBLIC PROC [cr: CellReading] = { fullFName: ROPE = ExtendName[cr.name, "aext"].fullFName; s: Source = [FS.StreamOpen[fullFName], fullFName]; Pushed: PROC [s: Source] = { PushedRead[cr.dr, cr, s, TRUE]; FinishWaitingMerges[cr]; RETURN}; FinishArray: PROC [ra: Sets.Value] ~ { act: CellType ~ NARROW[ra.VA]; FinishedMakingArrayConnections[act]; RETURN}; IF (NOT cr.dr.toMerge.Empty[]) OR cr.waitingMerges # NIL THEN ERROR; DoPushed[cr.dr, cr.name, TRUE, s, Pushed]; s.stream.Close[]; cr.newArrays.Enumerate[FinishArray]; RETURN}; PushedRead: PROC [dr: DesignReading, cr: CellReading, s: Source, nested: BOOL] = { from: IO.STREAM = s.stream; ct: CellType = cr.ct; d: Design ~ dr.d; DO keyword: ROPE; reader: Reader; Process.CheckForAbort[]; [] _ from.SkipWhitespace[]; IF from.EndOf[] THEN EXIT; IF dr.stop THEN Wait[dr]; keyword _ from.GetTokenRope[TokenBreak].token; reader _ NARROW[readers.ApplyA[keyword].MDA]; IF reader # NIL THEN reader.read[s, reader, cr] ELSE {ERROR--let's not be sloppy--; <> }; ENDLOOP; IF (NOT dr.toMerge.Empty[]) THEN { IF cr.firstMerge THEN ERROR; DoMerges[s, cr]; } ELSE IF cr.firstMerge THEN {cr.firstMerge _ FALSE; TryArrayFile[cr]}; IF nested THEN RETURN; {CleanupChild: PROC [ra: Sets.Value] = { ci: CellInstance = NARROW[ra.VA]; childType: CellType = NARROW[d.ciType.ApplyA[ci].MA]; IF childType.asArray # NIL THEN CheckArrayUsage[d, childType]; RETURN}; d.cct[i].EnumerateMapping[AV[ct], CleanupChild, rightToLeft]; RETURN}}; CheckArrayUsage: PUBLIC PROC [d: Design, act: CellType] ~ { IF d.arrayElt.HasMapA[act, rightToLeft] OR d.ciType.MappingSize[AV[act], rightToLeft] # IS.one THEN ERROR; }; FmtStack: PROC [stack: SourceList] RETURNS [prefix: ROPE] = { prefix _ NIL; FOR stack _ stack, stack.rest WHILE stack # NIL DO full: ROPE; cp: FS.ComponentPositions; [full, cp, ] _ FS.ExpandName[stack.first.name]; prefix _ IO.PutFR["%g[%g], %g", [rope[full.Substr[cp.base.start, cp.base.length]]], [integer[IO.GetIndex[stack.first.stream]]], [rope[prefix]]]; ENDLOOP; RETURN}; paths: PUBLIC SetBasics.Space ~ NEW [SetBasics.SpacePrivate _ [ Contains: PathsContains, Equal: PathsEqual, AHash: PathsHash, ACompare: PathsCompare, name: "paths" ]]; PathsContains: PROC [data: REF ANY, v: Sets.Value] RETURNS [BOOL] ~ { RETURN [WITH v.ra SELECT FROM x: Path => TRUE, ENDCASE => FALSE]}; PathsEqual: PROC [data: REF ANY, v1, v2: Sets.Value] RETURNS [BOOL] --SetBasics.EqualProc-- ~ { p1: Path ~ NARROW[v1.VA]; p2: Path ~ NARROW[v2.VA]; RETURN [ComparePaths[p1, p2]=equal]}; PathsHash: PROC [data: REF ANY, v: Sets.Value] RETURNS [CARDINAL] --SetBasics.HashProc-- ~ { RETURN [HashPath[NARROW[v.VA]]]}; PathsCompare: PROC [data: REF ANY, v1, v2: Sets.Value] RETURNS [c: SetBasics.TotalComparison] --SetBasics.CompareProc-- ~ { p1: Path ~ NARROW[v1.VA]; p2: Path ~ NARROW[v2.VA]; RETURN ComparePaths[p1, p2]}; ComparePaths: PUBLIC PROC [path1, path2: Path] RETURNS [c: SetBasics.TotalComparison] = { DO IF path1 = path2 THEN RETURN [equal]; IF path1 = NIL THEN RETURN [less]; IF path2 = NIL THEN RETURN [greater]; WITH path1.first SELECT FROM r1: ROPE => WITH path2.first SELECT FROM r2: ROPE => c _ SetBasics.Unbasicify[r1.Compare[r2]]; x2: REF Range2 => c _ less; ENDCASE => ERROR; s1: REF Range2 => WITH path2.first SELECT FROM r2: ROPE => c _ greater; s2: REF Range2 => IF (c _ IntCompare[s1[X].min, s2[X].min]) = equal THEN IF (c _ IntCompare[s1[X].maxPlusOne, s2[X].maxPlusOne]) = equal THEN IF (c _ IntCompare[s1[Y].min, s2[Y].min]) = equal THEN c _ IntCompare[s1[Y].maxPlusOne, s2[Y].maxPlusOne]; ENDCASE => ERROR; ENDCASE => ERROR; IF c # equal THEN RETURN; path1 _ path1.rest; path2 _ path2.rest; ENDLOOP; }; HashPath: PROC [path: Path] RETURNS [hash: CARDINAL] = { hash _ 0; FOR path _ path, path.rest WHILE path # NIL DO WITH path.first SELECT FROM r: ROPE => hash _ hash + RopeHash.FromRope[r]; x: REF Range2 => hash _ hash + SetBasics.HashIntI[x[X].min] + SetBasics.HashIntI[x[X].maxPlusOne] + SetBasics.HashIntI[x[Y].min] + SetBasics.HashIntI[x[Y].maxPlusOne]; ENDCASE => ERROR; ENDLOOP; }; fetSpace: Sets.Space ~ NEW [SetBasics.SpacePrivate _ [ Contains: FetsContains, Equal: FetsEqual, AHash: FetsHash, ACompare: FetsCompare, name: "fets"]]; FetsContains: PROC [data: REF ANY, v: Sets.Value] RETURNS [BOOL] ~ { IF v.i#0 THEN RETURN [FALSE]; WITH v.ra SELECT FROM x: FetType => RETURN [TRUE]; ENDCASE => RETURN [FALSE]; }; FetsHash: PROC [data: REF ANY, v: Sets.Value] RETURNS [hash: CARDINAL] ~ { ft: FetType ~ NARROW[v.VA]; hash _ RopeHash.FromRope[ft.className]; hash _ (hash + 3*ft.area + 11*ft.perim + 101*ft.twiceLength) MOD 65536; RETURN}; FetsEqual: PROC [data: REF ANY, v1, v2: Sets.Value] RETURNS [BOOL] ~ {RETURN [FetsCompare[data, v1, v2]=equal]}; FetsCompare: PROC [data: REF ANY, v1, v2: Sets.Value] RETURNS [c: SetBasics.TotalComparison] ~ { k1: FetType ~ NARROW[v1.VA]; k2: FetType ~ NARROW[v2.VA]; IF (c _ SetBasics.Unbasicify[k1.className.Compare[k2.className]]) # equal THEN RETURN; IF (c _ IntCompare[k1.area, k2.area]) # equal THEN RETURN; IF (c _ IntCompare[k1.perim, k2.perim]) # equal THEN RETURN; IF (c _ IntCompare[k1.twiceLength, k2.twiceLength]) # equal THEN RETURN; RETURN [equal]}; IntCompare: PROC [a, b: INT] RETURNS [SetBasics.TotalComparison] ~ SetBasics.CompareIntI; Register: PUBLIC PROC [keyword: ROPE, read: PROC [s: Source, reader: Reader, cr: CellReading], data: REF ANY _ NIL] = { r: Reader _ NEW [ReaderRep _ [keyword, read, data]]; readers.AddNewAA[keyword, r]; }; Start: PROC = { }; Start[]; END. `LichenFromExtImpl1.Mesa Last tweaked by Mike Spreitzer on April 29, 1988 11:45:32 am PDT Κ.– "cedar" style˜code™Kšœ@™@—K˜KšΟk œ.œœ ˜ξK˜šΡbnxœœ˜!Kšœœ˜ Kšœ&œ œŸ˜ΩKšœ˜Kšœ˜—K˜Kšœœ;Οnœ œ ˜^K˜Kšœ*œ˜0K˜K˜JKšœ*˜*Kšœ œ˜Kšœ œ˜Kšœ œ˜K˜š Ÿ œœœœœ˜cKš˜šŸœœ˜Kšœ œ˜Kšœ/˜/—šœ œœ˜Kšœœ˜Kšœœ˜Kšœœ˜4KšœI˜IKšœ/˜/šœœ˜Kšœ˜Kšœ+˜+Kšœ=˜=Kšœ%˜%Kšœ9˜9Kšœ?˜?K˜K•StartOfExpansionΔ[info: ViewerClasses.ViewerRec _ [class: NIL, wx: 0, wy: 0, ww: 0, wh: 0, cx: 0, cy: 0, cw: 0, ch: 0, lock: [process: PROCESS#0B, count: 0B (0)], tipTable: NIL, name: NIL, file: NIL, label: NIL, menu: NIL, icon: 177777B?, column: left, caption: FALSE, scrollable: TRUE, hscrollable: FALSE, iconic: TRUE, border: TRUE, newVersion: FALSE, newFile: FALSE, visible: TRUE, offDeskTop: FALSE, destroyed: FALSE, init: FALSE, saveInProgress: FALSE, inhibitDestroy: FALSE, guardDestroy: FALSE, paintingWedged: FALSE, spare0: FALSE, spare1: FALSE, spare2: FALSE, spare3: FALSE, spare4: FALSE, spare5: FALSE, spare6: FALSE, position: 0, openHeight: 0, link: NIL, parent: NIL, sibling: NIL, child: NIL, props: NIL, data: NIL], paint: BOOL _ TRUE]˜[Kšœœ˜ Kšœœ˜ Kšœ˜ Kšœ˜—šœ˜ KšœD˜DK˜"—K–κ[info: ViewerClasses.ViewerRec _ [class: NIL, wx: 0, wy: 0, ww: 0, wh: 0, cx: 0, cy: 0, cw: 0, ch: 0, lock: [process: PROCESS#0B, count: 0B (0)], tipTable: NIL, name: NIL, file: NIL, label: NIL, menu: NIL, icon: 177777B?, column: left, caption: FALSE, scrollable: TRUE, hscrollable: FALSE, iconic: TRUE, border: TRUE, newVersion: FALSE, newFile: FALSE, visible: TRUE, offDeskTop: FALSE, destroyed: FALSE, init: FALSE, saveInProgress: FALSE, inhibitDestroy: FALSE, guardDestroy: FALSE, paintingWedged: FALSE, spare0: FALSE, spare1: FALSE, spare2: FALSE, spare3: FALSE, spare4: FALSE, spare5: FALSE, spare6: FALSE, position: 0, openHeight: 0, link: NIL, parent: NIL, sibling: NIL, child: NIL, props: NIL, data: NIL], proc: Buttons.ButtonProc, clientData: REF ANY _ NIL, fork: BOOL _ TRUE, font: ImagerFont.Font _ NIL, documentation: REF ANY _ NIL, guarded: BOOL _ FALSE, paint: BOOL _ TRUE]šœ˜˜˜Kšœ„˜„K–B[container: Containers.Container, child: ViewerClasses.Viewer]˜@Kšœ…˜…K–B[container: Containers.Container, child: ViewerClasses.Viewer]˜>K–B[container: Containers.Container, child: ViewerClasses.Viewer]˜>K˜:Kšœœ˜*K˜—šœ˜K˜ K˜—KšœDœ ˜PKšœ˜—K˜šŸœœœ˜(Kšœœœ˜Kšœ œœ œ˜)—K˜šŸœœ˜$Kšœœ˜Kšœ œ˜K–h[icon: ViewerClasses.Viewer, closeOthers: BOOL _ FALSE, bottom: BOOL _ TRUE, paint: BOOL _ TRUE]šœ.œ˜5šœœ˜"šŸœœœ˜,Kšœœœ˜šœ œœ˜šœœ˜Kšœ˜Kšœ*˜*Kšœ˜K˜—K˜—šœ˜Kšœœ$˜.šœœœ˜3Kšœ˜K˜Kš œ"œJœ œ œ˜¨Kšœ3˜3K˜—K˜—K˜—Kšœ1˜1Kšœ ˜ Kšœ˜—Kšœ˜—K˜šŸ œ˜#Kšœœ ˜'šŸœœœ˜(Kšœœœ˜Kšœ œ ˜Kš œ ˜—K˜ Kšœœ œ œ ˜CK˜—K˜š Ÿœœ#œ œ Ÿœœ˜gK˜Kšœœ˜+Kšœ œ˜Kšœ œ ˜Kšœœ˜/Kšœ œ˜#Kšœœœ˜6šŸœœœ˜(Kšœœœ˜Kšœ œ˜Kšœ"˜"Kšœ˜Kšœ˜Kšœ)˜)K˜—šŸœœœ˜'Kšœœœ˜K˜Kšœ%˜%Kšœ˜Kšœ˜Kšœ)˜)K˜—K˜ Kšœœ ˜K˜K˜—K˜š Ÿ œœœœœ˜gKšœœ˜Kšœœ˜Kšœœœ˜K˜ Kšœ˜KšŸœœ&œ˜:Kšœ2˜2KšœK˜KKšœ;˜;KšœœY˜aKšœ œ#˜1Kšœœ ˜-K˜ Kšœ˜—K˜šŸ œœœ˜/Kšœ œ)˜8Kšœ œ#˜2šŸœœ˜Kšœœ˜K˜Kšœ˜—šŸ œœ˜&Kšœœœ˜Kšœ$˜$Kšœ˜—Kš œœœœœœ˜DKšœœ ˜*K˜Kšœ$˜$Kšœ˜—K˜šŸ œœ9œ˜RKšœœœ ˜K˜K˜š˜Kšœ œ˜K˜Kšœ˜K˜Kšœœœ˜Kšœ œ ˜K˜.Kšœ œœ˜-šœ ˜Kšœ˜šœΟcœ˜#K˜$Kšœœ˜$Kšœ7˜7K˜——Kšœ˜—šœœœ˜"Kšœœœ˜Kšœ˜K˜—Kšœœœœ˜EKšœœœ˜šœŸ œœ˜(Kšœœœ˜!Kšœœœ˜5Kšœœœ˜>Kšœ˜—Kšœœ!˜=Kšœ˜ —K˜šŸœœœ˜;Kš œ&œœœœœ˜jK˜—K˜šŸœœœ œ˜=Kšœ œ˜ šœœ œ˜2Kšœœ˜ Kšœœ˜Kšœœ˜/Kšœ œRœ1˜Kšœ˜—Kšœ˜—K˜šœœœ˜?KšŸœ˜KšŸœ ˜KšŸœ ˜KšŸœ˜Kšœ ˜ K˜—K˜š Ÿ œœœœœœ˜Ešœœœ˜Kšœ œ˜Kšœœ˜——K˜šŸ œœœœœœ œ˜_Kšœ œœ˜Kšœ œœ˜Kšœ˜%—K˜šŸ œœœœœœ œ˜\Kšœ œœ˜!—K˜š Ÿ œœœœœ  œ˜{Kšœ œœ˜Kšœ œœ˜Kšœ˜—K˜šŸ œœœœ#˜Yš˜Kšœœœ ˜%Kšœ œœœ˜"Kšœ œœœ ˜%šœ œ˜šœœœ œ˜(Kšœœ-˜5Kšœœ˜Kšœœ˜—šœœ œ œ˜.Kšœœ˜šœœ ˜Kšœ0˜6Kšœ>˜DKšœ0˜6K˜3—Kšœœ˜—Kšœœ˜—Kšœ œœ˜K˜K˜Kšœ˜—K˜—K˜šŸœœœœ˜8K˜ šœœœ˜.šœ œ˜Kšœœ'˜.Kšœœ‘˜§Kšœœ˜—Kšœ˜—K˜—K˜šœœ˜6KšŸœ˜KšŸœ ˜KšŸœ ˜KšŸœ˜K˜—K˜š Ÿ œœœœœœ˜DKšœœœœ˜šœœ˜Kšœœœ˜Kšœœœ˜—Kšœ˜—K˜š Ÿœœœœœœ˜JKšœœœ˜Kšœ'˜'Kšœ=œ˜GKšœ˜—K˜š Ÿ œœœœœœ˜BKšœœ$˜-—K˜š Ÿ œœœœœ#˜`Kšœœœ˜Kšœœœ˜KšœHœœ˜VKšœ,œœ˜:Kšœ.œœ˜