
DIRECTORY
C2CBasics,
C2CDefs,
C2CEnables,
C2CNames,
C2CIntCodeUtils,
IntCodeDefs,
IntCodeUtils,
IntToIntTab;

C2CEnablesImpl: CEDAR PROGRAM
IMPORTS C2CBasics, C2CNames, C2CIntCodeUtils, IntCodeUtils, IntToIntTab
EXPORTS C2CEnables = 
BEGIN
OPEN IntCodeDefs, C2CEnables, C2CBasics, C2CDefs;

IdList: TYPE = LIST OF LogicalId;
ConsId: PROC [idList: IdList, id: LogicalId] RETURNS [l: IdList] = {
FOR list: IdList м idList, list.rest WHILE list#NIL DO
IF list.first=id THEN RETURN [idList];
ENDLOOP;
RETURN [CONS[id, idList]];
};

globalPerModuleEnables: IntCodeUtils.IdTab;
ResetGlobalPerModuleEnables: PROC [] = {
globalPerModuleEnables м IntCodeUtils.NewIdTab[]
};

InitIdToLambdaInf: PROC [] = {
tab: IntCodeUtils.IdTab м globalPerModuleEnables м IntCodeUtils.NewIdTab[];
BEGIN  
VisitNIncludeLambda: IntCodeUtils.Visitor = {
WITH node SELECT FROM
labelNode: LabelNode => {
WITH labelNode.label.node SELECT FROM
lambdaNode: LambdaNode => {
old: REF м IntCodeUtils.Fetch[tab, labelNode.label.id];
WITH old SELECT FROM
inf: LabelUsage => IF inf.lambda=lambdaNode 
THEN RETURN [node] --same id for same lambda
ELSE ERROR; --multiply defined id
ENDCASE => {};
[] м IntCodeUtils.Store[tab, labelNode.label.id, NEW[LabelUsageRec м [lambda: lambdaNode, purposeOfLambda: unknown, definedLabels: IntToIntTab.Create[]]]];
RETURN [node]; --dont recurse down; lambdas are not nested
};
ENDCASE => {};
}; 
lambdaNode: LambdaNode => RETURN [node]; --dont recurse: lambdas are not nested
ENDCASE => {};
IntCodeUtils.MapNode[node, VisitNIncludeLambda];
RETURN [node];
};
[] м VisitNIncludeLambda[C2CBasics.rootNode]
END;
BEGIN 
SetPurpose: PROC [id: IntCodeDefs.LogicalId, purposeOfLambda: Purpose] = {
inf: LabelUsage м LambdaLabelUsage[id];
SELECT TRUE FROM
inf=NIL => CantHappen; --lambda not found in previous pass
inf.purposeOfLambda=unknown => {inf.purposeOfLambda м purposeOfLambda;
[] м C2CNames.LabName[id, "Enable"]; --place nice name
};
inf.purposeOfLambda#purposeOfLambda => CantHappen; --inconsistent usage
ENDCASE => {};
};
VisitLambdaInIdTab: IntCodeUtils.IdTabVisitor = {
VisitNode: IntCodeUtils.Visitor = {
WITH node SELECT FROM
lambdaNode: LambdaNode => RETURN [node]; --stop recursion
applyNode: ApplyNode => {
IF applyNode.handler#NIL AND applyNode.handler.proc#NIL THEN 
WITH applyNode.handler.proc SELECT FROM
gotoNode: GotoNode => SetPurpose[gotoNode.dest.id, enableHandler];
ENDCASE => ERROR;
WITH applyNode.proc SELECT FROM
operNode: OperNode => 
WITH operNode.oper SELECT FROM
codeOper: CodeOper => SetPurpose[codeOper.label.id, proc];
ENDCASE => {};
ENDCASE => {};
};
enableNode: EnableNode => {
IF enableNode.handle#NIL AND enableNode.handle.proc#NIL THEN
WITH enableNode.handle.proc SELECT FROM
gotoNode: GotoNode => SetPurpose[gotoNode.dest.id, enableHandler];
ENDCASE => ERROR CantHappenCedar;
};
labelNode: LabelNode => {
[] м IntToIntTab.Store[lambdaInf.definedLabels, labelNode.label.id, 0];
};
ENDCASE => NULL;
IntCodeUtils.MapNode[node, VisitNode];
RETURN [node];
};
lambdaInf: LabelUsage м NARROW[value];
IF lambdaInf.lambda=NIL THEN ERROR CantHappenCedar;
IntCodeUtils.MapNode[lambdaInf.lambda, VisitNode];
};
IntCodeUtils.Enumerate[tab, VisitLambdaInIdTab];
END;
BEGIN 
VisitLambdaInIdTab: IntCodeUtils.IdTabVisitor = {
lambdaInf: LabelUsage м NARROW[value];
IF lambdaInf.purposeOfLambda=enableHandler THEN {
RegisterCall: PROC [callee: LogicalId] = {
calleeInf: LabelUsage м LambdaLabelUsage[callee];
IF calleeInf.purposeOfLambda#enableHandler THEN CantHappen;
calleeInf.callers м ConsId[calleeInf.callers, id];
};
VisitUpLabels: IntCodeUtils.Visitor = {
WITH node SELECT FROM
oper: OperNode => {
WITH oper.oper SELECT FROM
code: CodeOper => {
WITH code.label.node SELECT FROM
lambda: LambdaNode => {--procedure call; NOT uplevel goto--}
ENDCASE => {
IF ~IntToIntTab.Fetch[lambdaInf.definedLabels, code.label.id].found THEN {
key: INT;
IF code.offset#0 THEN SIGNAL NotYetImpl;
key м IntToIntTab.Fetch[lambdaInf.upLabels, code.label.id].val;
IF key<1 THEN {
key м IntToIntTab.GetSize[lambdaInf.upLabels]+1;
[] м IntToIntTab.Store[lambdaInf.upLabels, code.label.id, key];
};
RETURN [C2CIntCodeUtils.GenConst[key]];
};
};
};
ENDCASE => {};
};
applyNode: ApplyNode => {
IF applyNode.handler#NIL AND applyNode.handler.proc#NIL THEN 
WITH applyNode.handler.proc SELECT FROM
gotoNode: GotoNode => RegisterCall[callee: gotoNode.dest.id];
ENDCASE => CantHappen;
};
enableNode: EnableNode => {
IF enableNode.handle#NIL AND enableNode.handle.proc#NIL THEN
WITH enableNode.handle.proc SELECT FROM
gotoNode: GotoNode => RegisterCall[callee: gotoNode.dest.id];
ENDCASE => CantHappenCedar;
};
lambdaNode: LambdaNode => RETURN [node]; --stop recursion
ENDCASE => {};
IntCodeUtils.MapNode[node, VisitUpLabels];
RETURN [node];
};
lambdaInf.upLabels м IntToIntTab.Create[3];
IntCodeUtils.MapNode[lambdaInf.lambda, VisitUpLabels];
}
};
IntCodeUtils.Enumerate[tab, VisitLambdaInIdTab];
END;
BEGIN 
VisitHandler: PROC [handlerId: LogicalId, lambdaInf: LabelUsage] = {
recurse: IdList м NIL;
EachUpLabel: IntToIntTab.EachPairAction = {
labId: LogicalId м key;
FOR list: IdList м lambdaInf.callers, list.rest WHILE list#NIL DO
callerInf: LabelUsage м LambdaLabelUsage[list.first];
key: INT;
IF IntToIntTab.Fetch[callerInf.definedLabels, labId].found THEN LOOP;
key м IntToIntTab.Fetch[callerInf.upLabels, labId].val;
IF key<1 THEN {
key м IntToIntTab.GetSize[callerInf.upLabels]+1;
[] м IntToIntTab.Store[callerInf.upLabels, labId, key];
recurse м ConsId[recurse, list.first];
};
ENDLOOP;
};
IF lambdaInf=NIL THEN lambdaInf м LambdaLabelUsage[handlerId];
IF lambdaInf.purposeOfLambda#enableHandler THEN CantHappen;
IF lambdaInf.callers=NIL THEN RETURN; --not used by handlers...
[] м IntToIntTab.Pairs[lambdaInf.upLabels, EachUpLabel];
FOR list: IdList м recurse, list.rest WHILE list#NIL DO
VisitHandler[list.first, NIL];
ENDLOOP;
};
VisitLambdaInIdTab: IntCodeUtils.IdTabVisitor = {
lambdaInf: LabelUsage м NARROW[value];
IF lambdaInf.purposeOfLambda=enableHandler THEN {
VisitHandler[id, lambdaInf];
}
};
IntCodeUtils.Enumerate[tab, VisitLambdaInIdTab];
END;
};

