DIRECTORY CedarProcess, Commander, Core, CoreOps, CoreProperties, HashTable, IO, ProcessProps, Rope, RopeList; CoreOpsImpl: CEDAR PROGRAM IMPORTS CedarProcess, CoreProperties, HashTable, IO, ProcessProps, Rope, RopeList EXPORTS CoreOps = BEGIN OPEN Core, CoreOps; nameProp: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CoreName, CoreProperties.Props[[CoreProperties.propCopy, CoreProperties.PropDoCopy], [CoreProperties.propPrint, CoreProperties.PropDontPrint]]]; printClassProcProp: ATOM _ CoreProperties.RegisterProperty[$CorePrintClassProc]; SetClassPrintProc: PUBLIC PROC [class: CellClass, proc: PrintClassProc] RETURNS [sameClass: CellClass] = { CoreProperties.PutCellClassProp[on: class, prop: printClassProcProp, value: NEW[PrintClassProc _ proc]]; sameClass _ class; }; CreateCellType: PUBLIC PROC [class: CellClass, public: Wire, data: REF ANY _ NIL, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [cellType: CellType] = { cellType _ NEW [CellTypeRec _ [class: class, public: public, data: data, properties: props]]; IF name#NIL THEN cellType _ SetCellTypeName[cellType, name]; }; SetCellTypeName: PUBLIC PROC [cellType: CellType, name: ROPE] RETURNS [sameCellType: CellType] = { CoreProperties.PutCellTypeProp[cellType, nameProp, name]; sameCellType _ cellType; }; GetCellTypeName: PUBLIC PROC [cellType: CellType] RETURNS [name: ROPE _ NIL] = { name _ NARROW [CoreProperties.GetCellTypeProp[cellType, nameProp]]; }; recastCacheProp: ATOM _ CoreProperties.RegisterProperty[$CoreRecastCache]; Recast: PUBLIC RecastProc = { value: REF _ CoreProperties.GetCellTypeProp[me, recastCacheProp]; IF value#NIL THEN RETURN [NARROW[value]]; new _ me.class.recast[me]; CoreProperties.PutCellTypeProp[me, recastCacheProp, new]; }; ToBasic: PUBLIC PROC [cellType: Core.CellType] RETURNS [basic: Core.CellType] = { FOR basic _ cellType, Recast[basic] UNTIL basic.class.recast = NIL DO NULL ENDLOOP; }; PrintCellType: PUBLIC PROC [cellType: CellType, out: STREAM _ NIL, indent: NAT _ 0, level: NAT _ 2] = { classProc: REF PrintClassProc; IF out=NIL THEN out _ NARROW[ProcessProps.GetProp[$CommanderHandle], Commander.Handle].out; IO.PutF[out, "\n\n%g: %g Cell Type", [rope[GetCellTypeName[cellType]]], [rope[cellType.class.name]] ]; IO.PutRope[out, "\nPublic wire:"]; PrintWire[cellType.public, out, indent+1, level]; IF (classProc _ NARROW [CoreProperties.GetProp[from: cellType.class.properties, prop: printClassProcProp]]) # NIL THEN classProc[cellType.data, out, indent, level]; CoreProperties.PrintProperties[props: cellType.properties, out: out, indent: indent, level: level]; }; PrintIndent: PUBLIC PROC [indent: NAT, out: STREAM, cr: BOOL _ TRUE] = { IF cr THEN { IO.PutChar[out, IO.CR]; FOR i: NAT IN [0..indent) DO IO.PutRope[out, " "] ENDLOOP } ELSE IO.PutRope[out, ", "] }; CreateWire: PUBLIC PROC [elements: Wires _ NIL, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [wire: Wire] = { size: NAT _ 0; FOR c: Wires _ elements, c.rest UNTIL c=NIL DO size _ size + 1; ENDLOOP; wire _ CreateWires[size, name, props]; size _ 0; FOR c: Wires _ elements, c.rest UNTIL c=NIL DO wire[size] _ c.first; size _ size + 1; ENDLOOP; }; CreateWires: PUBLIC PROC [size: NAT, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [wire: Wire] = { wire _ NEW[WireRec[size]]; wire.properties _ props; IF name#NIL THEN CoreProperties.PutWireProp[wire, nameProp, name]; }; SubrangeWire: PUBLIC PROC [wire: Wire, start, size: NAT, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [sub: Wire] = { sub _ CreateWires[size, name, props]; FOR i: NAT IN [0 .. size) DO sub[i] _ wire[start+i]; ENDLOOP; }; CopyWire: PUBLIC PROC [wire: Wire] RETURNS [new: Wire] = { Copy: PROC [wire: Wire] RETURNS [new: Wire] = { IF (new _ NARROW[HashTable.Fetch[table: visitTab, key: wire].value])=NIL THEN { new _ CreateWires[size: wire.size, props: CoreProperties.CopyProps[propList: wire.properties]]; IF NOT HashTable.Insert[table: visitTab, key: wire, value: new] THEN ERROR; FOR i: NAT IN [0 .. wire.size) DO new[i] _ Copy[wire[i]]; ENDLOOP; }; }; visitTab: HashTable.Table _ HashTable.Create[]; -- Wire to Wire new _ IF wire=NIL THEN NIL ELSE Copy[wire]; }; UnionWire: PUBLIC PROC [wire1, wire2: Wire, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [union: Wire] = { IF wire1 = NIL THEN RETURN [wire2]; -- BS thinks we should get rid of this test one day IF wire2 = NIL THEN RETURN [wire1]; -- BS thinks we should get rid of this test one day union _ CreateWires[size: wire1.size+wire2.size, name: name, props: props]; FOR i: NAT IN [0 .. wire1.size) DO union[i] _ wire1[i] ENDLOOP; FOR i: NAT IN [0 .. wire2.size) DO union[wire1.size+i] _ wire2[i] ENDLOOP; }; VisitWire: PUBLIC PROC [wire: Wire, eachWire: EachWireProc] RETURNS [quit: BOOL] = { subWires: BOOL; [subWires, quit] _ eachWire[wire]; IF quit OR NOT subWires THEN RETURN; FOR i: NAT IN [0 .. wire.size) DO IF VisitWire[wire[i], eachWire] THEN RETURN [TRUE]; ENDLOOP; quit _ FALSE; }; VisitAtomicWires: PUBLIC PROC [wire: Wire, eachWire: PROC [Wire]] = { IF wire.size=0 THEN eachWire[wire] ELSE FOR i: NAT IN [0 .. wire.size) DO VisitAtomicWires[wire[i], eachWire] ENDLOOP; }; VisitBinding: PUBLIC PROC [actual, public: Wire, eachWirePair: EachWirePairProc] RETURNS [quit: BOOL] = { subWires: BOOL; IF actual.size#public.size THEN RETURN [TRUE]; -- wires do not conform [subWires, quit] _ eachWirePair[actual, public]; IF quit OR NOT subWires THEN RETURN; FOR i: NAT IN [0 .. actual.size) DO IF VisitBinding[actual[i], public[i], eachWirePair] THEN RETURN [TRUE]; ENDLOOP; quit _ FALSE; }; Conform: PUBLIC PROC [actual, public: Wire] RETURNS [BOOL] = { EachWirePair: EachWirePairProc = {}; RETURN [NOT VisitBinding[actual, public, EachWirePair]]; }; WireBits: PUBLIC PROC [wire: Wire] RETURNS [bits: NAT] = { visitTab: HashTable.Table _ HashTable.Create[]; -- Wire to ATOM CountBits: PROC [wire: Wire] RETURNS [bits: NAT _ 0] = { IF NOT HashTable.Fetch[table: visitTab, key: wire].found THEN { IF wire.size=0 THEN bits _ 1 ELSE FOR sub: NAT IN [0..wire.size) DO bits _ bits + CountBits[wire[sub]]; ENDLOOP; IF NOT HashTable.Insert[table: visitTab, key: wire, value: $Counted] THEN ERROR; }; }; bits _ CountBits[wire]; }; GetShortWireName: PUBLIC PROC [wire: Wire] RETURNS [name: ROPE _ NIL] = { name _ IF wire=NIL THEN NIL ELSE NARROW [CoreProperties.GetWireProp[wire, nameProp]]; }; SetShortWireName: PUBLIC PROC [wire: Wire, name: ROPE] RETURNS [sameWire: Wire] = { IF wire#NIL THEN CoreProperties.PutWireProp[wire, nameProp, name]; sameWire _ wire; }; GetWireIndex: PUBLIC PROC [wire: Wire, name: ROPE] RETURNS [n: INT _ -1] ~ { IF wire#NIL THEN FOR i: NAT IN [0..wire.size) DO IF Rope.Equal[name, GetShortWireName[wire[i]]] THEN RETURN [i]; ENDLOOP; }; wireToNamesCacheProp: ATOM _ CoreProperties.RegisterProperty[$CoreWireToNamesCache, CoreProperties.Props[[CoreProperties.propPrint, CoreProperties.PropDontPrint]]]; nameToWireCacheProp: ATOM _ CoreProperties.RegisterProperty[$CoreNameToWireCache, CoreProperties.Props[[CoreProperties.propPrint, CoreProperties.PropDontPrint]]]; FullWireNames: PRIVATE PROC [root: Wire] RETURNS [wireToNames, nameToWire: HashTable.Table] = { SetName: PUBLIC PROC [wire: Wire, name: ROPE] = { names: LIST OF ROPE _ NARROW [HashTable.Fetch[wireToNames, wire].value]; previousWire: Wire _ NARROW [HashTable.Fetch[nameToWire, name].value]; IF name#NIL AND NOT RopeList.Memb[names, name] THEN { names _ CONS [name, names]; [] _ HashTable.Store[wireToNames, wire, names]; }; IF name#NIL AND ~HashTable.Insert[nameToWire, name, wire] AND previousWire#wire THEN ERROR; -- two different wires have the same name relative to this root FOR i: NAT IN [0 .. wire.size) DO short: ROPE _ GetShortWireName[wire[i]]; SetName[wire[i], SELECT TRUE FROM short=NIL => Rope.Cat[name, "[", IO.PutR1[IO.int[i]], "]"], name=NIL => short, ENDCASE => Rope.Cat[name, ".", short]]; ENDLOOP; }; wireToNames _ NARROW [CoreProperties.GetWireProp[root, wireToNamesCacheProp]]; nameToWire _ NARROW [CoreProperties.GetWireProp[root, nameToWireCacheProp]]; IF wireToNames#NIL AND nameToWire#NIL THEN RETURN; wireToNames _ HashTable.Create[WireBits[root]]; nameToWire _ HashTable.Create[WireBits[root], HashTable.RopeEqual, HashTable.HashRope]; SetName[root, GetShortWireName[root]]; CoreProperties.PutWireProp[root, wireToNamesCacheProp, wireToNames]; CoreProperties.PutWireProp[root, nameToWireCacheProp, nameToWire]; }; GetFullWireNames: PUBLIC PROC [root, wire: Wire] RETURNS [names: LIST OF ROPE ] = { names _ NARROW [HashTable.Fetch[FullWireNames[root].wireToNames, wire].value]; }; GetFullWireName: PUBLIC PROC [root, wire: Wire] RETURNS [name: ROPE ] = { names: LIST OF ROPE _ GetFullWireNames[root, wire]; IF names=NIL OR names.rest#NIL THEN ERROR; -- one full name only for this wire, please name _ names.first; }; IsFullWireName: PUBLIC PROC [root, wire: Wire, name: ROPE] RETURNS [BOOL] = { RETURN [RopeList.Memb[GetFullWireNames[root, wire], name]] }; FindWire: PUBLIC PROC [root: Wire, name: ROPE] RETURNS [wire: Wire _ NIL] = { wire _ NARROW [HashTable.Fetch[FullWireNames[root].nameToWire, name].value]; }; ParseWireName: PUBLIC PROC [name: ROPE] RETURNS [base: ROPE, components: LIST OF ROPE _ NIL] = { endBase: INT _ MIN [Rope.Index[name, 0, "."], Rope.Index[name, 0, "["]]; base _ Rope.Substr[name, 0, endBase]; name _ Rope.Substr[name, endBase]; WHILE Rope.Length[name]#0 DO SELECT Rope.Fetch[name] FROM '[ => { endBracket: INT _ Rope.Find[name, "]"]; IF endBracket=-1 THEN ERROR; -- malformed name components _ CONS [Rope.Substr[name, 1, endBracket-1], components]; name _ Rope.Substr[name, endBracket+1]; }; '. => { endField: INT _ MIN [Rope.Index[name, 1, "."], Rope.Index[name, 1, "["]]; components _ CONS [Rope.Substr[name, 1, endField-1], components]; name _ Rope.Substr[name, endField]; }; ENDCASE => ERROR; -- malformed name ENDLOOP; components _ RopeList.Reverse[components]; }; PrintWire: PUBLIC PROC [wire: Wire, out: STREAM _ NIL, indent: NAT _ 0, level: NAT _ 2] = { name: ROPE _ GetShortWireName[wire]; PrintAWire: PROC [wire: Wire, indent: NAT, level: NAT, name: ROPE, cr, firstWire: BOOL] = { CedarProcess.CheckAbort[]; PrintIndent[indent, out, cr OR firstWire]; IO.PutRope[out, name]; IF wire.size#0 THEN IO.PutF[out, ", %g elements", IO.int[wire.size]]; CoreProperties.PrintProperties[props: wire.properties, out: out, indent: indent+1, cr: cr, level: level]; IF level=0 AND wire.size#0 THEN IO.PutRope[out, " [...] "] ELSE FOR i: NAT IN [0 .. wire.size) DO subName: ROPE _ GetShortWireName[wire[i]]; IF subName=NIL THEN subName _ IO.PutFR["[%g]", IO.int[i]]; PrintAWire[wire[i], indent+1, level-1, subName, cr AND wire.size<=32, cr AND i=0]; ENDLOOP; }; IF out=NIL THEN out _ NARROW[ProcessProps.GetProp[$CommanderHandle], Commander.Handle].out; PrintAWire[wire, indent, level, IF name#NIL THEN name ELSE "", TRUE, TRUE]; }; FlushNameCaches: PUBLIC PROC [root: Wire] = { CoreProperties.PutWireProp[root, wireToNamesCacheProp, NIL]; CoreProperties.PutWireProp[root, nameToWireCacheProp, NIL]; }; Reverse: PUBLIC PROC [wires: Wires] RETURNS [revWires: Wires _ NIL] = { WHILE wires#NIL DO revWires _ CONS [wires.first, revWires]; wires _ wires.rest ENDLOOP; }; Delete: PUBLIC PROC [wires: Wires, wire: Wire] RETURNS [newWires: Wires _ NIL] = { WHILE wires#NIL DO IF wires.first#wire THEN newWires _ CONS [wires.first, newWires]; wires _ wires.rest; ENDLOOP; }; Member: PUBLIC PROC [wires: Wires, wire: Wire] RETURNS [BOOL] = { WHILE wires#NIL DO IF wires.first=wire THEN RETURN [TRUE]; wires _ wires.rest ENDLOOP; RETURN [FALSE]; }; RecursiveMember: PUBLIC PROC [wire, candidate: Wire] RETURNS [BOOL] = { FindActual: EachWireProc = {quit _ wire=candidate}; RETURN [VisitWire[wire, FindActual]]; }; FixStupidRef: PUBLIC PROC [ref: REF ANY] RETURNS [rope: ROPE] = { rope _ WITH ref SELECT FROM r: REF TEXT => Rope.FromRefText[r], r: ROPE => r, ENDCASE => ERROR; }; Print: PUBLIC PROC [ref: REF, out: STREAM _ NIL, indent: NAT _ 0, level: NAT _ 2] = { WITH ref SELECT FROM wire: Wire => PrintWire[wire, out, indent, level]; cellType: CellType => PrintCellType[cellType, out, indent, level]; ENDCASE => { IF out=NIL THEN out _ NARROW [ProcessProps.GetProp[$CommanderHandle], Commander.Handle].out; IO.PutRope[out, "*** CoreOps.Print Does not know how to print argument"]; }; }; END. ZCoreOpsImpl.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Barth, January 30, 1986 9:38:27 am PST Spreitzer, April 8, 1986 4:34:16 pm PST Bertrand Serlet May 29, 1986 7:37:33 pm PDT Louis Monier May 1, 1986 4:44:41 pm PDT Pradeep Sindhu February 24, 1986 6:48:20 pm PST Property Cell Classes Cell Types Wire Creation Wire Enumeration Wire Naming Association wire -> list of full names Association full name -> wire SetName has GetShortWireName[wire] instead of NIL to make full names also work for wires in their own context, as in Sisyph. Wire List Operations Miscellaneous ΚΨ– "cedar" style˜codešœ™Kšœ Οmœ1™Kš  œ˜$Kšžœžœ-˜8K˜K˜—š Ÿœžœžœžœžœ˜:Kšœ1‘˜@šŸ œžœžœžœ ˜8šžœžœ3žœ˜?Kšžœ žœ ˜š žœžœžœžœž˜&Kšœ#˜#Kšžœ˜—Kšžœžœ?žœžœ˜PK˜—K˜—K˜K˜——™ š Ÿœžœžœžœžœžœ˜IKš œžœžœžœžœžœžœ.˜UK˜K˜—š Ÿœžœžœžœžœ˜SKšžœžœžœ2˜BKšœ˜K˜K˜—š Ÿ œžœžœžœžœžœ ˜Lš žœžœžœžœžœžœž˜0Kšžœ-žœžœ˜?Kšžœ˜—K˜K˜—šœžœŠ˜€K™&K˜—šœžœ‰˜’K™K˜—šŸ œžœžœžœ/˜_šŸœžœžœžœ˜1Kš œžœžœžœžœ,˜HKšœžœ+˜Fš žœžœžœžœžœ˜5Kšœžœ˜Kšœ/˜/Kšœ˜—Jš žœžœžœ+žœžœžœ‘?˜›šžœžœžœž˜!Kšœžœ˜(šœžœžœž˜!Kšœžœžœžœ˜;Kšœžœ ˜Kšžœ ˜'—Jšžœ˜—K˜—Kšœžœ:˜NKšœ žœ9˜LKš žœ žœžœ žœžœžœ˜2Kšœ/˜/KšœW˜WKšœ|™|Kšœ&˜&JšœD˜DJšœB˜BK˜—K˜šŸœžœžœžœ žœžœžœ˜SKšœžœ@˜NK˜K˜—š Ÿœžœžœžœžœ˜IKšœžœžœžœ ˜3Kš žœžœžœ žœžœžœ‘+˜VKšœ˜K˜K˜—š Ÿœžœžœžœžœžœ˜MKšžœ4˜:K˜K˜—š Ÿœžœžœžœžœžœ˜MKšœžœ?˜LK˜K˜—šŸ œžœžœžœžœžœžœžœžœžœ˜`Jšœ žœžœ6˜HJšœ%˜%Jšœ"˜"šžœž˜šžœž˜˜Jšœ žœ˜'Jšžœžœžœ‘˜.Jšœ žœ2˜CJšœ'˜'J˜—˜Jšœ žœžœ6˜IJšœ žœ0˜AJšœ#˜#J˜—Jšžœžœ‘˜#—Jšžœ˜—J˜*J˜J˜—K˜šŸ œžœžœžœžœ žœ žœ ˜[Kšœžœ˜$š Ÿ œžœžœ žœžœžœ˜[Kšœ˜Kšœžœ ˜*Kšžœ˜Kšžœ žœžœžœ˜EKšœi˜išžœ žœ žœžœžœžœžœžœž˜aKšœ žœ˜*Kš žœ žœžœ žœžœ ˜:Kšœ3žœžœ˜RKšžœ˜—K˜K˜—Kšžœžœžœžœ?˜[Kš œžœžœžœžœžœžœ˜TK˜K˜—šŸœžœžœ˜-Jšœ7žœ˜