CDGenerateImpl.mesa (part of ChipNDale)
Copyright © 1985, 1986 by Xerox Corporation. All rights reserved.
by Christian Jacobi, June 5, 1985 8:02:35 pm PDT
Last Edited by Christian Jacobi, February 12, 1986 4:38:42 pm PST
DIRECTORY
CD,
CDGenerate,
CDGenerateBackdoor,
CDDirectory,
CDEvents,
CDMenuSpecials,
CDProperties,
Rope,
SymTab;
CDGenerateImpl:
CEDAR
MONITOR
IMPORTS CDDirectory, CDEvents, CDMenuSpecials, CDProperties, SymTab
EXPORTS CDGenerate, CDGenerateBackdoor =
BEGIN
publicTables: PUBLIC SymTab.Ref ← SymTab.Create[case: TRUE];
Table: TYPE = CDGenerate.Table;
TableRep: TYPE = CDGenerate.TableRep;
GeneratorProc: TYPE = CDGenerate.GeneratorProc;
IGeneratorProc: TYPE = CDGenerateBackdoor.IGeneratorProc;
SelectorProc: TYPE = CDGenerateBackdoor.SelectorProc;
Registration: TYPE = RECORD [generator: GeneratorProc, cache: BOOL, data: REF];
Entry: TYPE = RECORD[ob: CD.Object, registration: REF Registration, lastChange: REF←NIL];
Indirection: TYPE = RECORD [onTopOf: Table, iGenerator: IGeneratorProc, selector: SelectorProc, flush: BOOL, clear: BOOL, register: BOOL];
changePropertyKey:
REF
ATOM ←
NEW[
ATOM ← $changePropertyKey];
--to use less memory the property is only included when the object changes...
--If objects would tend too loose changeproperties, the key had to be assigned on first caching
ObjectHasChanged: CDEvents.EventProc =
BEGIN
WITH x
SELECT
FROM
ob:
CD.Object =>
IF ob.class.inDirectory
THEN
CDProperties.PutPropOnObject[onto: ob, prop: changePropertyKey, val: NEW[INT]];
ENDCASE => NULL;
END;
GetCache:
ENTRY PROC [table: Table, design:
CD.Design]
RETURNS [cache: SymTab.Ref] =
TRUSTED BEGIN
ENABLE UNWIND => NULL;
WITH CDProperties.GetPropFromDesign[from: design, prop:
LOOPHOLE[table]]
SELECT
FROM
symtab: SymTab.Ref => cache ← symtab;
ENDCASE => {
cache ← SymTab.Create[case: table.case];
CDProperties.PutPropOnDesign[onto: design, prop: LOOPHOLE[table], val: cache];
};
END;
OkObject:
PROC [design:
CD.Design, entry:
REF Entry]
RETURNS [ok:
BOOL←
TRUE] =
BEGIN
IF entry.ob.class.inDirectory
THEN {
ob1: CD.Object ← CDDirectory.Fetch[design, CDDirectory.Name[entry.ob]].object;
IF ob1=NIL OR ob1#entry.ob THEN RETURN [ok←FALSE];
ok ← entry.lastChange=CDProperties.GetPropFromObject[from: ob1, prop: changePropertyKey];
};
END;
Create:
PUBLIC
PROC [case:
BOOL ←
TRUE, cache:
BOOL ←
TRUE]
RETURNS [table: Table] =
BEGIN
table ← NEW[TableRep←[rep: SymTab.Create[case: case, mod: 51], case: case, cache: cache]];
END;
CreateIndirect:
PUBLIC
PROC [onTopOf: Table, iGenerator: IGeneratorProc, selector: SelectorProc←
NIL, cache:
BOOL ←
TRUE, flushThrough:
BOOL ←
TRUE, clearThrough:
BOOL ←
TRUE, registerThrough:
BOOL ←
TRUE]
RETURNS [table: Table] =
BEGIN
ind:
REF Indirection ←
NEW[Indirection
← [iGenerator: iGenerator, onTopOf: onTopOf, selector: selector, flush: flushThrough, clear: clearThrough, register: registerThrough]];
table ← NEW[TableRep ← [rep: ind, case: onTopOf.case, cache: cache AND onTopOf.cache]];
END;
Indiretee:
PUBLIC PROC [table: Table]
RETURNS [Table] =
--NIL if not indirect
BEGIN
WITH table.rep
SELECT
FROM
ind: REF Indirection => RETURN [ind.onTopOf]
ENDCASE => RETURN [NIL]
END;
Clear:
PUBLIC
PROC [table: Table] =
BEGIN
WITH table.rep
SELECT
FROM
symtab: SymTab.Ref => {
EachPair: SymTab.EachPairAction = {
[] ← symtab.Delete[key]; quit ← FALSE;
};
[] ← symtab.Pairs[EachPair];
};
ind: REF Indirection => IF ind.clear THEN Clear[ind.onTopOf];
ENDCASE => ERROR
END;
Register:
PUBLIC
PROC [table: Table, key: Rope.
ROPE, generator: GeneratorProc, cache:
BOOL, data:
REF]
RETURNS [first:
BOOL] =
BEGIN
WITH table.rep
SELECT
FROM
symtab: SymTab.Ref => {
IF generator=NIL THEN first ← ~ symtab.Delete[key]
ELSE first ← symtab.Store[key,
NEW[Registration
← [generator: generator, cache: cache AND table.cache, data: data]]]
};
ind:
REF Indirection =>
IF ind.register
THEN
RETURN [Register[ind.onTopOf, key, generator, cache, data]];
ENDCASE => ERROR
END;
FetchRegRef:
PROC [table: Table, key: Rope.
ROPE]
RETURNS [reg:
REF Registration←
NIL] =
--fetches registration of real generator
BEGIN
WITH table.rep
SELECT
FROM
symtab: SymTab.Ref =>
WITH symtab.Fetch[key].val
SELECT
FROM
reg: REF Registration => RETURN [reg];
ENDCASE => NULL;
ind: REF Indirection => RETURN [FetchRegRef[ind.onTopOf, key]]
ENDCASE => NULL;
END;
FetchRegistration:
PUBLIC
PROC [table: Table, key: Rope.
ROPE]
RETURNS [generator: GeneratorProc←
NIL, cache:
BOOL←
FALSE, data:
REF←
NIL] =
--cache means original registration and is not updated according to any indirection
BEGIN
reg: REF Registration = FetchRegRef[table, key];
IF reg#
NIL
THEN {
generator ← reg.generator;
cache ← reg.cache AND table.cache;
data ← reg.data
};
END;
FetchCached:
PUBLIC PROC[table: Table, design:
CD.Design, key: Rope.
ROPE]
RETURNS [ob:
CD.Object←
NIL] =
--returns NIL if not found, not cached or looks different
BEGIN
IF table.cache
THEN {
reg: REF Registration ← FetchRegRef[table, key];
IF reg=
NIL
OR reg.cache
THEN
{
obCache: SymTab.Ref ← GetCache[table, design];
entry: REF Entry ← NARROW[obCache.Fetch[key].val];
IF entry#
NIL
AND entry.registration=reg
THEN {
IF OkObject[design, entry] THEN RETURN [entry.ob]
ELSE [] ← obCache.Delete[key]
}
}
}
END;
FetchNCall:
PUBLIC
PROC[table: Table, design:
CD.Design, key: Rope.
ROPE, cache:
BOOL]
RETURNS [ob:
CD.Object←
NIL] =
--returns NIL if not found or generated
BEGIN
ob ← FetchIndirect[passTable: table, realTable: table, design: design, key: key, cache: cache]
END;
Flush:
PUBLIC
PROC [table: Table, design:
CD.Design, key: Rope.
ROPE] =
--Removes this entry from the cache
BEGIN
IF table.cache
THEN {
cache: SymTab.Ref ← GetCache[table, design];
[] ← cache.Delete[key]
};
WITH table.rep
SELECT
FROM
ind: REF Indirection => IF ind.flush THEN Flush[ind.onTopOf, design, key];
ENDCASE => NULL;
END;
FlushAll:
PUBLIC
PROC [table: Table, design:
CD.Design] =
--Removes all entries from the cache
BEGIN
IF table.cache
THEN
TRUSTED {
cache: SymTab.Ref ← SymTab.Create[case: table.case];
CDProperties.PutPropOnDesign[onto: design, prop: LOOPHOLE[table], val: cache]
};
WITH table.rep
SELECT
FROM
ind: REF Indirection => IF ind.flush THEN FlushAll[ind.onTopOf, design]
ENDCASE => NULL;
END;
SelectOneOf:
PUBLIC
PROC[table: Table, label: Rope.
ROPE]
RETURNS [key: Rope.
ROPE←
NIL] =
--Interactive selection
--NIL if discarded
BEGIN
WITH table.rep
SELECT
FROM
symtab: SymTab.Ref => key ← CDMenuSpecials.SelectOneOf[symtab, label];
ind:
REF Indirection => {
IF ind.selector=SelectOneOf THEN key ← SelectOneOf[ind.onTopOf, label]
ELSE IF ind.selector#NIL THEN key ← ind.selector[table, label]
};
ENDCASE => ERROR
END;
AssertTable:
PUBLIC
PROC [project: Rope.
ROPE]
RETURNS [table: Table] =
--Fetches a table; if not done then create one and store it for next call of AssertTable.
--This table can be imported by lots of unknown applications...
TRUSTED BEGIN
WITH publicTables.Fetch[project].val
SELECT
FROM
tab: Table => table ← tab;
ENDCASE => {
[] ← publicTables.Insert[project, LOOPHOLE[Create[]]];
table ← AssertTable[project];
}
END;
FetchIndirect:
PUBLIC
PROC [passTable, realTable: Table, design:
CD.Design, key: Rope.
ROPE, cache:
BOOL←
FALSE]
RETURNS [ob:
CD.Object←
NIL] =
--Like FetchNCall except:
--passTable will be passed trough only
--realTable table to be really called.
--To be called from indirection generators
BEGIN
reg: REF Registration←NIL;
obCache: SymTab.Ref;
entry: REF Entry←NIL;
--check fetch from cache
IF cache
AND realTable.cache
THEN {
--THEN also onTopOf.cache !
reg ← FetchRegRef[realTable, key];
IF reg=
NIL
OR reg.cache
THEN {
obCache ← GetCache[realTable, design];
entry ← NARROW[obCache.Fetch[key].val];
IF entry#
NIL
AND entry.registration=reg
THEN {
IF OkObject[design, entry] THEN RETURN [entry.ob]
ELSE [] ← obCache.Delete[key]
};
};
};
--make an actual call...
WITH realTable.rep
SELECT
FROM
st: SymTab.Ref => {
IF reg=NIL THEN reg ← FetchRegRef[realTable, key];
IF reg#
NIL
THEN
ob ← reg.generator[design: design, key: key, table: passTable, data: reg.data];
};
ind:
REF Indirection =>
TRUSTED {
ob ← ind.iGenerator[design: design, key: key, passTable: passTable, realTable: realTable];
};
ENDCASE => ERROR;
--store in cache
IF cache
AND realTable.cache
THEN {
IF reg=
NIL
OR reg.cache
THEN {
IF ob=NIL THEN [] ← obCache.Delete[key]
ELSE {
entry ←
NEW[Entry ← [
ob: ob,
registration: reg,
lastChange: CDProperties.GetPropFromObject[from: ob, prop: changePropertyKey]
]];
[] ← obCache.Store[key, entry];
}
}
};
END;
CDEvents.RegisterEventProc[event: $AfterChange, proc: ObjectHasChanged];
END.