LambdaLabelUsage: PUBLIC PROC [id: IntCodeDefs.LogicalId] RETURNS [LabelUsage] = {
tab: IntCodeUtils.IdTab м globalPerModuleEnables;
IF tab#NIL THEN {
WITH IntCodeUtils.Fetch[tab, id] SELECT FROM
lambdaInf: LabelUsage => RETURN [lambdaInf]; 
ENDCASE => ERROR CantHappen;
};
InitIdToLambdaInf[];
RETURN [LambdaLabelUsage[id]];
};


ProcNesting: TYPE = REF ProcNestingRec;
ProcNestingRec: TYPE = RECORD [nest: INT м 0, procLabel: IntCodeDefs.LabelNode м NIL, labTab: IntToIntTab.Table м NIL];

globalProcNesting: ProcNesting м NIL;
ResetGlobalPerModuleNesting: PROC [] = {
globalProcNesting м NIL
};

NestingInfo: PROC [] RETURNS [ProcNesting] = {
IF globalProcNesting=NIL THEN globalProcNesting м NEW[ProcNestingRec];
RETURN [globalProcNesting]
};

IncEnableNesting: PUBLIC PROC [] = {
pNesting: ProcNesting м NestingInfo[];
pNesting.nest м pNesting.nest+1;
};

