DIRECTORY
AMBridge,
AMModel,
AMTypes,
Basics USING [bytesPerWord],
BcdDefs USING [VersionStamp],
CD,
CDApplications,
CDConditions,
CDDirectory,
CDIO,
CDOps,
CDValue,
FileNames,
FS,
Interpreter USING [Evaluate],
IO,
Loader USING [Instantiate, IRItem],
PrincOps USING [ControlModule],
Rope,
TerminalIO,
TokenIO,
WorldVM USING [LocalWorld];

CDConditionsImpl: CEDAR PROGRAM 
IMPORTS AMBridge, AMModel, AMTypes, CD, CDApplications, CDDirectory, CDIO, CDOps, CDValue, FileNames, FS, Interpreter, IO, Loader, Rope, TerminalIO, TokenIO, WorldVM
EXPORTS CDConditions
SHARES CDDirectory =
BEGIN

ConditionProc: TYPE = CDConditions.ConditionProc;
CondPtr: TYPE = CDConditions.CondPtr;
CondRec: TYPE = CDConditions.CondRec;

pForConditions: REF CD.ObjectProcs ~ CD.RegisterObjectType[$Cond];
ConditionList: TYPE = LIST OF CD.ObPtr;

DrawMe: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation,
pr: CD.DrawRef] =
BEGIN
ENABLE UNWIND => 
IF pr.nesting.table[pr.nestDepth_1]=aptr THEN pr.nestDepth _ pr.nestDepth-1;
cptr: CondPtr = NARROW[aptr.ob.specificRef];
IF cptr.condition=NIL OR cptr.condition[aptr, pr] THEN {
pr.nesting.table[pr.nestDepth] _ aptr;
pr.nestDepth _ pr.nestDepth+1;
pr.drawChild[cptr.app, pos, orient, pr];
pr.nestDepth _ pr.nestDepth-1;
}
END; 

QuickDrawMe: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation,
pr: CD.DrawRef] =
BEGIN
ENABLE UNWIND => 
IF pr.nesting.table[pr.nestDepth_1]=aptr THEN pr.nestDepth _ pr.nestDepth-1;
cptr: CondPtr = NARROW[aptr.ob.specificRef];
IF cptr.condition=NIL OR cptr.condition[aptr, pr] THEN {
pr.nesting.table[pr.nestDepth] _ aptr;
pr.nestDepth _ pr.nestDepth+1;
cptr.app.ob.p.quickDrawMe[cptr.app, pos, orient, pr];
pr.nestDepth _ pr.nestDepth-1;
}
END; 

DescribeCond: PROC[me: CD.ObPtr] RETURNS [Rope.ROPE] = 
BEGIN
cptr: CondPtr = NARROW[me.specificRef];
RETURN [Rope.Cat["conditional ", CDOps.Info[cptr.app.ob], " [", CDDirectory.Name[me], "]"]]
END;

GetConditionList: PROC[design: CD.Design] RETURNS [REF ConditionList] =
BEGIN
x: REF _ CDValue.Fetch[design, $ConditionList];
IF x=NIL OR ~ISTYPE[x, REF ConditionList] THEN {
x _ NEW[ConditionList_NIL];
CDValue.Store[design, $ConditionList, x];
};
RETURN [NARROW[x, REF ConditionList]];
END;

Another: PROC [me: CD.ObPtr, from, to: CD.Design] RETURNS [CD.ObPtr] =
BEGIN
cp: CondPtr = NARROW[me.specificRef];
RETURN [CreateCondition[to, cp.app.ob, cp.condition, cp.data]]
END;

InternalCreateCondOb: PROC [design: CD.Design, ob: CD.ObPtr, condition: ConditionProc, data: REF] RETURNS [CD.ObPtr] =
BEGIN
refcl: REF ConditionList = GetConditionList[design];
cOb: CD.ObPtr = NEW[CD.ObjectDefinition];
cp: CondPtr = NEW[CondRec];
cOb.p _ pForConditions;
cOb.size _ ob.size;
cOb.layer _ ob.layer;
cOb.specificRef _ cp;
cp.app _ CDApplications.NewApplicationI[ob: ob];
cp.condition _ condition;
cp.data _ data;
refcl^ _ CONS[cOb, refcl^];
RETURN [cOb];
END;

