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, March 25, 1986 1:59:10 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: REFNIL];
Indirection: TYPE = RECORD [onTopOf: Table, iGenerator: IGeneratorProc, selector: SelectorProc, flush: BOOL, clear: BOOL, register: BOOL];
changePropertyKey: REF ATOMNEW[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.PutObjectProp[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.GetDesignProp[from: design, prop: LOOPHOLE[table]] SELECT FROM
symtab: SymTab.Ref => cache ← symtab;
ENDCASE => {
cache ← SymTab.Create[case: table.case];
CDProperties.PutDesignProp[onto: design, prop: LOOPHOLE[table], val: cache];
};
END;
OkObject: PROC [design: CD.Design, entry: REF Entry] RETURNS [ok: BOOLTRUE] =
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.GetObjectProp[from: ob1, prop: changePropertyKey];
};
END;
Create: PUBLIC PROC [case: BOOLTRUE, cache: BOOLTRUE] 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: BOOLTRUE, clearThrough: BOOLTRUE, registerThrough: BOOLTRUE] 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: BOOLFALSE, data: REFNIL] =
--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.PutDesignProp[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.ROPENIL] =
--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: BOOLFALSE] 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.GetObjectProp[from: ob, prop: changePropertyKey]
]];
[] ← obCache.Store[key, entry];
}
}
};
END;
CDEvents.RegisterEventProc[event: $AfterChange, proc: ObjectHasChanged];
END.