DecEnableNesting: PUBLIC PROC [] = {
pNesting: ProcNesting м NestingInfo[];
pNesting.nest м pNesting.nest-1;
IF pNesting.nest<0 THEN C2CBasics.CantHappen;
};

InitializeNestingsCurrentLambda: PROC [pNesting: ProcNesting, procLabel: IntCodeDefs.LabelNode] = {
nest: INT м 0;
Visit: IntCodeUtils.Visitor = {
WITH node SELECT FROM
var: Var => 
WITH var.location SELECT FROM
locLoc: LocalVarLocation => RETURN [node];--don't find label 
ENDCASE => {};
operNode: OperNode => 
WITH operNode.oper SELECT FROM
code: CodeOper => RETURN [node];--don't find label
ENDCASE => {};
enableNode: EnableNode => {
IntCodeUtils.MapNode[enableNode.handle.proc, Visit];
nest м nest+1;
IntCodeUtils.MapNodeList[enableNode.scope, Visit];
nest м nest-1;
RETURN [enableNode];
};
labelNode: IntCodeDefs.LabelNode => {
IF labelNode.label.id#nullLogicalId THEN
IF ~IntToIntTab.Insert[pNesting.labTab, labelNode.label.id, nest] 
THEN CantHappen; --label multiple defined
};
gotoNode: IntCodeDefs.GotoNode => RETURN [node]; --don't find label
lambdaNode: LambdaNode => RETURN [node]; --stop recursion, and, don't find label
ENDCASE => NULL;
IntCodeUtils.MapNode[node, Visit];
RETURN [node];
};
pNesting.procLabel м procLabel;
pNesting.labTab м IntToIntTab.Create[];
IF procLabel.label.node=NIL THEN CantHappen;
IntCodeUtils.MapNode[procLabel.label.node, Visit];
};

FindNest: PROC [pNesting: ProcNesting, id: IntCodeDefs.LogicalId] RETURNS [nest: INT] = {
IF C2CBasics.labelWithLambda=NIL THEN ERROR CantHappen;
IF pNesting.procLabel#C2CBasics.labelWithLambda THEN {
InitializeNestingsCurrentLambda[pNesting, C2CBasics.labelWithLambda]; 
};
nest м IntToIntTab.Fetch[pNesting.labTab, id].val;
IF nest<0 THEN CantHappen; --label is not found in this proc
};

PopsForJump: PUBLIC PROC [id: IntCodeDefs.LogicalId] RETURNS [pops: INT] = {
pNesting: ProcNesting м NestingInfo[];
pops м pNesting.nest-FindNest[pNesting, id];
IF pops<0 THEN CantHappen;
};

PopsForReturns: PUBLIC PROC [] RETURNS [pops: INT] = {
pNesting: ProcNesting м NestingInfo[];
pops м pNesting.nest;
IF pops<0 THEN CantHappen;
};


C2CBasics.CallbackWhenC2CIsCalled[ResetGlobalPerModuleNesting];
C2CBasics.CallbackWhenC2CIsCalled[ResetGlobalPerModuleEnables];
END.

  ╚  