CreateCondition: PUBLIC PROC [design: CD.Design, ob: CD.ObPtr, condition: ConditionProc_NIL, data: REF_NIL] RETURNS [CD.ObPtr] =
BEGIN
cOb: CD.ObPtr = InternalCreateCondOb[design, ob, condition, data];
[] _ CDDirectory.Include[design, cOb];
RETURN [cOb];
END;

ChangeCondition: PUBLIC PROC [design: CD.Design, ob: CD.ObPtr, fileName, procName: Rope.ROPE_NIL, data: REF_NIL, condition: ConditionProc_NIL] RETURNS [done: BOOL_FALSE] =
BEGIN
WriteNames: PROC [r: Rope.ROPE_NIL] = {
TerminalIO.WriteRope["  Condition proc "];
TerminalIO.WriteRope[procName]; 
TerminalIO.WriteRope["  on file "]; 
TerminalIO.WriteRope[fileName]; 
TerminalIO.WriteRope["; "]; 
IF ~Rope.IsEmpty[r] THEN TerminalIO.WriteRope[r]; 
};
cptr: CondPtr = NARROW[ob.specificRef];
cptr.data _ data;
cptr.fileName _ fileName;
cptr.procName _ procName;
IF condition#NIL THEN {
cptr.condition _ condition;
done _ TRUE;
}
ELSE IF Rope.IsEmpty[procName] THEN {
cptr.condition _ NIL;
done _ TRUE;
}
ELSE {
procAlone, modName: Rope.ROPE_NIL;
cptr.condition _ NIL;
cptr.data _ data;
cptr.fileName _ fileName;
cptr.procName _ procName;
BEGIN -- determine procAlone, modName
procDot: INT = TrailingDot[procName];
IF procDot < Rope.Length[procName] THEN {
procAlone _ Rope.Flatten[procName, procDot+1];
modName _ Rope.Flatten[procName, 0, procDot]
}
ELSE procAlone _ procName;
IF Rope.IsEmpty[modName] THEN modName _ SuggestedModule[fileName];
IF Rope.IsEmpty[procAlone] THEN procAlone _ "Condition";
END;
[] _ CDIO.UseWorkingDirectory[design];
TRUSTED BEGIN -- compare the file with the wanted module; load the file
root: AMModel.Context = AMModel.RootContext[WorldVM.LocalWorld[]];
ctxVersion, fileVersion: BcdDefs.VersionStamp;
modCtx: AMModel.Context;
fileStream: IO.STREAM;
fileStream _ FS.StreamOpen[CDIO.MakeName[fileName, "bcd"]
! FS.Error => IF error.group # bug THEN {
WriteNames[];
TerminalIO.WriteRope["Could not open "];
TerminalIO.WriteRope[fileName];
TerminalIO.WriteRope["  "];
TerminalIO.WriteRope[error.explanation];
TerminalIO.WriteLn[];
GOTO NotDone
}];
IO.SetIndex[fileStream, SIZE[CARDINAL]*Basics.bytesPerWord];
[] _ IO.UnsafeGetBlock[fileStream, [
base: LOOPHOLE[LONG[@fileVersion]],
startIndex: 0,
count: SIZE[BcdDefs.VersionStamp]*Basics.bytesPerWord]];
modCtx _ AMModel.MostRecentNamedContext[modName, root];
IF modCtx # NIL THEN
ctxVersion _ AMModel.SectionVersion[AMModel.ContextSection[modCtx]];
IF modCtx = NIL OR ctxVersion # fileVersion THEN {
msg: Rope.ROPE _ NIL;
unboundImports: LIST OF Loader.IRItem _ NIL;
cm: PrincOps.ControlModule;
file: FS.OpenFile = FS.OpenFileFromStream[fileStream];
fullName: Rope.ROPE = FS.GetName[file].fullFName;
TerminalIO.WriteRope["Loading "];
TerminalIO.WriteRope[fullName];
TerminalIO.WriteLn[];
[cm, unboundImports] _ Loader.Instantiate[file];
IF unboundImports # NIL THEN {
TerminalIO.WriteRope["Warning!  Unbound imports:"];
FOR eachIR: LIST OF Loader.IRItem _ unboundImports, eachIR.rest WHILE eachIR # NIL DO
TerminalIO.WriteRope[eachIR.first.interfaceName]; 
TerminalIO.WriteRope["#"]; 
TerminalIO.WriteInt[eachIR.first.index];
ENDLOOP;
TerminalIO.WriteLn[];
};
};
IO.Close[fileStream];
END;
TRUSTED BEGIN  -- get the procedure we want 
errorRope: Rope.ROPE;
noResult: BOOL;
tv: AMTypes.TV _ NIL;
type: AMTypes.Type;
[tv, errorRope, noResult] _ Interpreter.Evaluate[Rope.Cat[modName, ".", procAlone]];
IF noResult OR tv=NIL OR ~Rope.IsEmpty[errorRope] THEN {
WriteNames[];
TerminalIO.WriteRope["  no condition procedure: "]; 
TerminalIO.WriteRope[errorRope]; 
TerminalIO.WriteLn[]; 
RETURN
};
type _ AMTypes.TVType[tv];
WHILE AMTypes.TypeClass[type]=definition DO
tv _ AMTypes.Coerce[tv, AMTypes.UnderType[type]];
type _ AMTypes.TVType[tv];
ENDLOOP;
IF AMTypes.TypeClass[type]=ref THEN { 
WITH AMBridge.SomeRefFromTV[tv] SELECT FROM
cond: REF ConditionProc => {
cptr.condition _ cond^; 
done _ TRUE
}; 
ENDCASE => NULL;
}
ELSE IF AMTypes.TypeClass[type]=procedure THEN {
p: PROC ANY RETURNS ANY _ LOOPHOLE[AMBridge.TVToProc[tv]];
WITH p SELECT FROM
cond: ConditionProc => {
cptr.condition _ cond;
done _ TRUE
};
ENDCASE => NULL;
};
IF ~done THEN WriteNames["  has wrong type; not done\n"]; 
END;
};
IF done THEN CDOps.DelayedRedraw[design]
EXITS
NotDone => NULL;
END;

