Behaviour
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;
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;
};
roseInternalWireProp: ATOM = CoreProperties.RegisterProperty[prop: $RoseInternalWire];
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];
};
};
};
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;
};
The recursion in this procedure should be eliminated and the procedure made inline.
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];
};
};
};
The recursion in this procedure should be eliminated and the procedure made inline.
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;
};
Make this procedure inline after the recursion in this procedure is eliminated and the recursion in UpdateAndSchedule is eliminated.
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;
};
Make this procedure inline after the recursion in UpdateAndSchedule is eliminated.
UpdateWire:
PROC [simulation: Simulation, value: ValueWire] = {
internal: InternalValueWire ← value.internal;
newRing, oldRing: Drive;
newLevel: Level;
newRing ← value.d;
oldRing ← value.currentRing;
optimize the single writer, multiple reader case
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;
};
};
Make this procedure inline someday.
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;
};
GetValue: PUBLIC PROC [wire: Core.Wire] RETURNS [value: ValueWire] = {
value ← CreateInstanceValueWire[actual: wire];
[] ← LoadValue[value];
};
RefreshValue:
PUBLIC
PROC [value: ValueWire] = {
[] ← LoadValue[value];
};
SetValue:
PUBLIC
PROC [simulation: Simulation, value: ValueWire] = {
UpdateAndSchedule[simulation, 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 ← "<no wire source>"
ELSE {
name ← wire.name;
IF name=NIL THEN name ← NARROW[CoreProperties.GetWireProp[from: wire, prop: CoreClasses.internalFullName]];
IF name=NIL THEN name ← "<can't get to cell type for names yet>";
};
};
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
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;
};