CDGenerateImpl.mesa (part of ChipNDale)
Copyright © 1985, 1987 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, June 5, 1985 8:02:35 pm PDT
Last edited by: Christian Jacobi, February 24, 1987 11:35:03 am PST
DIRECTORY
CD,
CDGenerate,
CDGenerateBackdoor,
CDDirectory,
CDEvents,
CDMenuSpecials,
CDProperties,
Rope,
SymTab;
CDGenerateImpl:
CEDAR
MONITOR
IMPORTS CDDirectory, CDEvents, CDMenuSpecials, CDProperties, SymTab
EXPORTS CDGenerate, CDGenerateBackdoor
SHARES CDDirectory =
BEGIN
publicContexts: PUBLIC SymTab.Ref ← SymTab.Create[case: TRUE];
Context: TYPE = CDGenerate.Context;
ContextRep: TYPE = CDGenerate.ContextRep;
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: Context, 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 = {
WITH x
SELECT
FROM
ob:
CD.Object =>
IF ob.class.composed
THEN
CDProperties.PutObjectProp[ob, changePropertyKey, NEW[INT]];
ENDCASE => NULL;
};
GetCache:
ENTRY PROC [context: Context, design:
CD.Design]
RETURNS [cache: SymTab.Ref] = {
ENABLE UNWIND => NULL;
WITH CDProperties.GetDesignProp[design, context]
SELECT
FROM
symtab: SymTab.Ref => cache ← symtab;
ENDCASE => {
cache ← SymTab.Create[case: context.case];
CDProperties.PutDesignProp[design, context, cache];
};
};
OkObject:
PROC [design:
CD.Design, entry:
REF Entry]
RETURNS [ok:
BOOL←
TRUE] = {
IF entry.ob.class.composed
AND ~entry.ob.immutable
THEN {
IF ~CDDirectory.CompatibleOwner[design, entry.ob] THEN RETURN [ok←FALSE];
ok ← entry.lastChange=CDProperties.GetObjectProp[from: entry.ob, prop: changePropertyKey];
};
};
Create:
PUBLIC
PROC [case:
BOOL ←
TRUE, cache:
BOOL ←
TRUE]
RETURNS [context: Context] = {
context ← NEW[ContextRep←[rep: SymTab.Create[case: case, mod: 51], case: case, cache: cache]];
};
CreateIndirect:
PUBLIC
PROC [onTopOf: Context, iGenerator: IGeneratorProc, selector: SelectorProc←
NIL, cache:
BOOL ←
TRUE, flushThrough:
BOOL ←
TRUE, clearThrough:
BOOL ←
TRUE, registerThrough:
BOOL ←
TRUE]
RETURNS [context: Context] = {
ind:
REF Indirection ←
NEW[Indirection
← [iGenerator: iGenerator, onTopOf: onTopOf, selector: selector, flush: flushThrough, clear: clearThrough, register: registerThrough]];
context ← NEW[ContextRep ← [rep: ind, case: onTopOf.case, cache: cache AND onTopOf.cache]];
};
Indiretee:
PUBLIC PROC [context: Context]
RETURNS [Context] = {
--NIL if not indirect
WITH context.rep
SELECT
FROM
ind: REF Indirection => RETURN [ind.onTopOf]
ENDCASE => RETURN [NIL]
};
Clear:
PUBLIC
PROC [context: Context] = {
WITH context.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
};
Register:
PUBLIC
PROC [context: Context, key: Rope.
ROPE, generator: GeneratorProc, cache:
BOOL, data:
REF]
RETURNS [first:
BOOL] = {
WITH context.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 context.cache, data: data]]]
};
ind:
REF Indirection =>
IF ind.register
THEN
RETURN [Register[ind.onTopOf, key, generator, cache, data]];
ENDCASE => ERROR
};
FetchRegRef:
PROC [context: Context, key: Rope.
ROPE]
RETURNS [reg:
REF Registration←
NIL] = {
--fetches registration of real generator
WITH context.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;
};
FetchRegistration:
PUBLIC
PROC [context: Context, 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
reg: REF Registration = FetchRegRef[context, key];
IF reg#
NIL
THEN {
generator ← reg.generator;
cache ← reg.cache AND context.cache;
data ← reg.data
};
};
FetchCached:
PUBLIC PROC[context: Context, design:
CD.Design, key: Rope.
ROPE]
RETURNS [ob:
CD.Object←
NIL] = {
--returns NIL if not found, not cached or looks different
IF context.cache
THEN {
reg: REF Registration ← FetchRegRef[context, key];
IF reg=
NIL
OR reg.cache
THEN
{
obCache: SymTab.Ref ← GetCache[context, 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]
}
}
}
};
FetchNCall:
PUBLIC
PROC[context: Context, design:
CD.Design, key: Rope.
ROPE, cache:
BOOL]
RETURNS [ob:
CD.Object←
NIL] = {
--returns NIL if not found or generated
ob ← FetchIndirect[passContext: context, realContext: context, design: design, key: key, cache: cache]
};
Flush:
PUBLIC
PROC [context: Context, design:
CD.Design, key: Rope.
ROPE] = {
--Removes this entry from the cache
IF context.cache
THEN {
cache: SymTab.Ref ← GetCache[context, design];
[] ← cache.Delete[key]
};
WITH context.rep
SELECT
FROM
ind: REF Indirection => IF ind.flush THEN Flush[ind.onTopOf, design, key];
ENDCASE => NULL;
};
FlushAll:
PUBLIC
PROC [context: Context, design:
CD.Design] = {
--Removes all entries from the cache
IF context.cache
THEN {
cache: SymTab.Ref ← SymTab.Create[case: context.case];
CDProperties.PutDesignProp[design, context, cache]
};
WITH context.rep
SELECT
FROM
ind: REF Indirection => IF ind.flush THEN FlushAll[ind.onTopOf, design]
ENDCASE => NULL;
};
SelectOneOf:
PUBLIC
PROC[context: Context, label: Rope.
ROPE]
RETURNS [key: Rope.
ROPE←
NIL] = {
--Interactive selection
--NIL if discarded
WITH context.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[context, label]
};
ENDCASE => ERROR
};
AssertContext:
PUBLIC
PROC [project: Rope.
ROPE]
RETURNS [context: Context] = {
--Fetches a context; if not done then create one and store it for next call of AssertContext.
--This context can be imported by lots of unknown applications...
WITH publicContexts.Fetch[project].val
SELECT
FROM
tab: Context => context ← tab;
ENDCASE => {
[] ← publicContexts.Insert[project, Create[]];
context ← AssertContext[project];
}
};
FetchIndirect:
PUBLIC
PROC [passContext, realContext: Context, design:
CD.Design, key: Rope.
ROPE, cache:
BOOL←
FALSE]
RETURNS [ob:
CD.Object←
NIL] = {
--Like FetchNCall except:
--passContext will be passed trough only
--realContext context to be really called.
--To be called from indirection generators
reg: REF Registration←NIL;
obCache: SymTab.Ref;
entry: REF Entry←NIL;
--check fetch from cache
IF cache
AND realContext.cache
THEN {
--THEN also onTopOf.cache !
reg ← FetchRegRef[realContext, key];
IF reg=
NIL
OR reg.cache
THEN {
obCache ← GetCache[realContext, 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 realContext.rep
SELECT
FROM
st: SymTab.Ref => {
IF reg=NIL THEN reg ← FetchRegRef[realContext, key];
IF reg#
NIL
THEN
ob ← reg.generator[design: design, key: key, context: passContext, data: reg.data];
};
ind:
REF Indirection => {
ob ← ind.iGenerator[design: design, key: key, passContext: passContext, realContext: realContext];
};
ENDCASE => ERROR;
--store in cache
IF cache
AND realContext.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];
}
}
};
};
CDEvents.RegisterEventProc[event: $AfterChange, proc: ObjectHasChanged];
END.