SuggestedModule: PROC [base: Rope.ROPE] RETURNS [Rope.ROPE] = {
len, dot: INT;
base _ FileNames.GetShortName[base];
len _ Rope.Length[base];
dot _ TrailingDot[base];
IF len>dot AND Rope.Equal[Rope.Substr[base, dot+1], "bcd", FALSE] THEN 
base _ Rope.Flatten[base, 0, dot];
RETURN [base]
};

TrailingDot: PROC [base: Rope.ROPE] RETURNS [INT] = {
len: INT _ Rope.Length[base];
pos: INT _ len;
WHILE pos > 0 DO
SELECT Rope.Fetch[base, pos _ pos - 1] FROM
'. => RETURN [pos];
'!, '], '>, '/ => EXIT;
ENDCASE;
ENDLOOP;
RETURN [len];
};

EnumerateCondOb: PROC [me: CD.ObPtr, p: CDDirectory.EnumerateObjectsProc, x: REF] = 
BEGIN
cptr: CondPtr = NARROW[me.specificRef];
p[cptr.app.ob, x];
END;

ReadCondOb: CD.InternalReadProc --PROC [] RETURNS [ObPtr]-- =
BEGIN
ob: CD.ObPtr = CDIO.ReadObject[];
procName: Rope.ROPE = TokenIO.ReadRope[];
fileName: Rope.ROPE = TokenIO.ReadRope[];
cOb: CD.ObPtr = InternalCreateCondOb[CDIO.DesignInReadOperation[], ob, NIL, NIL];
[] _ ChangeCondition[design: CDIO.DesignInReadOperation[], ob: cOb, procName: procName, fileName: fileName];
RETURN [cOb]
END;

