<> <> <> <> <<>> 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; <> <> <> <> <> <> <> <> <> <> <> <> <<[found, val] _ SymTab.Fetch[roseClassTable, roseClassName];>> <> <> <> <> <> <> <> <<};>> <<>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<[found, val] _ SymTab.Fetch[roseClassTable, roseClassName];>> <> <> <> <> <> <> <> <> <<};>> <<>> roseInternalWireProp: ATOM = CoreProperties.RegisterProperty[prop: $RoseInternalWire]; <> <> <> <> <> <<};>> <<};>> <<[] _ CoreOps.VisitWire[wire: internal, eachWire: MakeInternalWire];>> <<};>> <<>> <> <> <> <> <> <> <> <> <> <> <<}>> <> <> <> <> <> <> <> <> <> <> <> <> <<};>> <<};>> <<};>> <<>> 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; }; <> <> <<[] _ LoadValue[value];>> <<};>> <<>> RefreshValue: PUBLIC PROC [value: ValueWire] = { [] _ LoadValue[value]; }; SetValue: PUBLIC PROC [simulation: Simulation, value: ValueWire] = { UpdateAndSchedule[simulation, value]; }; <> <> <> < {>> <> <> <> <<};>> < PrintLevelValue[value, out];>> < PrintNameValueStrength[value, out, IF value.b THEN "TRUE" ELSE "FALSE"];>> < PrintNameValueStrength[value, out, IO.PutFR["%g", IO.int[value.c]]];>> < PrintNameValueStrength[value, out, IO.PutFR["%g", IO.int[value.lc]]];>> < _{ERROR;>> < ERROR;>> <<};>> <<>> <> <> < "L",>> < "X",>> < "H",>> < ERROR];>> <<};>> <<>> <> <> < "expect",>> < "none",>> < "force",>> < "chargeWeak",>> < "chargeMediumWeak",>> < "charge",>> < "chargeMediumStrong",>> < "chargeStrong",>> < "chargeVeryStrong",>> < "driveWeak",>> < "driveMediumWeak",>> < "drive",>> < "driveMediumStrong",>> < "driveStrong",>> < "driveVeryStrong",>> < "input",>> < ERROR;>> <> <> <> <> <> <">> <> <> <> <";>> <<};>> <<};>> <> <<};>> <<>> <> <> <> <> <> <> <> <> <> <> <<};>> <> <<}>> <> <> <> <> <<};>> <<};>> <<>> <> <> <> <<};>> <<>> <> <> <> <> <> <> <<}>> <> <> <> <> <<};>> <<};>> <<>> <> 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.}