-- file Pass3Xa.Mesa -- last modified by Satterthwaite, December 17, 1979 1:46 PM DIRECTORY ComData: FROM "comdata" USING [ ownSymbols, seAnon, typeCHARACTER, typeCONDITION, typeINTEGER, typeStringBody], Copier: FROM "copier" USING [CompleteContext], InlineDefs: FROM "inlinedefs" USING [BITAND], Log: FROM "log" USING [Error, ErrorHti, ErrorN, ErrorNode, ErrorSei, ErrorTree], P3: FROM "p3" USING [ Attr, EmptyAttr, FullAttr, VoidAttr, NPUse, MergeNP, SetNP, --And,-- ArrangeKeys, Bundling, CanonicalType, CatchPhrase, CompleteRecord, DefaultInit, DefinedId, DiscriminatedType, Exp, FieldId, ForceType, OperandType, PopCtx, PushCtx, RAttr, RecordLhs, Rhs, RPop, RPush, RType, Span, TargetType, TypeForTree, Unbundle, UpdateTreeAttr, VariantUnionType, Voidable, VoidExp, VoidItem, XferForFrame], Pass3: FROM "pass3" USING [ currentBody, enclosingBody, implicitAttr, implicitRecord, implicitType, lockHeld], Symbols: FROM "symbols" USING [bodyType, ctxType, seType, HTIndex, SEIndex, ISEIndex, CSEIndex, ArraySEIndex, RecordSEIndex, CTXIndex, CBTIndex, HTNull, SENull, ISENull, CSENull, CTXNull, CBTNull, lG, typeANY, typeTYPE], SymbolOps: FROM "symbolops" USING [ ConstantId, FindExtension, FirstVisibleSe, NextSe, NormalType, TypeRoot, UnderType, VisibleCtxEntries, XferMode], Table: FROM "table" USING [Base, Notifier], Tree: FROM "tree" USING [Index, Link, Map, NodeName, Scan, Null, NullIndex, treeType], TreeOps: FROM "treeops" USING [ FreeNode, FreeTree, GetNode, IdentityMap, ListHead, ListLength, ListTail, MakeList, MakeNode, PopTree, PushList, PushTree, PushProperList, PushNode, ScanList, SetAttr, SetInfo, TestTree, UpdateList], Types: FROM "types" USING [SymbolTableBase, Assignable]; Pass3Xa: PROGRAM IMPORTS Copier, InlineDefs, Log, P3, SymbolOps, TreeOps, Types, dataPtr: ComData, passPtr: Pass3 EXPORTS P3 = BEGIN OPEN SymbolOps, TreeOps, P3; And: PROCEDURE [Attr, Attr] RETURNS [Attr] = LOOPHOLE[InlineDefs.BITAND]; -- pervasive definitions from Symbols SEIndex: TYPE = Symbols.SEIndex; ISEIndex: TYPE = Symbols.ISEIndex; CSEIndex: TYPE = Symbols.CSEIndex; RecordSEIndex: TYPE = Symbols.RecordSEIndex; SENull: Symbols.SEIndex = Symbols.SENull; typeANY: Symbols.CSEIndex = Symbols.typeANY; CTXIndex: TYPE = Symbols.CTXIndex; tb: Table.Base; -- tree base address (local copy) seb: Table.Base; -- se table base address (local copy) ctxb: Table.Base; -- context table base address (local copy) bb: Table.Base; -- body table base address (local copy) own: Types.SymbolTableBase; ExpANotify: PUBLIC Table.Notifier = BEGIN -- called by allocator whenever table area is repacked seb _ base[Symbols.seType]; ctxb _ base[Symbols.ctxType]; bb _ base[Symbols.bodyType]; tb _ base[Tree.treeType]; own _ dataPtr.ownSymbols; END; -- parameter reference bookkeeping phraseNP: PUBLIC NPUse; -- tree manipulation utilities WritableRef: PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] = BEGIN type: CSEIndex; phraseNP _ SetNP[phraseNP]; type _ OperandType[t]; DO type _ NormalType[type]; WITH t: seb[type] SELECT FROM pointer => RETURN [~t.readOnly]; arraydesc => RETURN [~t.readOnly]; relative => type _ UnderType[t.offsetType]; ENDCASE => RETURN [TRUE]; ENDLOOP; END; OperandLhs: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] = BEGIN DO WITH t SELECT FROM symbol => BEGIN sei: ISEIndex = index; ctx: CTXIndex = seb[sei].idCtx; IF ctx # Symbols.CTXNull THEN BEGIN ctxb[ctx].varUpdated _ TRUE; IF ctxb[ctx].level < passPtr.currentBody.level THEN phraseNP _ SetNP[phraseNP]; END; RecordLhs[sei]; RETURN [~seb[sei].immutable] END; subtree => BEGIN node: Tree.Index = index; IF node = Tree.NullIndex THEN RETURN [FALSE]; SELECT tb[node].name FROM dot => RETURN [WritableRef[tb[node].son[1]] AND (WITH tb[node].son[2] SELECT FROM symbol => ~seb[index].immutable, ENDCASE => FALSE)]; uparrow, dindex, seqindex => RETURN [WritableRef[tb[node].son[1]]]; reloc => RETURN [WritableRef[tb[node].son[2]]]; dollar => WITH tb[node].son[2] SELECT FROM symbol => IF ~seb[index].immutable THEN t _ tb[node].son[1] ELSE RETURN [FALSE]; ENDCASE => RETURN [FALSE]; index, loophole, cast, openx, pad, chop => t _ tb[node].son[1]; cdot => t _ tb[node].son[2]; apply => RETURN [ListLength[tb[node].son[1]] = 1]; ENDCASE => RETURN [FALSE]; END; ENDCASE => RETURN [FALSE]; ENDLOOP; END; LongPath: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [long: BOOLEAN] = BEGIN node: Tree.Index; WITH t SELECT FROM subtree => BEGIN node _ index; IF node = Tree.NullIndex THEN long _ FALSE ELSE SELECT tb[node].name FROM loophole, cast, openx, pad, chop => long _ LongPath[tb[node].son[1]]; ENDCASE -- dot, uparrow, dindex, reloc, seqindex, dollar, index -- => long _ tb[node].attr2; END; ENDCASE => long _ FALSE; RETURN END; OperandInline: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] = BEGIN bti: Symbols.CBTIndex; SELECT XferMode[OperandType[t]] FROM procedure => BEGIN bti _ BodyForTree[t]; RETURN [bti # Symbols.CBTNull AND bb[bti].inline] END; ENDCASE => RETURN [FALSE] END; OperandInternal: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] = BEGIN node: Tree.Index; WITH t SELECT FROM symbol => BEGIN sei: ISEIndex = index; subNode: Tree.Index; bti: Symbols.CBTIndex; IF ~seb[sei].immutable THEN RETURN [FALSE]; IF seb[sei].mark4 THEN BEGIN IF ~seb[sei].constant THEN RETURN [FALSE]; bti _ seb[sei].idInfo; RETURN [bti # Symbols.CBTNull AND bb[bti].internal] END; subNode _ seb[sei].idValue; RETURN [WITH tb[subNode].son[3] SELECT FROM subtree => tb[index].name = body AND tb[index].attr2, ENDCASE => FALSE] END; subtree => BEGIN node _ index; RETURN [SELECT tb[node].name FROM dot, cdot, assignx => OperandInternal[tb[node].son[2]], ifx => OperandInternal[tb[node].son[2]] OR OperandInternal[tb[node].son[3]], ENDCASE => FALSE] -- should check casex, bindx also END; ENDCASE => RETURN [FALSE]; END; -- expression list manipulation KeyedList: PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] = BEGIN RETURN [t # Tree.Null AND TestTree[ListHead[t], item]] END; PopKeyList: PROCEDURE [nItems: CARDINAL] RETURNS [t: Tree.Link] = BEGIN t _ MakeList[nItems]; IF t = Tree.Null AND nItems # 0 THEN BEGIN PushTree[t]; PushProperList[1]; t _ PopTree[] END; RETURN END; CheckLength: PROCEDURE [t: Tree.Link, length: INTEGER] = BEGIN n: INTEGER = ListLength[t]; SELECT n FROM = length => NULL; > length => Log.ErrorN[listLong, n-length]; < length => Log.ErrorN[listShort, length-n]; ENDCASE; END; ContextComplete: PROCEDURE [ctx: CTXIndex] RETURNS [BOOLEAN] = BEGIN RETURN [WITH ctxb[ctx] SELECT FROM simple => TRUE, included => complete, ENDCASE => FALSE] END; Safen: PROCEDURE [t: Tree.Link, type: CSEIndex] RETURNS [Tree.Link] = BEGIN PushTree[t]; WITH t SELECT FROM subtree => SELECT tb[index].name FROM construct, union, rowcons => NULL; ENDCASE => BEGIN PushNode[safen, 1]; SetInfo[type] END; ENDCASE => BEGIN PushNode[safen, 1]; SetInfo[type] END; RETURN [PopTree[]] END; Defaultable: PROCEDURE [type: SEIndex] RETURNS [BOOLEAN] = BEGIN s, next: SEIndex; FOR s _ type, next DO WITH seb[s] SELECT FROM id => BEGIN sei: ISEIndex = LOOPHOLE[s]; IF seb[sei].extended THEN RETURN [TRUE]; next _ seb[sei].idInfo; END; ENDCASE => RETURN [FALSE]; ENDLOOP; END; PadList: PROCEDURE [expList: Tree.Link, ctx: CTXIndex] RETURNS [Tree.Link] = BEGIN sei: ISEIndex; added: BOOLEAN; nFields: CARDINAL; PushField: Tree.Map = BEGIN PushTree[t]; nFields _ nFields + 1; sei _ NextSe[sei]; RETURN [Tree.Null] END; sei _ FirstVisibleSe[ctx]; added _ FALSE; nFields _ 0; [] _ FreeTree[UpdateList[expList, PushField]]; UNTIL sei = SENull DO IF ~(seb[sei].extended OR Defaultable[seb[sei].idType]) THEN EXIT; PushTree[Tree.Null]; added _ TRUE; nFields _ nFields + 1; sei _ NextSe[sei]; ENDLOOP; IF added THEN PushProperList[nFields] ELSE PushList[nFields]; RETURN [PopTree[]] END; FieldDefault: PROCEDURE [sei: ISEIndex] RETURNS [v: Tree.Link] = BEGIN CheckOption: Tree.Scan = BEGIN IF ~TestTree[t, void] THEN v _ IdentityMap[t] END; v _ Tree.Null; ScanList[FindExtension[sei].tree, CheckOption]; RETURN END; MatchFields: PUBLIC PROCEDURE [record: RecordSEIndex, expList: Tree.Link, elisions: BOOLEAN] RETURNS [val: Tree.Link] = BEGIN nFields: CARDINAL; ctx: CTXIndex; sei: ISEIndex; attr: Attr; first: BOOLEAN; exitNP: NPUse; EvaluateField: Tree.Map = BEGIN subAttr: Attr; type: CSEIndex; SELECT TRUE FROM (t = Tree.Null) => BEGIN IF ~elisions THEN Log.ErrorSei[elision, sei]; v _ IF seb[sei].extended THEN FieldDefault[sei] ELSE DefaultInit[seb[sei].idType]; IF v = Tree.Null THEN BEGIN subAttr _ VoidAttr; phraseNP _ none; type _ typeANY END ELSE BEGIN subAttr _ UpdateTreeAttr[v]; type _ OperandType[v] END; END; TestTree[t, void] => BEGIN IF ~elisions THEN Log.ErrorSei[elision, sei]; v _ Tree.Null; subAttr _ VoidAttr; phraseNP _ none; type _ typeANY; [] _ FreeTree[t]; END; ENDCASE => BEGIN v _ Rhs[t, IF sei = SENull THEN typeANY ELSE TargetType[UnderType[seb[sei].idType]]]; subAttr _ RAttr[]; type _ RType[]; RPop[]; END; IF v = Tree.Null AND elisions AND ~(IF seb[sei].extended THEN VoidItem[FindExtension[sei].tree] ELSE Voidable[seb[sei].idType]) THEN Log.ErrorSei[elision, sei]; IF ~subAttr.noXfer AND (~first OR ~seb[record].argument) THEN v _ Safen[v, type]; attr _ And[attr, subAttr]; first _ FALSE; exitNP _ MergeNP[exitNP][phraseNP]; IF sei # SENull THEN sei _ NextSe[sei]; RETURN END; KeyFillCheck: PROCEDURE [sei: ISEIndex] RETURNS [t: Tree.Link] = BEGIN IF elisions AND (seb[sei].extended OR Defaultable[seb[sei].idType]) THEN t _ Tree.Null ELSE BEGIN Log.ErrorHti[omittedKey, seb[sei].hash]; t _ [symbol[index: dataPtr.seAnon]]; END; RETURN END; IF record = SENull THEN BEGIN CheckLength[expList, 0]; sei _ Symbols.ISENull END ELSE BEGIN CompleteRecord[record]; IF ~ContextComplete[seb[record].fieldCtx] THEN BEGIN IF seb[record].hints.privateFields THEN Log.Error[noAccess]; sei _ Symbols.ISENull; END ELSE BEGIN ctx _ seb[record].fieldCtx; IF KeyedList[expList] THEN BEGIN nFields _ ArrangeKeys[ expList, ctx, FirstVisibleSe[ctx], Symbols.ISENull, KeyFillCheck]; expList _ PopKeyList[nFields]; END ELSE BEGIN nFields _ VisibleCtxEntries[ctx]; IF ListLength[expList] < nFields AND elisions THEN expList _ PadList[expList, ctx]; CheckLength[expList, nFields]; END; sei _ FirstVisibleSe[ctx]; END; END; attr _ FullAttr; first _ TRUE; exitNP _ none; val _ UpdateList[expList, EvaluateField]; RPush[record, attr]; phraseNP _ exitNP; RETURN END; -- operators Dot: PUBLIC PROCEDURE [node: Tree.Index] = BEGIN OPEN tb[node]; type, rType, nType: CSEIndex; sei: ISEIndex; fieldHti: Symbols.HTIndex; op: Tree.NodeName; matched, long: BOOLEAN; attr: Attr; nHits: CARDINAL; nDerefs: CARDINAL; son[1] _ Exp[son[1], typeANY]; type _ RType[]; attr _ RAttr[]; RPop[]; WITH son[2] SELECT FROM hash => fieldHti _ index; ENDCASE => ERROR; op _ dollar; nDerefs _ 0; long _ LongPath[son[1]]; -- N.B. failure is avoided only by EXITing the following loop DO nType _ NormalType[type]; WITH seb[nType] SELECT FROM record => BEGIN [nHits, sei] _ FieldId[fieldHti, LOOPHOLE[nType, RecordSEIndex]]; SELECT nHits FROM 0 => IF Bundling[nType] = 0 THEN GO TO nomatch; 1 => BEGIN son[2] _ [symbol[sei]]; rType _ UnderType[seb[sei].idType]; IF ~attr.const AND ConstantId[sei] THEN BEGIN op _ cdot; attr.const _ TRUE END; EXIT END; ENDCASE => GO TO ambiguous; type _ Unbundle[LOOPHOLE[nType, RecordSEIndex]]; son[1] _ IF op = dot THEN Dereference[son[1], type, long] ELSE ForceType[son[1], type]; op _ dollar; END; pointer => BEGIN IF (nDerefs _ nDerefs+1) > 255 THEN GO TO nomatch; IF op = dot THEN son[1] _ Dereference[son[1], type, long]; long _ seb[type].typeTag = long; attr.const _ FALSE; op _ dot; dereferenced _ TRUE; type _ UnderType[refType]; END; definition => BEGIN [matched, sei] _ DefinedId[fieldHti, nType]; IF matched THEN BEGIN op _ cdot; son[2] _ Tree.Link[symbol[sei]]; rType _ type _ UnderType[seb[sei].idType]; attr.const _ ConstantId[sei]; long _ FALSE; IF ctxb[seb[sei].idCtx].ctxType = imported THEN WITH seb[type] SELECT FROM pointer => BEGIN rType _ UnderType[refType]; son[2] _ Dereference[son[2], rType, FALSE]; END; ENDCASE; EXIT END; GO TO nomatch; END; ENDCASE => GO TO nomatch; REPEAT nomatch => BEGIN son[2] _ [symbol[dataPtr.seAnon]]; IF son[1] # son[2] AND fieldHti # Symbols.HTNull THEN Log.ErrorHti[unknownField, fieldHti]; rType _ typeANY; attr _ EmptyAttr; END; ambiguous => BEGIN Log.ErrorHti[ambiguousId, fieldHti]; son[2] _ [symbol[dataPtr.seAnon]]; rType _ typeANY; attr _ EmptyAttr; END; ENDLOOP; name _ op; attr2 _ long; RPush[rType, attr]; END; Dereference: PROCEDURE [t: Tree.Link, type: CSEIndex, long: BOOLEAN] RETURNS [Tree.Link] = BEGIN PushTree[t]; PushNode[uparrow, 1]; SetInfo[type]; SetAttr[2, long]; RETURN[PopTree[]] END; UpArrow: PUBLIC PROCEDURE [node: Tree.Index] = BEGIN OPEN tb[node]; type, nType: CSEIndex; attr: Attr; son[1] _ Exp[son[1], typeANY]; type _ RType[]; attr _ RAttr[]; RPop[]; attr.const _ FALSE; DO nType _ NormalType[type]; WITH seb[nType] SELECT FROM pointer => BEGIN dereferenced _ TRUE; RPush[UnderType[refType], attr]; attr2 _ seb[type].typeTag = long; EXIT END; record => BEGIN IF Bundling[nType] = 0 THEN GO TO fail; type _ Unbundle[LOOPHOLE[nType, RecordSEIndex]]; END; ENDCASE => GO TO fail; REPEAT fail => BEGIN IF type # typeANY THEN Log.ErrorTree[typeClash, son[1]]; RPush[type, attr]; END; ENDLOOP; END; Apply: PUBLIC PROCEDURE [node: Tree.Index, target: CSEIndex, mustXfer: BOOLEAN] = BEGIN OPEN tb[node]; opType, type, nType, subType: CSEIndex; nDerefs: CARDINAL; attr: Attr; leftNP: NPUse; desc, long: BOOLEAN; ApplyError: PROCEDURE [warn: BOOLEAN] = BEGIN IF warn THEN Log.ErrorTree[noApplication, son[1]]; son[2] _ UpdateList[son[2], VoidExp]; RPush[typeANY, EmptyAttr]; END; UniOperand: PROCEDURE RETURNS [valid: BOOLEAN] = BEGIN IF ~(valid _ ListLength[son[2]] = 1) THEN BEGIN CheckLength[son[2], 1]; son[2] _ UpdateList[son[2], VoidExp]; RPush[typeANY, EmptyAttr]; END ELSE IF KeyedList[son[2]] THEN Log.Error[keys]; RETURN END; IF son[1] # Tree.Null THEN BEGIN WITH seb[target] SELECT FROM union => BEGIN PushCtx[caseCtx]; son[1] _ Exp[son[1], typeANY]; PopCtx[]; END; ENDCASE => son[1] _ Exp[son[1], typeANY]; opType _ RType[]; attr _ RAttr[]; leftNP _ phraseNP; RPop[]; IF opType = Symbols.typeTYPE THEN type _ UnderType[TypeForTree[son[1]]]; END ELSE BEGIN opType _ Symbols.typeTYPE; SELECT seb[target].typeTag FROM record => type _ TypeRoot[target]; array => type _ target; ENDCASE => BEGIN type _ Symbols.CSENull; Log.ErrorNode[noTarget, node] END; END; nDerefs _ 0; desc _ FALSE; long _ LongPath[son[1]]; -- dereferencing/deproceduring loop DO nType _ NormalType[opType]; WITH seb[nType] SELECT FROM mode => BEGIN SELECT seb[type].typeTag FROM record => Construct[node, LOOPHOLE[type, RecordSEIndex]]; array => RowCons[node, LOOPHOLE[type, Symbols.ArraySEIndex]]; enumerated, subrange, basic => IF UniOperand[] THEN BEGIN son[1] _ FreeTree[son[1]]; son[1] _ Rhs[son[2], TargetType[type]]; son[2] _ Tree.Null; name _ check; attr _ RAttr[]; RPop[]; RPush[type, attr]; END; ENDCASE => ApplyError[type # Symbols.CSENull]; EXIT END; transfer => BEGIN SELECT mode FROM procedure => IF ~passPtr.lockHeld AND OperandInternal[son[1]] THEN Log.ErrorTree[internalCall, son[1]]; program => IF BodyForTree[son[1]] # Symbols.CBTNull THEN Log.ErrorTree[typeClash, son[1]]; ENDCASE; son[2] _ MatchFields[inRecord, son[2], TRUE]; name _ SELECT mode FROM procedure => callx, port => portcallx, process => joinx, signal => signalx, error => errorx, program => startx, ENDCASE => apply; attr _ And[RAttr[], attr]; phraseNP _ MergeNP[leftNP][phraseNP]; RPop[]; IF mode = procedure THEN CheckInline[node, attr]; attr.noXfer _ attr.const _ FALSE; RPush[outRecord, attr]; phraseNP _ SetNP[phraseNP]; EXIT END; array => BEGIN IF UniOperand[] THEN BEGIN IF KeyedList[son[2]] THEN Log.Error[keys]; son[2] _ Rhs[son[2], TargetType[UnderType[indexType]]]; END; attr _ And[RAttr[], attr]; phraseNP _ MergeNP[leftNP][phraseNP]; RPop[]; RPush[UnderType[componentType], attr]; IF mustXfer THEN BEGIN opType _ RType[]; RPop[]; PushTree[son[1]]; PushTree[son[2]]; PushNode[IF desc THEN dindex ELSE index, 2]; SetInfo[opType]; SetAttr[2, long]; son[1] _ PopTree[]; son[2] _ Tree.Null; IF nSons > 2 THEN Log.Error[misplacedCatch]; mustXfer _ FALSE; -- to avoid looping END ELSE BEGIN name _ IF desc THEN dindex ELSE index; attr2 _ long; EXIT END; END; arraydesc => BEGIN long _ seb[opType].typeTag = long; opType _ UnderType[describedType]; attr.const _ FALSE; desc _ TRUE; END; pointer => SELECT TRUE FROM basing => BEGIN IF UniOperand[] THEN BEGIN son[2] _ Rhs[son[2], typeANY]; subType _ CanonicalType[RType[]]; attr _ And[RAttr[], attr]; RPop[]; phraseNP _ MergeNP[leftNP][phraseNP]; WITH seb[subType] SELECT FROM relative => BEGIN IF ~Types.Assignable[ [own, UnderType[baseType]], [own, opType]] THEN Log.ErrorTree[typeClash, son[1]]; type _ UnderType[resultType]; END; ENDCASE => BEGIN type _ typeANY; IF subType # typeANY THEN Log.ErrorTree[typeClash, son[2]]; END; subType _ NormalType[type]; attr1 _ seb[subType].typeTag = arraydesc; attr2 _ seb[opType].typeTag = long OR seb[type].typeTag = long; WITH seb[subType] SELECT FROM pointer => BEGIN dereferenced _ TRUE; type _ UnderType[refType]; END; arraydesc => type _ UnderType[describedType]; ENDCASE; attr.const _ FALSE; RPush[type, attr]; name _ reloc; END; EXIT END; (subType _ UnderType[refType]) = dataPtr.typeStringBody => BEGIN IF UniOperand[] THEN BEGIN dereferenced _ TRUE; son[2] _ Rhs[son[2], dataPtr.typeINTEGER]; attr _ And[RAttr[], attr]; RPop[]; phraseNP _ MergeNP[leftNP][phraseNP]; attr.const _ FALSE; RPush[dataPtr.typeCHARACTER, attr]; name _ seqindex; attr2 _ seb[opType].typeTag = long; END; EXIT END; ENDCASE => BEGIN attr.const _ FALSE; dereferenced _ TRUE; WITH seb[subType] SELECT FROM record => IF ctxb[fieldCtx].level = Symbols.lG THEN BEGIN opType _ XferForFrame[fieldCtx]; son[1] _ ForceType[son[1], opType]; END ELSE GO TO deRef; ENDCASE => GO TO deRef; EXITS deRef => BEGIN IF (nDerefs _ nDerefs+1) > 255 THEN GO TO fail; long _ seb[opType].typeTag = long; son[1] _ Dereference[son[1], subType, long]; opType _ subType; END; END; record => BEGIN IF nType = dataPtr.typeCONDITION THEN BEGIN IF son[2] # Tree.Null THEN Log.ErrorN[listLong, ListLength[son[2]]]; RPush[Symbols.CSENull, attr]; name _ wait; phraseNP _ SetNP[phraseNP]; EXIT END; IF Bundling[opType] = 0 THEN GO TO fail; opType _ Unbundle[LOOPHOLE[opType, RecordSEIndex]]; son[1] _ ForceType[son[1], opType]; END; ENDCASE => GO TO fail; REPEAT fail => ApplyError[opType#typeANY OR nDerefs#0]; ENDLOOP; IF nSons > 2 THEN BEGIN saveNP: NPUse = phraseNP; SELECT name FROM callx, portcallx, signalx, errorx, startx, fork, joinx, wait, apply => NULL; ENDCASE => Log.Error[misplacedCatch]; [] _ CatchPhrase[son[3]]; phraseNP _ MergeNP[saveNP][phraseNP]; END; IF RType[] = Symbols.CSENull THEN name _ SELECT name FROM callx => call, portcallx => portcall, signalx => signal, errorx => error, startx => start, joinx => join, ENDCASE => name; END; Construct: PROCEDURE [node: Tree.Index, type: RecordSEIndex] = BEGIN OPEN tb[node]; cType: CSEIndex _ type; attr: Attr; t: Tree.Link; son[2] _ MatchFields[type, son[2], TRUE]; attr _ RAttr[]; RPop[]; WITH seb[type] SELECT FROM linked => BEGIN name _ union; cType _ VariantUnionType[linkType] END; ENDCASE => BEGIN name _ construct; IF hints.variant AND (t_ListTail[son[2]]) # Tree.Null THEN cType _ DiscriminatedType[type, t]; END; info _ cType; RPush[cType, attr]; END; RowCons: PROCEDURE [node: Tree.Index, aType: Symbols.ArraySEIndex] = BEGIN OPEN tb[node]; attr: Attr; componentType: SEIndex = seb[aType].componentType; iType: CSEIndex = UnderType[seb[aType].indexType]; cType: CSEIndex = TargetType[UnderType[componentType]]; exitNP: NPUse; MapValue: Tree.Map = BEGIN type: CSEIndex; subAttr: Attr; SELECT TRUE FROM (t = Tree.Null) => BEGIN v _ DefaultInit[componentType]; IF v = Tree.Null THEN BEGIN subAttr _ VoidAttr; phraseNP _ none; type _ typeANY END ELSE BEGIN subAttr _ UpdateTreeAttr[v]; type _ OperandType[v] END; END; TestTree[t, void] => BEGIN v _ Tree.Null; [] _ FreeTree[t]; subAttr _ VoidAttr; phraseNP _ none; type _ typeANY; END; ENDCASE => BEGIN v _ Rhs[t, cType]; subAttr _ RAttr[]; type _ RType[]; RPop[]; END; IF v = Tree.Null AND ~Voidable[componentType] THEN Log.ErrorSei[elision, IF seb[componentType].seTag=id THEN LOOPHOLE[componentType] ELSE dataPtr.seAnon]; IF ~subAttr.noXfer THEN v _ Safen[v, type]; exitNP _ MergeNP[exitNP][phraseNP]; attr _ And[attr, subAttr]; RETURN END; IF KeyedList[son[2]] OR (son[2] = Tree.Null AND seb[TargetType[iType]].typeTag = enumerated) THEN BEGIN keyType: CSEIndex = TargetType[iType]; vCtx: CTXIndex; first, last: ISEIndex; KeyFillCheck: PROCEDURE [sei: ISEIndex] RETURNS [t: Tree.Link] = BEGIN IF Defaultable[componentType] THEN t _ Tree.Null ELSE BEGIN Log.ErrorHti[omittedKey, seb[sei].hash]; t _ [symbol[index: dataPtr.seAnon]]; END; RETURN END; WITH seb[keyType] SELECT FROM enumerated => BEGIN vCtx _ valueCtx; IF ctxb[vCtx].ctxType = included THEN Copier.CompleteContext[LOOPHOLE[vCtx], FALSE]; IF ~ContextComplete[vCtx] THEN Log.Error[keys] ELSE BEGIN [first, last] _ Span[iType]; IF first # Symbols.ISENull AND last # Symbols.ISENull AND seb[first].idValue <= seb[last].idValue THEN son[2] _ PopKeyList[ArrangeKeys[ son[2], valueCtx, first, NextSe[last], KeyFillCheck]] ELSE Log.Error[keys]; END; END; ENDCASE => Log.Error[keys]; END; attr _ FullAttr; exitNP _ none; son[2] _ UpdateList[son[2], MapValue]; name _ rowcons; info _ aType; RPush[aType, attr]; phraseNP _ exitNP; END; All: PUBLIC PROCEDURE [node: Tree.Index, target: CSEIndex] = BEGIN OPEN tb[node]; t: Tree.Link = son[1]; l: CARDINAL = ListLength[t]; attr: Attr; SELECT l FROM 0, 1 => BEGIN WITH seb[target] SELECT FROM array => BEGIN cType: CSEIndex = TargetType[UnderType[componentType]]; SELECT TRUE FROM (t = Tree.Null) => IF (son[1] _ DefaultInit[componentType]) = Tree.Null THEN BEGIN attr _ VoidAttr; phraseNP _ none END ELSE attr _ UpdateTreeAttr[son[1]]; TestTree[t, void] => BEGIN son[1] _ Tree.Null; [] _ FreeTree[t]; attr _ VoidAttr; phraseNP _ none; END; ENDCASE => BEGIN son[1] _ Rhs[t, cType]; attr _ RAttr[]; RPop[] END; IF son[1] = Tree.Null AND ~Voidable[componentType] THEN Log.ErrorSei[elision, IF seb[componentType].seTag=id THEN LOOPHOLE[componentType] ELSE dataPtr.seAnon]; attr.const _ FALSE; END; ENDCASE => BEGIN Log.ErrorNode[noTarget, node]; son[1] _ VoidExp[son[1]]; attr _ EmptyAttr; END; END; ENDCASE => BEGIN Log.ErrorN[listLong, l-1]; son[1] _ UpdateList[son[1], VoidExp]; attr _ EmptyAttr; END; RPush[target, attr]; END; CheckInline: PROCEDURE [node: Tree.Index, attr: Attr] = BEGIN bti: Symbols.CBTIndex = BodyForTree[tb[node].son[1]]; IF bti # Symbols.CBTNull AND bb[bti].inline THEN WITH body: bb[bti].info SELECT FROM Internal => BEGIN PushTree[tb[node].son[1]]; PushTree[[subtree[index: body.thread]]]; PushNode[thread, 2]; SetInfo[passPtr.enclosingBody]; tb[node].son[1] _ PopTree[]; body.thread _ node; tb[node].attr3 _ attr.noXfer AND attr.noAssign; END; ENDCASE => ERROR; END; BodyForTree: PROCEDURE [t: Tree.Link] RETURNS [Symbols.CBTIndex] = BEGIN sei: ISEIndex; node, subNode: Tree.Index; WITH t SELECT FROM symbol => BEGIN sei _ index; SELECT TRUE FROM seb[sei].mark4 => RETURN [ IF seb[sei].constant THEN seb[sei].idInfo ELSE Symbols.CBTNull]; seb[sei].immutable => BEGIN node _ seb[sei].idValue; WITH tb[node].son[3] SELECT FROM subtree => BEGIN subNode _ index; IF tb[subNode].name = body THEN RETURN [tb[subNode].info]; END; ENDCASE; END; ENDCASE; END; subtree => BEGIN node _ index; SELECT tb[node].name FROM cdot => RETURN [BodyForTree[tb[node].son[2]]]; ENDCASE; END; ENDCASE; RETURN [Symbols.CBTNull] END; Assignment: PUBLIC PROCEDURE [node: Tree.Index] = BEGIN OPEN tb[node]; lhsType, rhsType: CSEIndex; attr: Attr; saveNP: NPUse; son[1] _ Exp[son[1], typeANY]; saveNP _ phraseNP; lhsType _ RType[]; attr _ RAttr[]; RPop[]; son[2] _ Rhs[son[2], TargetType[lhsType]]; IF seb[lhsType].typeTag = union THEN IF ~Types.Assignable[ [own, DiscriminatedType[typeANY, son[1]]], [own, DiscriminatedType[typeANY, son[2]]]] THEN Log.ErrorTree[typeClash, son[2]]; rhsType _ RType[]; attr _ And[RAttr[], attr]; RPop[]; attr.noAssign _ FALSE; phraseNP _ MergeNP[phraseNP][saveNP]; RPush[rhsType, attr]; IF ~OperandLhs[son[1]] THEN Log.ErrorTree[nonLHS, son[1]]; END; Extract: PUBLIC PROCEDURE [node: Tree.Index] = BEGIN OPEN tb[node]; type: CSEIndex; ctx: CTXIndex; sei: ISEIndex; nL, nR: CARDINAL; saveRecord: RecordSEIndex = passPtr.implicitRecord; saveAttr: Attr = passPtr.implicitAttr; saveNP: NPUse; FillNull: PROCEDURE [ISEIndex] RETURNS [Tree.Link] = BEGIN RETURN [Tree.Null] END; PushItem: Tree.Map = BEGIN PushTree[t]; RETURN [Tree.Null] END; Extractor: PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] = INLINE BEGIN RETURN [TestTree[t, apply] AND tb[GetNode[t]].son[1] = Tree.Null] END; AssignItem: Tree.Map = BEGIN saveType: CSEIndex = passPtr.implicitType; IF t = Tree.Null THEN v _ Tree.Null ELSE BEGIN passPtr.implicitType _ IF sei = SENull THEN typeANY ELSE UnderType[seb[sei].idType]; IF Extractor[t] THEN BEGIN subNode: Tree.Index = GetNode[t]; PushTree[tb[subNode].son[2]]; tb[subNode].son[2] _ Tree.Null; FreeNode[subNode]; PushTree[Tree.Null]; v _ MakeNode[extract, 2]; Extract[GetNode[v]]; END ELSE BEGIN PushTree[t]; PushTree[Tree.Null]; v _ MakeNode[assign, 2]; Assignment[GetNode[v]]; RPop[]; END; saveNP _ MergeNP[saveNP][phraseNP]; END; IF sei # SENull THEN sei _ NextSe[sei]; passPtr.implicitType _ saveType; RETURN END; son[2] _ Exp[son[2], typeANY]; type _ RType[]; passPtr.implicitAttr _ RAttr[]; RPop[]; saveNP _ phraseNP; IF type = SENull THEN BEGIN Log.ErrorTree[typeClash, son[2]]; type _ typeANY; nR _ 0; sei _ Symbols.ISENull; END ELSE BEGIN type _ TypeRoot[type]; WITH seb[type] SELECT FROM record => BEGIN CompleteRecord[LOOPHOLE[type, RecordSEIndex]]; IF ContextComplete[fieldCtx] THEN BEGIN passPtr.implicitRecord _ LOOPHOLE[type, RecordSEIndex]; ctx _ fieldCtx; sei _ FirstVisibleSe[ctx]; nR _ VisibleCtxEntries[ctx]; END ELSE BEGIN Log.Error[noAccess]; type _ typeANY; nR _ 0; sei _ Symbols.ISENull; END; END; ENDCASE => BEGIN IF type # typeANY THEN Log.ErrorTree[typeClash, son[2]]; type _ typeANY; nR _ 0; sei _ Symbols.ISENull; END; END; IF KeyedList[son[1]] AND type # typeANY THEN nL _ ArrangeKeys[ son[1], ctx, FirstVisibleSe[ctx], Symbols.ISENull, FillNull] ELSE BEGIN nL _ ListLength[son[1]]; son[1] _ FreeTree[UpdateList[son[1], PushItem]]; IF nL > nR AND type # typeANY THEN Log.ErrorN[listLong, nL-nR]; THROUGH (nL .. nR] DO PushTree[Tree.Null] ENDLOOP; nL _ MAX[nL, nR]; END; PushTree[UpdateList[MakeList[nR], AssignItem]]; PushNode[exlist, 1]; SetInfo[type]; son[1] _ PopTree[]; phraseNP _ saveNP; passPtr.implicitRecord _ saveRecord; passPtr.implicitAttr _ saveAttr; END; END.