WriteCondOb: CD.InternalWriteProc -- PROC [me: ObPtr] -- =
BEGIN
specific: CondPtr = NARROW[me.specificRef];
CDIO.WriteObject[specific.app.ob];
TokenIO.WriteRope[specific.procName];
TokenIO.WriteRope[specific.fileName];
END;

UpdateConditions: PUBLIC PROC [design: CD.Design, doAll: BOOL_TRUE] RETURNS [done: BOOL_FALSE] =
BEGIN
doneSoFar: BOOL_TRUE;
cl: ConditionList _ GetConditionList[design]^;
FOR l: ConditionList _ cl, l.rest WHILE l#NIL DO
WITH l.first.specificRef SELECT FROM
cptr: CondPtr => IF doAll OR cptr.condition=NIL THEN {
doneSoFar _ doneSoFar AND ChangeCondition[design, l.first, cptr.fileName, cptr.procName, cptr.data] 
};
ENDCASE => doneSoFar_FALSE; 
ENDLOOP;
RETURN [doneSoFar]
END; 


ReplaceDirectChildForConds: CDDirectory.ReplaceDChildsProc =
BEGIN
cp: CDConditions.CondPtr = NARROW[me.specificRef];
FOR rl: CDDirectory.ReplaceList _ replace, rl.rest WHILE rl#NIL DO
rep: REF CDDirectory.ReplaceRec = rl.first;
IF rep.old=cp.app.ob THEN {
oldSize: CD.DesignPosition _ me.size;
off: CD.DesignPosition _ rep.off;
cp.cache _ NIL;
cp.app.ob _ rep.new;
me.size _ rep.new.size;
IF design#NIL THEN
CDDirectory.RepositionObject[
design: design, 
ob: me, 
oldSize: oldSize,
baseOff: off
];
EXIT
};
ENDLOOP
END;

InitConditions: PROC [] =
BEGIN
cp: REF CDDirectory.DirectoryProcs ~ CDDirectory.InstallDirectoryProcs[pForConditions];
cp.enumerateChildObjects _ EnumerateCondOb;
cp.replaceDirectChilds _ ReplaceDirectChildForConds;
cp.another _ Another;
pForConditions.drawMe _ DrawMe;
pForConditions.quickDrawMe _ QuickDrawMe;
pForConditions.internalRead _ ReadCondOb;
pForConditions.internalWrite _ WriteCondOb;
pForConditions.describe _ DescribeCond;
CDValue.EnregisterKey[$ConditionList];
END; 

InitConditions[];
END. 

