[Indigo]<Rosemary>®>Rosemary.DF=>RoseCreateImpl.Mesa
Last Edited by: Spreitzer, April 15, 1985 11:50:54 am PST
DIRECTORY Asserting, Basics, Convert, IO, OrderedSymbolTableRef, PrincOps, PrincOpsUtils, Rope, RoseCreate, RoseEvents, RoseIOHacks, RoseRun, RoseTypes;
RoseCreateImpl:
CEDAR
PROGRAM
IMPORTS Asserting, Convert, IO, OSTR: OrderedSymbolTableRef, PrincOpsUtils, Rope, RoseCreate, RoseEvents, RoseIOHacks, RoseRun, RoseTypes
EXPORTS RoseCreate, RoseTypes =
BEGIN OPEN RoseCreate, RoseTypes;
cellTypes: SymbolTable ← OSTR.CreateTable[CompareCellTypes];
roots: PUBLIC SymbolTable ← OSTR.CreateTable[CompareComponents];
bogosityKey: ATOM = $bogosityKey;
survey: ERClass ←
NEW [ERClassRep ← [
CellInstance: SurveyCellInstance,
NodeInstance: NodeInstance,
Equivalence: Equivalence
]];
EqualInterfaces:
PUBLIC
PROC [a, b: Ports]
RETURNS [structurally, fully:
BOOL] = {
structurally ← fully ← a.length = b.length;
FOR portIndex: PortIndex
IN [0 .. a.length)
WHILE structurally
DO
IF
NOT (
Conforming[a[portIndex].type, b[portIndex].type] AND
a[portIndex].input = b[portIndex].input AND
a[portIndex].output = b[portIndex].output AND
a[portIndex].name.Equal[b[portIndex].name]
)
THEN structurally ← fully ← FALSE;
IF
NOT (
FieldEqual[a[portIndex].simple, b[portIndex].simple] AND
FieldEqual[a[portIndex].switch, b[portIndex].switch] AND
a[portIndex].type = b[portIndex].type AND
a[portIndex].XPhobic = b[portIndex].XPhobic
)
THEN fully ← FALSE;
ENDLOOP;
};
MinSize:
PROC [f: Field]
RETURNS [words:
CARDINAL] = {
words ←
WITH f
SELECT
FROM
word => firstWord + wordCount,
bit => wordOffset + (bitOffset + bitCount + Basics.bitsPerWord - 1)/Basics.bitsPerWord,
ENDCASE => ERROR;
};
FieldEqual:
PROC [f1, f2: Field]
RETURNS [eq:
BOOL] =
{eq ← Bitten[f1] = Bitten[f2]};
Bitten:
PROC [f: Field]
RETURNS [b0, db:
CARDINAL] = {
WITH x: f
SELECT
FROM
bit => RETURN [x.wordOffset*Basics.bitsPerWord+x.bitOffset, x.bitCount];
word => RETURN [x.firstWord*Basics.bitsPerWord, x.wordCount*Basics.bitsPerWord];
ENDCASE => ERROR;
};
RegisterCellType:
PUBLIC
PROC
[
incrementally: BOOL ← FALSE,
Identification:
name: ROPE,
Structure:
expandProc: ExpandProc ← NIL,
Behavior:
ioCreator: IOCreator ← NIL,
driveCreator: DriveCreator ← NIL,
initializer: Initializer ← NIL,
evals: EvalProcs ← [],
tests: CellTestList ← NIL,
Other:
ports: Ports,
typeData: REF ANY ← NIL,
other: Assertions ← NIL
]
RETURNS [type: CellType] =
BEGIN
replace: BOOL = NOT incrementally;
conformingInterface, equalInterface: BOOL ← FALSE;
oldHadBehavior: BOOL ← FALSE;
newHasBehavior: BOOL ← evals.EvalSimple # NIL OR evals.PropUD # NIL;
simpleWordCount, switchWordCount: CARDINAL ← 0;
hasASwitchPort: BOOL ← FALSE;
FOR portIndex: PortIndex
IN [0 .. ports.length)
DO
port: Port ← ports[portIndex];
simpleWordCount ← MAX[simpleWordCount, MinSize[port.simple]];
switchWordCount ← MAX[switchWordCount, MinSize[port.switch]];
IF port.type = NIL THEN ERROR Error[IO.PutFR["No NodeType given for Port %g", IO.rope[port.name]]];
IF NOT port.type.simple THEN hasASwitchPort ← TRUE;
ENDLOOP;
type ← NARROW[cellTypes.Lookup[name]];
IF type =
NIL
THEN {
type ← NEW [CellTypeRep ← [name: name, testers: OSTR.CreateTable[CompareTests]]];
cellTypes.Insert[type];
}
ELSE {
[conformingInterface, equalInterface] ← EqualInterfaces[ports, type.ports];
oldHadBehavior ← type.evals.EvalSimple # NIL OR type.evals.PropUD # NIL;
};
IF type.firstInstance #
NIL
THEN {
firstLeaf: BOOL ← TRUE;
IF NOT incrementally THEN ERROR Error["Can't forget about instances", type];
IF NOT conformingInterface THEN ERROR Error["Can't change interface structure of existing instances", type];
FOR instance: Cell ← type.firstInstance, instance.nextInstance
WHILE instance #
NIL
DO
IF instance.type # type THEN ERROR;
IF instance.expansion = Leaf
THEN {
IF firstLeaf
THEN {
firstLeaf ← FALSE;
IF NOT oldHadBehavior THEN ERROR;
IF NOT newHasBehavior THEN ERROR Error["Can't relieve existing instances of behavior", type];
IF NOT equalInterface THEN ERROR Error["Can't change interface of existing instances", type];
};
IF instance.realCellStuff.evals # type.evals THEN ERROR;
instance.realCellStuff.evals ← evals;
};
ENDLOOP;
};
type.ports ← ports;
IF
NOT equalInterface
THEN {
type.simpleWordCount ← simpleWordCount;
type.switchWordCount ← switchWordCount;
type.hasASwitchPort ← hasASwitchPort;
};
IF replace OR expandProc # NIL THEN type.expand ← expandProc;
IF replace OR ioCreator # NIL THEN type.ioCreator ← ioCreator;
IF replace OR driveCreator # NIL THEN type.driveCreator ← driveCreator;
IF replace OR initializer # NIL THEN type.initializer ← initializer;
IF replace OR evals # [] THEN type.evals ← evals;
IF replace OR typeData # NIL THEN type.typeData ← typeData;
IF incrementally
THEN type.other ← Asserting.Union[other, type.other]
ELSE type.other ← other;
IF NOT incrementally THEN type.testers.DeleteAllItems[];
FOR tests ← tests, tests.rest
WHILE tests #
NIL
DO
[] ← SetTest[test: NEW [CellTestRep ← tests.first], of: type, mayOverwriteOld: incrementally];
ENDLOOP;
END;
GetCellType:
PUBLIC
PROC [name:
ROPE]
RETURNS [type: CellType] =
{type ← NARROW[cellTypes.Lookup[name]]};
GetTest:
PUBLIC
PROC [name:
ROPE, from: CellType]
RETURNS [t: CellTest] =
{t ← NARROW[from.testers.Lookup[name]]};
SetTest:
PUBLIC
PROC [test: CellTest, of: CellType, mayOverwriteOld:
BOOL ←
FALSE]
RETURNS [old: CellTest] = {
old ← NARROW[of.testers.Lookup[test]];
IF old #
NIL
THEN {
IF mayOverwriteOld
THEN {IF of.testers.Delete[test] # old THEN ERROR}
ELSE ERROR Error[IO.PutFR["Duplicate Test (named %g) given for cell type %g", IO.rope[test.name], IO.rope[of.name]]];
};
of.testers.Insert[test];
};
CreateSim:
PUBLIC
PROC [steady:
BOOL]
RETURNS [sim: Simulation] = {
sim ← NEW [SimulationRep ← [steady: steady]];
RoseEvents.Notify[event: $NewSim, arg: sim];
};
CreateTopCell:
PUBLIC
PROC [instanceName, typeName:
ROPE, decider: ExpandDeciderClosure, sim: Simulation] =
BEGIN
bbTableSpace: PrincOps.BBTableSpace;
bbTable: PrincOps.BitBltTablePtr;
FinishLinkingCell:
PROC [item:
REF
ANY]
RETURNS [stop:
BOOL] =
BEGIN
cell: Cell ← NARROW[item];
type: CellType ← cell.type;
stop ← FALSE;
SELECT cell.expansion
FROM
Expand => {
cell.internalNodes.EnumerateIncreasing[OptimizePieces];
cell.components.EnumerateIncreasing[FinishLinkingCell];
};
Leaf => {
[cell.realCellStuff.effectivePorts, cell.realCellStuff.implNodes] ← EffectiveInterface[cell];
FOR epi: EffectivePortIndex
IN [0 .. cell.realCellStuff.effectivePorts.length)
DO
ep: EffectivePort ← cell.realCellStuff.effectivePorts[epi];
targType: NodeType ← ep.implType;
node: Node ← cell.realCellStuff.implNodes[epi];
portPtr: Ptr ← SlotToPtr[[cell, epi], NOT targType.simple];
IF targType.procs.InitPort # NIL THEN targType.procs.InitPort[node, portPtr];
RoseIOHacks.Copy[from: node.valPtr, to: portPtr, bitCount: node.bitCount, bbTable: bbTable];
IF Transduced[ep]
THEN {
modelPtr: Ptr ← SlotToPtr[[cell, epi], NOT ep.type.simple];
targType.procs.Transduce[
fromT: targType,
toT: ep.type,
fromP: portPtr,
toP: modelPtr];
};
ENDLOOP;
IF type.initializer # NIL THEN type.initializer[cell: cell];
};
ENDCASE => ERROR;
END;
type: CellType;
TRUSTED {bbTable ← PrincOpsUtils.AlignedBBTable[@bbTableSpace]};
type ← NARROW[cellTypes.Lookup[typeName]];
IF type = NIL THEN ERROR Error[IO.PutFR["No such type: %g", IO.rope[typeName]]];
sim.root ←
NEW [CellRep ← [
name: instanceName, type: type, sim: sim,
parent: NIL, leftChild: NIL, rightSibling: NIL, firstInternalNode: NIL,
internalNodes: OSTR.CreateTable[CompareNodes],
components: OSTR.CreateTable[CompareComponents],
interfaceNodes: NEW [NodeSR[0]],
other: Asserting.AssertFn1[$ExpandDeciderClosure, decider, NIL],
substantiality: Shadow, expansion: Expand,
realCellStuff: NIL]];
FinishSurveyingCell[sim.root, NIL];
[] ← FinishLinkingCell[sim.root];
END;
LevelList: TYPE = LIST OF Level;
Level:
TYPE =
RECORD [
s: Selector,
pl: PieceList];
OptimizePieces:
PROC [item:
REF
ANY]
RETURNS [stop:
BOOL] = {
n: Node ← NARROW[item];
Optimize:
PROC [ll: LevelList]
RETURNS [opt: PieceList] = {
FOR ll ← ll, ll.rest WHILE ll # NIL AND ll.first.pl = NIL DO NULL ENDLOOP;
IF ll =
NIL
THEN opt ←
NIL
ELSE {
in: Node ← ll.first.pl.first.twardImpl;
s: Selector ← Compose[ll.first.s, ll.first.pl.first.reln];
ll.first.pl ← ll.first.pl.rest;
IF in.significances[inImpl]
THEN {
p: Piece ← [n, in, s];
in.parentPieces ← CONS[p, in.parentPieces];
opt ← CONS[p, Optimize[ll]];
}
ELSE {
IF in.significances[fromDesign] THEN ERROR;
IF in.childPieces = NIL THEN ERROR;
opt ← Optimize[CONS[[s, in.childPieces], ll]];
};
};
};
stop ← FALSE;
IF NOT n.significances[fromDesign] THEN ERROR;
n.childPieces ← Optimize[LIST[[[whole[]], n.childPieces]]];
};
EffectiveInterface:
PROC [cell: Cell]
RETURNS [effectivePorts: EffectivePorts, implNodes: NodeS] = {
n: CARDINAL ← 0;
FOR pi: PortIndex
IN [0 .. cell.type.ports.length)
DO
node: Node ← cell.interfaceNodes[pi];
IF node.significances[inImpl]
THEN n ← n + 1
ELSE {
FOR pl: PieceList ← Implify[node.childPieces], Implify[pl.rest]
WHILE pl #
NIL
DO
n ← n + 1;
ENDLOOP;
};
ENDLOOP;
effectivePorts ← NEW [EffectivePortsRep[n]];
implNodes ← NEW [NodeSR[n]];
n ← 0;
FOR pi: PortIndex
IN [0 .. cell.type.ports.length)
DO
node: Node ← cell.interfaceNodes[pi];
port: Port ← cell.type.ports[pi];
children: PieceList ← IF node.childPieces # NIL THEN node.childPieces ELSE LIST[[node, node, [whole[]]]];
firstEffectivePortIndex: EffectivePortIndex ← n;
FOR pl: PieceList ← Implify[children], Implify[pl.rest]
WHILE pl #
NIL
DO
implNode: Node ← pl.first.twardImpl;
mod: ROPE ← SelectorToRope[pl.first.reln];
effectivePorts[n] ← [
simple: port.simple,
switch: port.switch,
name: port.name.Cat[mod],
type: port.type,
input: port.input,
output: port.output,
XPhobic: port.XPhobic,
other: port.other,
implType: implNode.type,
containingPort: pi
];
implNodes[n] ← pl.first.twardImpl;
n ← n + 1;
ENDLOOP;
effectivePorts[pi].firstEffectivePortIndex ← firstEffectivePortIndex;
ENDLOOP;
IF n # implNodes.length THEN ERROR;
};
SurveyCellInstance:
PROC [erInstance:
REF
ANY, instanceName, typeName, interfaceNodes:
ROPE, other: Assertions ←
NIL]
RETURNS [cell: Cell] =
BEGIN
within: Cell ← NARROW[erInstance];
type: CellType;
type ← NARROW[cellTypes.Lookup[typeName]];
IF type = NIL THEN ERROR Error[IO.PutFR["No such type: %g", IO.rope[typeName]]];
IF within = NIL THEN ERROR;
cell ←
NEW [CellRep ← [
name: instanceName, type: type, sim: within.sim,
parent: within, leftChild: NIL, rightSibling: NIL, firstInternalNode: NIL,
internalNodes: OSTR.CreateTable[CompareNodes],
components: OSTR.CreateTable[CompareComponents],
interfaceNodes: NEW [NodeSR[type.ports.length]],
other: other,
substantiality: Shadow, expansion: Expand,
realCellStuff: NIL]];
FinishSurveyingCell[cell, interfaceNodes];
END;
FinishSurveyingCell:
PROC [cell: Cell, interfaceNodes:
ROPE] =
BEGIN
type: CellType ← cell.type;
thisChild, lastChild: Cell;
thisNode, lastNode: Node;
IF cell.parent =
NIL
THEN {
IF type.ports.length > 0 THEN ERROR Error["Can't make root with non-empty interface", cell];
}
ELSE {
cell.parent.components.Insert[cell !OSTR.DuplicateKey => ERROR Error[IO.PutFR["Duplicated Cell name: %g", IO.rope[cell.name]]]];
do it in wrong order for now; parent will fix up after done expanding:
cell.rightSibling ← cell.parent.leftChild;
cell.parent.leftChild ← cell;
};
cell.nextInstance ← type.firstInstance;
type.firstInstance ← cell;
FillInInterfaceNodes[cell, interfaceNodes];
cell.expansion ← FindAndUseExpandDecider[cell];
SELECT cell.expansion
FROM
Expand =>
BEGIN
cell.substantiality ← Shadow;
cell.realCellStuff ← NIL;
type.expand[thisCell: cell, to: [cell, survey]];
END;
Leaf =>
BEGIN
cell.substantiality ← Real;
cell.realCellStuff ←
NEW [RealCellStuffRep ← [
effectivePorts: NIL,
implNodes: NIL,
schedNext: notInCellList, nextNeeded: notInCellList, nextNoted: notInCellList,
newIO: NIL, oldIO: NIL, switchIO: NIL,
newDriveAsAny: NIL, oldDriveAsAny: NIL,
newIOAsWP: NIL, oldIOAsWP: NIL, switchIOAsWP: NIL,
newDrive: NIL, oldDrive: NIL,
state: NIL,
evals: type.evals]];
FOR portIndex: PortIndex
IN [0..type.ports.length)
DO
node: Node ← cell.interfaceNodes[portIndex];
targType: NodeType ← cell.type.ports[portIndex].type;
IF cell.type.ports[portIndex].XPhobic THEN node.XPhobic ← TRUE;
ENDLOOP;
IF type.ioCreator #
NIL
THEN {
cell.realCellStuff.newIO ← type.ioCreator[ct: type, switch: FALSE];
cell.realCellStuff.oldIO ← type.ioCreator[ct: type, switch: FALSE];
cell.realCellStuff.newDriveAsAny ← type.driveCreator[ct: type];
cell.realCellStuff.oldDriveAsAny ← type.driveCreator[ct: type];
IF type.hasASwitchPort OR cell.realCellStuff.hasTransducedPort THEN cell.realCellStuff.switchIO ← type.ioCreator[ct: type, switch: TRUE];
}
ELSE IF type.simpleWordCount > 0 OR type.switchWordCount > 0 THEN ERROR Error[IO.PutFR["No IOCreator for type %g", IO.rope[type.name]]];
cell.realCellStuff.newIOAsWP ← LOOPHOLE[cell.realCellStuff.newIO];
cell.realCellStuff.oldIOAsWP ← LOOPHOLE[cell.realCellStuff.oldIO];
cell.realCellStuff.switchIOAsWP ← LOOPHOLE[cell.realCellStuff.switchIO];
TRUSTED {
cell.realCellStuff.newDrive ← LOOPHOLE[cell.realCellStuff.newDriveAsAny];
cell.realCellStuff.oldDrive ← LOOPHOLE[cell.realCellStuff.oldDriveAsAny];
};
END;
ENDCASE => ERROR;
lastChild ← NIL;
thisChild ← cell.leftChild;
WHILE thisChild #
NIL
DO
nextChild: Cell ← thisChild.rightSibling;
thisChild.rightSibling ← lastChild;
lastChild ← thisChild;
thisChild ← nextChild;
ENDLOOP;
cell.leftChild ← lastChild;
lastNode ← NIL;
thisNode ← cell.firstInternalNode;
WHILE thisNode #
NIL
DO
nextNode: Node ← thisNode.next;
thisNode.next ← lastNode;
lastNode ← thisNode;
thisNode ← nextNode;
ENDLOOP;
cell.firstInternalNode ← lastNode;
IF cell.parent =
NIL
THEN roots.Insert[cell !OSTR.DuplicateKey => ERROR Error[IO.PutFR["Duplicated Root name: %g", IO.rope[cell.name]]]]
ELSE IF cell.substantiality = Real THEN RoseRun.ScheduleCell[cell];
END;
GetName:
PROC [from:
IO.
STREAM]
RETURNS [name:
ROPE] = {
first: CHAR ← from.PeekChar[];
SELECT first
FROM
'" => name ← from.GetRopeLiteral[];
ENDCASE => name ← from.GetTokenRope[IDBreak].token;
};
IDBreak:
IO.BreakProc =
{
RETURN [
SELECT char
FROM
IO.SP, IO.CR, IO.LF, IO.TAB => sepr,
',, ': => break,
ENDCASE => other]};
FillInInterfaceNodes:
PUBLIC
PROC [cell: Cell, interfaceNodes:
ROPE] =
BEGIN
index: CARDINAL ← 0;
in: IO.STREAM ← IO.RIS[interfaceNodes];
[] ← in.GetIndex[]; --wake up generic GetIndex impl
FOR i:
NAT ← in.SkipWhitespace[], in.SkipWhitespace[]
WHILE
NOT in.EndOf[]
DO
nodeName: ROPE ← GetName[in];
portName: ROPE;
portIndex: PortIndex;
[] ← in.SkipWhitespace[];
IF (
NOT in.EndOf[])
AND (in.PeekChar[] = ':)
THEN
BEGIN
portName ← nodeName;
IF in.GetChar[] # ': THEN ERROR;
[] ← in.SkipWhitespace[];
IF in.EndOf[] THEN ERROR Error[IO.PutFR["Interface spec syntax error, at %g", IO.int[in.GetIndex[]]]];
nodeName ← GetName[in];
IF (portIndex ← GetIndex[cell.type.ports, portName]) = notFound THEN ERROR Error[IO.PutFR["No such port (%g) for CellType %g", IO.rope[portName], IO.rope[cell.type.name]]];
END
ELSE
BEGIN
IF index >= cell.interfaceNodes.length THEN ERROR Error[IO.PutFR["No %g'th element in %g's Interface", IO.int[index], IO.rope[cell.type.name]]];
portName ← cell.type.ports[portIndex ← index].name;
END;
IF cell.interfaceNodes[portIndex] # NIL THEN ERROR Error[IO.PutFR["Port %g specified twice in \"%g\"", IO.rope[portName], IO.rope[interfaceNodes]]];
cell.interfaceNodes[portIndex] ← LookupCellNode[cell.parent, nodeName];
IF cell.interfaceNodes[portIndex] = NIL THEN ERROR Error[IO.PutFR["Node %g not found", IO.rope[nodeName]]];
IF
NOT Conforming[cell.interfaceNodes[portIndex].type, cell.type.ports[portIndex].type]
THEN
ERROR InterfaceMismatch[
cell: cell,
index: portIndex,
expected: cell.type.ports[portIndex].type,
got: cell.interfaceNodes[portIndex].type];
index ← index + 1;
[] ← in.SkipWhitespace[];
IF in.EndOf[] THEN EXIT;
IF in.GetChar[] # ', THEN ERROR Error[IO.PutFR["Interface spec syntax error (missing comma), at %g", IO.int[in.GetIndex[]]]];
ENDLOOP;
FOR portIndex: PortIndex
IN [0 .. cell.interfaceNodes.length)
DO
IF cell.interfaceNodes[portIndex] =
NIL
THEN
BEGIN
nodeName: ROPE ← cell.type.ports[portIndex].name;
cell.interfaceNodes[portIndex] ← LookupCellNode[cell.parent, nodeName];
IF cell.interfaceNodes[portIndex] = NIL THEN ERROR Error[IO.PutFR["Port %g not specified in \"%g\"", IO.rope[nodeName], IO.rope[interfaceNodes]]];
END;
ENDLOOP;
in.Close[];
END;
GetIndex:
PUBLIC
PROC [ports: Ports, key:
ROPE]
RETURNS [index:
CARDINAL] =
BEGIN
FOR i:
CARDINAL
IN [0..ports.length)
DO
IF key.Equal[ports[i].name] THEN RETURN [i];
ENDLOOP;
RETURN [notFound];
END;
NumberOfExpandDecisions: INTEGER = (ORD[LAST[ExpandDecision]] - ORD[FIRST[ExpandDecision]]) + 1;
FindAndUseExpandDecider:
PROC [cell: Cell]
RETURNS [ExpandDecision] =
BEGIN
ed: ExpandDecision;
possibilities: [0 .. NumberOfExpandDecisions];
[ed, possibilities] ← PickOne[cell];
IF possibilities = 1 THEN RETURN [ed];
IF possibilities = 0 THEN ERROR Error[IO.PutFR["Can't do anything with type %g", IO.rope[cell.type.name]]];
FOR temp: Cell ← cell, temp.parent
WHILE temp #
NIL
DO
asAny: REF ANY ← Asserting.FnVal[$ExpandDeciderClosure, temp.other];
edc: ExpandDeciderClosure;
try: ExpandDecision;
IF asAny = NIL THEN LOOP;
edc ← NARROW[asAny];
try ← edc.Decide[cell, edc.otherData];
IF Possible[cell, try] THEN RETURN [try];
ENDLOOP;
RETURN [ed];
END;
PickOne:
PROC [cell: Cell]
RETURNS [whatToDo: ExpandDecision, possibilities: [0..3]] =
BEGIN
possibilities ← 0;
FOR i: [1..NumberOfExpandDecisions]
IN [1..NumberOfExpandDecisions]
DO
d: ExpandDecision ← orderedChoices[i];
IF Possible[cell, d] THEN {whatToDo ← d; possibilities ← possibilities + 1};
ENDLOOP;
END;
orderedChoices: ARRAY [1..2] OF ExpandDecision = [Leaf, Expand];
Possible:
PUBLIC
PROC [cell: Cell, whatToDo: ExpandDecision]
RETURNS [possible:
BOOLEAN] =
BEGIN
evalable: BOOL ← cell.type.evals.EvalSimple # NIL OR cell.type.evals.PropUD # NIL;
iok: BOOL ← (cell.type.simpleWordCount = 0 AND cell.type.switchWordCount = 0) OR cell.type.ioCreator # NIL;
RETURN [
SELECT whatToDo
FROM
Leaf => evalable AND iok,
Expand => cell.type.expand # NIL,
ENDCASE => ERROR];
END;
XPhobicize:
PUBLIC
PROC [n: Node]
RETURNS [m: Node
-- = n --] =
{(m ← n).XPhobic ← TRUE};
Words: TYPE = REF WordSeq;
WordSeq: TYPE = RECORD [words: SEQUENCE length: CARDINAL OF CARDINAL];
NodeInstance:
PROC [erInstance:
REF
ANY, name:
ROPE, type: NodeType, initialValue, initialValueFormat:
ROPE ←
NIL, initData:
REF
ANY ←
NIL, other: Assertions ←
NIL]
RETURNS [node: Node] = {
cellIn: Cell ← NARROW[erInstance];
node ← CreateNode[strIn: CellToStr[cellIn], cellIn: cellIn, name: name, type: type, initialValue: initialValue, initialValueFormat: initialValueFormat, initData: initData, other: other, significance: fromDesign]};
CreateNode:
PROC [strIn: Structure, cellIn: Cell, name:
ROPE, type: NodeType, initialValue, initialValueFormat:
ROPE ←
NIL, initData:
REF
ANY ←
NIL, other: Assertions ←
NIL, significance: NodeSignificance]
RETURNS [node: Node] =
BEGIN
bitCount: NAT ← type.procs.Bits[type];
wordCount: NAT ← (bitCount + Basics.bitsPerWord - 1)/Basics.bitsPerWord;
val: Words ← NEW [WordSeq[wordCount]];
sigs: NodeSignificances ← implOnly;
sigs[significance] ← TRUE;
node ←
NEW [NodeRep ← [
name: name,
type: type,
valRef: val,
valPtr: nilPtr,
bitCount: bitCount,
initialValue: initialValue,
initialValueFormat: type.procs.GetFormat[type, initialValueFormat],
cellIn: cellIn,
strIn: strIn,
nextPerturbed: notInNodeList,
nextAffected: notInNodeList,
nextX: notInNodeList,
prevX: notInNodeList,
significances: sigs,
next: NIL,
parentPieces: NIL--fill in later, in OptimizePieces--,
other: other
]];
TRUSTED {node.valPtr ← [word: @val[0], bit: 0]};
IF node.initialValueFormat = NIL THEN ERROR Error[IO.PutFR["Bad initialValueFormat %g for %g", IO.rope[initialValueFormat], IO.rope[name]]];
SELECT significance
FROM
fromDesign => {
cellIn.internalNodes.Insert[node !OSTR.DuplicateKey => ERROR Error[IO.PutFR["Duplicated Node name: %g", IO.rope[name]]]];
link in wrong order now; fix up when done expanding:
node.next ← cellIn.firstInternalNode;
cellIn.firstInternalNode ← node;
};
inImpl => NULL;
ENDCASE => ERROR;
IF type.procs.InitNode # NIL THEN type.procs.InitNode[node, initData, strIn.sim.steady];
IF initialValue #
NIL
THEN {
valStream: IO.STREAM ← IO.RIS[node.initialValue];
ok: BOOL ← node.initialValueFormat.ParseValue[node, node.initialValueFormat, node.valPtr, valStream];
[] ← valStream.SkipWhitespace[];
IF
NOT (ok
AND valStream.EndOf[])
THEN
SIGNAL Warning[
IO.PutFR[
"Unable to parse %g by format (%g) for node %g (of type %g)",
IO.rope[Convert.RopeFromRope[node.initialValue]],
IO.rope[initialValueFormat],
IO.rope[node.name],
IO.rope[node.type.procs.UserDescription[node.type]]]];
};
IF NOT type.simple THEN RoseRun.PerturbNode[node, NIL];
END;
Equivalence:
PROC [erInstance:
REF
ANY, a, b: NodeExpression] =
BEGIN
within: Cell ← NARROW[erInstance];
la, lb: NodeList;
la ← ToNodes[a, NIL];
lb ← ToNodes[b, NIL];
EquivNodeLists[la, lb];
END;
ToNodes:
PROC [ne: NodeExpression, tail: NodeList]
RETURNS [l: NodeList] = {
l ← tail;
WITH ne
SELECT
FROM
x: PrimaryNE => {
IF x.node.childPieces = NIL AND NOT x.node.significances[inImpl] THEN ERROR;
IF x.node.significances[inImpl]
THEN l ← CONS[SelectNode[x.node, x.selector].at, l]
ELSE l ← Select[x.node.childPieces, x.selector, l];
};
x: UnnamedConsNE => {
FOR i:
INT
DECREASING
IN [0 .. x.length)
DO
l ← ToNodes[x.elts[i], l];
ENDLOOP;
};
x: CatenateNE => {
FOR i:
INT
DECREASING
IN [0 .. x.length)
DO
l ← ToNodes[x.pieces[i], l];
ENDLOOP;
};
ENDCASE => ERROR;
};
Select:
PROC [pl: PieceList, s: Selector, tail: NodeList]
RETURNS [ol: NodeList] = {
first, count, direction, last, min, max: INT;
up: BOOL;
endPiece: PieceList;
prevList, el: NodeList ← NIL;
firstSize, endSize: INT;
[first, count, up] ← StandardSelectorRep[s, PieceListLength[pl]];
IF count < 2 THEN up ← TRUE;
direction ← UpToInt[up];
IF NOT up THEN ERROR--lazy implementor--;
last ← first + (count-1)*direction;
min ← MIN[first, last];
max ← MAX[first, last];
DO
pl ← Implify[pl];
firstSize ← NodeLength[pl.first.twardImpl];
IF min < firstSize THEN EXIT;
min ← min - firstSize;
max ← max - firstSize;
pl ← pl.rest;
ENDLOOP;
endPiece ← pl;
DO
endPiece ← Implify[endPiece];
el ← LIST[endPiece.first.twardImpl];
endSize ← NodeLength[endPiece.first.twardImpl];
IF prevList = NIL THEN ol ← el ELSE prevList.rest ← el;
IF max < endSize THEN EXIT;
max ← max - endSize;
prevList ← el;
endPiece ← endPiece.rest;
ENDLOOP;
el.rest ← tail;
IF min > 0
OR max+1 < endSize
THEN {
IF ol = el
THEN ol.first ← SelectNode[ol.first, [range[min, 1+max-min, TRUE]]].at
ELSE {
IF min > 0 THEN ol.first ← SelectNode[ol.first, [range[min, firstSize-min, TRUE]]].at;
IF max+1 < endSize THEN el.first ← SelectNode[el.first, [range[0, max+1, TRUE]]].at;
};
};
};
UpToInt: ARRAY BOOL OF INT = [FALSE: -1, TRUE: 1];
Implify:
PROC [il: PieceList, tail: PieceList ←
NIL]
RETURNS [ol: PieceList] = {
Append:
PROC [l1, l2: PieceList]
RETURNS [l: PieceList] = {
IF l2 = NIL THEN RETURN [l1];
IF l1 = NIL THEN RETURN [l2];
l ← CONS[l1.first, Append[l1.rest, l2]]};
IF il.first.twardImpl.significances[inImpl] THEN RETURN [Append[il, tail]];
IF il.first.twardImpl.significances[fromDesign] THEN ERROR;
ol ← Append[Implify[il.first.twardImpl.childPieces, il.rest], tail];
};
EquivNodeLists:
PROC [a, b: NodeList] = {
Munch:
PROC [pl: PieceList, nl: NodeList]
RETURNS [ans: NodeList] = {
IF pl = NIL THEN RETURN [nl];
ans ← CONS[pl.first.twardImpl, Munch[pl.rest, nl]];
};
WHILE a#
NIL
AND b#
NIL
DO
na, nb: Node;
la, lb: INT;
WHILE NOT a.first.significances[inImpl] DO a ← Munch[a.first.childPieces, a.rest] ENDLOOP;
WHILE NOT b.first.significances[inImpl] DO b ← Munch[b.first.childPieces, b.rest] ENDLOOP;
la ← NodeLength[na ← a.first];
lb ← NodeLength[nb ← b.first];
IF l
a = l
b
THEN {
JoinNodes[na, nb];
a ← a.rest;
b ← b.rest;
}
ELSE
IF l
a < l
b
THEN {
before, at, rest: Node;
[before: before, at: at, after: rest] ← SelectNode[nb, [range[0, la, TRUE]]];
IF before # NIL THEN ERROR;
JoinNodes[na, at];
a ← a.rest;
b.first ← rest;
}
ELSE
IF l
b < l
a
THEN {
before, at, rest: Node;
[before: before, at: at, after: rest] ← SelectNode[na, [range[0, lb, TRUE]]];
IF before # NIL THEN ERROR;
JoinNodes[nb, at];
b ← b.rest;
a.first ← rest;
}
ELSE ERROR;
ENDLOOP;
IF a#NIL OR b#NIL THEN ERROR Error["Non-corresponding node expressions equivalenced"];
};
StandardSelectorRep:
PROC [s: Selector, len:
INT ← -1]
RETURNS [first, count:
INT, up:
BOOL] = {
WITH x: s
SELECT
FROM
whole => {first ← 0; count ← len; up ← TRUE};
number => {first ← x.index; count ← 1; up ← TRUE};
range => {first ← x.first; count ← x.count; up ← x.up};
ENDCASE => ERROR;
};
SelectNode:
PROC [n: Node, s: Selector]
RETURNS [before, at, after: Node] = {
first, count: INT;
up: BOOL;
nl: INT ← NodeLength[n];
firstSel, lastSel: Selector.range;
Add:
PROC [in: Node, s: Selector] = {
n.childPieces ← CONS[[n, in, s], n.childPieces];
};
First:
PROC = {
IF first > 0
THEN {
firstSel ← [range[0, first, TRUE]];
before ← CreateNode[
strIn: n.strIn,
cellIn: NIL,
name:
IO.PutFR["%g%g",
IO.rope[n.name],
IO.rope[SelectorToRope[firstSel]]],
type: n.type.procs.SubType[n.type, firstSel],
significance: inImpl
];
Add[before, firstSel];
}
ELSE before ← NIL;
};
Mid:
PROC = {
at ← CreateNode[
strIn: n.strIn,
cellIn: NIL,
name:
IO.PutFR["%g%g",
IO.rope[n.name],
IO.rope[SelectorToRope[s]]],
type: n.type.procs.SubType[n.type, s],
significance: inImpl
];
Add[at, s];
};
Last:
PROC = {
IF first + count < nl
THEN {
lastSel ← [range[first + count, nl - (first + count), TRUE]];
after ← CreateNode[
strIn: n.strIn,
cellIn: NIL,
name:
IO.PutFR["%g%g",
IO.rope[n.name],
IO.rope[SelectorToRope[lastSel]]],
type: n.type.procs.SubType[n.type, lastSel],
significance: inImpl
];
Add[after, lastSel];
}
ELSE after ← NIL;
};
IF NOT n.significances[inImpl] THEN ERROR;
IF n.childPieces # NIL THEN ERROR;
IF s = [whole[]] THEN RETURN [NIL, n, NIL];
[first, count, up] ← StandardSelectorRep[s];
IF NOT up THEN ERROR--lazy implementor--;
IF nl < count THEN ERROR;
IF nl = count THEN RETURN [NIL, n, NIL];
IF up
--make sure n.childPieces come out in right order--
THEN {Last[]; Mid[]; First[]}
ELSE {First[]; Mid[]; Last[]};
n.significances[inImpl] ← FALSE;
IF n.childPieces.rest = NIL THEN ERROR;
};
JoinNodes:
PROC [n1, n2: Node] = {
equiv: BOOL;
keep, lose: Node;
IF n1.strIn # n2.strIn THEN ERROR Error[IO.PutFR["Can't equivalence nodes %g and %g because they're in different structures", IO.rope[LongNodeName[n1]], IO.rope[LongNodeName[n2]]]];
IF n1.significances[fromDesign] THEN n1 ← DummyDown[n1];
IF n2.significances[fromDesign] THEN n2 ← DummyDown[n2];
IF n1.significances # implOnly OR n2.significances # implOnly THEN ERROR;
equiv ← n1.type = n2.type;
IF NOT (equiv OR Conforming[n1.type, n2.type]) THEN ERROR Error[IO.PutFR["Can't equivalence nodes %g and %g because their types don't match", IO.rope[LongNodeName[n1]], IO.rope[LongNodeName[n2]]]];
IF n1.type.procs.Equivalent # NIL AND NOT equiv THEN equiv ← n1.type.procs.Equivalent[n1.type, n2.type];
IF n2.type.procs.Equivalent # NIL AND NOT equiv THEN equiv ← n2.type.procs.Equivalent[n2.type, n1.type];
IF
NOT equiv
THEN {
ERROR --lazy implementor--;
};
SELECT
TRUE
FROM
n1.strength < n2.strength => {keep ← n2; lose ← n1};
n1.strength >= n2.strength => {keep ← n1; lose ← n2};
ENDCASE => ERROR;
keep.name ← keep.name.Cat["&", lose.name];
IF keep.strength = lose.strength AND NOT RoseIOHacks.Equal[keep.valPtr, lose.valPtr, keep.bitCount] THEN ERROR;
IF keep.bitCount # lose.bitCount THEN ERROR;
IF keep.currentStrength # keep.strength OR lose.currentStrength # lose.strength THEN ERROR;
IF keep.switchConnections # NIL OR lose.switchConnections # NIL THEN ERROR;
IF keep.byStrength # ALL[emptyHead] OR lose.byStrength # ALL[emptyHead] THEN ERROR;
IF keep.found OR lose.found THEN ERROR;
keep.XPhobic ← keep.XPhobic OR lose.XPhobic;
IF keep.watchers # ALL[NIL] OR lose.watchers # ALL[NIL] THEN ERROR;
IF keep.next # NIL OR lose.next # NIL THEN ERROR;
IF keep.parentPieces # NIL OR lose.parentPieces # NIL THEN ERROR;
IF keep.childPieces # NIL OR lose.childPieces # NIL THEN ERROR;
IF keep.other # NIL OR lose.other # NIL THEN ERROR;
lose.replacedBy ← keep;
};
DummyDown:
PROC [dn: Node]
RETURNS [in: Node] = {
ERROR --lazy implementor--;
};
Conforming:
PROC [t1, t2: NodeType]
RETURNS [c:
BOOL] = {
An:
PROC [nt: NodeType]
RETURNS [flavor:
ATOM, length:
INTEGER] = {
WITH nt
SELECT
FROM
x: AtomNodeType => {flavor ← x.flavor; length ← 1};
x: ArrayNodeType => {flavor ← x.element.flavor; length ← x.length};
ENDCASE => ERROR;
};
c ← An[t1] = An[t2];
};
PieceListLength:
PROC [pl: PieceList]
RETURNS [len:
INT] = {
len ← 0;
FOR pl ← pl, pl.rest
WHILE pl #
NIL
DO
len ← len + NodeLength[pl.first.twardImpl];
ENDLOOP;
};
NodeLength:
PROC [n: Node]
RETURNS [l:
INTEGER] = {
WITH n.type
SELECT
FROM
x: AtomNodeType => l ← 1;
x: ArrayNodeType => l ← x.length;
ENDCASE => ERROR;
};
SelectorToRope:
PROC [s: Selector]
RETURNS [r:
ROPE] = {
r ←
WITH s
SELECT
FROM
whole => ".whole",
number => IO.PutFR["[%g]", IO.int[index]],
range =>
SELECT count
FROM
<1 => ERROR,
=1 => IO.PutFR["[%g]", IO.int[first]],
>1 => IO.PutFR["%g..%g)", IO.int[first], IO.int[first+count*UpToInt[up]]],
ENDCASE => ERROR,
ENDCASE => ERROR;
};
Compose:
PROC [s1, s2: Selector]
RETURNS [s: Selector] = {
xFirst, yFirst, zFirst, xCount, yCount, zCount: INTEGER;
xUp, yUp, zUp, scalar: BOOL;
IF s1 = [whole[]] THEN RETURN [s2];
IF s2 = [whole[]] THEN RETURN [s1];
scalar ← s1.kind = number OR s2.kind = number;
[xFirst, xCount, xUp] ← StandardSelectorRep[s1];
[yFirst, yCount, yUp] ← StandardSelectorRep[s2];
zFirst ← xFirst + yFirst*UpToInt[xUp];
zCount ← yCount;
zUp ← xUp = yUp;
IF scalar AND zCount # 1 THEN ERROR;
IF scalar
THEN RETURN [[number[zFirst]]]
ELSE RETURN [[range[zFirst, zCount, zUp]]];
};
CompareCellTypes:
PROC [r1, r2:
REF
ANY]
RETURNS [Basics.Comparison]
--OSTR.CompareProc-- =
BEGIN
ToKey:
SAFE
PROC [ref:
REF
ANY]
RETURNS [
ROPE] =
{
RETURN [
WITH ref
SELECT
FROM
r: ROPE => r, ct: CellType => ct.name, ENDCASE => ERROR]};
RETURN [ToKey[r1].Compare[ToKey[r2]]];
END;
CompareComponents:
PUBLIC
PROC [r1, r2:
REF
ANY]
RETURNS [Basics.Comparison]
--
OSTR.CompareProc
-- =
BEGIN
ToKey:
SAFE
PROC [ref:
REF
ANY]
RETURNS [
ROPE] =
{
RETURN [
WITH ref
SELECT
FROM
r: ROPE => r, c: Cell => c.name, ENDCASE => ERROR]};
RETURN [ToKey[r1].Compare[ToKey[r2]]];
END;
CompareNodes:
PUBLIC
PROC [r1, r2:
REF
ANY]
RETURNS [Basics.Comparison]
--OSTR.CompareProc-- =
BEGIN
k1, k2: ROPE;
WITH r1
SELECT
FROM
r: ROPE => k1 ← r;
n: Node => k1 ← n.name;
ENDCASE => ERROR;
k2 ←
WITH r2
SELECT
FROM
r: ROPE => r,
n: Node => n.name,
ENDCASE => ERROR;
RETURN [k1.Compare[k2]];
END;
CompareTests:
PROC [r1, r2:
REF
ANY]
RETURNS [Basics.Comparison]
--OSTR.CompareProc-- =
BEGIN
ToKey:
SAFE
PROC [ref:
REF
ANY]
RETURNS [
ROPE] =
{
RETURN [
WITH ref
SELECT
FROM
r: ROPE => r, a: CellTest => a.name, ENDCASE => ERROR]};
RETURN [ToKey[r1].Compare[ToKey[r2]]];
END;
END.