DIRECTORY Basics, Core, CoreClasses, CoreFlatten, CoreOps, CoreProperties, IO, Rosemary, SymTab; RosemaryImpl: CEDAR PROGRAM IMPORTS Basics, CoreProperties, SymTab EXPORTS Rosemary = BEGIN OPEN Rosemary; ROPE: TYPE = Core.ROPE; roseCellTypeProp: ATOM = CoreProperties.RegisterProperty[prop: $RoseCellType]; roseClassTable: SymTab.Ref _ SymTab.Create[]; Bind: PUBLIC PROC [cellType: Core.CellType, roseClassName: Core.ROPE] = { CoreProperties.PutCellTypeProp[on: cellType, prop: roseCellTypeProp, value: roseClassName]; }; Register: PUBLIC PROC [roseClassName: Core.ROPE, init: InitProc _ NIL, evalSimple: EvalProc _ NIL] RETURNS [sameRoseClassName: Core.ROPE] = { found: BOOL; val: REF ANY; [found, val] _ SymTab.Fetch[x: roseClassTable, key: roseClassName]; IF found THEN { rct: RoseCellType _ NARROW[val]; rct.init _ init; rct.evalSimple _ evalSimple; } ELSE [] _ SymTab.Store[x: roseClassTable, key: roseClassName, val: NEW[RoseCellTypeRec _ [init: init, evalSimple: evalSimple]]]; sameRoseClassName _ roseClassName; }; Stop: PUBLIC SIGNAL [msg: ROPE, data: REF ANY _ NIL] = CODE; roseInternalWireProp: ATOM = CoreProperties.RegisterProperty[prop: $RoseInternalWire]; Initialize: PUBLIC PROC [simulation: Simulation, steady: BOOL _ TRUE] = { ERROR; -- not yet implemented }; Settle: PUBLIC PROC [simulation: Simulation] = { UNTIL simulation.needEval=NIL DO currentInstance: RoseCellInstance _ simulation.needEval; currentValue: ValueWire _ currentInstance.value; simulation.needEval _ simulation.needEval.scheduleNext; currentInstance.scheduleNext _ NIL; [] _ LoadValue[currentValue]; currentInstance.roseCellType.evalSimple[p: currentValue, stateAny: currentInstance.state]; UpdateAndSchedule[simulation, currentValue]; ENDLOOP; FOR internals: InternalValueWires _ simulation.internal, internals.rest UNTIL internals=NIL DO IF internals.first.l=X THEN FOR readers: ValueWireList _ internals.first.readerValues, readers.rest UNTIL readers=NIL DO IF readers.first.type#l THEN ERROR; ENDLOOP; ENDLOOP; }; LoadValue: PROC [value: ValueWire] = { IF value.type = none THEN FOR child: NAT IN [0..value.size) DO LoadValue[value[child]]; ENDLOOP ELSE { IF value.size=0 THEN { value.l _ value.internal.l; value.b _ SELECT value.l FROM H => TRUE, L => FALSE, X => value.b ENDCASE => ERROR; value.lc _ IF value.b THEN 1 ELSE 0; value.c _ Basics.LowHalf[value.lc]; } ELSE { IF value.fieldSize>32 THEN ERROR; value.lc _ 0; FOR child: NAT IN [0..value.size) DO LoadValue[value[child]]; value.lc _ LOOPHOLE[ Basics.DoubleOr[ Basics.DoubleShiftLeft[LOOPHOLE[value.lc], value[child].fieldSize], LOOPHOLE[value[child].lc]]]; ENDLOOP; value.c _ Basics.LowHalf[value.lc]; }; }; }; UpdateAndSchedule: PROC [simulation: Simulation, value: ValueWire] = { SELECT value.type FROM none => { FOR child: NAT IN [0..value.size) DO UpdateAndSchedule[simulation, value[child]]; ENDLOOP; }; l => UpdateWire[simulation, value]; b => { value.l _ IF value.b THEN H ELSE L; UpdateWire[simulation, value]; }; c => PropagateBits[simulation, value, value.c]; lc => PropagateBits[simulation, value, value.lc]; sub => IF value.size>0 THEN PropagateBits[simulation, value, value.lc] ELSE UpdateWire[simulation, value]; ENDCASE => ERROR; }; PropagateBits: PROC [simulation: Simulation, value: ValueWire, childBits: LONG CARDINAL] = { FOR child: NAT DECREASING IN [0..value.size) DO childValue: ValueWire _ value[child]; childValue.lc _ LOOPHOLE[Basics.DoubleAnd[LOOPHOLE[childBits], LOOPHOLE[mask[childValue.fieldSize]]]]; childValue.c _ LOOPHOLE[Basics.LowHalf[childValue.lc]]; childValue.b _ IF Basics.BITAND[childValue.c, 1] = 1 THEN TRUE ELSE FALSE; childValue.l _ IF childValue.b THEN H ELSE L; childValue.d _ value.d; childBits _ LOOPHOLE[Basics.DoubleShiftRight[LOOPHOLE[childBits], childValue.fieldSize]]; UpdateAndSchedule[simulation, childValue]; ENDLOOP; }; UpdateWire: PROC [simulation: Simulation, value: ValueWire] = { internal: InternalValueWire _ value.internal; newRing, oldRing: Drive; newLevel: Level; newRing _ value.d; oldRing _ value.currentRing; IF newRing#oldRing THEN { IF value.nextStrengthRingMember=value THEN internal.writerValues[oldRing] _ NIL ELSE { internal.writerValues[oldRing] _ value.nextStrengthRingMember; value.nextStrengthRingMember.previousStrengthRingMember _ value.previousStrengthRingMember; value.previousStrengthRingMember.nextStrengthRingMember _ value.nextStrengthRingMember; }; InsertWireOnRing[value: value, newRing: newRing, internal: internal]; }; newLevel _ internal.l; FOR strength: Drive DECREASING IN [force..input] DO writer: ValueWire _ internal.writerValues[strength]; IF writer # NIL THEN { newLevel _ writer.l; IF newLevel=X THEN EXIT; FOR otherWriter: ValueWire _ writer.nextStrengthRingMember, otherWriter.nextStrengthRingMember UNTIL otherWriter=writer DO IF otherWriter.l # newLevel THEN { newLevel _ X; EXIT; }; ENDLOOP; EXIT; }; ENDLOOP; IF internal.l#newLevel THEN { internal.l _ newLevel; FOR readers: RoseCellInstances _ internal.readers, readers.rest UNTIL readers=NIL DO reader: RoseCellInstance _ readers.first; IF reader.scheduleNext=NIL THEN { reader.scheduleNext _ simulation.needEval; simulation.needEval _ reader; }; ENDLOOP; }; }; InsertWireOnRing: PROC [value: ValueWire, newRing: Drive, internal: InternalValueWire] = { IF internal.writerValues[newRing] = NIL THEN { internal.writerValues[newRing] _ value; value.nextStrengthRingMember _ value; value.previousStrengthRingMember _ value; } ELSE { currentHead: ValueWire _ internal.writerValues[newRing]; value.nextStrengthRingMember _ currentHead; value.previousStrengthRingMember _ currentHead.previousStrengthRingMember; currentHead.previousStrengthRingMember _ value; value.previousStrengthRingMember.nextStrengthRingMember _ value; }; value.currentRing _ newRing; }; RefreshValue: PUBLIC PROC [value: ValueWire] = { [] _ LoadValue[value]; }; SetValue: PUBLIC PROC [simulation: Simulation, value: ValueWire] = { UpdateAndSchedule[simulation, value]; }; roseTestTable: SymTab.Ref _ SymTab.Create[]; RegisterTest: PUBLIC PROC [testName: ROPE, testProc: CellTestProc] = { [] _ SymTab.Store[x: roseTestTable, key: testName, val: NEW[CellTestProc _ testProc]]; }; RunTest: PUBLIC PROC [simulation: Simulation, testName: ROPE] = { Eval: PROC = { SetValue[simulation: simulation, value: simulation.publicValue]; Settle[simulation: simulation]; CheckValue[simulation.publicValue]; }; found: BOOL; val: REF ANY; proc: REF CellTestProc; [found, val] _ SymTab.Fetch[roseTestTable, testName]; IF NOT found THEN ERROR; proc _ NARROW[val]; proc^[p: simulation.publicValue, Eval: Eval]; }; CheckValue: PROC [value: ValueWire] = { IF value.size>0 THEN FOR child: NAT IN [0..value.size) DO CheckValue[value[child]]; ENDLOOP ELSE IF value.internal.writerValues[expect]#NIL THEN IF value.internal.l#value.l THEN ERROR; }; mask: ARRAY [1..32] OF LONG CARDINAL _ ALL[1]; FOR i: NAT IN [2..32] DO mask[i] _ 2*mask[i-1] + 1; ENDLOOP; END. xRosemaryImpl.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Barth, November 5, 1985 11:03:34 am PST Bertrand Serlet November 20, 1985 1:13:01 am PST Behaviour Simulation Instantiation and Control InstantiateCellType: PUBLIC PROC [cellType: Core.CellType] RETURNS [simulation: Simulation] = { roseInstance: RoseCellInstance _ NEW[RoseCellInstanceRec]; found: BOOL; val: REF ANY; roseClassName: ROPE _ NARROW[CoreProperties.GetCellTypeProp[from: cellType, prop: roseCellTypeProp]]; simulation _ NEW[SimulationRec _ [ cellType: cellType]]; simulation.internal _ CreateInternalValueWires[cellType.public]; simulation.publicValue _ CreateInstanceValueWire[actual: cellType.public]; roseInstance.scheduleNext _ simulation.needEval; simulation.needEval _ roseInstance; [found, val] _ SymTab.Fetch[roseClassTable, roseClassName]; IF NOT found THEN ERROR; roseInstance.roseCellType _ NARROW[val]; roseInstance.coreCellInstance _ NIL; roseInstance.value _ CreateInstanceValueWire[instance: roseInstance, actual: cellType.public]; roseInstance.state _ roseInstance.roseCellType.init[cellType: cellType, p: roseInstance.value]; simulation.roseCellInstances _ CONS[roseInstance, simulation.roseCellInstances]; UpdateAndSchedule[simulation, roseInstance.value]; }; InstantiateInstances: PUBLIC PROC [cellType: Core.CellType] RETURNS [simulation: Simulation] = { recordCellType: CoreClasses.RecordCellType _ NARROW[cellType.data]; simulation _ NEW[SimulationRec _ [ cellType: cellType]]; simulation.internal _ CreateInternalValueWires[recordCellType.internal]; simulation.publicValue _ CreateInstanceValueWire[actual: cellType.public]; FOR instances: CoreClasses.CellInstanceList _ recordCellType.instances, instances.rest UNTIL instances=NIL DO coreInstance: CoreClasses.CellInstance _ instances.first; roseInstance: RoseCellInstance _ NEW[RoseCellInstanceRec]; roseClassName: ROPE _ NARROW[CoreProperties.GetCellTypeProp[from: coreInstance.type, prop: roseCellTypeProp]]; found: BOOL; val: REF ANY; roseInstance.scheduleNext _ simulation.needEval; simulation.needEval _ roseInstance; [found, val] _ SymTab.Fetch[roseClassTable, roseClassName]; IF NOT found THEN ERROR; roseInstance.roseCellType _ NARROW[val]; roseInstance.coreCellInstance _ coreInstance; roseInstance.value _ CreateInstanceValueWire[instance: roseInstance, actual: coreInstance.actual]; roseInstance.state _ roseInstance.roseCellType.init[cellType: coreInstance.type, p: roseInstance.value]; simulation.roseCellInstances _ CONS[roseInstance, simulation.roseCellInstances]; UpdateAndSchedule[simulation, roseInstance.value]; ENDLOOP; }; CreateInternalValueWires: PROC [internal: Core.Wire] RETURNS [internalValues: InternalValueWires _ NIL] = { MakeInternalWire: CoreOps.EachWireProc = { IF wire.structure=atom THEN { internalValues _ CONS[NEW[InternalValueWireRec], internalValues]; CoreProperties.PutWireProp[on: wire, prop: roseInternalWireProp, value: internalValues.first]; }; }; [] _ CoreOps.VisitWire[wire: internal, eachWire: MakeInternalWire]; }; CreateInstanceValueWire: PROC [actual: Core.Wire, instance: RoseCellInstance _ NIL] RETURNS [valueWire: ValueWire] = { IF actual.structure#atom THEN { valueWire _ NEW[ValueWireRec[actual.elements.size]]; valueWire.coreWire _ actual; valueWire.roseCellInstance _ instance; valueWire.fieldSize _ 0; FOR i:NAT IN [0 .. actual.elements.size) DO valueWire[i] _ CreateInstanceValueWire[actual.elements[i], instance]; valueWire.fieldSize _ valueWire.fieldSize + valueWire[i].fieldSize; ENDLOOP; } ELSE { valueWire _ NEW[ValueWireRec[0]]; valueWire.coreWire _ actual; valueWire.roseCellInstance _ instance; valueWire.type _ l; valueWire.fieldSize _ 1; valueWire.internal _ NARROW[CoreProperties.GetWireProp[from: actual, prop: roseInternalWireProp]]; InsertWireOnRing[value: valueWire, newRing: none, internal: valueWire.internal]; valueWire.internal.readerValues _ CONS[valueWire, valueWire.internal.readerValues]; IF instance#NIL THEN { valueWire.internal.writers _ CONS[instance, valueWire.internal.writers]; valueWire.internal.readers _ CONS[instance, valueWire.internal.readers]; }; }; }; The recursion in this procedure should be eliminated and the procedure made inline. The recursion in this procedure should be eliminated and the procedure made inline. Make this procedure inline after the recursion in this procedure is eliminated and the recursion in UpdateAndSchedule is eliminated. Make this procedure inline after the recursion in UpdateAndSchedule is eliminated. optimize the single writer, multiple reader case Make this procedure inline someday. GetValue: PUBLIC PROC [wire: Core.Wire] RETURNS [value: ValueWire] = { value _ CreateInstanceValueWire[actual: wire]; [] _ LoadValue[value]; }; PrintValue: PUBLIC PROC [value: ValueWire, out: Core.STREAM] = { IF value.type=sub AND value.size=0 THEN PrintLevelValue[value, out] ELSE SELECT value.type FROM none, sub => { FOR child: NAT IN [0..value.size) DO PrintValue[value[child], out]; ENDLOOP; }; l => PrintLevelValue[value, out]; b => PrintNameValueStrength[value, out, IF value.b THEN "TRUE" ELSE "FALSE"]; c => PrintNameValueStrength[value, out, IO.PutFR["%g", IO.int[value.c]]]; lc => PrintNameValueStrength[value, out, IO.PutFR["%g", IO.int[value.lc]]]; sub => ERROR; ENDCASE => ERROR; }; PrintLevelValue: PROC [value: ValueWire, out: Core.STREAM] = { PrintNameValueStrength[value, out, SELECT value.l FROM L => "L", X => "X", H => "H", ENDCASE => ERROR]; }; PrintNameValueStrength: PROC [value: ValueWire, out: Core.STREAM, valueRope: ROPE] = { strength: ROPE _ SELECT value.d FROM expect => "expect", none => "none", force => "force", chargeWeak => "chargeWeak", chargeMediumWeak => "chargeMediumWeak", charge => "charge", chargeMediumStrong => "chargeMediumStrong", chargeStrong => "chargeStrong", chargeVeryStrong => "chargeVeryStrong", driveWeak => "driveWeak", driveMediumWeak => "driveMediumWeak", drive => "drive", driveMediumStrong => "driveMediumStrong", driveStrong => "driveStrong", driveVeryStrong => "driveVeryStrong", input => "input", ENDCASE => ERROR; wire: Core.Wire _ value.coreWire; name: ROPE _ wire.name; IF name=NIL THEN { wireSource: CoreFlatten.WireSource _ NARROW[CoreProperties.GetWireProp[from: wire, prop: CoreFlatten.wireSource]]; wire _ wireSource.wire; IF wire=NIL THEN name _ "" ELSE { name _ wire.name; IF name=NIL THEN name _ NARROW[CoreProperties.GetWireProp[from: wire, prop: CoreClasses.internalFullName]]; IF name=NIL THEN name _ ""; }; }; IO.PutF[out, "%g: %g^%g\n", IO.rope[name], IO.rope[valueRope], IO.rope[strength]]; }; PrintDrivers: PUBLIC PROC [value: ValueWire, out: Core.STREAM] = { IF value.size=0 THEN { FOR strength: Drive DECREASING IN [expect..input] DO writer: ValueWire _ value.internal.writerValues[strength]; IF writer # NIL THEN { PrintCellTypeValue[writer, out]; FOR otherWriter: ValueWire _ writer.nextStrengthRingMember, otherWriter.nextStrengthRingMember UNTIL otherWriter=writer DO PrintCellTypeValue[otherWriter, out]; ENDLOOP; EXIT; }; ENDLOOP; } ELSE { FOR child: NAT IN [0..value.size) DO PrintDrivers[value[child], out]; ENDLOOP }; }; PrintCellTypeValue: PROC [value: ValueWire, out: Core.STREAM] = { IO.PutF[out, "\nCore cell type: %g\n", IO.rope[value.roseCellInstance.coreCellInstance.type.name]]; PrintValue[value, out]; }; PrintWriters: PUBLIC PROC [value: ValueWire, out: Core.STREAM] = { IF value.size=0 THEN { FOR writers: RoseCellInstances _ value.internal.writers, writers.rest UNTIL writers=NIL DO IO.PutF[out, "\nCore cell type: %g\n", IO.rope[writers.first.coreCellInstance.type.name]]; PrintValue[writers.first.value, out]; ENDLOOP; } ELSE { FOR child: NAT IN [0..value.size) DO PrintWriters[value[child], out]; ENDLOOP }; }; Test Procedures Start Code Κg– "cedar" style˜codešœ™Kšœ Οmœ1™˜>Kšœ[˜[KšœW˜WK˜—KšœE˜EK˜—Kšœ˜šžœž œžœž˜3Kšœ4˜4šžœ žœžœ˜Kšœ˜Kšžœ žœžœ˜šžœ\žœž˜zšžœžœ˜"Kšœ ˜ Kšžœ˜K˜—Kšžœ˜—Kšžœ˜K˜—Kšžœ˜—šžœžœ˜Kšœ˜šžœ=žœ žœž˜TKšœ)˜)šžœžœžœ˜!Kšœ*˜*Kšœ˜K˜—Kšžœ˜—K˜—K˜K˜—Kšœ#™#š œžœD˜Zšžœ"žœžœ˜.Kšœ'˜'Kšœ%˜%Kšœ)˜)K˜—šžœ˜Kšœ8˜8Kšœ+˜+KšœJ˜JKšœ/˜/Kšœ@˜@K˜—Kšœ˜K˜K˜—š‘Ÿ’Ÿ’Ÿ’Ÿ™FKšŸ.™.KšŸ™KšŸ™K™—š  œžœžœ˜0K˜Kšœ˜K˜—š œžœžœ/˜DKšœ%˜%Kšœ˜K˜—š  œžœžœžœ™@Kšžœžœžœ™Cšžœžœ ž™šœ™šžœžœžœž™$Kšœ™Kšžœ™—K™—Kšœ!™!Kšœ(žœ žœžœ ™MKšœ(žœ žœ™IKšœ)žœ žœ™KKšœžœ™ Kšžœžœ™—Kšœ™K™—š œžœžœ™>šœ#žœ ž™6K™ K™ K™ Kšžœžœ™—Kšœ™K™—š œžœžœ žœ™Všœ žœžœ ž™$Kšœ™Kšœ™Kšœ™Kšœ™Kšœ'™'Kšœ™Kšœ+™+Kšœ™Kšœ'™'Kšœ™Kšœ%™%Kšœ™Kšœ)™)Kšœ™Kšœ%™%Kšœ™Kšžœžœ™—K™!Kšœžœ ™šžœžœžœ™Kšœ%žœG™rKšœ™Kšžœžœžœ™*šžœ™Kšœ™KšžœžœžœžœM™kKšžœžœžœ1™AK™—K™—Kšžœžœ žœžœ™RKšœ™K™—š  œžœžœžœ™Bšžœžœ™šžœž œžœž™4Kšœ:™:šžœ žœžœ™Kšœ ™ šžœ\žœž™zKšœ%™%Kšžœ™—Kšžœ™K™—Kšžœ™—K™—šžœ™šžœžœžœž™$Kšœ ™ Kšž™—K™—Kšœ™K™—š œžœžœ™AKšžœ%žœ:™cKšœ™Kšœ™K™—š  œžœžœžœ™Bšžœžœ™šžœCžœ žœž™ZKšžœ%žœ1™ZKšœ%™%Kšžœ™—Kšœ™—šžœ™šžœžœžœž™$Kšœ ™ Kšž™—K™—Kšœ™K™——™Kšœ,˜,K˜š  œžœžœ žœ˜FKšœ9žœ˜WKšœ˜K˜—š œžœžœ$žœ˜Aš œžœ˜Kšœ@˜@Kšœ˜Kšœ#˜#Kšœ˜—Kšœžœ˜ Kšœžœžœ˜ Kšœžœ˜Kšœ5˜5Kšžœžœžœžœ˜Kšœžœ˜Kšœ-˜-Kšœ˜K˜—š  œžœ˜'š žœžœžœžœžœž˜9Kšœ˜Kšž˜—Kšžœžœ%žœžœžœžœžœ˜\Kšœ˜K˜——™ Kš œžœ žœžœžœžœ˜.šžœžœžœ ž˜Kšœ˜Kšžœ˜K˜——Kšžœ˜K˜—…—Iύ