DIRECTORY Basics, CoreOps, CoreProperties, RedBlackTree, Rope, RoseBind, RoseWireClasses, RoseWireTypes, RoseWiring; RoseWiringImpl: CEDAR PROGRAM IMPORTS CoreOps, CP: CoreProperties, RedBlackTree, Rope, RoseBind, RoseWireClasses, RoseWireTypes EXPORTS RoseWiring = BEGIN OPEN CO: CoreOps, RoseWireClasses, RoseWiring; ROPE: TYPE = Rope.ROPE; Wire: TYPE = RoseWireTypes.Wire; StructureOfWire: PROC [Wire] RETURNS [RoseWireTypes.CoreWireStructure] = RoseWireTypes.StructureOfWire; protoToRWC: ARRAY RoseWireTypes.WireFlavor OF ATOM = [ simple: CP.RegisterProperty[$RoseWiringImplProtoToSimpleRWC], switch: CP.RegisterProperty[$RoseWiringImplProtoToSwitchRWC], drive: CP.RegisterProperty[$RoseWiringImplProtoToDriveRWC] ]; Derivation: TYPE = REF DerivationRec; DerivationRec: TYPE = RECORD [ prototype: Wire, class: RoseWireTypes.RoseWireClass ]; classes: ARRAY RoseWireTypes.WireFlavor OF RoseWireTypes.SymbolTable _ [ simple: RedBlackTree.Create[GetRWCKey, RWCCompareSimple], switch: RedBlackTree.Create[GetRWCKey, RWCCompareSwitch], drive: RedBlackTree.Create[GetRWCKey, RWCCompareDrive] ]; nameOverride: ATOM _ CP.RegisterProperty[$RoseWireNameOverride]; ComputeWiring: PUBLIC PROC [publicWirePrototype: Wire, betterName: ROPE _ NIL] RETURNS [cw: RoseWireTypes.BehaviorClassWiring] = { OverrideName[publicWirePrototype, betterName]; cw _ NEW [RoseWireTypes.BehaviorClassWiringRep _ [ simple: GetWiring[publicWirePrototype, simple], switch: GetWiring[publicWirePrototype, switch], drive: GetWiring[publicWirePrototype, drive] ]]; }; GetWiring: PUBLIC PROC [proto: Wire, flavor: RoseWireTypes.WireFlavor] RETURNS [rwc: RoseWireTypes.RoseWireClass] = { drv: Derivation; rwc _ NARROW[PV[proto, protoToRWC[flavor]]]; IF rwc # NIL THEN RETURN; drv _ NARROW[classes[flavor].Lookup[proto]]; IF drv = NIL THEN { SELECT TRUE FROM StructureOfWire[proto] = atom => rwc _ SELECT flavor FROM simple => GetBool[], switch => GetBit[], drive => GetDrive[], ENDCASE => ERROR; flavor=drive AND PV[proto, RoseBind.simpleDrive] # NIL => rwc _ GetDrive[]; StructureOfWire[proto] = record => rwc _ GetRecord[proto, flavor]; StructureOfWire[proto] = sequence AND StructureOfWire[proto.elements[0]] = atom AND flavor = drive AND PV[proto, RoseBind.complexDrive] = NIL => rwc _ GetDrive[]; StructureOfWire[proto] = sequence AND PV[proto, RoseBind.variableWire] # NIL => rwc _ GetVariableSequence[proto, flavor]; StructureOfWire[proto] = sequence AND StructureOfWire[proto.elements[0]] = atom AND flavor = simple => rwc _ GetBasicSequence[proto]; StructureOfWire[proto] = sequence => rwc _ GetFixedSequence[proto, flavor]; ENDCASE => ERROR; drv _ NEW[DerivationRec _ [prototype: proto, class: rwc]]; classes[flavor].Insert[drv, proto]; } ELSE rwc _ drv.class; CP.PutWireProp[proto, protoToRWC[flavor], rwc]; }; OverrideName: PROC [w: Wire, name: ROPE] = { CP.PutWireProp[w, nameOverride, name]; }; WireName: PUBLIC PROC [w: Wire] RETURNS [name: ROPE] = { name _ NARROW[CP.GetWireProp[w, nameOverride]]; IF name = NIL THEN name _ CO.GetWireName[w]; }; GetRWCKey: PROC [data: REF ANY] RETURNS [proto: Wire] --RedBlackTree.GetKey-- = { drv: Derivation _ NARROW[data]; proto _ drv.prototype; }; RWCCompareSimple: PROC [k, data: REF ANY] RETURNS [c: Basics.Comparison] --RedBlackTree.Compare-- = { k1: Wire _ NARROW[k]; k2: Wire _ GetRWCKey[data]; c _ WireCompare[k1, k2, TRUE, FALSE, TRUE]; }; RWCCompareSwitch: PROC [k, data: REF ANY] RETURNS [c: Basics.Comparison] --RedBlackTree.Compare-- = { k1: Wire _ NARROW[k]; k2: Wire _ GetRWCKey[data]; c _ WireCompare[k1, k2, TRUE, FALSE, TRUE]; }; RWCCompareDrive: PROC [k, data: REF ANY] RETURNS [c: Basics.Comparison] --RedBlackTree.Compare-- = { k1: Wire _ NARROW[k]; k2: Wire _ GetRWCKey[data]; c _ WireCompare[k1, k2, TRUE, TRUE, TRUE]; }; WireCompare: PROC [w1, w2: Wire, name, drive, variable: BOOL] RETURNS [c: Basics.Comparison] = { IF name AND (c _ WireName[w1].Compare[WireName[w2]]) # equal THEN RETURN; IF (c _ INTCompare[ORD[StructureOfWire[w1]], ORD[StructureOfWire[w2]]]) # equal THEN RETURN; IF StructureOfWire[w1] = atom THEN RETURN; IF drive AND (c _ BoolCompare[SimpleDrive[w1], SimpleDrive[w2]]) # equal THEN RETURN; SELECT StructureOfWire[w1] FROM record => { IF (c _ INTCompare[w1.elements.size, w2.elements.size]) # equal THEN RETURN; FOR i: INT IN [0 .. w1.elements.size) DO e1: Wire _ w1.elements[i]; e2: Wire _ w2.elements[i]; IF (c _ WireCompare[e1, e2, TRUE, drive, variable]) # equal THEN RETURN; ENDLOOP; c _ equal; }; sequence => { IF variable AND (c _ BoolCompare[IsVariable[w1], IsVariable[w2]]) # equal THEN RETURN; IF (c _ WireCompare[w1.elements[0], w2.elements[0], FALSE, drive, variable]) # equal THEN RETURN; IF NOT (variable AND IsVariable[w1]) THEN c _ INTCompare[w1.elements.size, w2.elements.size]; }; ENDCASE => ERROR; }; SimpleDrive: PROC [w: Wire] RETURNS [BOOL] = { simple: BOOL = TRUE; complex: BOOL = FALSE; IF PV[w, RoseBind.simpleDrive] # NIL THEN RETURN [simple]; IF PV[w, RoseBind.complexDrive] # NIL THEN RETURN [complex]; IF StructureOfWire[w] = sequence AND StructureOfWire[w.elements[0]] = atom THEN RETURN [simple]; RETURN [complex]; }; IsVariable: PUBLIC PROC [w: Wire] RETURNS [BOOL] = {RETURN [PV[w, RoseBind.variableWire] # NIL]}; PV: PROC [w: Wire, prop: ATOM] RETURNS [val: REF ANY] = {val _ CP.GetWireProp[w, prop]}; INTCompare: PROC [i1, i2: INT] RETURNS [c: Basics.Comparison] = { c _ SELECT i1 FROM < i2 => less, = i2 => equal, > i2 => greater, ENDCASE => ERROR; }; BoolCompare: PROC [i1, i2: BOOL] RETURNS [c: Basics.Comparison] = { c _ SELECT i1 FROM < i2 => less, = i2 => equal, > i2 => greater, ENDCASE => ERROR; }; END. ¬RoseWiringImpl.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Barth, September 5, 1985 7:17:02 pm PDT Spreitzer, November 18, 1985 10:29:16 pm PST Κ – "cedar" style˜codešœ™Kšœ Οmœ1™žœžœ˜Lšžœžœžœž˜(K˜K˜Kšžœžœžœžœ˜HKšžœ˜—K˜ K˜—˜ Kšžœ žœ;žœžœ˜VKšžœ2žœžœžœ˜aKšžœžœ žœžœ4˜]K˜—Kšžœžœ˜—K˜—K˜š  œžœ žœžœ˜.Kšœžœžœ˜Kšœ žœžœ˜Kš žœžœžœžœžœ ˜:Kš žœžœžœžœžœ ˜