FramesImpl.mesa
Copyright Ó 1990, 1992 by Xerox Corporation. All rights reserved.
Sturgis, November 20, 1988
Sturgis, March 24, 1990 4:21:14 pm PST
Last changed by Theimer on July 9, 1989 8:40:21 pm PDT
Hopcroft July 26, 1989 11:00:15 am PDT
Spreitze, January 9, 1992 10:21 am PST
DIRECTORY
CCTypes USING[CCError, CCErrorCase, CCTypeProcs, CreateCedarType, ExtractIdField, GetIndirectType, GetRTargetType, GetScopeIndex, GetTargetTypeOfIndirect, GlobalScopeIndex, HasIdField, IdFieldCase, Load, LoadIdField, PrintType, PrintTypeBracketed, SelectIdField, sia],
CedarCode USING[BreakShowNode, Code, CodeToGetNameContext, CodeToSelectField, CodeToSelectNestedBlock, ConcatCode, CreateCedarNode, GetDataFromNode, GetTypeOfNode, OperationsBody, ShowNode],
CirioTypes USING[CompilerContext, Node, Type, TypedCode],
Frames USING[IndirectFrameTypeData, IndirectFrameData, IndirectGlobalFrameData, IndirectGlobalFrameTypeData, SourcePositionRep, TargetWorld],
IO,
Rope,
StructuredStreams;
Types
ClientIndirectFrameTypeData: TYPE = Frames.IndirectFrameTypeData;
PrivateIndirectFrameTypeData: TYPE = REF PrivateIndirectFrameTypeDataBody;
PrivateIndirectFrameTypeDataBody:
TYPE =
RECORD[
scopeIndex: CARD,
clientIndirectFrameTypeData: REF ClientIndirectFrameTypeData];
CreateIndirectFrameType:
PUBLIC
PROC[data:
REF ClientIndirectFrameTypeData, cc:
CC]
RETURNS[Type] =
BEGIN
privateData: PrivateIndirectFrameTypeData ¬
NEW[PrivateIndirectFrameTypeDataBody¬[
scopeIndex: CCTypes.GetScopeIndex[data.enclosingContext, cc] + 1,
clientIndirectFrameTypeData: data]];
RETURN[CCTypes.GetIndirectType[CCTypes.CreateCedarType[$frame, NIL, IndirectFrameCCTypeProcs, cc, privateData]]];
END;
IndirectFrameCCTypeProcs:
REF CCTypes.CCTypeProcs ¬
NEW[CCTypes.CCTypeProcs ¬[
selectIdField: FrameSelectIdField,
loadIdField: FrameLoadIdField,
getScopeIndex: FrameGetScopeIndex,
printType: FramePrintType]];
FrameSelectIdField:
PROC[id: Rope.
ROPE, fieldIndirectContext: CirioTypes.Type, cc:
CC, procData:
REF
ANY]
RETURNS[CirioTypes.TypedCode] =
BEGIN
privateData: PrivateIndirectFrameTypeData ¬ NARROW[procData];
frameData: REF ClientIndirectFrameTypeData ¬ privateData.clientIndirectFrameTypeData;
exists: BOOLEAN ¬ FALSE; -- tentative
CodeForNestedBlock:
PROC[index:
CARD]
RETURNS[CirioTypes.TypedCode] =
BEGIN
code1: Code ¬ CedarCode.CodeToSelectNestedBlock[0, index, fieldIndirectContext];
type1: Type ¬ frameData.blocks[index];
tc2: TypedCode ¬ CCTypes.SelectIdField[id, type1, cc];
code: Code ¬ CedarCode.ConcatCode[code1, tc2.code];
RETURN[[code, tc2.type]];
END;
CodeForArgs:
PROC
RETURNS[CirioTypes.TypedCode] =
BEGIN
code1: Code ¬ CedarCode.CodeToSelectField["&args", fieldIndirectContext];
type1: Type ¬ frameData.args;
tc2: TypedCode ¬ CCTypes.SelectIdField[id, type1, cc];
code: Code ¬ CedarCode.ConcatCode[code1, tc2.code];
RETURN[[code, tc2.type]];
END;
CodeForResults:
PROC
RETURNS[CirioTypes.TypedCode] =
BEGIN
code1: Code ¬ CedarCode.CodeToSelectField["&results", fieldIndirectContext];
type1: Type ¬ frameData.results;
tc2: TypedCode ¬ CCTypes.SelectIdField[id, type1, cc];
code: Code ¬ CedarCode.ConcatCode[code1, tc2.code];
RETURN[[code, tc2.type]];
END;
tc: CirioTypes.TypedCode ¬ FrameCodeForIdField[id, privateData, CodeForNestedBlock, CodeForArgs, CodeForResults, cc];
IF tc.code #
NIL
THEN {
RETURN [[
CedarCode.ConcatCode[CedarCode.CodeToGetNameContext[privateData.scopeIndex], tc.code],
tc.type]];
}
ELSE {
we have to try the enclosing contexts
IF frameData.enclosingContext #
NIL
THEN
BEGIN
type1: Type ¬ frameData.enclosingContext;
tc2: TypedCode ¬ CCTypes.SelectIdField[id, type1, cc];
RETURN [tc2];
END
ELSE
CCE[operation, Rope.Concat[id, " undefined"]];
};
END;
FrameLoadIdField:
PROC[id: Rope.
ROPE, fieldIndirectContext: CirioTypes.Type, cc:
CC, procData:
REF
ANY]
RETURNS[CirioTypes.TypedCode] =
BEGIN
privateData: PrivateIndirectFrameTypeData ¬ NARROW[procData];
frameData: REF ClientIndirectFrameTypeData ¬ privateData.clientIndirectFrameTypeData;
exists: BOOLEAN ¬ FALSE; -- tentative
CodeForNestedBlock:
PROC[index:
CARD]
RETURNS[CirioTypes.TypedCode] =
BEGIN
code1: Code ¬ CedarCode.CodeToSelectNestedBlock[0, index, fieldIndirectContext];
type1: Type ¬ frameData.blocks[index];
tc2: TypedCode ¬ CCTypes.Load[[code1, type1], cc];
tc3: TypedCode ¬ CCTypes.ExtractIdField[id, CCTypes.GetTargetTypeOfIndirect[type1], cc];
code: Code ¬ CedarCode.ConcatCode[tc2.code, tc3.code];
RETURN[[code, tc3.type]];
END;
CodeForArgs:
PROC
RETURNS[CirioTypes.TypedCode] =
BEGIN
code1: Code ¬ CedarCode.CodeToSelectField["&args", fieldIndirectContext];
type1: Type ¬ frameData.args;
tc2: TypedCode ¬ CCTypes.Load[[code1, type1], cc];
tc3: TypedCode ¬ CCTypes.ExtractIdField[id, CCTypes.GetTargetTypeOfIndirect[type1], cc];
code: Code ¬ CedarCode.ConcatCode[tc2.code, tc3.code];
RETURN[[code, tc3.type]];
END;
CodeForResults:
PROC
RETURNS[CirioTypes.TypedCode] =
BEGIN
code1: Code ¬ CedarCode.CodeToSelectField["&results", fieldIndirectContext];
type1: Type ¬ frameData.results;
tc2: TypedCode ¬ CCTypes.Load[[code1, type1], cc];
tc3: TypedCode ¬ CCTypes.ExtractIdField[id, CCTypes.GetTargetTypeOfIndirect[type1], cc];
code: Code ¬ CedarCode.ConcatCode[tc2.code, tc3.code];
RETURN[[code, tc3.type]];
END;
tc: CirioTypes.TypedCode ¬ FrameCodeForIdField[id, privateData, CodeForNestedBlock, CodeForArgs, CodeForResults, cc];
IF tc.code #
NIL
THEN {
RETURN [[
CedarCode.ConcatCode[CedarCode.CodeToGetNameContext[privateData.scopeIndex], tc.code],
tc.type]];
}
ELSE {
we have to try the enclosing contexts
IF frameData.enclosingContext #
NIL
THEN
BEGIN
type1: Type ¬ frameData.enclosingContext;
tc2: TypedCode ¬ CCTypes.LoadIdField[id, type1, cc];
RETURN [tc2];
END
ELSE
CCE[operation, Rope.Concat[id, " undefined"]];
};
END;
FrameCodeForIdField:
PROC[id: Rope.
ROPE, privateData: PrivateIndirectFrameTypeData, codeForNestedBlock:
PROC[index:
CARD]
RETURNS[CirioTypes.TypedCode], codeForArgs:
PROC
RETURNS[CirioTypes.TypedCode], codeForResults:
PROC
RETURNS[CirioTypes.TypedCode], cc:
CC]
RETURNS[CirioTypes.TypedCode] =
BEGIN
frameData: REF ClientIndirectFrameTypeData ¬ privateData.clientIndirectFrameTypeData;
FOR
I:
INT
DECREASING
IN [0..frameData.nBlocks)
DO
idField: CCTypes.IdFieldCase
¬ CCTypes.HasIdField[id, CCTypes.GetRTargetType[frameData.blocks[I], cc], cc];
IF idField = possible THEN CCE[cirioError]; -- these should be pure record/fieldList types.
IF idField = yes THEN RETURN[codeForNestedBlock[I]];
ENDLOOP;
try args
BEGIN
argsHasId: CCTypes.IdFieldCase ¬ CCTypes.HasIdField[id, CCTypes.GetRTargetType[frameData.args, cc], cc];
IF argsHasId = possible THEN CCE[cirioError]; -- this should be a pure record/fieldList type.
IF argsHasId = yes THEN RETURN[codeForArgs[]];
END;
try resuls
BEGIN
resultsHasId: CCTypes.IdFieldCase ¬ CCTypes.HasIdField[id, CCTypes.GetRTargetType[frameData.results, cc], cc];
IF resultsHasId = possible THEN CCE[cirioError]; -- this should be a pure record/fieldList type.
IF resultsHasId = yes THEN RETURN[codeForResults[]];
END;
RETURN[[NIL, NIL]];
END;
FrameGetScopeIndex:
PROC [type: Type, cc:
CC, procData:
REF
ANY]
RETURNS [
CARD] =
BEGIN
privateData: PrivateIndirectFrameTypeData ¬ NARROW[procData];
RETURN [privateData.scopeIndex];
END;
FramePrintType:
PROC [to:
IO.
STREAM, type: Type, printDepth:
INT, printWidth:
INT, cc:
CC, procData:
REF
ANY] = {
privateData: PrivateIndirectFrameTypeData ¬ NARROW[procData];
frameData: REF ClientIndirectFrameTypeData ¬ privateData.clientIndirectFrameTypeData;
SS.Bp[to, always, 0];
SS.Bp[to, always, 0];
CCTypes.PrintType[to, frameData.args, printDepth-1, printWidth, cc];
SS.Bp[to, always, 0];
CCTypes.PrintType[to, frameData.results, printDepth-1, printWidth, cc];
FOR
I:
INT
IN [0..frameData.nBlocks)
DO
SS.Bp[to, always, CCTypes.sia];
CCTypes.PrintTypeBracketed[to, frameData.blocks[I], printDepth-1, printWidth, cc];
ENDLOOP;
IF printDepth>3
THEN {
SS.Bp[to, always, 0];
CCTypes.PrintType[to, frameData.enclosingContext, printDepth-1, printWidth, cc]};
RETURN};
ClientIndirectGlobalFrameTypeData: TYPE = Frames.IndirectGlobalFrameTypeData;
PrivateIndirectGlobalFrameTypeData: TYPE = REF PrivateIndirectGlobalFrameTypeDataBody;
PrivateIndirectGlobalFrameTypeDataBody:
TYPE =
RECORD[
scopeIndex: CARD,
clientIndirectGlobalFrameTypeData: REF ClientIndirectGlobalFrameTypeData];
CreateIndirectGlobalFrameType:
PUBLIC
PROC[data:
REF ClientIndirectGlobalFrameTypeData, cc:
CC]
RETURNS[Type] =
BEGIN
Note: data.scopeIndex is set automatically when data is initialized. This is because the initialization value is a constant.
privateData: PrivateIndirectGlobalFrameTypeData ¬
NEW[PrivateIndirectGlobalFrameTypeDataBody¬[
scopeIndex:CCTypes.GlobalScopeIndex,
clientIndirectGlobalFrameTypeData: data]];
RETURN[CCTypes.GetIndirectType[CCTypes.CreateCedarType[$globalFrame, NIL, IndirectGlobalFrameCCTypeProcs, cc, privateData]]];
END;
IndirectGlobalFrameCCTypeProcs:
REF CCTypes.CCTypeProcs ¬
NEW[CCTypes.CCTypeProcs ¬[
selectIdField: GlobalFrameSelectIdField,
loadIdField: GlobalFrameLoadIdField,
getScopeIndex: GlobalFrameGetScopeIndex,
printType: GlobalFramePrintType]];
GlobalFrameSelectIdField:
PROC[id: Rope.
ROPE, fieldIndirectContext: CirioTypes.Type, cc:
CC, procData:
REF
ANY]
RETURNS[CirioTypes.TypedCode] =
BEGIN
privateData: PrivateIndirectGlobalFrameTypeData ¬ NARROW[procData];
globalFrameData: REF ClientIndirectGlobalFrameTypeData ¬ privateData.clientIndirectGlobalFrameTypeData;
exists: BOOLEAN ¬ FALSE; -- tentative
idFieldCase: CCTypes.IdFieldCase ¬ CCTypes.HasIdField[id, CCTypes.GetRTargetType[globalFrameData.globalVars, cc], cc];
IF idFieldCase = possible THEN CCE[cirioError]; -- this should be pure record/fieldList type.
IF idFieldCase = yes
THEN
BEGIN
code1: Code ¬ CedarCode.CodeToSelectField["&globalVars", fieldIndirectContext];
type1: Type ¬ globalFrameData.globalVars;
tc2: TypedCode ¬ CCTypes.SelectIdField[id, type1, cc];
code: Code ¬ CedarCode.ConcatCode[code1, tc2.code];
RETURN[[
CedarCode.ConcatCode[CedarCode.CodeToGetNameContext[privateData.scopeIndex], code],
tc2.type]];
END;
otherwise
CCE[operation, Rope.Concat[id, " undefined"]];
END;
GlobalFrameLoadIdField:
PROC[id: Rope.
ROPE, fieldIndirectContext: CirioTypes.Type, cc:
CC, procData:
REF
ANY]
RETURNS[CirioTypes.TypedCode] =
BEGIN
privateData: PrivateIndirectGlobalFrameTypeData ¬ NARROW[procData];
globalFrameData: REF ClientIndirectGlobalFrameTypeData ¬ privateData.clientIndirectGlobalFrameTypeData;
exists: BOOLEAN ¬ FALSE; -- tentative
idFieldCase: CCTypes.IdFieldCase ¬ CCTypes.HasIdField[id, CCTypes.GetRTargetType[globalFrameData.globalVars, cc], cc];
IF idFieldCase = possible THEN CCE[cirioError]; -- this should be pure record/fieldList type.
IF idFieldCase = yes
THEN
BEGIN
code1: Code ¬ CedarCode.CodeToSelectField["&globalVars", fieldIndirectContext];
type1: Type ¬ globalFrameData.globalVars;
tc2: TypedCode ¬ CCTypes.Load[[code1, type1], cc];
tc3: TypedCode ¬ CCTypes.ExtractIdField[id, CCTypes.GetTargetTypeOfIndirect[type1], cc];
code: Code ¬ CedarCode.ConcatCode[tc2.code, tc3.code];
RETURN[[
CedarCode.ConcatCode[CedarCode.CodeToGetNameContext[privateData.scopeIndex], code],
tc3.type]];
END;
otherwise
CCE[operation, Rope.Concat[id, " undefined"]];
END;
GlobalFrameGetScopeIndex:
PROC [type: Type, cc:
CC, procData:
REF
ANY]
RETURNS [
CARD] =
BEGIN
privateData: PrivateIndirectGlobalFrameTypeData ¬ NARROW[procData];
RETURN [privateData.scopeIndex];
END;
GlobalFramePrintType:
PROC [to:
IO.
STREAM, type: Type, printDepth:
INT, printWidth:
INT, cc:
CC, procData:
REF
ANY] = {
privateData: PrivateIndirectGlobalFrameTypeData ¬ NARROW[procData];
frameData: REF ClientIndirectGlobalFrameTypeData ¬ privateData.clientIndirectGlobalFrameTypeData;
SS.Bp[to, always, 0];
CCTypes.PrintType[to, frameData.globalVars, printDepth, printWidth, cc];
RETURN};
IndirectFrameData: TYPE = Frames.IndirectFrameData;
CreateIndirectFrameNode:
PUBLIC
PROC[data:
REF IndirectFrameData, type: Type, cc:
CC]
RETURNS[Node] =
BEGIN
RETURN[CedarCode.CreateCedarNode[FrameOps, type, data]];
END;
FrameOps:
REF CedarCode.OperationsBody ¬
NEW[CedarCode.OperationsBody¬[
advanceNameScope: FrameAdvanceNameScope,
getCurrentType: FrameGetCurrentType,
extractField: FrameExtractField,
selectField: FrameSelectField,
selectNestedBlock: FrameSelectNestedBlock,
show: FrameShow
]];
FrameAdvanceNameScope:
PUBLIC
PROC[node: Node, cc:
CC]
RETURNS[Node] =
BEGIN
frameData: REF IndirectFrameData ¬ NARROW[CedarCode.GetDataFromNode[node]];
RETURN[frameData.enclosingContext];
END;
FrameGetCurrentType:
PROC[node: Node, cc:
CC]
RETURNS[Type] =
BEGIN
RETURN[CedarCode.GetTypeOfNode[node]];
END;
FrameExtractField:
PROC[id: Rope.
ROPE, type: Type, node: Node, cc:
CC]
RETURNS[Node] =
BEGIN
frameData: REF IndirectFrameData ¬ NARROW[CedarCode.GetDataFromNode[node]];
SELECT
TRUE
FROM
Rope.Equal[id, "&descriptor"] =>
RETURN[frameData.descriptor];
Rope.Equal[id, "&sourcePosition"] => RETURN[frameData.getSourcePosition[frameData.procData, cc]];
Rope.Equal[id, "&procedure"] => RETURN[frameData.procedure];
Rope.Equal[id, "&caller"] => RETURN[frameData.getCallingNode[frameData.procData, cc]];
Rope.Equal[id, "&enclosingContext"] => RETURN[frameData.enclosingContext];
ENDCASE => CCE[cirioError]; -- shouldn't happen
END;
FrameSelectField:
PROC[id: Rope.
ROPE, indirectType: Type, indirectNode: Node, cc:
CC]
RETURNS[Node] =
BEGIN
frameData: REF IndirectFrameData ¬ NARROW[CedarCode.GetDataFromNode[indirectNode]];
SELECT
TRUE
FROM
Rope.Equal[id, "&args"] => RETURN[frameData.args];
Rope.Equal[id, "&results"] => RETURN[frameData.results];
ENDCASE => CCE[cirioError]; -- shouldn't happen
END;
FrameSelectNestedBlock:
PROC[set:
INT, depth:
INT, indirectType: Type, indirectNode: Node, cc:
CC]
RETURNS[Node] =
The set parameter is used to select enumeration constant blocks from variable blocks.
Here, there are only variable blocks so set is ignored.
BEGIN
frameData: REF IndirectFrameData ¬ NARROW[CedarCode.GetDataFromNode[indirectNode]];
RETURN[frameData.blocks[depth]];
END;
FrameShow:
PROC[to:
IO.
STREAM, node: Node, depth:
INT, width:
INT, cc:
CC] = {
frameData: REF IndirectFrameData ¬ NARROW[CedarCode.GetDataFromNode[node]];
CedarCode.ShowNode[to, frameData.descriptor, depth-1, width, cc];
SS.Bp[to, always, 0];
CedarCode.ShowNode[to, frameData.procedure, depth-1, width, cc];
SS.Bp[to, always, 0];
to.PutRope["Arguments:"];
CedarCode.BreakShowNode[to, frameData.args, depth-1, width, cc, " "];
SS.Bp[to, always, 0];
to.PutRope["Results:"];
CedarCode.BreakShowNode[to, frameData.results, depth-1, width, cc, " "];
SS.Bp[to, always, 0];
to.PutRope["Variables:"];
FOR i:
CARDINAL
IN [0..frameData.nBlocks)
DO
CedarCode.BreakShowNode[to, frameData.blocks[i], depth-1, width, cc, " "];
ENDLOOP;
SS.Bp[to, always, 0];
IF depth>3
THEN {
to.PutRope["Global Frame:"];
CedarCode.BreakShowNode[to, frameData.enclosingContext, depth-1, width, cc, " "]}
ELSE to.PutRope["Global Frame omitted"];
RETURN};
IndirectGlobalFrameData: TYPE = Frames.IndirectGlobalFrameData;
CreateIndirectGlobalFrameNode:
PUBLIC
PROC[data:
REF IndirectGlobalFrameData, type: Type, cc:
CC]
RETURNS[Node] =
BEGIN
RETURN[CedarCode.CreateCedarNode[GlobalFrameOps, type, data]];
END;
GlobalFrameOps:
REF CedarCode.OperationsBody ¬
NEW[CedarCode.OperationsBody¬[
extractField: GlobalFrameExtractField,
selectField: GlobalFrameSelectField,
show: GlobalFrameShow]];
GlobalFrameExtractField:
PROC[id: Rope.
ROPE, type: Type, node: Node, cc:
CC]
RETURNS[Node] =
BEGIN
globalFrameData: REF IndirectGlobalFrameData ¬ NARROW[CedarCode.GetDataFromNode[node]];
SELECT
TRUE
FROM
Rope.Equal[id, "&descriptor"] =>
RETURN[globalFrameData.descriptor];
ENDCASE => CCE[cirioError]; -- shouldn't happen
END;
GlobalFrameSelectField:
PROC[id: Rope.
ROPE, indirectType: Type, indirectNode: Node, cc:
CC]
RETURNS[Node] =
BEGIN
globalFrameData: REF IndirectGlobalFrameData ¬ NARROW[CedarCode.GetDataFromNode[indirectNode]];
SELECT
TRUE
FROM
Rope.Equal[id, "&globalVars"] => RETURN[globalFrameData.globalVars];
ENDCASE => CCE[cirioError]; -- shouldn't happen
END;
GlobalFrameShow:
PROC[to:
IO.
STREAM, node: Node, depth:
INT, width:
INT, cc:
CC] = {
frameData: REF IndirectGlobalFrameData ¬ NARROW[CedarCode.GetDataFromNode[node]];
SS.Bp[to, always, 0];
CedarCode.ShowNode[to, frameData.descriptor, depth, width, cc];
SS.Bp[to, always, 0];
CedarCode.ShowNode[to, frameData.globalVars, depth, width, cc];
SS.Bp[to, always, 0];
RETURN};