Pass4Xc.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Satterthwaite, April 11, 1986 10:25:01 am PST
Russ Atkinson (RRA) December 12, 1986 7:18:55 pm PST
DIRECTORY
Alloc: TYPE USING [Notifier],
ComData: TYPE USING [idCARDINAL, idINT, interface, typeINT, typeStringBody],
ComDataExtras: TYPE USING [idCARD32],
LiteralOps: TYPE USING [FindDescriptor],
Log: TYPE USING [Error, ErrorTree, WarningTree],
P4: TYPE USING [
Attr, BiasForType, BitsForType, both, CatchNest, CommonAttr, CommonProp, Exp,
FillMultiWord, ForceType, LiteralAttr, MakeArgRecord, MakeStructuredLiteral,
MakeTreeLiteral, maxRegs, none, OperandStruct, OperandType, other, Prop, RegCount,
RegsForType, RelTest, RepForType, Repr, Rhs, RValue, StructuredLiteral,
TreeLiteral, TreeLiteralValue, TypeExp, TypeForTree, unsigned, ValueDescriptor,
VAttr, voidAttr, VPop, VProp, VPush, VRegs, VRep, WordSeq, WordsForType],
Symbols: TYPE USING [
Base, BitAddress, BitCount, ByteLength, codeCHAR, codeINT, CSEIndex, ctxType,
ISEIndex, ISENull, lZ, seType, Type, WordLength],
SymbolOps: TYPE USING [
ArgRecord, BitsPerElement, Cardinality, CtxLevel, FirstCtxSe, NormalType, NextSe,
PackedSize, VariantField, UnderType],
SymLiteralOps: TYPE USING [TypeRef],
Tree: TYPE USING [Base, Index, Link, NodeName, Null, treeType],
TreeOps: TYPE USING [
FreeNode, FreeTree, GetNode, IdentityMap, MakeNode, OpName, PopTree,
PushLit, PushNode, PushSe, PushTree, SetAttr, SetInfo];
Pass4Xc: PROGRAM
IMPORTS ComDataExtras, Log, LiteralOps, P4, SymbolOps, SymLiteralOps, TreeOps, dataPtr: ComData
EXPORTS P4 = {
OPEN SymbolOps, TreeOps, P4;
Type: TYPE = Symbols.Type;
CSEIndex: TYPE = Symbols.CSEIndex;
WordLength: CARDINAL = Symbols.WordLength;
tb: Tree.Base; -- tree base address (local copy)
seb: Symbols.Base; -- se table base address (local copy)
ctxb: Symbols.Base; -- context table base address (local copy)
ExpCNotify: PUBLIC Alloc.Notifier = {
called by allocator whenever table area is repacked
tb ← base[Tree.treeType];
seb ← base[Symbols.seType]; ctxb ← base[Symbols.ctxType];
};
interval utilities
NormalizeRange: PUBLIC PROC [t: Tree.Link] RETURNS [val: Tree.Link] = {
next: Tree.Link;
FOR val ← t, next DO
WITH val SELECT FROM
symbol => {
lBound: INTEGER = BiasForType[index];
THROUGH [1..2] DO
PushTree[MakeTreeLiteral[ABS[lBound]]];
IF lBound < 0 THEN PushNode[uminus, 1];
ENDLOOP;
PushTree[MakeTreeLiteral[Cardinality[index] - 1]];
PushNode[plus, 2]; SetInfo[dataPtr.idINT];
next ← MakeNode[intCC, 2]};
subtree => {
node: Tree.Index = index;
SELECT tb[node].name FROM
subrangeTC, cdot => {
next ← tb[node].son[2]; tb[node].son[2] ← Tree.Null; FreeNode[node]};
IN [intOO .. intCC] => EXIT;
ENDCASE => ERROR};
ENDCASE => ERROR;
ENDLOOP;
RETURN};
Interval: PUBLIC PROC [node: Tree.Index, bias: INTEGER, target: Repr]
RETURNS [const: BOOL] = {
OPEN tb[node];
attr: Attr;
nRegs: RegCount;
son[1] ← RValue[son[1], bias, target];
attr ← VAttr[]; nRegs ← VRegs[];
son[2] ← RValue[son[2], bias, target];
nRegs ← MAX[VRegs[], nRegs]; attr ← CommonAttr[attr, VAttr[]];
VPop[]; VPop[]; VPush[bias, attr, nRegs];
const ← StructuredLiteral[son[1]] AND StructuredLiteral[son[2]] AND ~attr1;
RETURN};
EmptyInterval: PUBLIC SIGNAL = CODE;
ConstantInterval: PUBLIC PROC [node: Tree.Index] RETURNS [origin, range: INTEGER] = {
OPEN tb[node];
uBound: INTEGER;
rep: Repr ← VRep[];
empty: BOOL ← FALSE;
origin ← TreeLiteralValue[son[1]]; uBound ← TreeLiteralValue[son[2]];
SELECT name FROM
intOO, intOC => {
IF RelTest[son[1], son[2], relGE, rep] THEN empty ← TRUE;
origin ← origin + 1;
son[1] ← FreeTree[son[1]];
name ← IF name = intOO THEN intCO ELSE intCC;
son[1] ← MakeTreeLiteral[origin]};
ENDCASE;
SELECT name FROM
intCC => IF RelTest[son[1], son[2], relG, rep] THEN empty ← TRUE;
intCO => {
IF RelTest[son[1], son[2], relGE, rep] THEN empty ← TRUE;
uBound ← uBound - 1;
son[2] ← FreeTree[son[2]];
name ← intCC; son[2] ← MakeTreeLiteral[uBound]};
ENDCASE => ERROR;
IF ~empty THEN range ← uBound - origin ELSE {SIGNAL EmptyInterval; range ← 0};
RETURN};
type utilities (move?)
UnderTypeTree: PROC [tree: Tree.Link] RETURNS [CSEIndex] = {
TypeExp[tree];
RETURN [UnderType[TypeForTree[tree]]];
};
operators on types
TypeOp: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
SELECT tb[node].name FROM
size => val ← Size[node];
first, last => val ← EndPoint[node];
typecode => val ← TypeCode[node];
ENDCASE => {
Log.Error[unimplemented]; VPush[0, voidAttr, 0]; val ← [subtree[node]]};
};
Size: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
ApplyLit: PROC [op: Tree.NodeName, val: WORD] = {
PushTree[MakeTreeLiteral[val]];
PushNode[op, 2];
SetInfo[dataPtr.idINT];
SetAttr[1, FALSE]; SetAttr[2, FALSE]; SetAttr[3, FALSE];
};
BitsPerItem: PROC [type: CSEIndex] RETURNS [Symbols.BitCount] = {
IF type = dataPtr.typeStringBody
THEN RETURN [Symbols.ByteLength]
ELSE {
sei: Symbols.ISEIndex ← VariantField[type];
IF sei # Symbols.ISENull THEN {
subType: CSEIndex = UnderType[seb[sei].idType];
WITH t: seb[subType] SELECT FROM
sequence => RETURN [BitsPerElement[t.componentType, t.packed]];
ENDCASE;
};
};
ERROR;
};
inBits: BOOL = tb[node].attr1;
son1: Tree.Link ← tb[node].son[1];
the type
son2: Tree.Link ← tb[node].son[2];
# of repetitions
IF inBits THEN {
RRA: this is an extension put here for Mimosa compatibility.
ApplyLong: PROC [op: Tree.NodeName] = {
PushNode[op, 2];
SetInfo[ComDataExtras.idCARD32];
SetAttr[1, FALSE]; SetAttr[2, TRUE]; SetAttr[3, FALSE];
};
PushLongLit: PROC [lit: CARD] = {
w: ARRAY [0..1] OF WORD ← LOOPHOLE[lit];
PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[w]]];
PushNode[mwconst, 1];
SetInfo[ComDataExtras.idCARD32];
};
PushLong: PROC [tree: Tree.Link] = {
type: CSEIndex ← UnderType[OperandType[tree]];
bits: Symbols.BitCount ← P4.BitsForType[type];
PushTree[tree];
IF bits <= WordLength THEN {
PushNode[lengthen, 1];
SetAttr[1, FALSE]; SetAttr[2, TRUE]; SetAttr[3, FALSE];
SetInfo[ComDataExtras.idCARD32];
};
};
IF OpName[son1] = apply
THEN {
A sequence type
subNode: Tree.Index = GetNode[son1];
items: Tree.Link ← tb[subNode].son[2];
type: CSEIndex ← UnderTypeTree[tb[subNode].son[1]];
nBits: Symbols.BitCount ← P4.BitsForType[type];
bitsPerItem: Symbols.BitCount ← BitsPerItem[type];
tb[subNode].son[2] ← Tree.Null;
PushLong[items];
IF bitsPerItem # 1 THEN {
PushLongLit[bitsPerItem];
ApplyLong[times];
};
IF nBits # 0 THEN {
PushLongLit[nBits];
ApplyLong[plus];
};
}
ELSE {
Very simple static type, not a sequence.
type: CSEIndex ← UnderTypeTree[son1];
nBits: Symbols.BitCount ← P4.BitsForType[type];
IF son2 # Tree.Null THEN
Round up to the packed size when a repetition is present.
SELECT nBits FROM
<= Symbols.ByteLength => nBits ← PackedSize[nBits];
< WordLength => nBits ← WordLength;
ENDCASE;
PushLongLit[nBits];
};
IF son2 # Tree.Null THEN {
For now, possibly forever, implemented by simple multiplication
tb[node].son[2] ← Tree.Null;
IF NOT TreeLiteral[son2] OR TreeLiteralValue[son2] # 1 THEN {
PushLong[son2];
ApplyLong[times];
};
};
val ← Rhs[PopTree[], ComDataExtras.idCARD32];
FreeNode[node];
RETURN;
};
IF OpName[son1] = apply
THEN {
subNode: Tree.Index = GetNode[son1];
sei: Symbols.ISEIndex;
bitsPerItem: Symbols.BitCount;
type: CSEIndex ← UnderTypeTree[tb[subNode].son[1]];
bitsPerItem ← BitsPerItem[type];
PushTree[tb[subNode].son[2]];
tb[subNode].son[2] ← Tree.Null;
IF bitsPerItem < WordLength
THEN {
itemsPerWord: CARDINAL = WordLength/CARDINAL[bitsPerItem];
ApplyLit[plus, itemsPerWord-1];
ApplyLit[div, itemsPerWord];
}
ELSE ApplyLit[times, bitsPerItem/WordLength];
ApplyLit[plus, P4.WordsForType[type]];
IF son2 # Tree.Null THEN {
PushTree[son2];
tb[node].son[2] ← Tree.Null;
PushNode[times, 2];
SetInfo[dataPtr.idINT];
SetAttr[1, FALSE]; SetAttr[2, FALSE]; SetAttr[3, FALSE];
};
}
ELSE {
type: CSEIndex ← UnderTypeTree[son1];
IF son2 = Tree.Null
THEN PushTree[MakeTreeLiteral[P4.WordsForType[type]]]
ELSE {
nBits: CARDINAL = P4.BitsForType[type];
PushTree[son2];
tb[node].son[2] ← Tree.Null;
IF nBits <= Symbols.ByteLength
THEN {
n: CARDINAL = WordLength/PackedSize[nBits];
ApplyLit[plus, n-1];
ApplyLit[div, n];
}
ELSE ApplyLit[times, P4.WordsForType[type]];
};
};
val ← Rhs[PopTree[], dataPtr.idCARDINAL];
FreeNode[node];
};
EndPoint: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
OPEN tb[node];
type, next: CSEIndex;
first: BOOL = (name=first);
MaxInteger: WORD = INTEGER.LAST;
MaxWord: WORD = CARDINAL.LAST;
v: WORD;
vv: ARRAY [0..2) OF WORD;
TypeExp[son[1]];
FOR type ← UnderType[TypeForTree[son[1]]], next DO
WITH seb[type] SELECT FROM
basic => {
v ← SELECT code FROM
Symbols.codeINT => IF first THEN MaxInteger+1 ELSE MaxInteger,
Symbols.codeCHAR => IF first THEN 0 ELSE CARDINAL[Cardinality[type]-1],
ENDCASE => IF first THEN 0 ELSE MaxWord;
GO TO short};
enumerated => {
v ← IF first THEN 0 ELSE CARDINAL[Cardinality[type]-1]; GO TO short};
relative => next ← UnderType[offsetType];
subrange => {v ← IF first THEN origin ELSE origin+range; GO TO short};
long => {
vv ← IF UnderType[rangeType] = dataPtr.typeINT
THEN IF first THEN [0, MaxInteger+1] ELSE [MaxWord, MaxInteger]
ELSE IF first THEN [0, 0] ELSE [MaxWord, MaxWord];
GO TO long};
ENDCASE => ERROR;
REPEAT
short => val ← MakeTreeLiteral[v];
long => {
PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[vv]]];
PushNode[mwconst, 1]; SetInfo[type]; val ← PopTree[]};
ENDLOOP;
FreeNode[node];
VPush[0, LiteralAttr[RepForType[type]], RegsForType[type]]; RETURN};
TypeCode: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
TypeExp[tb[node].son[1]];
IF dataPtr.interface THEN val ← [subtree[index: node]]
ELSE {
val ← SymLiteralOps.TypeRef[TypeForTree[tb[node].son[1]], FALSE];
FreeNode[node]};
VPush[0, LiteralAttr[both], 1]; RETURN};
misc transfer operators
MiscXfer: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
attr: Attr;
SELECT tb[node].name FROM
create => {
tb[node].son[1] ← RValue[tb[node].son[1], 0, none];
attr ← [prop: VProp[], rep: unsigned]; VPop[]};
fork => {
OPEN tb[node];
type: CSEIndex;
son[1] ← Exp[son[1], none];
attr.prop ← VProp[]; VPop[]; type ← OperandStruct[son[1]];
WITH t: seb[type] SELECT FROM
transfer => {
son[2] ← MakeArgRecord[ArgRecord[t.typeIn], son[2]];
attr.prop ← CommonProp[attr.prop, VProp[]]; attr.rep ← other; VPop[]};
ENDCASE => ERROR};
ENDCASE => {Log.Error[unimplemented]; attr ← voidAttr};
attr.prop.noXfer ← attr.prop.noFreeVar ← FALSE; VPush[0, attr, maxRegs];
IF tb[node].nSons > 2 THEN CatchNest[tb[node].son[3]];
RETURN[[subtree[index: node]]]};
NIL
Nil: PUBLIC PROC [node: Tree.Index] RETURNS [Tree.Link] = {
type: Type = tb[node].info;
n: CARDINAL;
words: ValueDescriptor;
IF tb[node].son[1] # Tree.Null THEN TypeExp[tb[node].son[1]];
n ← P4.WordsForType[type];
words ← NEW[WordSeq[n]];
FOR i: CARDINAL IN [0..n) DO words[i] ← 0 ENDLOOP;
PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[@words[0], n]]];
IF n > 1 THEN {PushNode[mwconst, 1]; SetInfo[type]};
FreeNode[node]; words ← NIL;
VPush[BiasForType[type], LiteralAttr[RepForType[type]], RegsForType[type]];
RETURN[ForceType[PopTree[], type]]};
misc addressing operators
AddrOp: PUBLIC PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
attr: Attr;
nRegs: RegCount;
SELECT tb[node].name FROM
addr => val ← Addr[node];
base => {
tb[node].son[1] ← Exp[tb[node].son[1], none];
nRegs ← VRegs[]; attr ← [prop: VProp[], rep: unsigned]; VPop[];
VPush[0, attr, nRegs]; val ← [subtree[index: node]]};
length => {
type: CSEIndex;
tb[node].son[1] ← Exp[tb[node].son[1], none];
type ← OperandStruct[tb[node].son[1]];
WITH seb[type] SELECT FROM
array => {
val ← MakeTreeLiteral[Cardinality[indexType]];
FreeNode[node]; attr ← LiteralAttr[both]; nRegs ← 1};
ENDCASE => {
val ← [subtree[index: node]]; attr ← [prop: VProp[], rep: both]; nRegs ← VRegs[]};
VPop[]; VPush[0, attr, nRegs]};
arraydesc =>
val ← IF OpName[tb[node].son[1]] # list THEN Desc[node] ELSE DescList[node];
ENDCASE => {
Log.Error[unimplemented]; VPush[0, voidAttr, 0]; val ← [subtree[node]]};
RETURN};
Addr: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
OPEN tb[node];
v: Tree.Link;
subNode: Tree.Index;
type, next: CSEIndex;
prop: Prop;
nRegs: RegCount;
son[1] ← Exp[son[1], none];
nRegs ← MAX[VRegs[], RegsForType[info]];
prop ← VProp[]; prop.noFreeVar ← FALSE;
FOR t: Tree.Link ← son[1], v DO
WITH t SELECT FROM
symbol => {
sei: Symbols.ISEIndex = index;
IF seb[sei].constant THEN GO TO fail;
IF CtxLevel[seb[sei].idCtx] = Symbols.lZ AND
(LOOPHOLE[seb[sei].idValue, Symbols.BitAddress].bd # 0 OR
LOOPHOLE[seb[sei].idInfo, CARDINAL] MOD WordLength # 0) THEN GO TO fail;
GO TO pass};
subtree => {
subNode ← index;
SELECT tb[subNode].name FROM
dot, dollar => v ← tb[subNode].son[2];
index, dindex, seqindex =>
FOR type ← NormalType[OperandType[tb[subNode].son[1]]], next DO
WITH t: seb[type] SELECT FROM
array => IF t.packed THEN GO TO fail ELSE GO TO pass;
sequence => IF t.packed THEN GO TO fail ELSE GO TO pass;
arraydesc => next ← UnderType[t.describedType];
ENDCASE => ERROR;
ENDLOOP;
apply => GO TO fail;
uparrow, reloc => GO TO pass;
cast, chop => v ← tb[subNode].son[1];
base, length => GO TO pass;
ENDCASE => ERROR};
ENDCASE => ERROR;
REPEAT
pass => NULL;
fail => Log.ErrorTree[nonAddressable, son[1]];
ENDLOOP;
val ← [subtree[index: node]];
IF OpName[son[1]] = dot THEN {
subNode ← GetNode[son[1]];
IF TreeLiteral[tb[subNode].son[1]] THEN {
val ← MakeStructuredLiteral[
TreeLiteralValue[tb[subNode].son[1]] + LOOPHOLE[
seb[NARROW[tb[subNode].son[2], Tree.Link.symbol].index].idValue,
Symbols.BitAddress].wd,
info];
FreeNode[node]}};
VPop[];
VPush[0, [prop: prop, rep: unsigned], nRegs]; RETURN};
Desc: PROC [node: Tree.Index] RETURNS [Tree.Link] = {
subNode: Tree.Index = GetNode[tb[node].son[1]];
long: BOOL = tb[subNode].attr2;
prop: Prop;
nRegs: RegCount;
subType: CSEIndex;
tb[subNode].son[1] ← Exp[tb[subNode].son[1], none];
nRegs ← VRegs[]; prop ← VProp[]; VPop[];
subType ← OperandStruct[tb[subNode].son[1]];
WITH t: seb[subType] SELECT FROM
array => {
n: CARDINAL = Cardinality[t.indexType];
IF n = 0 THEN Log.WarningTree[emptyArray, tb[subNode].son[1]];
IF t.packed AND (BitsForType[subType] MOD WordLength # 0) THEN
Log.ErrorTree[nonAddressable, tb[subNode].son[1]];
PushTree[[subtree[subNode]]]; PushTree[MakeTreeLiteral[n]]};
sequence => {
copy: Tree.Link = IdentityMap[tb[subNode].son[1]];
cNode: Tree.Index = NARROW[copy, Tree.Link.subtree].index;
PushTree[tb[subNode].son[1]]; PushTree[MakeTreeLiteral[0]];
PushNode[seqindex, 2]; SetInfo[t.componentType];
SetAttr[2, long]; SetAttr[3, FALSE];
tb[subNode].son[1] ← PopTree[]; PushTree[[subtree[subNode]]];
tb[cNode].son[2] ← FreeTree[tb[cNode].son[2]];
tb[cNode].son[2] ← [symbol[index: t.tagSei]];
tb[cNode].info ← dataPtr.idCARDINAL;
PushTree[copy]};
record => { -- StringBody only (compatibility glitch)
copy: Tree.Link = IdentityMap[tb[subNode].son[1]];
sei: Symbols.ISEIndex = NextSe[NextSe[FirstCtxSe[t.fieldCtx]]];
PushTree[tb[subNode].son[1]]; PushSe[sei]; PushNode[dollar, 2];
SetInfo[seb[sei].idType]; SetAttr[2, long];
tb[subNode].son[1] ← PopTree[]; PushTree[[subtree[subNode]]];
PushTree[copy]; PushSe[NextSe[FirstCtxSe[t.fieldCtx]]]; PushNode[dollar, 2];
SetInfo[dataPtr.idCARDINAL]; SetAttr[2, long]};
ENDCASE => {
PushTree[[subtree[subNode]]]; PushTree[Tree.Null]};
PushTree[Tree.Null]; PushNode[list, 3]; tb[node].son[1] ← PopTree[];
VPush[0, [prop: prop, rep: other], MAX[RegsForType[tb[node].info], nRegs]];
RETURN[[subtree[index: node]]]};
DescList: PROC [node: Tree.Index] RETURNS [val: Tree.Link] = {
subNode: Tree.Index = GetNode[tb[node].son[1]];
type: Type = tb[node].info;
subType: CSEIndex;
prop: Prop;
nRegs: RegCount;
tb[subNode].son[1] ← RValue[tb[subNode].son[1], 0, unsigned];
nRegs ← VRegs[]; prop ← VProp[]; subType ← OperandStruct[tb[subNode].son[1]];
WITH seb[subType] SELECT FROM
ref =>
IF BitsForType[refType] MOD WordLength # 0 THEN
Log.ErrorTree[nonAddressable, tb[subNode].son[1]];
ENDCASE;
tb[subNode].son[2] ← RValue[tb[subNode].son[2], 0, none];
nRegs ← MAX[VRegs[], nRegs]; prop ← CommonProp[VProp[], prop];
IF tb[subNode].son[3] # Tree.Null THEN TypeExp[tb[subNode].son[3]];
VPop[]; VPop[];
IF StructuredLiteral[tb[subNode].son[1]] AND TreeLiteral[tb[subNode].son[2]] THEN {
n: CARDINAL = WordsForType[type];
words: ValueDescriptor ← NEW[WordSeq[n]];
FillMultiWord[words, 0, tb[subNode].son[1]];
words[n-1] ← TreeLiteralValue[tb[subNode].son[2]];
PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[@words[0], n]]];
PushNode[mwconst, 1]; SetInfo[type];
words ← NIL;
val ← PopTree[]; FreeNode[node]}
ELSE val ← [subtree[index: node]];
VPush[0, [prop: prop, rep: other], MAX[RegsForType[type], nRegs]]; RETURN};
}.