DIRECTORY AMBridge, AMTypes, Core, CoreOps, CoreProperties, IO, PrintTV, RefTab, Rope; CoreOpsImpl: CEDAR PROGRAM IMPORTS AMBridge, CoreProperties, IO, PrintTV, RefTab, Rope EXPORTS CoreOps = BEGIN OPEN Core, CoreOps; nameProp: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CoreName, CoreProperties.Props[ [CoreProperties.propCopy, CoreProperties.PropDoCopy], [CoreProperties.propPrint, CoreProperties.PropDontPrint] ]]; printClassProcProp: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CorePrintClassProc]; 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]]; CoreProperties.PutCellTypeProp[cellType, nameProp, name]; }; 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.GetProp[me.properties, recastCacheProp]; IF value#NIL THEN RETURN [NARROW[value]]; new _ me.class.recast[me]; me.properties _ CoreProperties.PutProp[me.properties, recastCacheProp, new]; }; PrintCellType: PUBLIC PROC [cellType: CellType, out: STREAM, depth: NAT _ 0] = { classProc: REF PrintClassProc; 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, depth+1]; IF (classProc _ NARROW[CoreProperties.GetProp[from: cellType.class.properties, prop: printClassProcProp]]) # NIL THEN classProc[cellType.data, out]; CoreProperties.PrintProperties[props: cellType.properties, out: out]; }; PrintIndent: PUBLIC PROC [depth: NAT, out: STREAM] = { IO.PutChar[out, IO.CR]; FOR i: NAT IN [0..depth) DO IO.PutRope[out, " "] ENDLOOP; }; CreateWire: PUBLIC PROC [size: NAT _ 0, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [wire: Wire] = { wire _ NEW [WireRec[size]]; wire.properties _ props; FOR i: NAT IN [0 .. size) DO wire[i] _ CreateWire[]; ENDLOOP; IF name#NIL THEN CoreProperties.PutWireProp[wire, nameProp, name]; }; CreateSequenceWire: PUBLIC PROC [elements: LIST OF Wire, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [wire: Wire] = { wire _ WiresToWire[elements, name, props]; CoreProperties.PutWireProp[wire, sequenceProp, sequenceProp]; FOR w: NAT IN [1 .. wire.size) DO IF ~Conform[wire[0], wire[w]] THEN ERROR; ENDLOOP; }; SubrangeWire: PUBLIC PROC [wire: Wire, start, size: NAT, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [sub: Wire] = { sub _ CreateWire[size, name, props]; CoreProperties.PutWireProp[sub, sequenceProp, sequenceProp]; FOR i: NAT IN [0 .. size) DO sub[i] _ wire[start+i]; ENDLOOP; }; WiresToWire: PUBLIC PROC [wires: LIST OF Wire, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [wire: Wire] = { size: NAT _ 0; FOR c: LIST OF Wire _ wires, c.rest UNTIL c=NIL DO size _ size + 1; ENDLOOP; wire _ NEW [WireRec[size]]; wire.properties _ props; IF name#NIL THEN CoreProperties.PutWireProp[wire, nameProp, name]; size _ 0; FOR c: LIST OF Wire _ wires, c.rest UNTIL c=NIL DO wire[size] _ c.first; size _ size + 1; ENDLOOP; }; CopyWire: PUBLIC PROC [wire: Wire] RETURNS [new: Wire] = { new _ CreateWire[size: wire.size, props: CoreProperties.CopyProps[propList: wire.properties]]; FOR i: NAT IN [0 .. wire.size) DO new[i] _ CopyWire[wire[i]] ENDLOOP; }; sequenceProp: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CoreSequence, CoreProperties.Props[[CoreProperties.propCopy, CoreProperties.PropDoCopy]]]; VisitWire: PUBLIC PROC [wire: Wire, eachWire: EachWireProc] RETURNS [quit: BOOL] = { subWires: BOOL; [subWires, quit] _ eachWire[wire]; IF quit OR ~subWires THEN RETURN; FOR i: NAT IN [0 .. wire.size) DO IF VisitWire[wire[i], eachWire] THEN RETURN [TRUE]; ENDLOOP; quit _ FALSE; }; 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 ~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: RefTab.Ref _ RefTab.Create[]; -- Wire to ATOM CountBits: PROC [wire: Wire] RETURNS [bits: NAT _ 0] = { IF NOT RefTab.Fetch[x: 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 RefTab.Insert[x: visitTab, key: wire, val: $Counted] THEN ERROR; }; }; bits _ CountBits[wire]; }; GetWireName: PUBLIC PROC [wire: Wire] RETURNS [name: ROPE _ NIL] = { name _ NARROW [CoreProperties.GetWireProp[wire, nameProp]]; }; GetWireIndex: PUBLIC PROC [wire: Wire, name: ROPE] RETURNS [n: INT _ -1] ~ { FOR i: NAT IN [0..wire.size) DO IF Rope.Equal[name, GetWireName[wire[i]]] THEN RETURN [i]; ENDLOOP; }; FullNameWire: PUBLIC PROC [wire: Wire, name: ROPE _ NIL, prop: ATOM _ publicFullName] = { wire.properties _ CoreProperties.PutProp[on: wire.properties, prop: prop, value: name]; FOR i: NAT IN [0 .. wire.size) DO new: ROPE _ SELECT TRUE FROM CoreProperties.GetWireProp[wire, sequenceProp]#NIL => IO.PutFR["%g[%g]", IO.rope[name], IO.int[i]], GetWireName[wire[i]]#NIL => IF name=NIL THEN GetWireName[wire[i]] ELSE Rope.Cat[name, ".", GetWireName[wire[i]]], ENDCASE => IF name=NIL THEN "?" ELSE Rope.Cat[name, ".?"]; FullNameWire[wire[i], new, prop]; ENDLOOP; }; nameClassWireProcProp: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CoreClassWireNameProc]; publicFullName: PUBLIC ATOM _ CoreProperties.RegisterProperty[ $CorePublicWireFullName, CoreProperties.Props[[CoreProperties.propPrint, CoreProperties.PropDontPrint]] ]; PrintWire: PUBLIC PROC [wire: Wire, out: STREAM, depth: NAT _ 0] = { name: ROPE _ GetWireName[wire]; PrintIndent[depth, out]; IO.PutF[out, "%g", IF name=NIL THEN IO.rope[""] ELSE IO.rope[name]]; IF wire.size#0 THEN IO.PutF[out, ", %g elements", IO.int[wire.size]]; CoreProperties.PrintProperties[props: wire.properties, out: out, depth: depth+1]; FOR i: NAT IN [0 .. wire.size) DO PrintWire[wire[i], out, depth+1]; ENDLOOP; }; Reverse: PUBLIC PROC [wires: LIST OF Wire] RETURNS [revWires: LIST OF Wire _ NIL] = { WHILE wires#NIL DO revWires _ CONS [wires.first, revWires]; wires _ wires.rest ENDLOOP; }; Delete: PUBLIC PROC [wires: LIST OF Wire, wire: Wire] RETURNS [newWires: LIST OF Wire _ NIL] = { WHILE wires#NIL DO IF wires.first#wire THEN newWires _ CONS [wires.first, newWires]; wires _ wires.rest; ENDLOOP; }; Member: PUBLIC PROC [wires: LIST OF Wire, wire: Wire] RETURNS [BOOL] = { WHILE wires#NIL DO IF wires.first=wire THEN RETURN [TRUE]; wires _ wires.rest ENDLOOP; RETURN [FALSE]; }; InternalPrintCellType: PrintTV.TVPrintProc = { cellType: CellType; ref: REF READONLY ANY; TRUSTED {ref _ AMBridge.SomeRefFromTV[tv]}; cellType _ NARROW [ref, REF READONLY CellType]^; stream.PutF["{CellType - class: %g, public: ", IO.rope[cellType.class.name]]; Print[ref: cellType.public, stream: stream, depth: depth-1, width: width, verbose: verbose]; stream.PutF[", data: "]; Print[ref: cellType.data, stream: stream, depth: depth-1, width: width, verbose: verbose]; stream.PutF[", properties: "]; Print[ref: cellType.properties, stream: stream, depth: depth-1, width: width, verbose: verbose]; stream.PutF["}"]; }; Print: PROC [ref: REF ANY, stream: STREAM, depth: INT _ 4, width: INT _ 32, verbose: BOOL _ FALSE] = { tv: AMTypes.TV; TRUSTED {tv _ AMBridge.TVForReferent[NEW [REF _ ref]]}; PrintTV.Print[tv, stream, depth, width, verbose]; }; END. CoreOpsImpl.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Barth, December 5, 1985 12:48:50 pm PST Spreitzer, December 1, 1985 6:56:42 pm PST Bertrand Serlet November 26, 1985 3:23:19 pm PST Louis Monier December 16, 1985 3:20:39 pm PST Names Cell Classes Cell Types Creation of Wires Enumerating Wires Naming of Wires (temporary) Printing of Wires (temporary) Operations on LIST OF Wires Printing of Core Values (not yet functional) BS: There is something in the interpreter (or in my understanding of it) that prevents using PrintTV now, but that's the hope [tv: TV, data: REF ANY, stream: STREAM, depth: INT _ 4, width: INT _ 32, verbose: BOOL _ FALSE] RETURNS [useOld: BOOL _ FALSE] PrintTV.RegisterTVPrintProc[CODE[CellType], InternalPrintCellType]; Κ – "cedar" style˜codešœ™Kšœ Οmœ1™Kš  œ˜$Kšžœžœ-˜8K˜K˜—š Ÿœžœžœžœžœ˜:Kšœ)’˜8šŸ œžœžœžœ ˜8šžœžœ,žœ˜8Kšžœ žœ ˜š žœžœžœžœž˜&Kšœ#˜#Kšžœ˜—Kšžœžœ6žœžœ˜GK˜—K˜—K˜K˜——™š Ÿ œžœžœžœžœžœ˜DKšœžœ.˜;K˜—K˜š Ÿ œž œžœžœžœ ˜Lšžœžœžœž˜Kšžœ(žœžœ˜:Kšžœ˜—K˜—š Ÿ œž œžœžœžœ˜YKšœW˜Wšžœžœžœž˜!šœžœžœžœž˜šœ/žœ˜3Kšœžœžœ žœ ˜0—šœž˜Kš œžœžœžœžœ+˜X—šž˜Kš œžœžœžœžœ˜2——Jšœ!˜!Jšžœ˜—K˜—K˜Kšœžœžœ;˜]šœžœžœ#˜>Kšœ˜KšœN˜NKšœ˜——™š Ÿ œžœžœžœ žœ ˜DKšœžœ˜K˜Kšžœžœžœžœžœžœžœ ˜MKšžœ žœžœžœ˜EKšœQ˜Qšžœžœžœž˜!Kšœ!˜!Kšžœ˜—K˜——šœžœžœ™šŸœžœžœ žœžœžœ žœžœžœ˜UJš žœžœžœ žœ-žœ˜WJšœ˜—šŸœžœžœ žœžœžœ žœžœžœ˜`šžœžœž˜Jšžœžœ žœ˜AJšœ˜Jšžœ˜—Jšœ˜—šŸœžœžœ žœžœžœžœ˜HJšžœžœžœžœžœžœžœžœ˜VJšžœžœ˜Jšœ˜——™,Kšœ}™}K–‚ -- [tv: TV, data: REF ANY, stream: STREAM, depth: INT _ 4, width: INT _ 32, verbose: BOOL _ FALSE] RETURNS [useOld: BOOL _ FALSE]˜š œ˜.KšΠck~™~Kšœ˜Kšœžœžœžœ˜Kšžœ$˜+Kšœ žœžœžœ ˜0Kšœ/žœ˜MKšœ\˜\Kšœ˜KšœZ˜ZKšœ˜Kšœ`˜`Kšœ˜Jšœ˜—K˜šŸœžœžœžœ žœ žœ žœžœžœ˜fKšœ žœ˜Kšžœžœžœ ˜7Kšœ1˜1K˜—K˜Kšœžœ#™C—K˜Kšžœ˜K˜—…—2-Α