CDPropertiesImpl.mesa a Chipndale module
by Ch. Jacobi September 27, 1983 2:06 pm
last edited Christian Jacobi February 14, 1984 1:28 pm
DIRECTORY
CDProperties,
CD,
CDPrivate,
Atom,
RefTab,
Rope,
TokenIO;
CDPropertiesImpl: CEDAR MONITOR
IMPORTS CD, CDPrivate, CDProperties, Atom, RefTab, TokenIO
EXPORTS CDProperties =
BEGIN
Properties: TYPE = CD.Properties;
PropertyProcs: TYPE = CDProperties.PropertyProcs;
PropertyProcsRec: TYPE = CDProperties.PropertyProcsRec;
atomTab: RefTab.Ref = RefTab.Create[]; -- contains atoms [maybe in future ref's] where properties hang
--Registration
propertyNameTab: RefTab.Ref = RefTab.Create[]; -- key: propertynames; value: PropertyProcs
registrationTab: RefTab.Ref = RefTab.Create[]; -- contains registrationKeys
RegisterProperty: PUBLIC ENTRY PROC [prop: REF, registrationKey: REFNIL] RETURNS [first: BOOLEAN←TRUE] =
--registers "prop" in a table; any program which wants to use an ATOM
--as a "prop" gets to know if it is already in use.
BEGIN
val: RefTab.Val;
found: BOOL;
[found, val] ← RefTab.Fetch[x: registrationTab, key: prop]; -- returns a registration key
IF found THEN {
IF registrationKey#NIL AND registrationKey=val THEN RETURN [FALSE];
RETURN WITH ERROR CD.Error[doubleRegistration]
}
ELSE {
pp: PropertyProcs ← NEW[PropertyProcsRec];
[] ← RefTab.Insert[propertyNameTab, prop, pp]; -- procs
[] ← RefTab.Insert[registrationTab, prop, registrationKey]; -- registration
};
END;
--Usage
HasNoCDProperties: ERROR = CODE;
PutProp: PUBLIC PROC [onto: REF, prop: REF, val: REF] =
--a NIL val removes the property
BEGIN
WITH onto SELECT FROM
a: CD.ApplicationPtr => PutPropOnApplication[a, prop, val];
--considered bad: o: CD.ObPtr => PutPropOnObject[o, prop, val];
d: CD.Design => PutPropOnDesign[d, prop, val];
t: CD.Technology => PutPropOnTechnology[t, prop, val];
--l: CD.LevelRef => PutPropOnLevelRef[l, prop, val];
at: ATOM => PutPropOnAtom[at, prop, val];
ENDCASE => ERROR HasNoCDProperties
END;
GetProp: PUBLIC PROC [from: REF, prop: REF] RETURNS [REF] =
--NIL if prop is not found
BEGIN
RETURN [WITH from SELECT FROM
a: CD.ApplicationPtr => CDProperties.GetPropFromList[a.properties, prop],
o: CD.ObPtr => CDProperties.GetPropFromList[o.properties, prop],
d: CD.Design => CDProperties.GetPropFromList[d.properties, prop],
t: CD.Technology => CDProperties.GetPropFromList[t.properties, prop],
--l: CD.LevelRef => CDProperties.GetPropFromList[l.properties, prop],
at: ATOM => GetPropFromAtom[at, prop],
ENDCASE => ERROR HasNoCDProperties]
END;
--speed ups
PutPropOnObject: PUBLIC ENTRY PROC [onto: CD.ObPtr, prop: REF, val: REF] =
--a NIL val removes the property
BEGIN
IF val#NIL THEN onto.properties ← Atom.PutPropOnList[onto.properties, prop, val]
ELSE onto.properties ← Atom.RemPropFromList[onto.properties, prop]
END;
PutPropOnApplication: PUBLIC ENTRY PROC[onto: CD.ApplicationPtr, prop: REF, val: REF] =
--a NIL val removes the property
BEGIN
IF val#NIL THEN onto.properties ← Atom.PutPropOnList[onto.properties, prop, val]
ELSE onto.properties ← Atom.RemPropFromList[onto.properties, prop]
END;
PutPropOnDesign: PUBLIC ENTRY PROC [onto: CD.Design, prop: REF, val: REF] =
--a NIL val removes the property
BEGIN
IF val#NIL THEN onto.properties ← Atom.PutPropOnList[onto.properties, prop, val]
ELSE onto.properties ← Atom.RemPropFromList[onto.properties, prop]
END;
PutPropOnTechnology: PUBLIC ENTRY PROC[onto: CD.Technology, prop: REF, val: REF] =
--a NIL val removes the property
BEGIN
IF val#NIL THEN onto.properties ← Atom.PutPropOnList[onto.properties, prop, val]
ELSE onto.properties ← Atom.RemPropFromList[onto.properties, prop]
END;
PutPropOnAtom: PUBLIC PROC[onto: ATOM, prop: REF, val: REF] =
--a NIL val removes the property
{PutPropOnRef[onto: onto, prop: prop, val: val]};
PutPropOnLevel: PUBLIC ENTRY PROC[onto: CD.Level, prop: REF, val: REF] =
--a NIL val removes the property
BEGIN
CDPrivate.levels[onto].properties ←
IF val#NIL THEN Atom.PutPropOnList[CDPrivate.levels[onto].properties, prop, val]
ELSE Atom.RemPropFromList[CDPrivate.levels[onto].properties, prop];
END;
PutPropOnRef: ENTRY PROC[onto: REF, prop: REF, val: REF] =
--a NIL val removes the property
--here onto MUST NOT be a Chipndale ref pointing to a record with properties,
--since then the properties must be used, not the hash table
BEGIN
x: REF;
found: BOOL;
pp: REF CD.Properties;
[found, x] ← RefTab.Fetch[x: atomTab, key: onto];
IF found THEN pp ← NARROW[x, REF CD.Properties]
ELSE {
IF prop=NIL THEN RETURN;
pp ← NEW[CD.Properties←NIL];
[] ← RefTab.Store[x: atomTab, key: onto, val: pp];
};
IF prop#NIL THEN pp^ ← Atom.PutPropOnList[propList: pp^, prop: prop, val: val]
ELSE {
pp^ ← Atom.RemPropFromList[propList: pp^, prop: prop];
IF pp^=NIL THEN [] ← RefTab.Delete[x: atomTab, key: onto]
}
END;
GetPropFromRef: ENTRY PROC [from: REF, prop: REF] RETURNS [REF] =
--NIL if prop is not found
--here from MUST NOT be a Chipndale ref pointing to a record with properties,
--since then the properties must be used, not the hash table
INLINE BEGIN
x: REF;
found: BOOL;
pp: REF CD.Properties;
[found, x] ← RefTab.Fetch[x: atomTab, key: from];
IF NOT found THEN RETURN[NIL];
pp ← NARROW[x, REF CD.Properties];
RETURN[Atom.GetPropFromList[propList: pp^, prop: prop]]
END;
GetPropFromObject: PUBLIC PROC [from: CD.ObPtr, prop: REF] RETURNS [REF] =
--NIL if prop is not found
{RETURN[CDProperties.GetPropFromList[from.properties, prop]]};
GetPropFromApplication: PUBLIC PROC [from: CD.ApplicationPtr, prop: REF] RETURNS [REF] =
--NIL if prop is not found
{RETURN[CDProperties.GetPropFromList[from.properties, prop]]};
GetPropFromDesign: PUBLIC PROC [from: CD.Design, prop: REF] RETURNS [REF] =
--NIL if prop is not found
{RETURN[CDProperties.GetPropFromList[from.properties, prop]]};
GetPropFromTechnology: PUBLIC PROC [from: CD.Technology, prop: REF] RETURNS [REF] =
--NIL if prop is not found
{RETURN[CDProperties.GetPropFromList[from.properties, prop]]};
GetPropFromLevel: PUBLIC PROC [from: CD.Level, prop: REF] RETURNS [REF] =
--NIL if prop is not found
{RETURN[CDProperties.GetPropFromList[CDPrivate.levels[from].properties, prop]]};
GetPropFromAtom: PUBLIC PROC [from: ATOM, prop: REF] RETURNS [REF] =
--NIL if prop is not found
{RETURN[GetPropFromRef[from: from, prop: prop]]};
--property procedures
InstallProcs: PUBLIC ENTRY PROC [prop: REF, new: PropertyProcsRec] =
--prop must be registered and yours
--overwrites values for which new has non NIL entries
BEGIN
p: PropertyProcs ← FetchProcs[prop];
IF p#NIL THEN
BEGIN
IF new.exclusive THEN p.exclusive←TRUE;
IF new.makeCopy#NIL THEN p.makeCopy ← new.makeCopy;
IF new.internalWrite#NIL THEN p.internalWrite ← new.internalWrite;
IF new.internalRead#NIL THEN p.internalRead ← new.internalRead;
IF new.ownersData#NIL THEN p.ownersData ← new.ownersData;
END
END;
FetchProcs: PUBLIC PROC [prop: REF] RETURNS [PropertyProcs] =
--never copy PropertyProcs^; it can be extended by future calls of InstallProcs
BEGIN
x: REF;
found: BOOL;
[found: found, val: x] ← RefTab.Fetch[propertyNameTab, prop];
IF found THEN RETURN [NARROW[x, PropertyProcs]] ELSE RETURN [NIL]
END;
CopyVal: PUBLIC PROC [prop: REF, val: REF] RETURNS [valCopy: REF] =
{valCopy ← val};
DontCopy: PUBLIC PROC [prop: REF, val: REF] RETURNS [nil: REF] =
{nil ← NIL};
CopyProps: PUBLIC PROC [propList: Properties] RETURNS [copy: Properties←NIL] =
BEGIN
p: CDProperties.PropertyProcs;
FOR l: Properties ← propList, l.rest WHILE l#NIL DO
p ← FetchProcs[l.first.key];
IF p#NIL AND p.makeCopy#NIL THEN {
copy ← Atom.PutPropOnList[
propList: copy,
prop: l.first.key,
val: p.makeCopy[prop: l.first.key, val: l.first.val]
];
}
ELSE IF ISTYPE[l.first.key, ATOM] THEN
WITH l.first.val SELECT FROM
r: Rope.ROPE => {
copy ← Atom.PutPropOnList[
propList: copy,
prop: l.first.key,
val: r
];
};
at: ATOM => {
copy ← Atom.PutPropOnList[
propList: copy,
prop: l.first.key,
val: at
];
}
ENDCASE => NULL;
ENDLOOP;
END;
RopePWrite: PUBLIC PROC [prop: REF, val: REF] =
BEGIN
WITH val SELECT FROM
r: Rope.ROPE => TokenIO.WriteRope[r];
at: ATOM => TokenIO.WriteRope[Atom.GetPName[at]];
ENDCASE => TokenIO.WriteRope["bad property value"];
END;
AtomPWrite: PUBLIC PROC [prop: REF, val: REF] =
BEGIN
WITH val SELECT FROM
at: ATOM => TokenIO.WriteAtom[at];
r: Rope.ROPE => TokenIO.WriteAtom[Atom.MakeAtom[r]];
ENDCASE => TokenIO.WriteAtom[$Bad];
END;
IntPWrite: PUBLIC PROC [prop: REF, val: REF] =
BEGIN
WITH val SELECT FROM
ri: REF INT => TokenIO.WriteInt[ri^];
rc: REF CARDINAL => TokenIO.WriteInt[rc^];
rn: REF NAT => TokenIO.WriteInt[rn^];
ENDCASE => TokenIO.WriteInt[0];
END;
SomePWrite: PUBLIC PROC [prop: REF, val: REF] =
BEGIN
WITH val SELECT FROM
at: ATOM => TokenIO.WriteAtom[at];
r: Rope.ROPE => TokenIO.WriteRope[r];
ri: REF INT => TokenIO.WriteInt[ri^];
rc: REF CARDINAL => TokenIO.WriteInt[rc^];
rn: REF NAT => TokenIO.WriteInt[rn^];
ENDCASE => TokenIO.WriteAtom[$Unknown];
END;
RopePRead: PUBLIC PROC [prop: ATOM] RETURNS [val: REF] =
BEGIN
val ← TokenIO.ReadRope[]
END;
AtomPRead: PUBLIC PROC [prop: ATOM] RETURNS [val: REF] =
BEGIN
val ← TokenIO.ReadAtom[]
END;
IntPRead: PUBLIC PROC [prop: ATOM] RETURNS [val: REF] =
BEGIN
val ← NEW[INT←TokenIO.ReadInt[]]
END;
SomePRead: PUBLIC PROC [prop: ATOM] RETURNS [val: REF] =
BEGIN
t: TokenIO.Token ← TokenIO.ReadToken[];
SELECT t.kind FROM
atom, int, rope => val ← t.ref;
ENDCASE => val ← $Error;
END;
-------------
--now register some properties
[] ← CDProperties.RegisterProperty[$SignalName];
[] ← CDProperties.RegisterProperty[$InstanceName];
CDProperties.InstallProcs[prop: $SignalName, new:
CDProperties.PropertyProcsRec[
makeCopy: CDProperties.CopyVal,
internalWrite: CDProperties.RopePWrite,
internalRead: CDProperties.RopePRead
]];
CDProperties.InstallProcs[prop: $InstanceName, new:
CDProperties.PropertyProcsRec[
makeCopy: CDProperties.CopyVal,
internalWrite: CDProperties.RopePWrite,
internalRead: CDProperties.RopePRead
]];
END.