CDConditionsImpl.mesa        (part of ChipNDale)
Copyright c 1984, 1985 by Xerox Corporation.  All rights reserved.
by Christian Jacobi,  May 4, 1984 10:12:34 am PDT 
last edited by Christian Jacobi,  April 12, 1985 5:18:31 pm PST
some code from Russ Atkinson's HandCodingDriver
--there are restrictions on the type of data; (because of IO!)
--if condition is nil, tries to evaluate fileName, procName
--redraws the complete design
--there are restrictions on the type of data
--Read the version stamp of the file
--Get the version stamp of the loaded bcd.
--We must try to load this file dynamically 
--At this point we have found the named module, and we want to find the named procedure in the module, if there is one.  If one was not specified, default to "Condition".
--given a filename, suggests a modulename
--position of last dot
--checks if any conditions have been recompiled and reloads them
--doAll TRUE:  checks all, including already loded conditions
--doAll FALSE:  checks the conditions which are not already loded
�Ê0˜š
œ0™0Jšœ
Ïm
œ7™BJš
œ2™2Jš
œ?™?J™/J˜—š
Ïk	˜	Jš
œ	˜	Jš
œ˜Jš
œ˜Jšœžœ˜Jšœžœ˜Jš
œ˜Jš
œ˜Jš
œ
˜
Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ
˜
Jšžœ
˜Jšœžœ˜Jšžœ
˜Jšœžœ˜#Jšœ	žœ˜Jš
œ˜Jš
œ˜Jš
œ˜Jšœžœ˜J˜—šÏbœžœ
žœ
˜ JšžœžœžœžœžœÏc
œ˜¥
Jšžœ
˜Jšžœ˜—Jš
ž˜J˜Jšœžœ˜1Jšœ	žœ˜%Jšœ	žœ˜%J˜Jšœžœžœ˜BJš	œžœžœ
žœ
žœ˜'J˜š
Ïnœžœžœžœžœ
˜VJšœžœ˜Jš
ž˜šžœ
žœ˜Jšžœ'žœ˜L—Jšœžœ˜,šžœžœ
žœžœ˜8Jš
œ&˜&Jš
œ˜Jš
œ(˜(Jš
œ˜Jš
œ
˜
—Jšžœ˜—J˜š
¡œžœžœžœžœ
˜[Jšœžœ˜Jš
ž˜šžœ
žœ˜Jšžœ'žœ˜L—Jšœžœ˜,šžœžœ
žœžœ˜8Jš
œ&˜&Jš
œ˜Jš
œ5˜5Jš
œ˜Jš
œ
˜
—Jšžœ˜—J˜š
¡œžœžœžœžœ˜7Jš
ž˜Jšœžœ˜'JšžœU˜[Jšžœ
˜—J˜š
¡œžœ	žœ	žœžœ˜GJš
ž˜Jšœžœ)˜/šžœžœ
žœžœžœžœ˜0Jšœžœžœ˜Jš
œ)˜)J˜—Jšžœžœžœ˜&Jšžœ
˜—J˜š¡œžœžœžœ	žœžœ	˜FJš
ž˜Jšœžœ˜%Jšžœ8˜>Jšžœ
˜—J˜š¡œžœ
žœ
žœ(žœžœžœ	˜vJš
ž˜Jšœžœ*˜4Jšœžœ	žœ
žœ˜)Jšœžœ
˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ0˜0Jš
œ˜Jš
œ˜Jšœ	žœ˜Jšžœ˜
Jšžœ
˜—J˜š¡œžœ
žœ
žœ
žœ!žœžœ
žœžœžœ	˜€
Jš
œ>™>Jš
ž˜Jšœžœ;˜BJš
œ&˜&Jšžœ˜
Jšžœ
˜—J˜šÐbnœžœ
žœ
žœ
žœ!žœ
žœžœ
žœžœžœžœ
žœ˜«
Jš
œ;™;Jš
œ™J™,Jš
ž˜š¡
œžœ
žœ
žœ˜'Jš
œ*˜*Jš
œ ˜ Jš
œ$˜$Jš
œ ˜ Jš
œ˜Jšžœžœ˜2J˜—Jšœžœ˜'Jš
œ˜Jš
œ˜Jš
œ˜šžœžœ
žœ˜Jš
œ˜Jšœž˜J˜
—šžœ
žœžœ˜%Jšœžœ
˜Jšœžœ
˜J˜
—šžœ˜Jšœžœ
˜"Jšœžœ
˜Jš
œ˜Jš
œ˜Jš
œ˜šžœ
 ˜%Jšœ	žœ˜%šžœ!žœ˜)Jš
œ.˜.Jš
œ,˜,J˜
—Jšžœ˜Jšžœžœ%˜BJšžœžœ˜8Jšžœ
˜—Jšœžœ˜&šž
œ
 9˜GJš
