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
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 [] = {
--finds all uplevel goto's of handlers and replaces the goto's with returning an appropriate constant.
tab: IntCodeUtils.IdTab ¬ globalPerModuleEnables ¬ IntCodeUtils.NewIdTab[];
--find all lambdas and include them into the table
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;
--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
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;
--frame extensions won't cause uplevel gotos...
};
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;
--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
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 {
--an uplevel goto is found
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];
};
--finally replace up level goto with 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;
--go through all the handlers and
-- go through all uplevel gotos;
-- check whether upLevelness needs to propagate; recurse
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 {
--entered a new procedure; compute labTab
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.