RoseInstantiateImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reversed.
Barth, August 1, 1985 2:31:39 pm PDT
Spreitzer, October 2, 1985 10:46:23 pm PDT
DIRECTORY BitTwiddling, Core, CoreFlatten, CoreOps, CoreProperties, CoreRecord, IO, Rope, RoseBind, RoseBindPrivate, RoseControl, RoseEngine, RosePrivates, RoseSimTypes, RoseWireTwiddling, RoseWireTypes, RoseWiring;
RoseInstantiateImpl:
CEDAR
PROGRAM
IMPORTS BitTwiddling, CoreFlatten, CoreOps, CP: CoreProperties, RoseBind, RoseBindPrivate, RoseEngine, RoseWireTwiddling, RoseWiring
EXPORTS RoseControl, RoseEngine, RoseSimTypes
=
BEGIN OPEN CR: CoreRecord, RoseWireTypes, RoseSimTypes, RoseEngine;
This program instantiates a Rosemary simulation.
A Wire will be a leaf iff:
All of its parts, if any, are used in parallel, and
No ancestor could be a leaf.
BehaviorClass: TYPE = REF BehaviorClassRec;
BehaviorClassRec: PUBLIC TYPE = RoseBindPrivate.BehaviorClassRec;
Simulation: TYPE = REF SimulationRec;
SimulationRec: PUBLIC TYPE = RoseSimTypes.SimulationRec;
notInWireList: PUBLIC RoseWire ← NEW [RoseWireRep];
notInCellList: PUBLIC RoseCellInstance ← NEW [RoseCellInstanceRep];
roseWireTypeKey: PUBLIC ATOM ← CP.RegisterProperty[$RoseWireTypeKey];
roseWireKey: PUBLIC ATOM ← CP.RegisterProperty[$RoseWireKey];
roseCellKey: PUBLIC ATOM ← CP.RegisterProperty[$RoseCellKey];
wireGroupKey: ATOM = CP.RegisterProperty[$RoseWireGroup];
wireBehaviorKindKey: ATOM = CP.RegisterProperty[$RoseWireBehaviorKind];
coreCellTypeToRoseCellType: ATOM = CP.RegisterProperty[$RoseCellTypeFromCoreCellType];
Instantiate:
PUBLIC
PROC [cellType: CellType, expansionControl: CoreFlatten.FlattenControl]
RETURNS [simulation: Simulation] = {
rootType: CellType ← GetTestRootType[cellType];
flatRootType: CellType ← CoreFlatten.Flatten[
rootType,
CoreFlatten.ControlByRecognition[
LIST[
[CoreFlatten.RecognizeName["tester"], immediate[leaf]],
[CoreFlatten.RecognizeName["testee"], nest[expansionControl]]
]]
];
simulation ←
NEW [SimulationRec ← [
flatRootType: flatRootType,
rootRecordType: NARROW[flatRootType.data],
sch: NEW [SchedulingRep ← [sim: NIL]]
]];
simulation.sch.sim ← simulation;
MakeUpPointers[simulation.rootRecordType.internalWire, NIL];
ComputeBehaviorKinds[simulation];
FindLeafWires[simulation];
MakeRoseWires[simulation];
MakeRoseCells[simulation];
FinishTestInstantiation[simulation, rootType];
};
upPointerKey: ATOM = CP.RegisterProperty[$RoseUpPointer];
MakeUpPointers:
PROC [wire: Wire, parent: Wire] = {
CP.PutWireProp[wire, upPointerKey, parent];
IF wire.elements #
NIL
THEN {
wire ← wire;
FOR i:
INT
IN [0 .. wire.elements.size)
DO
MakeUpPointers[wire.elements[i], wire];
ENDLOOP;
wire ← wire;
};
};
GetInternalParent:
PUBLIC
PROC [wire: Wire]
RETURNS [parent: Wire] =
{parent ← NARROW[CP.GetWireProp[wire, upPointerKey]]};
IsInternal:
PROC [sim: Simulation, wire: Wire]
RETURNS [is:
BOOL] =
{is ← wire=sim.rootRecordType.internalWire OR CP.GetWireProp[wire, upPointerKey]#NIL};
ComputeBehaviorKinds:
PROC [sim: Simulation] = {
GetPWPWBK:
PROC [publicWirePrototype: Wire, specIn: WireBehaviorKind]
RETURNS [pwpWBK: WireBehaviorKind] = {
pwpWBK ← GetWBK[publicWirePrototype];
IF pwpWBK = unspecified
THEN {
thisSpec: WireBehaviorKind ← SELECT CP.GetWireProp[publicWirePrototype, RoseBind.switchWire] FROM =NIL => specIn, #NIL => switch, ENDCASE => ERROR;
SELECT publicWirePrototype.structure
FROM
atom => pwpWBK ← IF thisSpec # unspecified THEN thisSpec ELSE simple;
sequence => {
IF publicWirePrototype.elements.size = 0 THEN ERROR;
FOR i:
NAT
IN [0 .. publicWirePrototype.elements.size)
DO
this: WireBehaviorKind ← GetPWPWBK[publicWirePrototype.elements[i], thisSpec];
IF i = 0 THEN pwpWBK ← this ELSE IF pwpWBK # this THEN ERROR;
ENDLOOP;
pwpWBK ← pwpWBK
};
record => {
someSwitch, someSimple, some: BOOL ← FALSE;
sim ← sim;
FOR i:
NAT
IN [0 .. publicWirePrototype.elements.size)
DO
sub: WireBehaviorKind ← GetPWPWBK[publicWirePrototype.elements[i], thisSpec];
some ← TRUE;
SELECT sub
FROM
simple => someSimple ← TRUE;
switch => someSwitch ← TRUE;
mixed => someSimple ← someSwitch ← TRUE;
unspecified => ERROR;
ENDCASE => ERROR;
ENDLOOP;
IF NOT some THEN ERROR;
pwpWBK ← IF someSimple THEN IF someSwitch THEN mixed ELSE simple ELSE IF someSwitch THEN switch ELSE ERROR;
};
ENDCASE => ERROR;
SetWBK[publicWirePrototype, pwpWBK];
};
IF specIn # unspecified AND specIn # pwpWBK THEN ERROR;
};
GetWBKCopy:
PROC [from, to: Wire, proto:
BOOL]
RETURNS [wbk: WireBehaviorKind] = {
wbk ← GetWBK[to];
IF wbk # unspecified THEN RETURN;
SELECT to.structure
FROM
atom => NULL;
record, sequence => {
from ← from;
FOR i:
NAT
IN [0 .. to.elements.size)
DO
fromI: NAT ← IF proto AND from.structure=sequence THEN 0 ELSE i;
[] ← GetWBKCopy[from.elements[fromI], to.elements[i], proto];
ENDLOOP;
to ← to;
};
ENDCASE => ERROR;
SetWBK[to, wbk ← GetWBK[from]];
IF wbk = unspecified THEN ERROR;
};
sim ← sim;
FOR il: CellInstanceList ← sim.rootRecordType.instances, il.rest
WHILE il #
NIL
DO
ci: CellInstance ← il.first;
cic: BehaviorClass ← RoseBindPrivate.GetBehaviorClass[ci.type, FALSE, FALSE, FALSE].class;
[] ← GetPWPWBK[cic.publicWirePrototype, unspecified];
[] ← GetWBKCopy[cic.publicWirePrototype, ci.type.publicWire, TRUE];
ENDLOOP;
sim ← sim;
};
GetWBK:
PUBLIC
PROC [wire: Wire]
RETURNS [wbk: WireBehaviorKind] = {
val: REF ANY ← CP.GetWireProp[wire, wireBehaviorKindKey];
wbk ←
SELECT val
FROM
$simple => simple,
$switch => switch,
$mixed => mixed,
NIL => unspecified,
ENDCASE => ERROR;
};
SetWBK:
PROC [wire: Wire, wbk: WireBehaviorKind] = {
CP.PutWireProp[
wire,
wireBehaviorKindKey,
SELECT wbk
FROM
simple => $simple,
switch => $switch,
mixed => $mixed,
ENDCASE => ERROR
];
};
FindLeafWires:
PROC [sim: Simulation] = {
FlwAwWork:
PROC [publicWire, actualWire: Wire, drive: RoseWireType] = {
pwWBK: WireBehaviorKind ← GetWBK[publicWire];
IF pwWBK=unspecified THEN ERROR;
SELECT (IsInternal[sim, actualWire]
AND drive.class.structure=atom
AND pwWBK
IN [simple..switch])
FROM
FALSE => {
SELECT actualWire.structure
FROM
atom => ERROR;
sequence, record => {
actualWire ← actualWire;
FOR i:
NAT
IN [0 .. actualWire.elements.size)
DO
FlwAwWork[
publicWire.elements[i],
actualWire.elements[i],
SELECT drive.class.structure
FROM
atom => drive,
record => drive.class.super.SubType[drive, [field[i]]],
sequence => drive.class.super.SubType[drive, [subscript[i]]],
ENDCASE => ERROR
];
ENDLOOP;
IF CP.GetWireProp[actualWire, wireGroupKey] = NIL THEN MarkAboveLeaf[actualWire];
};
ENDCASE => ERROR;
};
TRUE => {
group: WireGroup ← GetWireGroup[actualWire];
awWBK: WireBehaviorKind ← GetWBK[actualWire];
newAWwbk: WireBehaviorKind ←
SELECT
TRUE
FROM
awWBK=unspecified => pwWBK,
awWBK=mixed => ERROR,
awWBK=pwWBK => awWBK,
ENDCASE => switch;
IF awWBK#pwWBK THEN SetWBK[actualWire, newAWwbk];
SELECT group
FROM
aboveLeaf, leaf => NULL;
belowLeaf => BreakWire[GetInternalParent[actualWire]];
ENDCASE => ERROR;
};
ENDCASE => ERROR;
};
rootWire: Wire ← sim.rootRecordType.internalWire;
MarkAsLeaf[rootWire];
FOR il: CellInstanceList ← sim.rootRecordType.instances, il.rest
WHILE il #
NIL
DO
ci: CellInstance ← il.first;
cic: BehaviorClass ← RoseBindPrivate.GetBehaviorClass[ci.type, FALSE, FALSE, TRUE].class;
driveType: RoseWireType ← cic.wiring[drive].super.GetType[cic.wiring[drive], ci.actualWire];
FlwAwWork[ci.type.publicWire, ci.actualWire, driveType];
ENDLOOP;
sim ← sim;
};
MarkAsLeaf:
PROC [wire: Wire] = {
CP.PutWireProp[wire, wireGroupKey, $Leaf];
};
MarkAboveLeaf:
PROC [wire: Wire] = {
CP.PutWireProp[wire, wireGroupKey, $AboveLeaf];
};
GetWireGroup:
PUBLIC
PROC [wire: Wire]
RETURNS [wg: WireGroup] = {
val: ATOM ← NARROW[CP.GetWireProp[wire, wireGroupKey]];
wg ←
SELECT val
FROM
$Leaf => leaf,
$AboveLeaf => aboveLeaf,
NIL => belowLeaf,
ENDCASE => ERROR;
};
BreakWire:
PROC [wire: Wire] = {
pg: WireGroup ← GetWireGroup[wire];
FOR i:
NAT
IN [0 .. wire.elements.size)
DO
child: Wire ← wire.elements[i];
cg: WireGroup ← GetWireGroup[child];
SELECT cg
FROM
belowLeaf => MarkAsLeaf[child];
leaf, aboveLeaf => NULL;
ENDCASE => ERROR;
ENDLOOP;
MarkAboveLeaf[wire];
SELECT pg
FROM
belowLeaf => BreakWire[GetInternalParent[wire]];
leaf => NULL;
aboveLeaf => ERROR;
ENDCASE => ERROR;
};
MakeRoseWires:
PROC [sim: Simulation] = {
Work:
PROC [wire: Wire] = {
wg: WireGroup ← GetWireGroup[wire];
SELECT wg
FROM
belowLeaf => ERROR;
aboveLeaf => {
wire ← wire;
FOR i:
INT
IN [0 .. wire.elements.size)
DO
Work[wire.elements[i]];
ENDLOOP;
wire ← wire;
};
leaf => {
rw: RoseWire;
rwc: RoseWireClass;
rwt: RoseWireType;
wbk: WireBehaviorKind ← GetWBK[wire];
rwc ← RoseWiring.GetWiring[
wire,
SELECT wbk
FROM
simple => simple,
switch => switch,
ENDCASE => ERROR
];
rwt ← rwc.super.GetType[rwc, wire];
CP.PutWireProp[wire, roseWireTypeKey, rwt];
rw ←
NEW [RoseWireRep ← [
schIn: sim.sch,
core: wire,
type: rwt,
valPtr: RoseWireTwiddling.CreateUntypedInstance[rwt],
bitCount: rwt.class.super.Bits[rwt],
nextPerturbed: notInWireList,
nextAffected: notInWireList,
nextDelayed: notInWireList,
prevDelayed: notInWireList
]];
CP.PutWireProp[wire, roseWireKey, rw];
};
ENDCASE => ERROR;
};
Work[sim.rootRecordType.internalWire];
};
MakeRoseCells:
PROC [sim: Simulation] = {
FOR il: CellInstanceList ← sim.rootRecordType.instances, il.rest
WHILE il #
NIL
DO
ci: CellInstance = NARROW[il.first];
args: REF ANY = CP.GetCellTypeProp[ci.type, RoseBind.argsKey];
rct: RoseCellType = GetRoseCellType[ci.type, TRUE, TRUE];
bc: BehaviorClass = rct.behaviorClass;
pw: Wire = ci.type.publicWire;
rci: RoseCellInstance ←
NEW [RoseCellInstanceRep ← [
schIn: sim.sch,
core: ci,
args: args,
type: rct,
effectivePorts: NIL,
connectedWires: NIL,
schedNext: notInCellList,
nextNeeded: notInCellList,
nextNoted: notInCellList,
switchIO: bc.private.createSwitch[pw],
newIO: bc.private.createSimple[pw],
oldIO: bc.private.createSimple[pw],
newDrive: bc.private.createDrive[pw],
oldDrive: bc.private.createDrive[pw]
]];
IF rci.type.behaviorClass.details.CreateState # NIL THEN rci.state ← rci.type.behaviorClass.details.CreateState[args];
[rci.effectivePorts, rci.connectedWires, rci.hasTransducedPort] ← ComputeEffectiveInterface[rci];
CP.PutCellInstanceProp[ci, roseCellKey, rci];
ENDLOOP;
sim ← sim;
};
GetRoseCellType:
PUBLIC
PROC [ct: CellType, details, privates:
BOOL]
RETURNS [rct: RoseCellType] = {
rct ← NARROW[CP.GetCellTypeProp[ct, coreCellTypeToRoseCellType]];
IF rct =
NIL
THEN {
bc: BehaviorClass;
[bc] ← RoseBindPrivate.GetBehaviorClass[ct, FALSE, FALSE, TRUE];
rct ←
NEW [RoseCellTypeRep ← [
behaviorClass: bc,
wireTypes: [
switch: bc.wiring[switch].super.GetType[bc.wiring[switch], ct.publicWire],
simple: bc.wiring[simple].super.GetType[bc.wiring[simple], ct.publicWire],
drive: bc.wiring[drive].super.GetType[bc.wiring[drive], ct.publicWire]
]
]];
CP.PutCellTypeProp[ct, coreCellTypeToRoseCellType, rct];
};
IF details
OR privates
THEN {
goodDetails, goodPrivate: BOOL;
[goodDetails, goodPrivate] ← RoseBindPrivate.EnsureBCParts[rct.behaviorClass, details, privates];
IF (details AND NOT goodDetails) OR (privates AND NOT goodPrivate) THEN ERROR;
};
};
ComputeEffectiveInterface:
PROC [rci: RoseCellInstance]
RETURNS [effectivePorts: EffectivePortS, connectedWires: RoseWireS, hasTransducedPort:
BOOL] = {
length, index: NAT ← 0;
Count:
PROC [wire: Wire] = {
wg: WireGroup ← GetWireGroup[wire];
SELECT wg
FROM
belowLeaf => ERROR;
aboveLeaf => {
wire ← wire;
FOR i:
INT
IN [0 .. wire.elements.size)
DO
Count[wire.elements[i]];
ENDLOOP;
wire ← wire;
};
leaf => length ← length + 1;
ENDCASE => ERROR;
};
Fillin:
PROC [publicWire, actualWire: Wire, switchType, simpleType, driveType: RoseWireType, switch, newSimple, oldSimple, newDrive, oldDrive: Ptr, path: PortPath] = {
wg: WireGroup ← GetWireGroup[actualWire];
SELECT wg
FROM
belowLeaf => ERROR;
aboveLeaf => {
actualWire ← actualWire;
FOR i:
INT
IN [0 .. actualWire.elements.size)
DO
sel: Selector ←
SELECT actualWire.structure
FROM
atom => ERROR,
sequence => [subscript[i]],
record => [field[i]],
ENDCASE => ERROR;
Fillin[
publicWire.elements[i],
actualWire.elements[i],
switchType.class.super.SubType[switchType, sel],
simpleType.class.super.SubType[simpleType, sel],
driveType.class.super.SubType[driveType, sel],
Subscript[switch, switchType, sel],
Subscript[newSimple, simpleType, sel],
Subscript[oldSimple, simpleType, sel],
Subscript[newDrive, driveType, sel],
Subscript[oldDrive, driveType, sel],
PathAppend[path, i]
];
ENDLOOP;
actualWire ← actualWire;
};
leaf => {
rw: RoseWire ← NARROW[CP.GetWireProp[actualWire, roseWireKey]];
wbkP: WireBehaviorKind ← GetWBK[publicWire];
wbkA: WireBehaviorKind ← GetWBK[actualWire];
pSimple:
BOOL ←
SELECT wbkP
FROM
simple => TRUE,
switch => FALSE,
ENDCASE => ERROR;
aSimple:
BOOL ←
SELECT wbkA
FROM
simple => TRUE,
switch => FALSE,
ENDCASE => ERROR;
transduced: BOOL = (aSimple # pSimple);
me: Slot = [rci, index];
modelType: RoseWireType =
IF pSimple THEN simpleType ELSE switchType;
IF transduced AND aSimple THEN ERROR;
IF transduced THEN hasTransducedPort ← TRUE;
effectivePorts[index] ← [
switch: switch,
newSimple: newSimple,
oldSimple: oldSimple,
newDrive: newDrive,
oldDrive: oldDrive,
type: modelType,
implType: IF transduced THEN switchType ELSE modelType,
path: path,
input: TRUE,
output: TRUE,
XPhobic: pSimple,
transduced: transduced
];
SELECT aSimple
FROM
TRUE => {
initialStrength: Strength = none;
prev: Slot = rw.byStrength[initialStrength].last;
effectivePorts[index].curStrength ← initialStrength;
effectivePorts[index].strengthNext ← nilSlot;
effectivePorts[index].strengthPrev ← prev;
IF prev = nilSlot
THEN rw.byStrength[initialStrength].first ← me
ELSE prev.cell.effectivePorts[prev.effectivePortIndex].strengthNext ← me;
rw.byStrength[initialStrength].last ← me;
};
FALSE => {
rw.switchConnections ← CONS[me, rw.switchConnections];
rw.XPhobic ← rw.XPhobic OR effectivePorts[index].XPhobic;
};
ENDCASE => ERROR;
connectedWires[index] ← rw;
index ← index + 1;
};
ENDCASE => ERROR;
};
hasTransducedPort ← FALSE;
Count[rci.core.actualWire];
effectivePorts ← NEW [EffectivePortSeq[length]];
connectedWires ← NEW [RoseWireSeq[length]];
Fillin[
rci.core.type.publicWire,
rci.core.actualWire,
rci.type.wireTypes[switch],
rci.type.wireTypes[simple],
rci.type.wireTypes[drive],
RoseWireTwiddling.RefToPtr[rci.switchIO, rci.type.wireTypes[switch]],
RoseWireTwiddling.RefToPtr[rci.newIO, rci.type.wireTypes[simple]],
RoseWireTwiddling.RefToPtr[rci.oldIO, rci.type.wireTypes[simple]],
RoseWireTwiddling.RefToPtr[rci.newDrive, rci.type.wireTypes[drive]],
RoseWireTwiddling.RefToPtr[rci.oldDrive, rci.type.wireTypes[drive]],
NIL
];
IF index # length THEN ERROR;
};
Subscript:
PROC [p: Ptr, rwt: RoseWireType, sel: Selector]
RETURNS [q: Ptr] = {
dereference: BOOL = rwt.class.dereference;
dBits: NAT;
dBits ← rwt.class.super.SelectorOffset[rwt, sel];
IF dereference THEN p ← BitTwiddling.DeReferencePtr[p];
q ← BitTwiddling.OffsetPtr[p, dBits];
};
PathAppend:
PROC [path: PortPath, index:
INT]
RETURNS [longer: PortPath] = {
RETURN [IF path = NIL THEN LIST[index] ELSE CONS[path.first, PathAppend[path.rest, index]]];
};
flattenToBehavior: PUBLIC CoreFlatten.FlattenControl ← NEW [CoreFlatten.FlattenControlRec ← [DecideByBehavior, NIL]];
DecideByBehavior:
PROC [data:
REF
ANY, who: CoreFlatten.InstantiationPath]
RETURNS [ed: CoreFlatten.ExpandDecision] = {
ci: CellInstance = who.first;
ed ← IF RoseBindPrivate.GetBehaviorClass[ci.type, TRUE, FALSE, FALSE].goodDetails THEN leaf ELSE expand;
};
FlattenStructure:
PUBLIC
PROC [from: Core.CellType]
RETURNS [fc: CoreFlatten.FlattenControl] = {
fc ← NEW [CoreFlatten.FlattenControlRec ← [DecideByStructure, from]];
};
DecideByStructure:
PROC [data:
REF
ANY, who: CoreFlatten.InstantiationPath]
RETURNS [ed: CoreFlatten.ExpandDecision] = {
ct: CellType ← IF who # NIL THEN who.first.type ELSE NARROW[data];
WHILE ct.class.recast #
NIL
DO
ct ← CoreOps.Recast[ct];
ENDLOOP;
WITH ct.data
SELECT
FROM
rct: CR.RecordCellType => RETURN [expand];
ENDCASE => RETURN [leaf];
};
END.