œB˜BJš
œ.˜.Jš
œ˜Jšœžœ
žœ
˜Jš
œ$™$šœ
žœ*˜9šœžœ
žœžœ˜)Jš
œ
˜
Jš
œ(˜(Jš
œ˜Jš
œ˜Jš
œ(˜(Jš
œ˜Jšžœ˜Jš
œ˜——Jšžœžœ
žœ˜<šœžœ˜$Jšœžœ
žœ˜#Jš
œ˜Jšœžœ-˜8—Jš
œ*™*Jš
œ7˜7šžœ
žœ
ž˜Jš
œD˜D—šžœ
žœ
žœžœ˜2Jš
œ,™,Jšœ
žœžœ
˜Jšœžœ
žœžœ
˜,Jš
œ˜Jšœžœžœ ˜6Jšœžœžœ˜1Jš
œ!˜!Jš
œ˜Jš
œ˜Jš
œ0˜0šžœžœ
žœ˜Jš
œ3˜3šžœ	žœ
žœ-žœ
žœ
ž˜UJš
œ2˜2Jš
œ˜Jš
œ(˜(Jšžœ
˜—Jš
œ˜J˜—Jš
œ˜—Jšžœ˜Jš
ϻ
™ª
Jšžœ
˜—šžœ
žœ ˜,Jšœžœ
˜Jšœ
žœ
˜Jšœžœžœ
˜Jš
œ˜Jš
œT˜Tš
žœ
žœžœ
žœžœ˜8Jš
œ
˜
Jš
œ4˜4Jš
œ!˜!J˜Jš
ž˜Jš
œ˜—Jš
œ˜šžœ$ž˜+Jš
œ1˜1Jš
œ˜Jšžœ
˜—šžœžœ
˜&šžœžœ
ž˜+šœžœ˜Jš
œ˜Jšœž˜Jš
œ˜—Jšžœžœ
˜—J˜
—šžœ
žœ#žœ˜0Jšœžœ
žœ
žœ
žœžœ˜:šžœžœ
ž˜š
œ˜Jš
œ˜Jšœž˜J˜—Jšžœžœ
˜—J˜—Jšžœžœ-˜:Jšžœ
˜—Jš
œ˜—Jšžœžœ˜(š
ž˜Jšœžœ
˜—Jšžœ
˜—J˜š
¡œžœ
žœžœžœ˜?Jš
œ)™)Jšœ
žœ
˜Jš
œ$˜$Jš
œ˜Jš
œ˜šžœ	žœ-žœžœ
˜GJš
œ"˜"—Jšžœ˜
J˜—J˜š
¡œžœ
žœžœžœ˜5Jš
œ™Jšœžœ˜Jšœžœ˜šžœ	ž˜šžœ!ž˜+Jšœžœ˜Jšœžœ
˜Jšžœ
˜—Jšžœ
˜—Jšžœ˜
J˜J˜—š¡œžœžœ0žœ˜TJš
ž˜Jšœžœ˜'Jš
œ˜Jšžœ
˜—J˜šŸ
œžœ œ˜=Jš
ž˜Jšœžœ	žœ˜!Jšœžœ˜)Jšœžœ˜)Jš	œžœžœžœžœ˜QJšœžœK˜lJšžœ˜Jšžœ
˜—J˜šŸœžœ œ˜:Jš
ž˜Jšœžœ˜+Jšžœ˜"Jš
œ%˜%Jš
œ%˜%Jšžœ
˜—J˜š¡œžœ
žœ
žœžœ
žœžœžœ
žœ˜`Jš
œ@™@Jš
œ=™=Jš
œA™AJš
ž˜Jšœžœ
žœ
˜Jš
œ.˜.šžœžœžœ
ž˜0šžœžœ
ž˜$š	œžœžœžœ
žœ˜6JšœžœK˜dJ˜—Jšžœžœ˜—Jšžœ
˜—Jšžœ˜Jšžœ˜—J˜J˜šŸœ"˜<Jš
ž˜Jšœžœ˜2šžœ0žœžœ
ž˜BJšœžœ#˜+šžœžœ˜Jš
œ%˜%Jš
œ!˜!Jšœžœ
˜Jš
œ˜Jš
œ˜šžœžœ
ž˜š
œ˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜——Jš
ž˜J˜—Jš
ž˜—Jšžœ
˜—J˜š¡œžœ˜Jš
ž˜JšœžœP˜WJš
œ+˜+Jš
œ4˜4Jš
œ˜Jš
œ˜Jš
œ)˜)Jš
œ)˜)Jš
œ+˜+Jš
œ'˜'Jš
œ&˜&Jšžœ˜—J˜Jš
œ˜Jšžœ˜J˜—…—&Ð9