CoreFlattenImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Spreitzer, August 15, 1985 8:09:21 pm PDT
DIRECTORY Atom, Convert, Core, CoreFlatten, CoreOps, CoreProperties, CoreRecordCellClass, Process, Rope;
CoreFlattenImpl: CEDAR MONITOR
IMPORTS CoreOps, CoreProperties, CoreRecordCellClass, Process
EXPORTS CoreFlatten
INVARIANT
Sym.inUse describes whether some process is using that Sym.
=
BEGIN OPEN Core, CoreRecordCellClass, CoreFlatten;
Introduction
This interface implements a utility for flattening the data structure defined in Core.
Flat Core
instantiationPath: PUBLIC ATOM ← $CoreFlatInstantiationPath;
wireSource: PUBLIC ATOM ← $CoreFlatWireSource;
InstantiationPath: TYPE = REF InstantiationPathRep;
InstantiationPathRep: PUBLIC TYPE = RECORD [
head: InstanceList,
deeper earlier
tail: InstanceList
points to the last CONS cell in the list
];
easyExhibitDirection: InstantiationPathDirection ← shallower;
IsEmpty: PUBLIC PROC [ip: InstantiationPath] RETURNS [BOOL] =
{RETURN [ip.head = NIL]};
Split: PUBLIC PROC [ip: InstantiationPath, end: InstantiationPathDirection] RETURNS [step: Instance, rest: InstantiationPath] = {
SELECT end FROM
deeper => RETURN [
ip.head.first,
NEW [InstantiationPathRep ← [
head: ip.head.rest,
tail: IF ip.head.rest = NIL THEN NIL ELSE ip.tail
]]
];
shallower => {
rest: InstantiationPath ← NEW [InstantiationPathRep ← [NIL, NIL]];
FOR il: InstanceList ← ip.head, il.rest WHILE il # ip.tail DO
rest ← IPAdd[rest, il.first, shallower, TRUE];
ENDLOOP;
RETURN [ip.tail.first, rest];
};
ENDCASE => ERROR;
};
Exhibit: PUBLIC PROC [ip: InstantiationPath, later: InstantiationPathDirection, to: PROC [step: Instance]] = {
WorkD: PROC [il: InstanceList] = {
IF il # NIL THEN {WorkD[il.rest]; to[il.first]};
};
SELECT later FROM
shallower => {
IF ip.tail # NIL THEN FOR il: InstanceList ← ip.head, il.rest WHILE il # ip.tail.rest DO
to[il.first];
ENDLOOP;
ip ← ip;
};
deeper => WorkD[ip.head];
ENDCASE => ERROR;
};
IPAdd: PROC [ip: InstantiationPath, step: Instance, end: InstantiationPathDirection, destructively: BOOL] RETURNS [longer: InstantiationPath] = {
longer ← ip;
SELECT destructively FROM
FALSE => SELECT end FROM
shallower => {
longer ← IPCopy[ip];
longer ← IPAdd[longer, step, shallower, TRUE];
};
deeper => {
longer ← NEW [InstantiationPathRep ← ip^];
longer.head ← CONS[step, longer.head];
IF longer.tail = NIL THEN longer.tail ← longer.head;
};
ENDCASE => ERROR;
TRUE => SELECT end FROM
shallower => {
this: InstanceList ← LIST[step];
IF longer.tail # NIL THEN longer.tail.rest ← this ELSE longer.head ← this;
longer.tail ← this;
};
deeper => {
longer.head ← CONS[step, longer.head];
IF longer.tail = NIL THEN longer.tail ← longer.head;
};
ENDCASE => ERROR;
ENDCASE => ERROR;
};
IPCopy: PROC [ip: InstantiationPath] RETURNS [copy: InstantiationPath] = {
copy ← EmptyPath[];
IF ip.tail # NIL THEN FOR il: InstanceList ← ip.head, il.rest WHILE il # ip.tail.rest DO
copy ← IPAdd[copy, il.first, shallower, TRUE];
ENDLOOP;
copy ← copy;
};
IPCat: PROC [shallow, deep: InstantiationPath, destroyShallow, destroyDeep: BOOL] RETURNS [both: InstantiationPath] = {
IF shallow.tail = NIL THEN RETURN [deep];
IF deep.head = NIL THEN RETURN [shallow];
IF shallow = deep THEN ERROR;
SELECT destroyShallow FROM
TRUE => {
shallow.tail.rest ← deep.head;
shallow.tail ← deep.tail;
RETURN [shallow];
};
FALSE => {
shallow ← IPCopy[shallow];
RETURN [IPCat[shallow, deep, TRUE, destroyDeep]];
};
ENDCASE => ERROR;
};
EmptyPath: PROC RETURNS [empty: InstantiationPath] =
{empty ← NEW [InstantiationPathRep ← [NIL, NIL]]};
UnitPath: PROC [step: Instance] RETURNS [ip: InstantiationPath] = {
this: InstanceList ← LIST[step];
ip ← NEW [InstantiationPathRep ← [this, this]]};
Symbols
A Symbol is like a property, except that it logically is retained for only a bounded period of time.
The following implementation assumes there will be only one instance of itself in any VM.
Sym: TYPE = REF SymRec;
SymRec: TYPE = RECORD [atom: ATOM, curKey: Key ← Key.FIRST, inUse: BOOL ← FALSE];
Key: TYPE = LONG CARDINAL;
Holder: TYPE = REF HolderRec;
HolderRec: TYPE = RECORD [key: Key, value: REF ANY];
symChange: CONDITION;
AllocSym: ENTRY PROC [s: Sym] = {
ENABLE UNWIND => NULL;
WHILE s.inUse DO WAIT symChange ENDLOOP;
IF s.curKey = Key.LAST THEN ERROR;
s.curKey ← s.curKey + 1;
s.inUse ← TRUE;
};
ReleaseSym: ENTRY PROC [s: Sym] = {
s.inUse ← FALSE;
BROADCAST symChange;
};
CreateSym: PROC [atom: ATOM] RETURNS [s: Sym] = {
s ← NEW [SymRec ← [atom]];
CoreProperties.RegisterProperty[s.atom];
};
GetSym: PROC [from: Core.Properties, sym: Sym] RETURNS [value: REF ANY] = {
h: Holder ← NARROW[CoreProperties.GetProp[from, sym.atom]];
value ← IF (h = NIL) OR (h.key # sym.curKey) THEN NIL ELSE h.value;
};
PutSym: PROC [on: Core.Properties, sym: Sym, value: REF ANY] RETURNS [updated: Core.Properties] = {
h: Holder ← NARROW[CoreProperties.GetProp[on, sym.atom]];
IF h # NIL THEN {
h.key ← sym.curKey;
h.value ← value;
RETURN [on]};
updated ← CoreProperties.PutProp[on, sym.atom, NEW [HolderRec ← [sym.curKey, value]] ];
};
Wire Binding
AssocWire: PROC [key: Sym, from, to: Wire] = {
from.properties ← PutSym[from.properties, key, to];
IF from.elements # NIL THEN {
FOR i: INT IN [0 .. from.elements.size) DO
AssocWire[key, from.elements[i], to.elements[i]];
ENDLOOP;
key ← key};
};
GetWireAssoc: PROC [key: Sym, from: Wire] RETURNS [to: Wire] =
{to ← NARROW[GetSym[from.properties, key]]};
Flattening
Promotions: TYPE = REF PromotionsRec;
PromotionsRec: TYPE = RECORD [
count: NAT ← 0,
wires: WireList ← NIL];
WireList: TYPE = LIST OF Wire;
formalToActual: Sym ← CreateSym[$CoreFlattenFormalToActual];
templateToCopy: Sym ← CreateSym[$CoreFlattenTemplateToCopy];
partPublic: Sym ← CreateSym[$CoreFlattenPartPublic];
FlattenOnce: PROC [design: Design, cellType: CellType, control: FlattenControl] RETURNS [flat: CellType] = {
Each child is expanded or not, depending on what control says.
oldRec, newRec: RecordCellType;
promotions: Promotions ← NEW [PromotionsRec ← []];
AllocSym[formalToActual];
AllocSym[templateToCopy];
AllocSym[partPublic];
{ENABLE UNWIND => {
ReleaseSym[formalToActual];
ReleaseSym[templateToCopy];
ReleaseSym[partPublic];
};
cellType ← Recordify[design, cellType];
[oldRec, newRec, flat] ← CopyCellType[design, templateToCopy, cellType];
newRec.instances ← NIL;
FOR cl: InstanceList ← oldRec.instances, cl.rest WHILE cl # NIL DO
child: Instance ← cl.first;
childType: CellType ← Recordify[design, child.type];
childRec: RecordCellType ← NARROW[childType.data];
childPath: InstantiationPath ← UnitPath[child];
SELECT control.Decide[control.data, childPath] FROM
expand => {
AssocWire[formalToActual, child.type.publicWire, child.actualWire];
PromotePrivates[design, flat, newRec, childType, childRec, formalToActual, templateToCopy, partPublic, promotions, UnitPath[child]];
FOR gl: InstanceList ← childRec.instances, gl.rest WHILE gl # NIL DO
oldGrandchild: Instance ← gl.first;
gcPath: InstantiationPath ← IPAdd[childPath, oldGrandchild, deeper, FALSE];
newGrandchild: Instance;
newGrandchild ← CopyInstance[design, oldGrandchild, formalToActual, templateToCopy, gcPath, childPath];
newRec.instances ← CONS[newGrandchild, newRec.instances];
ENDLOOP;
child ← child;
};
leaf => {
newChild: Instance ← CopyInstance[design, child, formalToActual, templateToCopy, childPath, EmptyPath[]];
newRec.instances ← CONS[newChild, newRec.instances];
};
ENDCASE => ERROR;
child ← child;
ENDLOOP;
flat ← flat;
IF promotions.count # 0 THEN {
oldPW: Wire ← flat.publicWire;
newPW: Wire ← NEW [WireRec ← [
name: NIL,
structure: record,
elements: NEW [WireSequenceRec[oldPW.elements.size + promotions.count]],
properties: oldPW.properties
]];
i: NAT ← 0;
Don't need to NoteWireSource[newPW, oldPW, NIL] because already done in CopyCellType
IF oldPW.structure # record THEN ERROR;
THROUGH [0 .. oldPW.elements.size) DO
newPW.elements[i] ← oldPW.elements[i];
i ← i + 1;
ENDLOOP;
FOR wl: WireList ← promotions.wires, wl.rest WHILE wl # NIL DO
newPW.elements[i] ← wl.first;
i ← i + 1;
ENDLOOP;
IF i # (oldPW.elements.size + promotions.count) THEN ERROR;
flat.publicWire ← newPW;
};
};
ReleaseSym[formalToActual];
ReleaseSym[templateToCopy];
ReleaseSym[partPublic];
};
Recordify: PROC [design: Design, ct: CellType] RETURNS [rct: CellType] = {
FOR rct ← ct, CoreOps.Recast[rct] UNTIL rct.class = recordCellClass DO NULL ENDLOOP;
rct ← rct};
CopyCellType: PROC [design: Design, templateToCopy: Sym, old: CellType] RETURNS [oldRec, newRec: RecordCellType, new: CellType] = {
oldRec ← NARROW[old.data];
newRec ← NEW [RecordCellTypeRec ← [
internalWire: CoreOps.CopyWire[oldRec.internalWire],
instances: oldRec.instances]];
NoteWireSource[newRec.internalWire, [EmptyPath[], oldRec.internalWire], TRUE];
AssocWire[templateToCopy, oldRec.internalWire, newRec.internalWire];
new ← NEW [CellTypeRec ← old^];
new.data ← newRec;
new.properties ← CoreProperties.CopyProps[old.properties];
new.publicWire ← DuplicatePublicWire[design, templateToCopy, old.publicWire];
new ← new};
DuplicatePublicWire: PROC [design: Design, templateToCopy: Sym, oldPublicWire: Wire] RETURNS [newPublicWire: Wire] = {
newPublicWire ← GetWireAssoc[templateToCopy, oldPublicWire];
IF newPublicWire # NIL --means this is part of internalWire-- THEN RETURN;
newPublicWire ← NEW [WireRec ← [
name: NIL,
structure: oldPublicWire.structure,
elements: NIL,
properties: CoreProperties.CopyProps[oldPublicWire.properties]
]];
NoteWireSource[newPublicWire, [EmptyPath[], oldPublicWire], FALSE];
IF oldPublicWire.elements # NIL THEN {
newPublicWire.elements ← NEW [WireSequenceRec[oldPublicWire.elements.size]];
FOR i: INT IN [0 .. oldPublicWire.elements.size) DO
newPublicWire.elements[i] ← DuplicatePublicWire[design, templateToCopy, oldPublicWire.elements[i]];
ENDLOOP;
design ← design};
design ← design};
PromotePrivates: PROC [design: Design, parent: CellType, parentRec: RecordCellType, child: CellType, childRec: RecordCellType, formalToActual, templateToCopy, partPublic: Sym, promotions: Promotions, path: InstantiationPath] = {
FindPublic: PROC [childsInternal: Wire] RETURNS [somePublic: BOOL] = {
somePublic ← GetWireAssoc[formalToActual, childsInternal] # NIL;
IF (NOT somePublic) AND childsInternal.structure # atom THEN {
FOR i: NAT IN [0 .. childsInternal.elements.size) DO
subWire: Wire ← childsInternal.elements[i];
subSomePublic: BOOL ← FindPublic[subWire];
somePublic ← somePublic OR subSomePublic;
ENDLOOP;
child ← child;
};
IF somePublic THEN childsInternal.properties ← PutSym[childsInternal.properties, partPublic, $T];
};
DoForPrivateCover: PROC [childsInternal: Wire] = {
allPublic: BOOL ← GetWireAssoc[formalToActual, childsInternal] # NIL;
somePublic: BOOL ← allPublic OR (GetSym[childsInternal.properties, partPublic] = $T);
IF NOT somePublic THEN {
new: Wire ← CoreOps.CopyWire[childsInternal];
NoteWireSource[new, [path, childsInternal], TRUE];
AssocWire[templateToCopy, childsInternal, new];
promotions.count ← promotions.count + 1;
promotions.wires ← CONS[new, promotions.wires];
}
ELSE IF allPublic THEN {
AssocToCopy[childsInternal];
}
ELSE {
FOR i: NAT IN [0 .. childsInternal.elements.size) DO
DoForPrivateCover[childsInternal.elements[i]];
ENDLOOP;
design ← design;
};
};
AssocToCopy: PROC [childsInternal: Wire] = {
actual: Wire ← GetWireAssoc[formalToActual, childsInternal];
copy: Wire ← GetWireAssoc[templateToCopy, actual];
IF copy # NIL
THEN AssocWire[templateToCopy, childsInternal, copy]
ELSE {
FOR i: NAT IN [0 .. childsInternal.elements.size) DO
AssocToCopy[childsInternal.elements[i]];
ENDLOOP;
design ← design;
};
};
[] ← FindPublic[childRec.internalWire];
DoForPrivateCover[childRec.internalWire];
};
CopyInstance: PROC [design: Design, old: Instance, formalToActual, templateToCopy: Sym, longPath, shortPath: InstantiationPath] RETURNS [new: Instance] = {
CopyActual: PROC [old: Wire] RETURNS [new: Wire] = {
new ← GetWireAssoc[templateToCopy, old];
IF new # NIL THEN RETURN;
new ← NEW [WireRec ← [
name: NIL,
structure: old.structure,
elements: NIL,
properties: CoreProperties.CopyProps[old.properties]
]];
NoteWireSource[new, [shortPath, old], FALSE];
IF old.elements = NIL THEN ERROR --this recursion must ground out in a piece of already copied template--;
new.elements ← NEW [WireSequenceRec[old.elements.size]];
FOR i: INT IN [0 .. old.elements.size) DO
new.elements[i] ← CopyActual[old.elements[i]];
ENDLOOP;
new ← new;
};
new ← NEW [InstanceRec ← [
name: NIL,
actualWire: CopyActual[old.actualWire],
type: old.type,
properties: CoreProperties.CopyProps[old.properties]
]];
NoteInstanceSource[new, longPath];
};
Flatten: PUBLIC PROC [design: Design, cellType: CellType, control: FlattenControl] RETURNS [flat: CellType] = {
Each descendent is expanded or not, depending on what control says.
oldRec, newRec: RecordCellType;
promotions: Promotions ← NEW [PromotionsRec ← []];
AllocSym[formalToActual];
AllocSym[templateToCopy];
AllocSym[partPublic];
{ENABLE UNWIND => {
ReleaseSym[formalToActual];
ReleaseSym[templateToCopy];
ReleaseSym[partPublic];
};
Work: PROC [cl: InstanceList, pathPrefix: InstantiationPath] = {
flat ← flat;
FOR cl ← cl, cl.rest WHILE cl # NIL DO
child: Instance ← cl.first;
path: InstantiationPath ← IPAdd[pathPrefix, child, deeper, FALSE];
childType: CellType ← Recordify[design, child.type];
childRec: RecordCellType ← NARROW[childType.data];
SELECT control.Decide[control.data, path] FROM
expand => {
AssocWire[formalToActual, child.type.publicWire, child.actualWire];
PromotePrivates[design, flat, newRec, childType, childRec, formalToActual, templateToCopy, partPublic, promotions, path];
Work[childRec.instances, path];
child ← child;
};
leaf => {
newChild: Instance ← CopyInstance[design, child, formalToActual, templateToCopy, path, pathPrefix];
newRec.instances ← CONS[newChild, newRec.instances];
};
ENDCASE => ERROR;
child ← child;
ENDLOOP;
flat ← flat;
};
cellType ← Recordify[design, cellType];
[oldRec, newRec, flat] ← CopyCellType[design, templateToCopy, cellType];
newRec.instances ← NIL;
Work[oldRec.instances, EmptyPath[]];
IF promotions.count # 0 THEN {
oldPW: Wire ← flat.publicWire;
newPW: Wire ← NEW [WireRec ← [
name: NIL,
structure: record,
elements: NEW [WireSequenceRec[oldPW.elements.size + promotions.count]],
properties: oldPW.properties
]];
i: NAT ← 0;
Don't need to NoteWireSource[newPW, oldPW, NIL] because already done in CopyCellType
IF oldPW.structure # record THEN ERROR;
THROUGH [0 .. oldPW.elements.size) DO
newPW.elements[i] ← oldPW.elements[i];
i ← i + 1;
ENDLOOP;
FOR wl: WireList ← promotions.wires, wl.rest WHILE wl # NIL DO
newPW.elements[i] ← wl.first;
i ← i + 1;
ENDLOOP;
IF i # (oldPW.elements.size + promotions.count) THEN ERROR;
flat.publicWire ← newPW;
};
};
ReleaseSym[formalToActual];
ReleaseSym[templateToCopy];
ReleaseSym[partPublic];
};
Backpointers
FlattenInstantiationPath: PROC [org: InstantiationPath] RETURNS [flat: InstantiationPath] = {
alreadyFlat: BOOL ← TRUE;
Test: PROC [step: Instance] = {
IF CoreProperties.GetProp[step.properties, instantiationPath] # NIL THEN alreadyFlat ← FALSE;
};
Cons: PROC [step: Instance] = {
ip: InstantiationPath ← NARROW[CoreProperties.GetProp[step.properties, instantiationPath]];
IF ip = NIL
THEN flat ← IPAdd[flat, step, easyExhibitDirection, TRUE]
ELSE SELECT easyExhibitDirection FROM
deeper => flat ← IPCat[ip, flat, FALSE, TRUE];
shallower => flat ← IPCat[flat, ip, TRUE, FALSE];
ENDCASE => ERROR;
};
Exhibit[org, easyExhibitDirection, Test];
IF alreadyFlat THEN RETURN [org];
flat ← EmptyPath[];
Exhibit[org, easyExhibitDirection, Cons];
flat ← flat;
};
NoteInstanceSource: PROC [newInstance: Instance, path: InstantiationPath] = {
flatPath: InstantiationPath ← FlattenInstantiationPath[path];
newInstance.properties ← CoreProperties.PutProp[newInstance.properties, instantiationPath, flatPath];
};
NoteWireSource: PROC [newWire: Wire, source: WireSourceRec, recursively: BOOL] = {
source.instantiationPath ← FlattenInstantiationPath[source.instantiationPath];
DO
oldSource: WireSource ← GetWireSource[source.wire];
IF oldSource = NIL THEN EXIT;
source ← [
instantiationPath: IPCat[source.instantiationPath, FlattenInstantiationPath[oldSource.instantiationPath], FALSE, FALSE],
wire: oldSource.wire];
ENDLOOP;
newWire.properties ← CoreProperties.PutProp[newWire.properties, wireSource, NEW [WireSourceRec ← source] ];
IF recursively AND newWire.elements # NIL THEN {
FOR i: NAT IN [0 .. newWire.elements.size) DO
NoteWireSource[newWire.elements[i], [source.instantiationPath, source.wire.elements[i]], recursively];
ENDLOOP;
newWire ← newWire;
};
};
GetWireSource: PROC [w: Wire] RETURNS [ws: WireSource] = {
ws ← NARROW[CoreProperties.GetProp[w.properties, wireSource]];
};
Control by File
ControlByFile: PUBLIC PROC [fileName: ROPE] RETURNS [control: FlattenControl] = {ERROR --not yet implemented--};
Start Code
Start: PROC = TRUSTED {
Process.InitializeCondition[@symChange, Process.SecondsToTicks[60]];
Process.EnableAborts[@symChange];
};
Start[];
END.