DIRECTORY
Alloc: TYPE USING [AddNotify, Bounds, DropNotify, Notifier, Words],
ComData: TYPE USING [bodyIndex, defBodyLimit, idLOCK, importCtx, interface, mainCtx, moduleCtx, monitored, nBodies, nInnerBodies, nSigCodes, table, textIndex],
CompilerUtil: TYPE USING [],
Log: TYPE USING [Error, ErrorHti],
SourceMap: TYPE USING [Loc, Down],
Symbols: TYPE USING [Base, BodyInfo, BodyLink, BodyRecord, bodyType, BTIndex, BTNull, CBTIndex, CBTNull, ContextLevel, CSEIndex, CSENull, CTXIndex, CTXNull, ctxType, ISEIndex, ISENull, lG, lL, lZ, Name, nullName, nullType, RecordSEIndex, RecordSENull, RootBti, SERecord, seType, TransferMode, Type, typeANY, typeTYPE],
SymbolOps: TYPE USING [BlockLevel, FillCtxSe, FirstCtxSe, NewCtx, MakeNonCtxSe, MakeSeChain, NameClash, NextLevel, NextSe, SetMainCtx, StaticNestError],
Tree: TYPE USING [Base, Index, Link, Map, NodeName, Null, NullIndex, Scan, treeType],
TreeOps:
TYPE
USING [FreeNode, GetInfo, GetNode, ListHead, ListLength, NthSon, OpName, PutInfo, ScanList, UpdateList];
Pass2:
PROGRAM
IMPORTS Alloc, Log, SourceMap, SymbolOps, TreeOps, dataPtr: ComData
EXPORTS CompilerUtil = {
OPEN TreeOps, SymbolOps, Symbols;
tb: Tree.Base; -- tree base (private copy)
seb: Symbols.Base; -- se table base (private copy)
ctxb: Symbols.Base; -- context table base (private copy)
bb: Symbols.Base; -- body table base (private copy)
Notify: Alloc.Notifier = {
called by allocator whenever tables are repacked
tb ← base[Tree.treeType];
seb ← base[seType]; ctxb ← base[ctxType]; bb ← base[bodyType]};
ContextInfo:
TYPE =
RECORD[
ctx: CTXIndex,
staticLevel: ContextLevel,
seChain: ISEIndex];
current: ContextInfo;
NewContext:
PROC[level: ContextLevel, entries:
NAT, unique:
BOOL] = {
OPEN c: current;
c.staticLevel ← level;
IF entries = 0 AND ~unique THEN {c.ctx ← CTXNull; c.seChain ← ISENull}
ELSE {
c.ctx ← NewCtx[level];
ctxb[c.ctx].seList ← c.seChain ← MakeSeChain[c.ctx, entries, level=lG]}
main driver
P2Unit:
PUBLIC
PROC[t: Tree.Link]
RETURNS[Tree.Link] = {
node: Tree.Index;
(dataPtr.table).AddNotify[Notify]; anySei ← CSENull;
node ← GetNode[t];
BEGIN
ENABLE {
-- default error reporting
NameClash => {Log.ErrorHti[duplicateId, name]; RESUME};
StaticNestError => {Log.Error[staticNesting]; RESUME}};
dataPtr.textIndex ← tb[node].info;
dataPtr.bodyIndex ← CBTNull;
dataPtr.nBodies ← dataPtr.nInnerBodies ← dataPtr.nSigCodes ← 0;
btLink ← [which:parent, index:BTNull];
NewContext[
level: lZ,
entries: ListLength[tb[node].son[1]] + CountIds[tb[node].son[6]],
unique: FALSE];
dataPtr.moduleCtx ← current.ctx;
ScanList[tb[node].son[1], IdItem];
ImportList[tb[node].son[2]];
process LOCKS clause
dataPtr.monitored ← tb[node].son[5] # Tree.Null;
lockLambda ← Lambda[tb[node].son[5], lL];
MainBody[tb[node].son[6]];
dataPtr.defBodyLimit ← (dataPtr.table).Bounds[bodyType].size;
END;
(dataPtr.table).DropNotify[Notify];
RETURN[t]};
ImportList:
PROC[t: Tree.Link] = {
saved: ContextInfo = current;
NewContext[lG, ListLength[t], FALSE];
dataPtr.importCtx ← current.ctx;
ScanList[t, IdItem];
current ← saved};
MainBody:
PROC[t: Tree.Link] =
INLINE {
dataPtr.interface ← (OpName[NthSon[t, 2]] = definitionTC);
DeclList[t];
BodyList[RootBti]};
monitor lock processing
lockLambda: Tree.Index;
Lambda:
PROC[item: Tree.Link, level: ContextLevel]
RETURNS[node: Tree.Index] = {
node ← GetNode[item];
IF node # Tree.NullIndex
THEN {
saved: ContextInfo = current;
NewContext[level, CountIds[tb[node].son[1]], FALSE];
tb[node].info ← current.ctx;
DeclList[tb[node].son[1]]; Exp[tb[node].son[2]];
current ← saved};
RETURN};
ImplicitLock:
PROC = {
sei: ISEIndex = current.seChain;
tb[lockLambda].son[2] ← Ids[
list: tb[lockLambda].son[2],
public: tb[lockLambda].attr2,
link: Tree.NullIndex];
seb[sei].idType ← dataPtr.idLOCK; seb[sei].idInfo ← 1; seb[sei].mark3 ← TRUE};
body processing
btLink: BodyLink;
AllocateBody:
PROC[node: Tree.Index, id: ISEIndex]
RETURNS[bti: CBTIndex] = {
queue body for later processing
force nesting message here
SELECT NextLevel[current.staticLevel]
FROM
lG, lL => {
bti ← (dataPtr.table).Words[bodyType, BodyRecord.Callable.Outer.SIZE];
bb[bti] ← [,,,,,,, Callable[,,,,,,,,,,Outer[]]]};
ENDCASE => {
bti ← (dataPtr.table).Words[bodyType, BodyRecord.Callable.Inner.SIZE];
bb[bti] ← [,,,,,,, Callable[,,,,,,,,,, Inner[frameOffset: ]]]};
bb[bti].firstSon ← BTNull;
bb[bti].sourceIndex ← dataPtr.textIndex.Down;
bb[bti].info ← [Internal[bodyTree:node, thread:Tree.NullIndex, frameSize: ]];
bb[bti].id ← id;
bb[bti].entry ← bb[bti].internal ← FALSE;
conservative initial approximations
bb[bti].ioType ← typeANY;
bb[bti].noXfers ← FALSE;
bb[bti].hints ← [safe:FALSE, argUpdated:TRUE, nameSafe:FALSE, noStrings:FALSE];
LinkBody[bti]; RETURN};
LinkBody:
PROC[bti: BTIndex] = {
IF btLink.which = parent
THEN {
bb[bti].link ← btLink;
IF btLink.index # BTNull
THEN bb[btLink.index].firstSon ← bti
ELSE IF bti # RootBti THEN ERROR}
ELSE {
bb[bti].link ← bb[btLink.index].link;
bb[btLink.index].link ← [which:sibling, index: bti]}
SetEntryAttr:
PROC[t: Tree.Link, attr: Tree.NodeName] = {
IF OpName[t] # body OR ~dataPtr.monitored THEN Log.Error[misplacedEntry]
ELSE {
-- see AllocateBody
bti: CBTIndex = GetInfo[t];
SELECT attr
FROM
entry => bb[bti].entry ← TRUE;
internal => bb[bti].internal ← TRUE;
ENDCASE}
BodyList:
PROC[firstBti: BTIndex] = {
FOR bti: BTIndex ← firstBti, bb[bti].link.index
UNTIL bti = BTNull
DO
WITH bb[bti]
SELECT
FROM
Callable => Body[LOOPHOLE[bti, CBTIndex]];
ENDCASE => NULL;
IF bb[bti].link.which = parent THEN EXIT;
ENDLOOP
Body:
PROC[bti: CBTIndex] = {
node: Tree.Index = NARROW[bb[bti].info, BodyInfo.Internal].bodyTree;
level: ContextLevel;
nLocks: [0..1];
oldBodyIndex: CBTIndex = dataPtr.bodyIndex;
oldBtLink: BodyLink = btLink;
saved: ContextInfo = current;
dataPtr.bodyIndex ← bti;
btLink ← [which:parent, index:bti];
level ← NextLevel[saved.staticLevel ! StaticNestError => {RESUME}];
nLocks ←
IF level = lG
AND dataPtr.monitored
AND tb[lockLambda].attr1
THEN 1
ELSE 0;
NewContext[
level: level,
entries: nLocks + CountIds[tb[node].son[2]],
unique: level = lG];
bb[bti].localCtx ← current.ctx; bb[bti].level ← BlockLevel[level];
bb[bti].monitored ← nLocks # 0; bb[bti].inline ← tb[node].attr3;
bb[bti].type ←
IF current.ctx = CTXNull
OR bb[bti].inline
THEN RecordSENull
ELSE BodyType[current.ctx, bb[bti].monitored];
IF level = lG
THEN {
IF bti # RootBti THEN ERROR;
dataPtr.mainCtx ← current.ctx; SetMainCtx[current.ctx]};
ExpList[tb[node].son[1]];
IF nLocks # 0 THEN ImplicitLock[];
DeclList[tb[node].son[2]];
StmtList[tb[node].son[3]];
BodyList[bb[bti].firstSon];
current ← saved; dataPtr.bodyIndex ← oldBodyIndex; btLink ← oldBtLink};
NewScope:
PROC[node: Tree.Index, decls: Tree.Link]
RETURNS[bti: BTIndex] = {
level: ContextLevel = BlockLevel[current.staticLevel];
NewContext[level:level, entries:CountIds[decls], unique:FALSE];
bti ← (dataPtr.table).Words[bodyType, BodyRecord.Other.SIZE];
bb[bti] ← [
link: ,
firstSon: BTNull,
type:
IF bb[dataPtr.bodyIndex].inline
THEN RecordSENull ELSE BodyType[current.ctx, FALSE],
localCtx: current.ctx, level: level,
sourceIndex: tb[node].info,
info: [Internal[bodyTree:node, thread:Tree.NullIndex, frameSize: ]],
extension: Other[relOffset: ]];
LinkBody[bti]; btLink ← [which:parent, index:bti];
DeclList[decls]};
BodyType:
PROC[ctx: CTXIndex, monitored:
BOOL]
RETURNS[rSei: RecordSEIndex] = {
rSei ← LOOPHOLE[MakeNonCtxSe[SERecord.cons.record.notLinked.SIZE]];
seb[rSei].typeInfo ← record[
machineDep: FALSE, painted: TRUE, argument: FALSE,
hints: [
unifield: FALSE, variant: FALSE,
assignable: FALSE, comparable: FALSE, privateFields: TRUE,
refField: FALSE, default: FALSE, voidable: FALSE],
length: 0,
fieldCtx: ctx,
monitored: monitored,
linkPart: notLinked[]];
RETURN};
CodeBody:
PROC[node: Tree.Index] = {
InlineOp: Tree.Scan = {ExpList[t]};
ScanList[tb[node].son[1], InlineOp]};
declarations
DeclList: PROC[t: Tree.Link, linkId: Type←nullType] = {
DeclItem: Tree.Scan = {
node: Tree.Index = GetNode[t];
saveIndex: SourceMap.Loc = dataPtr.textIndex;
dataPtr.textIndex ← tb[node].info;
tb[node].son[1] ← Ids[
list: tb[node].son[1],
type: (tb[node].name = typedecl),
public: tb[node].attr2,
link: node];
tb[node].attr2 ← tb[node].attr3 ← FALSE;
SELECT tb[node].name
FROM
typedecl => {
TypeExp[t:tb[node].son[2], typeId:FirstId[tb[node].son[1]], linkId:linkId];
ExpList[tb[node].son[3]]};
decl => {
TypeExp[t:tb[node].son[2], linkId:linkId];
tb[node].son[3] ← InitialValue[
tb[node].son[3],
IF tb[node].attr1 THEN FirstId[tb[node].son[1]] ELSE ISENull]};
ENDCASE => Log.Error[unimplemented];
dataPtr.textIndex ← saveIndex};
ScanList[t, DeclItem]};
CountIds:
PROC[declList: Tree.Link]
RETURNS[n:
NAT𡤀] = {
NIds: Tree.Scan = {n ← n + ListLength[NthSon[t, 1]]};
ScanList[declList, NIds]; RETURN};
InitialValue:
PROC[t: Tree.Link, id: ISEIndex]
RETURNS[v: Tree.Link] = {
v ← t; -- the default
IF t # Tree.Null
THEN
WITH t
SELECT
FROM
subtree: Tree.Link.subtree => {
node: Tree.Index = subtree.index;
SELECT tb[node].name
FROM
body => {
bti: CBTIndex = AllocateBody[node, id];
tb[node].info ← bti;
IF ~tb[node].attr3
THEN {
dataPtr.nBodies ← dataPtr.nBodies+1;
IF current.staticLevel >= lL
THEN
dataPtr.nInnerBodies ← dataPtr.nInnerBodies + 1};
btLink ← [which:sibling, index:bti]};
entry, internal => {
v ← InitialValue[tb[node].son[1], id];
SetEntryAttr[v, tb[node].name];
tb[node].son[1] ← Tree.Null; FreeNode[node]};
signalinit => {
tb[node].info ← dataPtr.nSigCodes;
dataPtr.nSigCodes ← dataPtr.nSigCodes+1};
inline => CodeBody[node];
ENDCASE => ExpList[t]};
ENDCASE => ExpList[t]
IdItem: Tree.Scan = {
node: Tree.Index = GetNode[t];
saveIndex: SourceMap.Loc = dataPtr.textIndex;
dataPtr.textIndex ← tb[node].info;
tb[node].son[1] ← Ids[list: tb[node].son[1], public: FALSE, link: node];
dataPtr.textIndex ← saveIndex};
id list manipulation
Ids:
PROC [
list: Tree.Link,
public: BOOL,
type: BOOL ← FALSE,
link: Tree.Index]
RETURNS[Tree.Link] = {
Id: Tree.Map = {
WITH t
SELECT
FROM
hash, symbol => {
name: Name = (
WITH t
SELECT
FROM
hash => index,
symbol => seb[index].hash,
ENDCASE => ERROR);
sei: ISEIndex = current.seChain;
current.seChain ← NextSe[current.seChain];
FillCtxSe[sei, name, public];
seb[sei].idType ← IF type THEN typeTYPE ELSE typeANY;
seb[sei].public ← public;
seb[sei].immutable ← seb[sei].constant ← FALSE;
seb[sei].idValue ← link; seb[sei].idInfo ← 0;
seb[sei].extended ← seb[sei].linkSpace ← FALSE;
v ← [symbol[index: sei]]};
subtree => {
node: Tree.Index = index;
tb[node].son[1] ← Id[tb[node].son[1]]; Position[tb[node].son[2]];
v ← t};
ENDCASE => ERROR;
RETURN};
RETURN[UpdateList[list, Id]]};
FirstId:
PROC[t: Tree.Link]
RETURNS[ISEIndex] = {
head: Tree.Link = ListHead[t];
RETURN[
WITH head
SELECT
FROM
symbol => index,
subtree => FirstId[tb[index].son[1]],
ENDCASE => ERROR]
type manipulation
TypeExp:
PROC[t: Tree.Link, typeId, linkId: Type←nullType] = {
sei: CSEIndex;
WITH t
SELECT
FROM
subtree: Tree.Link.subtree => {
node: Tree.Index = subtree.index;
SELECT tb[node].name FROM
enumeratedTC => {
sei ← MakeNonCtxSe[SERecord.cons.enumerated.SIZE];
seb[sei].typeInfo ← enumerated[
ordered: TRUE, sparse: FALSE,
machineDep: tb[node].attr2,
unpainted: ~(tb[node].attr2 OR dataPtr.interface),
valueCtx: Enumeration[node], empty: , nValues: ];
AssignValues[sei, IF typeId # nullType THEN typeId ELSE sei]};
recordTC, monitoredTC => {
tCtx: CTXIndex;
nFields: NAT;
sei ← MakeNonCtxSe[SERecord.cons.record.notLinked.SIZE];
[tCtx, nFields] ← FieldList[
t: tb[node].son[1],
level: lZ,
typeId: IF typeId # nullType THEN typeId ELSE sei];
seb[sei].typeInfo ← record[
machineDep: tb[node].attr1,
painted: tb[node].attr1 OR (dataPtr.interface AND tb[node].attr3),
argument: FALSE,
hints: [
unifield: nFields = 1 AND ~tb[node].attr2,
variant: tb[node].attr2,
assignable: TRUE, comparable: FALSE, privateFields: FALSE,
refField: FALSE, default: FALSE, voidable: TRUE],
length: ,
fieldCtx: tCtx,
monitored: tb[node].name = monitoredTC,
linkPart: notLinked[]];
IF tb[node].name = monitoredTC AND tb[node].attr1 THEN Log.Error[attrClash]};
variantTC => {
sei ← MakeNonCtxSe[SERecord.cons.record.linked.SIZE];
seb[sei].typeInfo ← record[
machineDep: tb[node].attr1,
painted: tb[node].attr3,
argument: FALSE,
hints: [
unifield: FALSE,
variant: tb[node].attr2,
assignable: TRUE, comparable: FALSE, privateFields: FALSE,
refField: FALSE, default: FALSE, voidable: TRUE],
length: ,
fieldCtx: FieldList[t:tb[node].son[1], level:lZ, typeId:typeId].ctx,
monitored: FALSE,
linkPart: linked[linkId]]};
refTC, listTC, pointerTC, varTC => {
sei ← MakeNonCtxSe[SERecord.cons.ref.SIZE];
seb[sei].typeInfo ← ref[
counted: tb[node].name = refTC OR tb[node].name = listTC,
var: tb[node].name = varTC,
ordered: tb[node].attr1,
basing: tb[node].attr2,
list: tb[node].name = listTC,
readOnly: tb[node].attr3,
refType: ];
TypeExp[tb[node].son[1]]};
arrayTC => {
sei ← MakeNonCtxSe[SERecord.cons.array.SIZE];
seb[sei].typeInfo ← array[
packed: tb[node].attr3,
indexType: ,
componentType: ];
OptTypeExp[tb[node].son[1]]; TypeExp[tb[node].son[2]]};
arraydescTC => {
sei ← MakeNonCtxSe[SERecord.cons.arraydesc.SIZE];
seb[sei].typeInfo ← arraydesc[
readOnly: tb[node].attr3, var: FALSE, describedType: ];
TypeExp[tb[node].son[1]]};
procTC, processTC, portTC, signalTC, errorTC, programTC => {
modeMap:
ARRAY Tree.NodeName[procTC..programTC]
OF TransferMode = [
procTC: proc, processTC: process, portTC: port,
signalTC: signal, errorTC: error, programTC: program];
sei ← MakeNonCtxSe[SERecord.cons.transfer.SIZE];
seb[sei].typeInfo ← transfer[
mode: modeMap[tb[node].name], safe: tb[node].attr3,
typeIn: ArgList[tb[node].son[1]],
typeOut: ArgList[tb[node].son[2]]]};
anyTC => sei ← TypeAny[];
definitionTC => {
sei ← MakeNonCtxSe[SERecord.cons.definition.SIZE];
seb[sei].typeInfo ← definition[nDummyGfi: [q: 0, r: 1], named: FALSE, defCtx: ]};
unionTC => sei ← Union[node, linkId];
sequenceTC => sei ← Sequence[node];
relativeTC => {
sei ← MakeNonCtxSe[SERecord.cons.relative.SIZE];
seb[sei].typeInfo ← relative[baseType: , offsetType: , resultType: ];
TypeExp[tb[node].son[1]]; TypeExp[tb[node].son[2]]};
subrangeTC => {
sei ← MakeNonCtxSe[SERecord.cons.subrange.SIZE];
seb[sei].typeInfo ← subrange[
filled: FALSE, empty: FALSE,
rangeType: ,
origin: , range: ];
TypeExp[tb[node].son[1]]; Exp[tb[node].son[2]]};
longTC => {
sei ← MakeNonCtxSe[SERecord.cons.long.SIZE];
seb[sei].typeInfo ← long[rangeType: ];
TypeExp[tb[node].son[1]]};
opaqueTC => {
sei ← MakeNonCtxSe[SERecord.cons.opaque.SIZE];
seb[sei].typeInfo ← opaque[
lengthKnown: tb[node].son[1] # Tree.Null,
length: 0,
id:
WITH seb[typeId]
SELECT
FROM
id => LOOPHOLE[typeId],
ENDCASE => ISENull];
Exp[tb[node].son[1]]};
zoneTC => {
sei ← MakeNonCtxSe[SERecord.cons.zone.SIZE];
seb[sei].typeInfo ← zone[counted: ~tb[node].attr1, mds: tb[node].attr2]};
paintTC => {
sei ← CSENull;
TypeExp[tb[node].son[1]]; TypeExp[tb[node].son[2]]};
implicitTC, linkTC, frameTC => sei ← CSENull;
dot, discrimTC => {TypeExp[tb[node].son[1]]; sei ← CSENull};
apply => {TypeExp[tb[node].son[1]]; Exp[tb[node].son[2]]; sei ← CSENull};
ENDCASE => {sei ← CSENull; Log.Error[nonTypeCons]};
tb[node].info ← sei};
ENDCASE => NULL
OptTypeExp: PROC[t: Tree.Link] = {IF t # Tree.Null THEN TypeExp[t]};
Enumeration:
PROC[node: Tree.Index]
RETURNS[ctx: CTXIndex] = {
saved: ContextInfo = current;
NewContext[lZ, ListLength[tb[node].son[1]], TRUE]; ctx ← current.ctx;
tb[node].son[1] ← Ids[
list: tb[node].son[1],
public: tb[node].attr1,
link: Tree.NullIndex];
current ← saved; RETURN};
AssignValues:
PROC[type: CSEIndex, valueType: Type] = {
WITH t: seb[type]
SELECT
FROM
enumerated => {
i: CARDINAL ← 0;
FOR sei: ISEIndex ← FirstCtxSe[t.valueCtx], NextSe[sei]
UNTIL sei = ISENull
DO
seb[sei].idType ← valueType; seb[sei].idInfo ← 0;
seb[sei].idValue ← i; i ← i+1;
seb[sei].immutable ← seb[sei].constant ← TRUE;
seb[sei].mark3 ← seb[sei].mark4 ← TRUE;
ENDLOOP;
t.empty ← (i=0); t.nValues ← i};
ENDCASE => ERROR
FieldList:
PROC[t: Tree.Link, level: ContextLevel, typeId: Type]
RETURNS [ctx: CTXIndex, nFields: NAT] = {
saved: ContextInfo = current;
nFields ← CountIds[t];
NewContext[level, nFields, TRUE]; ctx ← current.ctx;
DeclList[t, typeId];
current ← saved; RETURN};
ArgList:
PROC[t: Tree.Link]
RETURNS [sei: CSEIndex] = {
IF t = Tree.Null THEN sei ← RecordSENull
ELSE IF OpName[t] = anyTC THEN sei ← TypeAny[]
ELSE {
tCtx: CTXIndex;
nFields: NAT;
sei ← MakeNonCtxSe[SERecord.cons.record.notLinked.SIZE];
[tCtx, nFields] ← FieldList[t, lZ, sei];
seb[sei].typeInfo ← record[
machineDep: FALSE,
painted: FALSE,
argument: TRUE,
hints: [
unifield: nFields = 1,
variant: FALSE,
assignable: TRUE, comparable: FALSE, privateFields: FALSE,
refField: FALSE, default: FALSE, voidable: TRUE],
length: ,
fieldCtx: tCtx,
monitored: FALSE,
linkPart: notLinked[]]};
RETURN};
anySei: CSEIndex;
TypeAny:
PROC
RETURNS [CSEIndex] = {
IF anySei = CSENull
THEN {
anySei ← MakeNonCtxSe[SERecord.cons.any.SIZE];
seb[anySei] ← [mark3: TRUE, mark4: TRUE, body: cons[any[]]]};
RETURN[anySei]};
TagField:
PROC[t: Tree.Link,
MakeTagType:
PROC
RETURNS[CSEIndex]]
RETURNS [tagId: ISEIndex] = {
saved: ContextInfo = current;
node: Tree.Index;
current.ctx ← CTXNull; current.seChain ← MakeSeChain[CTXNull, 1, FALSE];
DeclList[t];
node ← GetNode[t];
tagId ← FirstId[tb[node].son[1]];
IF OpName[tb[node].son[2]] = implicitTC
THEN {
subNode: Tree.Index = GetNode[tb[node].son[2]];
IF MakeTagType # NIL THEN tb[subNode].info ← MakeTagType[]
ELSE {Log.Error[attrClash]; tb[subNode].info ← typeANY}};
current ← saved; RETURN};
Union:
PROC[node: Tree.Index, linkId: Type]
RETURNS[sei: CSEIndex] = {
saved: ContextInfo = current;
MakeTagType:
PROC
RETURNS [type: CSEIndex] = {
saved: ContextInfo = current;
CollectTags: Tree.Scan = {
node: Tree.Index = GetNode[t];
tb[node].son[1] ← Ids[
list: tb[node].son[1],
public: tb[node].attr2,
link: Tree.NullIndex
! NameClash => {RESUME}]
NewContext[lZ, CountIds[tb[node].son[2]], TRUE];
type ← MakeNonCtxSe[SERecord.cons.enumerated.SIZE];
seb[type].typeInfo ← enumerated[
ordered: FALSE, sparse: FALSE,
machineDep: FALSE,
unpainted: ~dataPtr.interface,
valueCtx: current.ctx, empty: , nValues: ];
ScanList[tb[node].son[2], CollectTags];
AssignValues[type, type];
current ← saved; RETURN};
tagId: ISEIndex = TagField[tb[node].son[1], MakeTagType];
NewContext[lZ, CountIds[tb[node].son[2]], TRUE];
DeclList[tb[node].son[2], linkId
! NameClash => {Log.ErrorHti[duplicateTag, name]; RESUME}];
sei ← MakeNonCtxSe[SERecord.cons.union.SIZE];
seb[sei].typeInfo ← union[
caseCtx: current.ctx,
machineDep: tb[node].attr1,
overlaid: tb[node].attr2,
controlled: seb[tagId].hash # nullName,
tagSei: tagId,
hints: [
equalLengths: FALSE,
refField: FALSE, default: FALSE, voidable: TRUE]];
current ← saved; RETURN};
Sequence:
PROC[node: Tree.Index]
RETURNS[sei: CSEIndex] = {
tagId: ISEIndex = TagField[tb[node].son[1], NIL];
IF tb[node].attr2 THEN Log.Error[attrClash];
TypeExp[tb[node].son[2]];
sei ← MakeNonCtxSe[SERecord.cons.sequence.SIZE];
seb[sei].typeInfo ← sequence[
packed: tb[node].attr3,
controlled: seb[tagId].hash # nullName,
machineDep: tb[node].attr1,
tagSei: tagId,
componentType: ];
RETURN};
statements
Stmt:
PROC[stmt: Tree.Link] = {
node: Tree.Index;
saveIndex: SourceMap.Loc = dataPtr.textIndex;
IF stmt = Tree.Null THEN RETURN;
WITH stmt
SELECT
FROM
subtree => {
node ← index;
dataPtr.textIndex ← tb[node].info;
SELECT tb[node].name
FROM
assign => {Exp[tb[node].son[1]]; Exp[tb[node].son[2]]};
extract => {ExpList[tb[node].son[1]]; Exp[tb[node].son[2]]};
apply => {
Exp[tb[node].son[1]]; ExpList[tb[node].son[2]];
IF tb[node].nSons > 2 THEN CatchPhrase[tb[node].son[3]]};
block => Block[node];
if => {
Exp[tb[node].son[1]]; StmtList[tb[node].son[2]]; StmtList[tb[node].son[3]]};
case => {
Exp[tb[node].son[1]]; SelectionList[tb[node].son[2], Stmt]; Stmt[tb[node].son[3]]};
bind => {
Exp[tb[node].son[1]]; Exp[tb[node].son[2]];
SelectionList[tb[node].son[3], Stmt];
Stmt[tb[node].son[4]]};
do => DoStmt[node];
return, resume => ExpList[tb[node].son[1]];
label => {StmtList[tb[node].son[1]]; StmtList[tb[node].son[2]]};
goto, exit, loop, reject, continue, retry, syserror, stop, null => NULL;
free => {
Exp[tb[node].son[1]]; Exp[tb[node].son[2]];
IF tb[node].nSons > 3 THEN CatchPhrase[tb[node].son[4]]};
signal, error, xerror, start, restart,
join, wait, notify, broadcast, dst, lst, lste, lstf =>
Exp[tb[node].son[1]];
open => {ExpList[tb[node].son[1]]; StmtList[tb[node].son[2]]};
enable => {CatchPhrase[tb[node].son[1]]; StmtList[tb[node].son[2]]};
checked => Stmt[tb[node].son[1]];
list => ScanList[stmt, Stmt];
item => Stmt[tb[node].son[2]];
ENDCASE => Log.Error[unimplemented]};
ENDCASE => NULL;
dataPtr.textIndex ← saveIndex};
StmtList: PROC[list: Tree.Link] = Stmt;
Block:
PROC[node: Tree.Index] = {
saved: ContextInfo = current;
bti: BTIndex = NewScope[node, tb[node].son[1]];
tb[node].info ← bti;
StmtList[tb[node].son[2]];
BodyList[bb[bti].firstSon];
current ← saved; btLink ← [which:sibling, index:bti]};
SelectionList: PROC[t: Tree.Link, selection: Tree.Scan] = {
Item: Tree.Scan = {
node: Tree.Index = GetNode[t];
saveIndex: SourceMap.Loc = dataPtr.textIndex;
dataPtr.textIndex ← tb[node].info;
IF OpName[tb[node].son[1]] # decl
THEN {
ExpList[tb[node].son[1]]; selection[tb[node].son[2]]}
ELSE {
saved: ContextInfo = current;
bti: BTIndex = NewScope[node, tb[node].son[1]];
tb[node].name ← ditem; tb[node].info ← bti; tb[node].attr3 ← FALSE;
selection[tb[node].son[2]];
current ← saved; btLink ← [which:sibling, index:bti]};
dataPtr.textIndex ← saveIndex};
ScanList[t, Item]};
DoStmt:
PROC[node: Tree.Index] = {
OPEN tb[node];
saved: ContextInfo = current;
forTree: Tree.Link = tb[node].son[1];
bti: BTIndex ← BTNull;
IF forTree # Tree.Null
THEN {
subTree: Tree.Link = NthSon[forTree, 1];
IF OpName[subTree] # decl THEN Exp[subTree]
ELSE bti ← NewScope[node, subTree];
PutInfo[forTree, bti];
SELECT OpName[forTree]
FROM
forseq => {Exp[NthSon[forTree, 2]]; Exp[NthSon[forTree, 3]]};
upthru, downthru => Range[NthSon[forTree, 2]];
ENDCASE => ERROR};
Exp[tb[node].son[2]];
ExpList[tb[node].son[3]];
StmtList[tb[node].son[4]]; StmtList[tb[node].son[5]]; StmtList[tb[node].son[6]];
current ← saved;
IF bti # BTNull THEN btLink ← [which:sibling, index:bti]};
CatchPhrase:
PROC[t: Tree.Link] = {
node: Tree.Index = GetNode[t];
saved: ContextInfo = current;
NewContext[
level: NextLevel[saved.staticLevel],
entries: 0,
unique: FALSE];
SelectionList[tb[node].son[1], Stmt]; Stmt[tb[node].son[2]];
current ← saved};
expressions
Exp:
PROC[exp: Tree.Link] = {
IF exp = Tree.Null THEN RETURN;
WITH exp
SELECT
FROM
subtree => {
node: Tree.Index = index;
SELECT tb[node].name
FROM
apply => {
Exp[tb[node].son[1]]; ExpList[tb[node].son[2]];
IF tb[node].nSons > 2 THEN CatchPhrase[tb[node].son[3]]};
signalx, errorx, startx, fork, joinx,
dot, uparrow, uminus, not, addr, create, cast =>
Exp[tb[node].son[1]];
plus, minus, times, div, mod,
relE, relN, relL, relGE, relG, relLE, intOO, intOC, intCO, intCC,
or, and, assignx => {
Exp[tb[node].son[1]]; Exp[tb[node].son[2]]};
in, notin => {Exp[tb[node].son[1]]; Range[tb[node].son[2]]};
ifx => {Exp[tb[node].son[1]]; Exp[tb[node].son[2]]; Exp[tb[node].son[3]]};
casex => {
Exp[tb[node].son[1]]; SelectionList[tb[node].son[2], Exp]; Exp[tb[node].son[3]]};
bindx => {
Exp[tb[node].son[1]]; Exp[tb[node].son[2]];
SelectionList[tb[node].son[3], Exp];
Exp[tb[node].son[4]]};
extractx => {ExpList[tb[node].son[1]]; Exp[tb[node].son[2]]};
pred, succ, ord, lengthen, float, abs, min, max, base, length, all, val =>
ExpList[tb[node].son[1]];
arraydesc => {
SELECT ListLength[tb[node].son[1]]
FROM
1 => Exp[tb[node].son[1]];
3 => {
subNode: Tree.Index = GetNode[tb[node].son[1]];
Exp[tb[subNode].son[1]]; Exp[tb[subNode].son[2]];
OptTypeExp[tb[subNode].son[3]]};
ENDCASE => ERROR};
void, clit, llit, atom, mwconst, syserrorx => NULL;
loophole => {Exp[tb[node].son[1]]; OptTypeExp[tb[node].son[2]]};
narrow, istype => {
Exp[tb[node].son[1]]; OptTypeExp[tb[node].son[2]];
IF tb[node].nSons > 2 THEN CatchPhrase[tb[node].son[3]]};
new => {
Exp[tb[node].son[1]];
TypeExp[tb[node].son[2]];
tb[node].son[3] ← InitialValue[tb[node].son[3], ISENull];
IF tb[node].nSons > 3 THEN CatchPhrase[tb[node].son[4]]};
cons, listcons => {
Exp[tb[node].son[1]]; ExpList[tb[node].son[2]];
IF tb[node].nSons > 2 THEN CatchPhrase[tb[node].son[3]]};
first, last, typecode => TypeExp[tb[node].son[1]];
size => {TypeExp[tb[node].son[1]]; Exp[tb[node].son[2]]};
nil => OptTypeExp[tb[node].son[1]];
item => Exp[tb[node].son[2]];
ENDCASE => Log.Error[unimplemented]};
ENDCASE => NULL
ExpList: PROC[list: Tree.Link] = INLINE {ScanList[list, Exp]};
Position:
PROC[t: Tree.Link] = {
IF OpName[t] = item
THEN {
node: Tree.Index = GetNode[t];
Exp[tb[node].son[1]]; Exp[tb[node].son[2]]}
ELSE Exp[t]};
Range:
PROC[t: Tree.Link] = {
WITH t
SELECT
FROM
subtree: Tree.Link.subtree => {
node: Tree.Index = subtree.index;
SELECT tb[node].name
FROM
subrangeTC => {TypeExp[tb[node].son[1]]; Exp[tb[node].son[2]]};
IN [intOO .. intCC] => Exp[t];
ENDCASE => TypeExp[t]};
ENDCASE => TypeExp[t]