C2CGlobalFrameImpl.mesa
Copyright Ó 1989, 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Christian Jacobi, July 25, 1989 1:16:47 pm PDT
Christian Jacobi, October 7, 1992 10:53 am PDT
DIRECTORY
C2CBasics, C2CCodeUtils, C2CEmit, C2CGlobalFrame, C2CNames, C2CTarget, IntCodeDefs, IntCodeUtils, IO, PriorityQueue, Rope;
C2CGlobalFrameImpl:
CEDAR
MONITOR
IMPORTS C2CBasics, C2CCodeUtils, C2CEmit, C2CNames, C2CTarget, IntCodeUtils, IO, PriorityQueue
EXPORTS C2CGlobalFrame =
BEGIN OPEN C2CBasics, IntCodeDefs;
ROPE: TYPE = Rope.ROPE;
myKeyForNameOfGlobalFrame: ATOM ¬ $GlobalFrameName;
FindInstallLabel:
PROC [moduleNode: IntCodeDefs.ModuleNode]
RETURNS [labelNode: LabelNode] = {
FOR list: NodeList ¬ moduleNode.procs, list.rest
WHILE list#
NIL
DO
WITH list.first
SELECT
FROM
commentNode: CommentNode => {LOOP};
labelNode: LabelNode => {
WITH labelNode.label.node
SELECT
FROM
lambdaNode: LambdaNode =>
IF lambdaNode.kind=install THEN RETURN [labelNode] ELSE CantHappen;
ENDCASE => CantHappen;
};
ENDCASE => ERROR CantHappen;
ENDLOOP;
ERROR CantHappen;
};
FindInstallProc:
PROC [moduleNode: IntCodeDefs.ModuleNode]
RETURNS [lambdaNode: LambdaNode] = {
labelNode: LabelNode ~ FindInstallLabel[moduleNode];
RETURN [NARROW[labelNode.label.node]]
};
GlobalFrameName:
PUBLIC
PROC []
RETURNS [name: Rope.
ROPE] = {
--returns name of global frame [must already have been generated]
--type of global frame is NOT canonical; it must never be accessed directly
x: REF ¬ GetProp[myKeyForNameOfGlobalFrame];
WITH x
SELECT
FROM
r: ROPE => RETURN [r];
ENDCASE => CantHappen; --not yet generated
};
MakeupNameForGlobalFrame:
PROC []
RETURNS [name: Rope.
ROPE] = {
x: REF ¬ GetProp[myKeyForNameOfGlobalFrame];
IF x#NIL THEN CantHappen; --multiple global frames
name ¬ C2CNames.TryName["globalframe"];
PutProp[myKeyForNameOfGlobalFrame, name];
};
GlobalFrameSize:
PROC [moduleNode: IntCodeDefs.ModuleNode]
RETURNS [frameSize:
INT ¬ 0] = {
frameMax: INT ¬ 0;
FOR list: VarList ¬ moduleNode.vars, list.rest
WHILE list#
NIL
DO
var: Var ¬ list.first;
bits: INT ¬ C2CTarget.TemporaryBits[var.bits]; --needs to be in synch with front end !!!
WITH var.location
SELECT
FROM
globLoc: GlobalVarLocation => {
offset: INT ¬ MAX[0, globLoc.id]; --WOW
frameMax ¬ MAX[frameMax, offset+bits]
};
ENDCASE => CantHappenCedar;
frameSize ¬ frameSize+bits;
ENDLOOP;
frameSize ¬ MAX[frameSize, frameMax];
};
GFPtrOrNil:
PROC [node: Node]
RETURNS [var: Var¬
NIL] = {
--returns pointer to globalframe in case node is an appropriate declaration
--returns NIL otherwise
WITH node
SELECT
FROM
decl: DeclNode => {
WITH decl.init
SELECT
FROM
oper: OperNode =>
WITH oper.oper
SELECT
FROM
mesaOp: MesaOper => {IF mesaOp.mesa=globalFrame THEN RETURN [decl.var]};
ENDCASE => {}
ENDCASE => {}
};
ENDCASE => {}
};
IsConstGFAssignment:
PROC [node: Node, gfPtr: Var]
RETURNS [
BOOL ¬
FALSE] = {
--returns whether node is an assignment of a constant into the global frame
--and also checks whether all the alignments are proper
--Note: We restrict ourself to bitsPerWord assignments only!
IsQualifyingConst:
PUBLIC
PROC [node: IntCodeDefs.Node]
RETURNS [
BOOL ¬
FALSE] = {
WITH node
SELECT
FROM
constNode: WordConstNode => RETURN [TRUE];
oper: OperNode =>
WITH oper.oper
SELECT
FROM
codeOper: CodeOper => {
WITH codeOper.label.node
SELECT
FROM
lambda: LambdaNode => RETURN [codeOper.offset=0 AND ~codeOper.direct];
ENDCASE => NULL;
};
ENDCASE => NULL;
ENDCASE => NULL;
};
WITH node
SELECT
FROM
assign: AssignNode =>
IF assign.bits=0
AND assign.lhs.bits=C2CTarget.bitsPerWord
AND IsQualifyingConst[assign.rhs]
THEN {
WITH assign.lhs.location
SELECT
FROM
field: FieldLocation => {
IF (field.start MOD C2CTarget.bitsPerWord)#0 THEN RETURN [FALSE];
WITH field.base
SELECT
FROM
var: Var =>
WITH var.location
SELECT
FROM
deref: DerefLocation =>
WITH deref.addr
SELECT
FROM
pvar: Var =>
IF pvar.id=gfPtr.id
THEN {
IF deref.align>=C2CTarget.bestAlignment THEN RETURN [TRUE]
};
ENDCASE => {};
ENDCASE => {};
ENDCASE => {};
};
ENDCASE => {}
};
ENDCASE => {};
};
PreMunchConstAssign:
PROC [on: OrderedNode]
RETURNS [size:
INT, offset:
INT] = {
assign: AssignNode ~ NARROW[on.node];
field: FieldLocation ~ NARROW[assign.lhs.location];
size ¬ assign.lhs.bits;
offset ¬ field.start;
};
MunchConstAssign:
PROC [on: OrderedNode]
RETURNS [size:
INT, offset:
INT, value: C2CEmit.Code] = {
assign: AssignNode ~ NARROW[on.node];
field: FieldLocation ~ NARROW[assign.lhs.location];
size ¬ assign.lhs.bits;
offset ¬ field.start;
WITH assign.rhs
SELECT
FROM
const: WordConstNode => value ¬ C2CEmit.CastWord[C2CCodeUtils.ConstC[IntCodeUtils.WordToCard[const.word]]];
oper: OperNode =>
WITH oper.oper
SELECT
FROM
codeOper: CodeOper => {
WITH codeOper.label.node
SELECT
FROM
lambda: LambdaNode => {
procName: ROPE ¬ C2CNames.LabName[id: codeOper.label.id, class: "Proc"];
value ¬ C2CEmit.Cat["(word) ", procName];
};
ENDCASE => ERROR;
};
ENDCASE => ERROR;
ENDCASE => ERROR;
};
OffsetSortPred: PriorityQueue.SortPred = {
xon: OrderedNode ¬ NARROW[x];
yon: OrderedNode ¬ NARROW[y];
xassign: AssignNode ¬ NARROW[xon.node];
yassign: AssignNode ¬ NARROW[yon.node];
xfield: FieldLocation ¬ NARROW[xassign.lhs.location];
yfield: FieldLocation ¬ NARROW[yassign.lhs.location];
SELECT
TRUE
FROM
xfield.start<yfield.start => {
IF xfield.start+xassign.lhs.bits>yfield.start THEN CantHappen; --single word consts!
RETURN [TRUE];
};
yfield.start<xfield.start => {
IF yfield.start+yassign.lhs.bits>xfield.start THEN CantHappen; --single word consts!
RETURN [FALSE];
};
ENDCASE => {
--conflict; make sort anti-stable [last one returned first]
RETURN [xon.count>yon.count];
};
};
OrderedNode: TYPE = REF OrderedNodeRec;
OrderedNodeRec:
TYPE =
RECORD [node: Node, count:
INT];
--we want an anti-stable sort; therefore we add a count to the nodes...
GetAndRemoveConstantInits:
PROC [lambdaNode: LambdaNode]
RETURNS [pqRef: PriorityQueue.Ref] = {
--removes constant initialization nodes from procedure
--and returns priority queue containing the removed nodes
count: INT ¬ 0;
on: OrderedNode;
body: NodeList ¬ lambdaNode.body;
gfPtr: Var ¬ GFPtrOrNil[body.first];
pqRef ¬ PriorityQueue.Create[OffsetSortPred];
IF gfPtr=NIL THEN RETURN;
DO
IF body.rest=NIL THEN EXIT;
IF ~IsConstGFAssignment[body.rest.first, gfPtr] THEN EXIT;
on ¬ NEW[OrderedNodeRec ¬ [node: body.rest.first, count: (count¬count+1)]];
PriorityQueue.Insert[pqRef, on];
body.rest ¬ body.rest.rest;
ENDLOOP;
};
GlobalFrameDeclarationCode: PUBLIC PROC []moduleNode: IntCodeDefs.ModuleNode] RETURNS [code: C2CEmit.Code] = {
--a simple version without side effects
gfName: ROPE ← MakeupNameForGlobalFrame[];
gfSize: INT ← GlobalFrameSize[moduleNode];
code ← C2CEmit.Cat["static ", C2CTypes.DefineType[gfSize], " ", gfName, ";\n"];
};
GlobalFrameDeclarationCode:
PUBLIC
PROC [moduleNode: IntCodeDefs.ModuleNode]
RETURNS [code: C2CEmit.Code] = {
lambdaNode: LambdaNode ~ FindInstallProc[moduleNode];
pqRef: PriorityQueue.Ref ¬ GetAndRemoveConstantInits[lambdaNode];
gfName: ROPE ¬ MakeupNameForGlobalFrame[];
c1, c2: C2CEmit.Code; --c1 represents declaration; c2 initial value
nextPos: INT ¬ 0;
cnt: INT ¬ 0;
warning: C2CEmit.Code ¬ NIL;
Separator:
PROC [] = {
IF cnt#0
THEN {
c2 ¬ C2CEmit.Cat[c2, ", "];
IF cnt
MOD 4 = 0
THEN {
c1 ¬ C2CEmit.Cat[c1, "\n"];
c2 ¬ C2CEmit.Cat[c2, "\n"]
};
};
};
NextField:
PROC [value: C2CEmit.CodeOrRope] = {
IF value=NIL THEN value ¬ C2CEmit.IdentCode["0"];
Separator[];
c1 ¬ C2CEmit.Cat[c1, IO.PutFR1["word f%g; ", IO.int[nextPos/C2CTarget.bitsPerWord]]];
IF value#
NIL
THEN c2 ¬ C2CEmit.Cat[c2, value]
ELSE c2 ¬ C2CEmit.Cat[c2, "0"];
cnt ¬ cnt + 1;
nextPos ¬ nextPos + C2CTarget.bitsPerWord;
};
Advance:
PROC [nextOffset:
INT] = {
missing: INT ¬ nextOffset-nextPos;
SELECT missing
FROM
0 => {};
>0 => {
fidx: INT ¬ nextPos / C2CTarget.bitsPerWord;
sz: INT ¬ missing / C2CTarget.bitsPerWord;
IF missing MOD C2CTarget.bitsPerWord # 0 THEN CantHappen;
Separator[];
IF sz=1
THEN {
c1 ¬ C2CEmit.Cat[c1, IO.PutFR1["word f%g; ", IO.int[fidx]]];
c2 ¬ C2CEmit.Cat[c2, "0"];
}
ELSE {
c1 ¬ C2CEmit.Cat[c1, IO.PutFR["word f%g[%g]; ", IO.int[fidx], IO.int[sz]]];
c2 ¬ C2CEmit.Cat[c2, "{0}"];
};
cnt ¬ cnt + 1;
nextPos ¬ nextOffset;
};
ENDCASE => ERROR CantHappen;
};
WHILE ~PriorityQueue.Empty[pqRef]
DO
size, offset: INT; value: C2CEmit.Code;
on: OrderedNode ¬ NARROW[PriorityQueue.Remove[pqRef]];
[size, offset, value] ¬ MunchConstAssign[on];
IF size#C2CTarget.bitsPerWord THEN ERROR CantHappen;
IF offset<nextPos
THEN {
IF offset+C2CTarget.bitsPerWord=nextPos
THEN {
--multi assignments; do nothing. Important note: sort is anti-stable
warning ¬ C2CEmit.Cat[warning, C2CEmit.line,
C2CEmit.CComment[IO.PutFR1["assignment at word %g removed by C2C", IO.int[offset / C2CTarget.bitsPerWord]]]
];
LOOP
};
ERROR CantHappen;
};
Advance[offset];
NextField[value];
ENDLOOP;
Advance[GlobalFrameSize[moduleNode]];
code ¬ C2CEmit.Cat["static struct {", C2CEmit.nestNLine, c1, "\n} ", gfName];
code ¬ C2CEmit.Cat[code, " = {\n", c2, "\n};\n", warning];
code ¬ C2CEmit.Cat[code, C2CEmit.unNestNLine];
};
END.