-- file Pass3D.mesa -- last modified by Satterthwaite, February 24, 1983 3:14 pm -- last modified by Donahue, 10-Dec-81 10:22:58 DIRECTORY A3: TYPE USING [ AssignableType, Default, DefaultInit, IndexType, NewableType, OrderedType, TargetType, TypeForTree, Voidable, VoidItem], Alloc: TYPE USING [Notifier], ComData: TYPE USING [ idANY, idCARDINAL, interface, mainCtx, moduleCtx, seAnon, textIndex, typeINTEGER, typeStringBody], Inline: TYPE USING [BITOR], Log: TYPE USING [Error, ErrorHti, ErrorSei, ErrorTree], P3: TYPE USING [ Attr, NPUse, SequenceNP, fullAttr, voidAttr, mark, pathNP, phraseNP, CheckDisjoint, ClearRefStack, CopyTree, EnterComposite, Exp, FindSe, InterfaceCtx, MakeFrameRecord, PopCtx, PushCtx, RAttr, RecordLhs, RecordMention, Rhs, RPop, RPush, RType, SafetyAttr, SealRefStack, SearchCtxList, SelectVariantType, TopCtx, UnsealRefStack, VariantUnionType, VoidExp], Symbols: TYPE USING [ Base, SERecord, Name, Type, ISEIndex, CSEIndex, RecordSEIndex, RefSEIndex, CTXIndex, CBTIndex, nullType, ISENull, CTXNull, codeANY, codeINT, lG, lZ, typeANY, typeTYPE, seType, ctxType, mdType, bodyType], SymbolOps: TYPE USING [ ArgCtx, CopyXferType, EnterExtension, LinkMode, MakeNonCtxSe, NormalType, RCType, ReferentType, TypeForm, TypeLink, UnderType, XferMode], Tree: TYPE USING [Base, Index, Link, Map, Null, NullIndex, Scan, treeType], TreeOps: TYPE USING [ FreeTree, GetHash, GetNode, GetSe, IdentityMap, ListHead, ListLength, NthSon, OpName, ScanList, UpdateList]; Pass3D: PROGRAM IMPORTS A3, Inline, Log, P3, SymbolOps, TreeOps, dataPtr: ComData EXPORTS P3 = { OPEN TreeOps, SymbolOps, Symbols, A3, P3; 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) mdb: Symbols.Base; -- module table base address (local copy) bb: Symbols.Base; -- body table base address (local copy) DeclNotify: PUBLIC Alloc.Notifier = { -- called by allocator whenever table area is repacked tb ← base[Tree.treeType]; seb ← base[seType]; ctxb ← base[ctxType]; mdb ← base[mdType]; bb ← base[bodyType]}; -- signals for type loop detection CheckTypeLoop: SIGNAL [loopNode: Tree.Index] RETURNS [BOOL] = CODE; LogTypeLoop: SIGNAL [loopNode: Tree.Index] = CODE; -- declaration processing ItemId: PUBLIC PROC [t: Tree.Link] RETURNS [ISEIndex] = { RETURN [WITH t SELECT FROM symbol => index, subtree => ItemId[tb[index].son[1]], ENDCASE => ERROR]}; FirstId: PUBLIC PROC [node: Tree.Index] RETURNS [ISEIndex] = { RETURN [ItemId[ListHead[tb[node].son[1]]]]}; DeclList: PUBLIC Tree.Scan = {ScanList[t, DeclA]; ScanList[t, DeclBInit]}; DeclA: Tree.Scan = { node: Tree.Index = GetNode[t]; type: Type; saveIndex: CARDINAL = dataPtr.textIndex; IF tb[node].attr3 = P3.mark THEN RETURN; -- already processed tb[node].attr3 ← P3.mark; dataPtr.textIndex ← tb[node].info; tb[node].son[2] ← TypeLink[tb[node].son[2] ! CheckTypeLoop => {IF loopNode = node THEN RESUME [TRUE]}; LogTypeLoop => {IF loopNode = node THEN RESUME}]; type ← TypeForTree[tb[node].son[2]]; SELECT tb[node].name FROM typedecl => DefineTypeSe[tb[node].son[1], type]; decl => DefineSeType[tb[node].son[1], type, tb[node].attr1]; ENDCASE => ERROR; ClearRefStack[]; dataPtr.textIndex ← saveIndex}; DeclBField: Tree.Scan = {DeclBDefault[t, FALSE]}; DeclBVarField: Tree.Scan = {DeclBDefault[t, TRUE]}; DeclBDefault: PROC [t: Tree.Link, varOK: BOOL←FALSE] = { node: Tree.Index = GetNode[t]; saveIndex: CARDINAL = dataPtr.textIndex; IF tb[node].attr2 = P3.mark THEN RETURN; -- already processed tb[node].attr2 ← P3.mark; dataPtr.textIndex ← tb[node].info; TypeAttr[typeExp: tb[node].son[2], varOK: varOK]; SELECT tb[node].name FROM typedecl => NULL; decl => { type: Type = TypeForTree[tb[node].son[2]]; IF ~NewableType[type] THEN Log.ErrorTree[typeLength, tb[node].son[2]]; IF tb[node].son[3] # Tree.Null THEN { ScanList[tb[node].son[1], RecordDeclInit]; tb[node].son[3] ← DefaultExp[t:tb[node].son[3], type:type, ids:tb[node].son[1]]}; DefineSeValue[tb[node].son[1], FALSE]}; ENDCASE => ERROR; ClearRefStack[]; dataPtr.textIndex ← saveIndex}; DeclBInit: Tree.Scan = { node: Tree.Index = GetNode[t]; saveIndex: CARDINAL = dataPtr.textIndex; IF tb[node].attr2 = P3.mark THEN RETURN; -- already processed tb[node].attr2 ← P3.mark; dataPtr.textIndex ← tb[node].info; [] ← CheckPositions[tb[node].son[1], FieldAttrs[]]; SELECT tb[node].name FROM typedecl => { TypeAttr[tb[node].son[2]]; IF tb[node].son[3] # Tree.Null THEN { tb[node].son[3] ← DefaultExp[ t:tb[node].son[3], type:TypeForTree[tb[node].son[2]], ids:tb[node].son[1]]; [] ← ProcessDefault[node]}}; decl => { type: Type; constFlag, extFlag: BOOL; ctx: CTXIndex = TopCtx[]; TypeAttr[typeExp: tb[node].son[2], varOK: InterfaceContext[ctx]]; type ← TypeForTree[tb[node].son[2]]; IF ~NewableType[type] THEN Log.ErrorTree[typeLength, tb[node].son[2]]; IF tb[node].son[3] = Tree.Null THEN { IF ~InterfaceContext[ctx] AND ~tb[node].attr1 THEN { tb[node].son[3] ← DefaultInit[type]; pathNP ← SequenceNP[pathNP][phraseNP]; RPop[]}; constFlag ← FALSE} ELSE { [tb[node].son[3], extFlag] ← InitialExp[tb[node].son[3], type]; IF extFlag AND ~tb[node].attr1 THEN Log.ErrorTree[misusedInline, tb[node].son[3]]; pathNP ← SequenceNP[pathNP][phraseNP]; constFlag ← tb[node].attr1 AND RAttr[].const; RPop[]; IF tb[node].son[3] # Tree.Null THEN ScanList[tb[node].son[1], RecordDeclInit]}; SELECT TRUE FROM (tb[node].son[3] = Tree.Null) => IF ~InterfaceContext[ctx] AND ~Voidable[type] THEN Log.ErrorSei[missingInit, FirstId[node]]; GlobalContext[ctx] => SELECT RCType[type] FROM composite => EnterComposite[type, tb[node].son[3], TRUE]; ENDCASE => NULL; ENDCASE => NULL; DefineSeValue[tb[node].son[1], constFlag]}; ENDCASE => ERROR; ClearRefStack[]; dataPtr.textIndex ← saveIndex}; RecordDeclInit: Tree.Scan = { sei: ISEIndex = ItemId[t]; RecordMention[sei]; RecordLhs[sei]}; DefaultExp: PROC [t: Tree.Link, type: Type, ids: Tree.Link] RETURNS [v: Tree.Link] = { subType: CSEIndex = TargetType[type]; ExpInit: PROC [t: Tree.Link] RETURNS [val: Tree.Link] = { val ← Rhs[t, subType]; RPop[]; RETURN}; v ← UpdateList[t, ExpInit]; IF VoidItem[v] AND ~Voidable[type] THEN Log.ErrorSei[defaultForm, ItemId[ids]]; RETURN}; InitialExp: PUBLIC PROC [t: Tree.Link, type: Type] RETURNS [v: Tree.Link, extended: BOOL] = { subType: CSEIndex = UnderType[type]; v ← t; extended ← FALSE; phraseNP ← none; SELECT OpName[t] FROM body => { -- defer processing of bodies (see Body) expNode: Tree.Index = GetNode[t]; bti: CBTIndex = tb[expNode].info; attr: Attr ← voidAttr; SELECT XferMode[type] FROM proc, program => NULL; ENDCASE => IF TypeForm[type] = definition THEN attr ← fullAttr ELSE Log.Error[bodyType]; bb[bti].ioType ← SELECT seb[type].seTag FROM cons => subType, ENDCASE => CopyXferType[subType, IdentityMap]; RPush[type, attr]; extended ← tb[expNode].attr3; -- inline CheckBodyType[subType, expNode]}; inline => { expNode: Tree.Index = GetNode[t]; CodeBody: Tree.Map = {RETURN [UpdateList[t, NumericConst]]}; IF XferMode[type] # proc THEN Log.Error[inlineType]; IF tb[expNode].attr1 THEN Log.Error[attrClash]; tb[expNode].son[1] ← UpdateList[tb[expNode].son[1], CodeBody]; RPush[type, fullAttr]; extended ← TRUE; CheckBodyType[subType, expNode]}; apply => { expNode: Tree.Index = GetNode[t]; IF tb[expNode].son[1] = Tree.Null AND ReferentType[subType] = dataPtr.typeStringBody AND ListLength[tb[expNode].son[2]] = 1 THEN tb[expNode].name ← stringinit; v ← Rhs[t, TargetType[subType]]}; signalinit => RPush[type, voidAttr]; void => {v ← FreeTree[t]; RPush[subType, voidAttr]}; ENDCASE => v ← Rhs[t, TargetType[subType]]; RETURN}; RecordField: PROC [ctx: CTXIndex] RETURNS [BOOL] = INLINE { RETURN [ctx = CTXNull OR (ctxb[ctx].level = lZ AND ctx # dataPtr.moduleCtx)]}; GlobalContext: PROC [ctx: CTXIndex] RETURNS [BOOL] = INLINE { RETURN [~dataPtr.interface AND ctxb[ctx].level = lG]}; InterfaceContext: PROC [ctx: CTXIndex] RETURNS [BOOL] = INLINE { RETURN [dataPtr.interface AND ctx = dataPtr.mainCtx]}; InterfaceSe: PROC [sei: ISEIndex] RETURNS [BOOL] = INLINE { RETURN [InterfaceContext[seb[sei].idCtx]]}; CheckBodyType: PROC [type: CSEIndex, node: Tree.Index] = { WITH t: seb[type] SELECT FROM transfer => { IF TypeForm[t.typeIn] = any OR TypeForm[t.typeOut] = any THEN Log.Error[bodyType]; IF t.safe AND SafetyAttr[node] = none THEN Log.Error[unsafeBlock]}; ENDCASE}; DefineTypeSe: PROC [t: Tree.Link, info: Type] = { first: BOOL ← TRUE; UpdateSe: Tree.Scan = { sei: ISEIndex = ItemId[t]; seb[sei].idType ← typeTYPE; seb[sei].idInfo ← info; seb[sei].immutable ← seb[sei].constant ← TRUE; IF first THEN {info ← sei; first ← FALSE}; seb[sei].mark3 ← TRUE}; ScanList[t, UpdateSe]}; DefineSeType: PROC [t: Tree.Link, type: Type, fixed: BOOL] = { UpdateSe: Tree.Scan = { sei: ISEIndex = ItemId[t]; seb[sei].idType ← type; seb[sei].constant ← FALSE; IF InterfaceSe[sei] THEN seb[sei].immutable ← seb[sei].immutable OR fixed ELSE seb[sei].immutable ← fixed; seb[sei].mark3 ← TRUE}; ScanList[t, UpdateSe]}; DefineSeValue: PROC [t: Tree.Link, const: BOOL] = { UpdateSe: Tree.Scan = { sei: ISEIndex = ItemId[t]; seb[sei].constant ← const; IF InterfaceSe[sei] AND LinkMode[sei] = val THEN seb[sei].immutable ← TRUE}; ScanList[t, UpdateSe]}; ProcessDefault: PROC [node: Tree.Index] RETURNS [nonVoid: BOOL] = { copy: BOOL; v: Tree.Link = tb[node].son[3]; DefineDefault: Tree.Scan = { EnterExtension[ItemId[t], default, IF copy THEN CopyTree[v] ELSE v]; copy ← TRUE}; SELECT OpName[v] FROM stringinit => Log.ErrorSei[defaultForm, FirstId[node]]; lengthen => IF OpName[NthSon[v, 1]] = stringinit THEN Log.ErrorSei[defaultForm, FirstId[node]]; void => nonVoid ← FALSE; ENDCASE => nonVoid ← TRUE; copy ← FALSE; ScanList[tb[node].son[1], DefineDefault]; tb[node].son[3] ← Tree.Null}; -- forward reference resolution ResolveType: PUBLIC PROC [sei: ISEIndex] = { currentCtx: CTXIndex = TopCtx[]; IF seb[sei].idCtx # currentCtx THEN {PopCtx[]; ResolveType[sei]; PushCtx[currentCtx]} ELSE {SealRefStack[]; DeclA[[subtree[index: seb[sei].idValue]]]; UnsealRefStack[]}}; ResolveValue: PUBLIC PROC [sei: ISEIndex] = { currentCtx: CTXIndex = TopCtx[]; IF seb[sei].idCtx # currentCtx THEN {PopCtx[]; ResolveValue[sei]; PushCtx[currentCtx]} ELSE { SealRefStack[]; IF RecordField[currentCtx] THEN DeclBDefault[[subtree[index: seb[sei].idValue]]] ELSE DeclBInit[[subtree[index: seb[sei].idValue]]]; UnsealRefStack[]}}; -- type expressions CheckTypeId: PROC [sei: ISEIndex] RETURNS [BOOL] = { node: Tree.Index; IF seb[sei].mark3 THEN RETURN [seb[sei].idType = typeTYPE]; node ← seb[sei].idValue; RETURN [node = Tree.NullIndex OR tb[node].name = typedecl]}; TypeSymbol: PROC [sei: ISEIndex] RETURNS [val: Tree.Link] = { entryIndex: CARDINAL = dataPtr.textIndex; circular: BOOL ← FALSE; IF ~seb[sei].mark3 THEN { ENABLE LogTypeLoop => { saveIndex: CARDINAL = dataPtr.textIndex; dataPtr.textIndex ← entryIndex; Log.ErrorSei[circularType, sei]; circular ← TRUE; dataPtr.textIndex ← saveIndex}; declNode: Tree.Index = seb[sei].idValue; IF tb[declNode].attr3 # P3.mark THEN ResolveType[sei] ELSE IF SIGNAL CheckTypeLoop[declNode] THEN SIGNAL LogTypeLoop[declNode]}; IF CheckTypeId[sei] AND ~circular THEN val ← [symbol[index: sei]] ELSE { IF ~circular AND sei # dataPtr.seAnon THEN Log.ErrorSei[nonTypeId, sei]; val ← [symbol[index: dataPtr.idANY]]}; RETURN}; PushArgCtx: PROC [sei: CSEIndex] = { ctx: CTXIndex = ArgCtx[sei]; IF ctx # CTXNull THEN PushCtx[ctx]}; PopArgCtx: PROC [sei: CSEIndex] = { IF ArgCtx[sei] # CTXNull THEN PopCtx[]}; TypeExp: PUBLIC PROC [typeExp: Tree.Link] RETURNS [val: Tree.Link] = { val ← TypeLink[typeExp]; TypeAttr[val]; RETURN}; TypeAppl: PUBLIC PROC [typeExp: Tree.Link] RETURNS [val: Tree.Link] = { attr: Attr; IF OpName[typeExp] = apply THEN { node: Tree.Index = GetNode[typeExp]; rType: Type; tb[node].son[1] ← TypeExp[tb[node].son[1]]; tb[node].info ← rType ← TypeForTree[tb[node].son[1]]; SELECT TRUE FROM (UnderType[rType] = dataPtr.typeStringBody), (TypeForm[VariantUnionType[rType]] = sequence) => { tb[node].son[2] ← Rhs[tb[node].son[2], dataPtr.typeINTEGER]; attr ← RAttr[]; RPop[]}; (TypeForm[VariantUnionType[rType]] = union) => { TypeDiscrim[rType, node]; phraseNP ← none; attr ← fullAttr}; ENDCASE => { Log.ErrorTree[typeClash, tb[node].son[1]]; tb[node].son[2] ← Exp[tb[node].son[2], typeANY]; attr ← RAttr[]; RPop[]}; val ← typeExp} ELSE {val ← TypeExp[typeExp]; phraseNP ← none; attr ← fullAttr}; RPush[typeTYPE, attr]}; ClusterExp: PROC [t: Tree.Link] RETURNS [val: Tree.Link] = { WITH t SELECT FROM hash => { sei: ISEIndex = FindSe[index].symbol; IF ~CheckTypeId[sei] THEN -- prevent duplicate error messages val ← Exp[IF sei = dataPtr.seAnon THEN [symbol[sei]] ELSE t, typeANY] ELSE {val ← TypeSymbol[sei]; RPush[typeTYPE, fullAttr]}}; symbol => { sei: ISEIndex = index; IF ~CheckTypeId[sei] THEN val ← Exp[t, typeANY] ELSE {val ← TypeSymbol[sei]; RPush[typeTYPE, fullAttr]}}; ENDCASE => {val ← TypeLink[t]; RPush[typeTYPE, fullAttr]}; RETURN}; TypeDot: PROC [rType: Type, node: Tree.Index] = TypeDiscrim; -- for now, should do other possible cluster items TypeDiscrim: PROC [rType: Type, node: Tree.Index] = { t2: Tree.Link = tb[node].son[2]; WITH h: t2 SELECT FROM hash => { iSei: ISEIndex = SelectVariantType[rType, h.index]; IF iSei # ISENull THEN { tb[node].info ← iSei; tb[node].son[2] ← [symbol[index: iSei]]; tb[node].name ← discrimTC} ELSE { IF rType # typeANY THEN Log.ErrorTree[unknownVariant, t2]; tb[node].info ← dataPtr.idANY}}; ENDCASE => { Log.ErrorTree[unknownVariant, t2]; tb[node].son[2] ← VoidExp[t2]}}; FindLinkType: SIGNAL RETURNS [CSEIndex] = CODE; -- to find list link type TypeLink: PROC [typeExp: Tree.Link] RETURNS [val: Tree.Link] = { WITH typeExp SELECT FROM hash => { sei: ISEIndex = FindSe[index].symbol; IF sei # ISENull THEN val ← TypeSymbol[sei] ELSE {Log.ErrorHti[nonTypeId, index]; val ← [symbol[dataPtr.idANY]]}}; symbol => val ← TypeSymbol[index]; subtree => { node: Tree.Index = index; iSei: ISEIndex; SELECT tb[node].name FROM discrimTC => { tb[node].son[1] ← TypeLink[tb[node].son[1]]; TypeDiscrim[TypeForTree[tb[node].son[1]], node]}; apply => { rType: Type; tb[node].son[1] ← TypeLink[tb[node].son[1]]; tb[node].info ← rType ← TypeForTree[tb[node].son[1]]; IF TypeForm[VariantUnionType[rType]] = union THEN TypeDiscrim[rType, node] ELSE Log.ErrorTree[noApplication, tb[node].son[1]]}; dot => { name: Name = GetHash[tb[node].son[2]]; nDerefs: CARDINAL ← 0; found: BOOL; next: Type; ctx: CTXIndex ← CTXNull; tb[node].son[1] ← ClusterExp[tb[node].son[1]]; FOR subType: Type ← RType[], next DO csei: CSEIndex = UnderType[subType]; WITH t: seb[csei] SELECT FROM mode => GOTO type; definition, transfer => { ctx ← InterfaceCtx[csei, tb[node].son[1]]; GO TO cluster}; record => {ctx ← t.fieldCtx; GO TO cluster}; ref => {IF (nDerefs ← nDerefs+1) > 63 THEN GO TO cluster; next ← t.refType}; long => next ← t.rangeType; subrange => next ← t.rangeType; ENDCASE => GO TO cluster; REPEAT type => TypeDot[TypeForTree[tb[node].son[1]], node]; cluster => { [found, iSei] ← SearchCtxList[name, ctx]; IF ~found THEN {iSei ← dataPtr.idANY; Log.ErrorHti[unknownField, name]}; tb[node].name ← cdot; tb[node].info ← iSei; tb[node].son[2] ← TypeSymbol[iSei]}; ENDLOOP; RPop[]}; paintTC => { tb[node].son[1] ← TypeLink[tb[node].son[1]]; tb[node].son[2] ← TypeLink[tb[node].son[2]]; tb[node].info ← TypeForTree[tb[node].son[2]]}; linkTC => tb[node].info ← SIGNAL FindLinkType[]; implicitTC => NULL; frameTC => { tb[node].son[1] ← Exp[tb[node].son[1], typeANY]; RPop[]; tb[node].info ← MakeFrameRecord[tb[node].son[1]]}; ENDCASE => { OPEN tb[node]; type: CSEIndex = info; WITH t: seb[type] SELECT FROM enumerated => NULL; record => {PushCtx[t.fieldCtx]; ScanList[son[1], DeclA]; PopCtx[]}; ref => { son[1] ← TypeLink[son[1] ! CheckTypeLoop => {RESUME [FALSE]}]; t.refType ← TypeForTree[son[1]]}; array => { IF son[1] = Tree.Null THEN t.indexType ← dataPtr.idCARDINAL ELSE {son[1] ← TypeLink[son[1]]; t.indexType ← TypeForTree[son[1]]}; son[2] ← TypeLink[son[2]]; t.componentType ← TypeForTree[son[2]]}; arraydesc => { son[1] ← TypeLink[son[1] ! CheckTypeLoop => {RESUME [FALSE]}]; t.describedType ← TypeForTree[son[1]]}; transfer => { ENABLE CheckTypeLoop => {RESUME [FALSE]}; CheckDisjoint[ArgCtx[t.typeIn], ArgCtx[t.typeOut]]; PushArgCtx[t.typeIn]; IF OpName[son[1]] # anyTC THEN ScanList[son[1], DeclA]; PushArgCtx[t.typeOut]; IF OpName[son[2]] # anyTC THEN ScanList[son[2], DeclA]; PopArgCtx[t.typeOut]; PopArgCtx[t.typeIn]}; definition => t.defCtx ← dataPtr.mainCtx; union => {DeclA[son[1]]; ScanList[son[2], DeclA]}; sequence => { DeclA[son[1]]; son[2] ← TypeLink[son[2]]; t.componentType ← TypeForTree[son[2]]}; relative => { son[1] ← TypeLink[son[1] ! CheckTypeLoop => {RESUME [FALSE]}]; t.baseType ← TypeForTree[son[1]]; son[2] ← TypeLink[son[2]]; t.resultType ← t.offsetType ← TypeForTree[son[2]]}; opaque => IF t.id = ISENull OR ~InterfaceSe[t.id] THEN Log.Error[misplacedType]; zone => NULL; subrange => { t.range ← LOOPHOLE[node]; -- to allow symbolic evaluation son[1] ← TypeLink[son[1]]; t.rangeType ← TypeForTree[son[1]]}; long => { son[1] ← TypeLink[son[1] ! FindLinkType => {RESUME [type]}]; t.rangeType ← TypeForTree[son[1]]}; any => NULL; ENDCASE => ERROR; seb[type].mark3 ← TRUE}; val ← typeExp}; ENDCASE => ERROR; RETURN}; TypeAttr: PROC [typeExp: Tree.Link, indirect, varOK: BOOL ← FALSE] = { WITH typeExp SELECT FROM symbol => IF ~indirect THEN { sei: ISEIndex = index; IF seb[sei].mark3 AND ~seb[sei].mark4 THEN { declNode: Tree.Index = seb[sei].idValue; IF tb[declNode].attr2 # P3.mark THEN ResolveValue[sei]}}; subtree => { node: Tree.Index = index; SELECT tb[node].name FROM discrimTC => TypeAttr[tb[node].son[1], indirect]; cdot => TypeAttr[tb[node].son[2], indirect]; paintTC => { TypeAttr[tb[node].son[1]]; TypeAttr[tb[node].son[2], indirect]; Log.Error[unimplemented]}; implicitTC, linkTC => NULL; frameTC => NULL; apply => tb[node].son[2] ← VoidExp[tb[node].son[2]]; dot => NULL; ENDCASE => { OPEN tb[node]; type: CSEIndex = info; subType: CSEIndex; WITH t: seb[type] SELECT FROM enumerated => IF AssignedEnumeration[son[1]] AND ~t.machineDep THEN Log.Error[machDep]; record => { saveNP: NPUse = pathNP; PushCtx[t.fieldCtx]; pathNP ← none; ScanList[son[1], DeclBField]; WITH s: t SELECT FROM linked => CheckDisjointPrefix[t.fieldCtx, s.linkType]; notLinked => { attrs: FieldAttrs = CollectAttrs[ son[1], FieldAttrs[positionValid: t.machineDep]]; UpdateHints[LOOPHOLE[type], attrs]; attr1 ← AssignedPositions[attrs]}; ENDCASE => ERROR; PopCtx[]; pathNP ← saveNP}; ref => { IF t.var AND ~varOK THEN Log.Error[var]; TypeAttr[son[1], TRUE]}; array => { IF son[1] # Tree.Null THEN TypeAttr[son[1]]; SELECT TRUE FROM ~IndexType[t.indexType] => { t.indexType ← typeANY; Log.Error[nonOrderedType]}; (TypeForm[t.indexType]=long) => Log.Error[subrangeNesting]; ENDCASE; TypeAttr[son[2], indirect]; IF ~NewableType[t.componentType] THEN Log.ErrorTree[typeLength, son[2]]}; arraydesc => { TypeAttr[son[1], TRUE]; IF TypeForm[t.describedType] # array THEN Log.Error[descriptor]}; transfer => { saveNP: NPUse = pathNP; IF t.mode = error THEN t.safe ← FALSE; PushArgCtx[t.typeIn]; ArgAttr[t.typeIn, son[1], t.mode = proc OR t.mode = signal]; PushArgCtx[t.typeOut]; ArgAttr[t.typeOut, son[2], FALSE]; PopArgCtx[t.typeOut]; PopArgCtx[t.typeIn]; pathNP ← saveNP}; definition => NULL; union => { tagType: CSEIndex; DeclBDefault[son[1]]; seb[t.tagSei].immutable ← TRUE; tagType ← TargetType[seb[t.tagSei].idType]; IF seb[tagType].typeTag # enumerated THEN { Log.ErrorSei[nonTagType, t.tagSei]; tagType ← typeANY}; VariantList[son[2], tagType]}; sequence => { DeclBDefault[son[1]]; seb[t.tagSei].immutable ← TRUE; SELECT TRUE FROM ~IndexType[seb[t.tagSei].idType] => Log.ErrorSei[nonTagType, t.tagSei]; (TypeForm[seb[t.tagSei].idType]=long) => Log.Error[unimplemented]; ENDCASE; TypeAttr[son[2], indirect]}; relative => { vType: CSEIndex; TypeAttr[son[1], TRUE]; IF seb[NormalType[t.baseType]].typeTag # ref THEN Log.Error[relative]; TypeAttr[son[2]]; vType ← UnderType[t.offsetType]; subType ← NormalType[vType]; SELECT seb[subType].typeTag FROM ref, arraydesc => NULL; ENDCASE => {Log.Error[relative]; subType ← typeANY}; IF seb[UnderType[t.baseType]].typeTag = long OR seb[vType].typeTag = long THEN subType ← MakeLongType[subType, vType]; t.resultType ← subType}; zone => NULL; opaque => IF son[1] # Tree.Null THEN { son[1] ← Rhs[son[1], dataPtr.typeINTEGER]; IF ~RAttr[].const THEN Log.ErrorTree[nonConstant, son[1]]; RPop[]}; subrange => { target: CSEIndex; subNode: Tree.Index = GetNode[son[2]]; TypeAttr[son[1], indirect]; subType ← UnderType[t.rangeType]; SELECT TRUE FROM (TypeForm[subType] = ref) => target ← dataPtr.typeINTEGER; OrderedType[subType] => { WITH s: seb[subType] SELECT FROM long => { t.rangeType ← s.rangeType; subType ← UnderType[s.rangeType]}; real => Log.Error[subrangeNesting]; ENDCASE; target ← TargetType[subType]}; ENDCASE => {Log.Error[nonOrderedType]; target ← typeANY}; tb[subNode].son[1] ← EndPoint[tb[subNode].son[1], target]; tb[subNode].son[2] ← EndPoint[tb[subNode].son[2], target]}; long => { TypeAttr[son[1], indirect, varOK]; subType ← UnderType[t.rangeType]; WITH s: seb[subType] SELECT FROM basic => SELECT s.code FROM codeINT, codeANY => NULL; ENDCASE => Log.Error[long]; ref, arraydesc => NULL; subrange => IF t.rangeType # dataPtr.idCARDINAL THEN Log.Error[long]; ENDCASE => Log.Error[long]}; any => NULL; ENDCASE => ERROR}}; ENDCASE => ERROR}; EndPoint: PROC [t: Tree.Link, target: CSEIndex] RETURNS [v: Tree.Link] = { v ← Rhs[t, target]; IF ~RAttr[].const THEN Log.ErrorTree[nonConstant, v]; RPop[]}; -- record attribute collection FieldAttrs: TYPE = RECORD [ positionValid: BOOL ← FALSE, noAssign: BOOL ← FALSE, refField, unVoidable, default: BOOL ← FALSE, positions: PACKED ARRAY {implicit, explicit} OF BOOL ← [FALSE, FALSE]]; MergeAttrs: PROC [attr1, attr2: FieldAttrs] RETURNS [FieldAttrs] = LOOPHOLE[Inline.BITOR]; UpdateHints: PROC [rSei: RecordSEIndex, attrs: FieldAttrs] = { seb[rSei].hints.assignable ← ~attrs.noAssign; seb[rSei].hints.refField ← attrs.refField; seb[rSei].hints.voidable ← ~attrs.unVoidable; seb[rSei].hints.default ← attrs.default}; AssignedPositions: PROC [attrs: FieldAttrs] RETURNS [assigned: BOOL] = { IF attrs.positionValid THEN { IF attrs.positions = [TRUE, TRUE] THEN Log.Error[mixedPositions]; assigned ← attrs.positions[explicit]} ELSE assigned ← FALSE; RETURN}; CollectAttrs: PROC [t: Tree.Link, attrs: FieldAttrs] RETURNS [FieldAttrs] = { ProcessField: Tree.Scan = { node: Tree.Index = GetNode[t]; type: Type = TypeForTree[tb[node].son[2]]; subType: CSEIndex = UnderType[type]; attrs ← CheckPositions[tb[node].son[1], attrs]; IF (IF tb[node].son[3] = Tree.Null THEN Default[type] = nonVoid ELSE ProcessDefault[node]) THEN attrs.default ← TRUE; WITH t: seb[subType] SELECT FROM union => { subNode: Tree.Index = GetNode[tb[node].son[2]]; IF t.controlled THEN ProcessField[tb[subNode].son[1]]; attrs ← MergeVariantAttrs[tb[subNode].son[2], attrs]; t.hints.refField ← attrs.refField; t.hints.voidable ← ~attrs.unVoidable; t.hints.default ← attrs.default; tb[subNode].attr1 ← attrs.positions[explicit]}; sequence => { subNode: Tree.Index = GetNode[tb[node].son[2]]; IF t.controlled THEN ProcessField[tb[subNode].son[1]]; IF RCType[t.componentType] # none THEN { IF ~t.controlled THEN Log.Error[attrClash]; attrs.refField ← --attrs.unVoidable ←-- TRUE}; attrs.noAssign ← TRUE; tb[subNode].attr1 ← attrs.positions[explicit]}; ENDCASE => { IF ~attrs.refField AND RCType[subType] # none THEN attrs.refField ← attrs.unVoidable ← TRUE; IF ~attrs.unVoidable AND ~Voidable[type] THEN attrs.unVoidable ← TRUE; IF ~AssignableType[subType, FALSE] THEN attrs.noAssign ← TRUE}}; ScanList[t, ProcessField]; RETURN [attrs]}; ArgAttr: PROC [rSei: CSEIndex, t: Tree.Link, varOK: BOOL] = { IF rSei # nullType THEN WITH seb[rSei] SELECT FROM record => { ScanList[t, IF varOK THEN DeclBVarField ELSE DeclBField]; UpdateHints[LOOPHOLE[rSei], CollectAttrs[t, FieldAttrs[]]]}; ENDCASE}; -- machine dependent layout NumericConst: Tree.Map = {v ← Rhs[t, dataPtr.typeINTEGER]; RPop[]; RETURN}; AssignedEnumeration: PROC [t: Tree.Link] RETURNS [assigned: BOOL] = { AssignElement: Tree.Scan = { WITH t SELECT FROM subtree => { node: Tree.Index = index; tb[node].son[2] ← NumericConst[tb[node].son[2]]; assigned ← TRUE}; ENDCASE => NULL; RETURN}; assigned ← FALSE; ScanList[t, AssignElement]; RETURN}; CheckPositions: PROC [t: Tree.Link, attrs: FieldAttrs] RETURNS [FieldAttrs] = { CheckPosition: Tree.Scan = { WITH t SELECT FROM subtree => { node: Tree.Index = GetNode[tb[index].son[2]]; IF ~attrs.positionValid THEN Log.ErrorSei[position, ItemId[tb[index].son[1]]]; tb[node].son[1] ← NumericConst[tb[node].son[1]]; IF tb[node].son[2] # Tree.Null THEN { subNode: Tree.Index = GetNode[tb[node].son[2]]; tb[subNode].son[1] ← NumericConst[tb[subNode].son[1]]; tb[subNode].son[2] ← NumericConst[tb[subNode].son[2]]}; attrs.positions[explicit] ← TRUE}; ENDCASE => attrs.positions[implicit] ← TRUE}; ScanList[t, CheckPosition]; RETURN [attrs]}; -- variants CheckDisjointPrefix: PROC [ctx: CTXIndex, link: Type] = { FOR sei: Type ← link, SymbolOps.TypeLink[sei] UNTIL sei = nullType DO type: CSEIndex = UnderType[sei]; WITH t: seb[type] SELECT FROM record => CheckDisjoint[ctx, t.fieldCtx]; ENDCASE; ENDLOOP}; VariantList: PROC [t: Tree.Link, tagType: CSEIndex] = { DefineTag: Tree.Scan = { sei: ISEIndex = GetSe[t]; seb[sei].idValue ← TagValue[seb[sei].hash, tagType]}; VariantItem: Tree.Scan = { node: Tree.Index = GetNode[t]; saveIndex: CARDINAL = dataPtr.textIndex; dataPtr.textIndex ← tb[node].info; ScanList[tb[node].son[1], DefineTag]; DeclBDefault[t]; dataPtr.textIndex ← saveIndex}; ScanList[t, VariantItem]}; TagValue: PROC [tag: Name, tagType: CSEIndex] RETURNS [CARDINAL] = { matched: BOOL; sei: ISEIndex; WITH seb[tagType] SELECT FROM enumerated => { [matched, sei] ← SearchCtxList[tag, valueCtx]; IF matched THEN RETURN [seb[sei].idValue]}; ENDCASE; Log.ErrorHti[unknownTag, tag]; RETURN [0]}; MergeVariantAttrs: PROC [list: Tree.Link, prefixAttrs: FieldAttrs] RETURNS [mergedAttrs: FieldAttrs] = { ProcessVariant: Tree.Scan = { node: Tree.Index = GetNode[t]; ProcessLabel: Tree.Scan = { sei: ISEIndex = GetSe[t]; type: Type = seb[sei].idInfo; WITH v: seb[type] SELECT FROM cons => WITH r: v SELECT FROM record => { subNode: Tree.Index = GetNode[tb[node].son[2]]; attrs: FieldAttrs = CollectAttrs[tb[subNode].son[1], prefixAttrs]; UpdateHints[LOOPHOLE[type], attrs]; r.hints.default ← TRUE; tb[subNode].attr1 ← attrs.positions[explicit]; mergedAttrs ← MergeAttrs[mergedAttrs, attrs]}; ENDCASE; id => NULL; ENDCASE}; ScanList[tb[node].son[1], ProcessLabel]}; mergedAttrs ← prefixAttrs; ScanList[list, ProcessVariant]; mergedAttrs.default ← prefixAttrs.default; RETURN}; -- type construction MakeLongType: PUBLIC PROC [rType: Type, hint: CSEIndex] RETURNS [type: CSEIndex] = { subType: CSEIndex = UnderType[rType]; WITH t: seb[hint] SELECT FROM long => IF TargetType[t.rangeType] = TargetType[subType] THEN RETURN [hint]; ENDCASE; WITH t: seb[subType] SELECT FROM relative => { oType: CSEIndex = MakeLongType[UnderType[t.offsetType], UnderType[t.resultType]]; type ← MakeNonCtxSe[SERecord.cons.relative.SIZE]; seb[type] ← [mark3: TRUE, mark4: TRUE, body: cons[relative[ baseType: t.baseType, offsetType: oType, resultType: oType]]]}; ENDCASE => { type ← MakeNonCtxSe[SERecord.cons.long.SIZE]; seb[type] ← [mark3: TRUE, mark4: TRUE, body: cons[long[rangeType: rType]]]}; RETURN}; MakeRefType: PUBLIC PROC [ cType: Type, hint: CSEIndex, readOnly, counted, var: BOOL] RETURNS [type: RefSEIndex] = { WITH t: seb[hint] SELECT FROM ref => IF ~t.ordered AND t.readOnly = readOnly AND t.counted = counted AND t.var = var AND UnderType[t.refType] = UnderType[cType] THEN RETURN [LOOPHOLE[hint]]; ENDCASE; type ← LOOPHOLE[MakeNonCtxSe[SERecord.cons.ref.SIZE]]; seb[type] ← [mark3: TRUE, mark4: TRUE, body: cons[ref[ counted: counted, var: var, readOnly: readOnly, ordered: FALSE, list: FALSE, basing: FALSE, refType: cType]]]; RETURN}; }.