C2CEnablesImpl.mesa
Copyright ╙ 1987, 1988, 1989, 1990, 1991 by Xerox Corporation.  All rights reserved.
Christian Jacobi, 1987
Christian Jacobi, October 5, 1990 10:55:35 am PDT
--finds all uplevel goto's of handlers and replaces the goto's with returning an appropriate constant. 
--find all lambdas and include them into the table
--set purposes of lambdas: go through all lambdas in table; for each lambda recurse down checking whether sub node usage tells about beeing handlers or procedures
--also: finds all declared labels
--frame extensions won't cause uplevel gotos...
--go through all handlers to find all direct uplevel gotos and replace them
--also find out what other handlers are called, to build call graph
--an uplevel goto is found
--finally replace up level goto with key--
--go through all the handlers and 
--	go through all uplevel gotos; 
--		check whether upLevelness needs to propagate; recurse
--entered a new procedure; compute labTab
Э╩л  Ц(cedarcode) styleХNewlineDelimiter
Щ codeЪЬЩKЪЬ
╧eЬIЩTKЪЬЩKЪЬ1Щ1KШ Ъ╧k	Ш	KЪЬ
Ш
KЪЬШKЪЬШKЪЬ	Ш	KЪЬШKЪЬШKЪЬШKЪЬШKШ ЧЧЪ╧nЬЮЬЮШKЪЮЬ@ШGKЪЮЬШЧЪЮШKЪЮЬ-Ш1ЧKШ KЪЬЮЬЮЬЮЬШ!ЪЯЬЮЬ!ЮЬШDЪЮЬ"ЮЬЮЬЮШ6KЪЮЬЮЬЮЬ
Ш&KЪЮЬШЧKЪЮЬЮЬШKШЧKШ ЪЬ+Ш+ЪЯЬЮЬШ(KЪЬ0Ш0KЪЬШKШ ЧЧЪЯЬЮЬШKЩgKЪЬKШKKЪ╧c2Щ2ЪЮЬаШЪЯЬШ-ЪЮЬЮЬЮШЪЬШЪЮЬЮЬЮШ%ЪЬШKЪЬЮЬ/Ш7ЪЮЬЮЬЮШЪЬЮЬШ,KЪЮЬЮЬаШ,KЪЮЬЮЬаШ!ЧKЪЮЬШЧKЪЬ1ЮЬgШЫKЪЮЬа,Ш:KШЧKЪЮЬШЧKЪЬШЧKЪЬЮЬ	а&ШOKЪЮЬШЧKЪЬ0Ш0KЪЮЬШKШЧKЪЬ,Ш,KЪЮЬШЧKЪавЩвKЩ!ЪЮЬШЪЯ
ЬЮЬ:ШJKЪЬ'Ш'ЪЮЬЮЬЮШKЪЬЮЬа#Ш:ЪЬFШFKЪЬ%аШ6KЪЬШЧKЪЬ3аШGKЪЮЬШЧKШЧЪЯЬШ1ЪЯ	ЬШ#ЪЮЬЮЬЮШKЪЬЮЬ	аШ9ЪЬШЪ
ЮЬЮЬЮЬЮЬЮЬШ=ЪЮЬЮЬЮШ'KЪЬBШBKЪЮЬЮЬШЧЧЪЮЬЮЬЮШЪЬШЪЮЬЮЬЮШKЪЬ:Ш:KЪЮЬШЧЧKЪЮЬШЧKШЧЪЬШЪ	ЮЬЮЬЮЬЮЬЮШ<ЪЮЬЮЬЮШ'KЪЬBШBKЪЮЬЮЬШ!KЪЬ/Щ/ЧЧKШЧЪЬШKЪЬGШGKШЧKЪЮЬЮЬШЧKЪЬ&Ш&KЪЮЬШKШЧKЪЬЮЬШ&KЪЮЬЮЬЮЬЮЬШ3KЪЬ2Ш2KЪЬШЧKЪЬ0Ш0KЪЮЬШЧKЪаKЩKKЪаCЩCЪЮЬШЪЯЬШ1KЪЬЮЬШ&ЪЮЬ)ЮЬШ1ЪЯЬЮЬШ*KЪЬ1Ш1KЪЮЬ)ЮЬШ;KЪЬ2Ш2KШЧЪЯЬШ'ЪЮЬЮЬЮШШЪЮЬЮЬЮШЪЬШЪЮЬЮЬЮШ KЪЬа$ЬШ<ЪЮЬШЪЮЬBЮЬШJKЪаЩKЪЬЮЬШ	KЪЮЬЮЬЮЬШ(KЪЬ?Ш?ЪЮЬЮЬШKЪЬ0Ш0KЪЬ?Ш?KЪЬШЧKЪа*Щ*KЪЮЬ!Ш'KЪЬШЧKШЧЧKЪЬШЧKЪЮЬШЧKШЧЪЬШЪ
ЮЬЮЬЮЬЮЬЮЬШ=ЪЮЬЮЬЮШ'KЪЬ=Ш=KЪЮЬШЧЧKШЧЪЬШЪ	ЮЬЮЬЮЬЮЬЮШ<ЪЮЬЮЬЮШ'KЪЬ=Ш=KЪЮЬШЧЧKШЧKЪЬЮЬ	аШ9KЪЮЬШЧKЪЬ*Ш*KЪЮЬШKШЧKЪЬ+Ш+KЪЬ6Ш6KШЧKШЧKЪЬ0Ш0KЪЮЬШЧKЩ"KЩ!KЩ9ЪЮЬШЪЯЬЮЬ2ШDKЪЬЮЬШЪЯЬ Ш+KЪЬШЪЮЬ-ЮЬЮЬЮШAKЪЬ5Ш5KЪЬЮЬШ	KЪЮЬ9ЮЬЮЬШEKЪЬ7Ш7ЪЮЬЮЬШKЪЬ0Ш0KЪЬ7Ш7KЪЬ&Ш&KЪЬШЧKЪЮЬШЧKЪЬШЧKЪЮЬЮЬЮЬ)Ш>KЪЮЬ)ЮЬШ;KЪ	ЮЬЮЬЮЬЮЬаШ?KЪЬ8Ш8ЪЮЬ#ЮЬЮЬЮШ7KЪЬЮЬШKЪЮЬШЧKШЧЪЯЬШ1KЪЬЮЬШ&ЪЮЬ)ЮЬШ1KЪЬШKШЧKШЧKЪЬ0Ш0KЪЮЬШЧKЪЬШЧKШ ЪЯЬЮЬЮЬЮЬШRKЪЬ1Ш1ЪЮЬЮЬЮЬШЪЮЬЮЬЮШ,KЪЬЮЬШ-KЪЮЬЮЬШЧKШЧKЪЬШKЪЮЬШKЪЬШЧKШ KШ KЪЬЮЬЮЬШ'KЪЬЮЬЮЬЮЬ)ЮЬЮЬШwKШ ЪЬ!ЮЬШ%ЪЯЬЮЬШ(KЪЬЮШKЪЬШKШ ЧЧЪЯЬЮЬЮЬШ.KЪЮЬЮЬЮЬЮЬШFKЪЮЬШKШЧKШ ЪЯЬЮЬЮЬШ$KЪЬ&Ш&KЪЬ Ш KШЧKШ ЪЯЬЮЬЮЬШ$KЪЬ&Ш&KЪЬ Ш KЪЮЬЮЬШ-KШKШ ЧЪЯЬЮЬ>ШcKЪЬЮЬШЪЯЬШЪЮЬЮЬЮШЪЬШЪЮЬЮЬЮШKЪЬЮЬаШ=KЪЮЬШЧЧЪЬШЪЮЬЮЬЮШKЪЬЮЬаШ2KЪЮЬШЧЧЪЬШKЪЬ4Ш4KЪЬШKЪЬ2Ш2KЪЬШKЪЮЬШKШЧЪЬ%Ш%ЪЮЬ"ЮШ(ЪЮЬ@ШBKЪЮЬаШ)ЧЧKЪЬШЧKЪЬ"ЮЬ	аШCKЪЬЮЬ	а'ШPKЪЮЬЮЬШЧKЪЬ"Ш"KЪЮЬШKШЧKЪЬШKЪЬ'Ш'KЪЮЬЮЬЮЬШ,KЪЬ2Ш2KШЧKШ ЪЯЬЮЬ4ЮЬЮЬШYKЪЮЬЮЬЮЬЮЬШ7ЪЮЬ.ЮЬШ6KЪа)Щ)KЪЬFШFKШЧKЪЬ2Ш2KЪЮЬЮЬа!Ш<KШЧKШ Ъ
ЯЬЮЬЮЬЮЬЮЬШLKЪЬ&Ш&KЪЬ,Ш,KЪЮЬЮЬШKШЧKШ Ъ
ЯЬЮЬЮЬЮЬЮЬШ6KЪЬ&Ш&KЪЬШKЪЮЬЮЬШKШЧKШ KШ KЪЬ?Ш?KЪЬ?Ш?KЪЮЬШKШ Ч ЕЧ    #к  3  