-- file Pass4D.Mesa -- last modified by Satterthwaite, December 20, 1979 1:37 PM DIRECTORY AltoDefs: FROM "altodefs" USING [charlength, wordlength], ComData: FROM "comdata" USING [ definitionsOnly, mainBody, mainCtx, textIndex, typeCARDINAL, typeCONDITION, typeLOCK], ControlDefs: FROM "controldefs" USING [GFTIndex, globalbase, localbase], LiteralOps: FROM "literalops" USING [Find, FindDescriptor], Log: FROM "log" USING [Error, ErrorSei, ErrorTree, Warning], P4: FROM "p4" USING [ Repr, none, signed, unsigned, both, other, Mark, BitsForType, ConstantInterval, EmptyInterval, Interval, LayoutArgs, LayoutFields, MakeEPLink, NeutralExp, PushAssignment, Rhs, StructuredLiteral, TreeLiteral, TreeLiteralValue, VPop, VRep], Symbols: FROM "symbols" USING [seType, ctxType, bodyType, ExtensionType, SEIndex, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, CBTIndex, SENull, BTNull, codeANY, codeCHARACTER, codeINTEGER, lZ, lG, typeANY], SymbolOps: FROM "symbolops" USING [ Cardinality, ConstantId, CtxEntries, EnterExtension, FindExtension, LinkMode, NextSe, NormalType, UnderType, WordsForType], Table: FROM "table" USING [Base, Notifier], Tree: FROM "tree" USING [treeType, Index, Link, Map, Scan, Null], TreeOps: FROM "treeops" USING [ CopyTree, FreeNode, FreeTree, GetNode, IdentityMap, ListHead, ListLength, PopTree, PushList, PushLit, PushNode, PushTree, ScanList, SetAttr, SetInfo, TestTree, UpdateList]; Pass4D: PROGRAM IMPORTS Log, LiteralOps, P4, SymbolOps, TreeOps, dataPtr: ComData EXPORTS P4 = BEGIN OPEN TreeOps, SymbolOps, Symbols; 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) DeclNotify: PUBLIC Table.Notifier = BEGIN -- called by allocator whenever table area is repacked tb _ base[Tree.treeType]; seb _ base[seType]; ctxb _ base[ctxType]; bb _ base[bodyType]; END; VarInit: PUBLIC SIGNAL RETURNS [BOOLEAN] = CODE; OwnGfi: ControlDefs.GFTIndex = 1; DeclItem: PUBLIC PROCEDURE [item: Tree.Link] = BEGIN node: Tree.Index = GetNode[item]; type: CSEIndex; expNode: Tree.Index; initFlag, eqFlag: BOOLEAN; ExpInit: PROCEDURE = BEGIN OPEN tb[node]; val, info: UNSPECIFIED; t: Tree.Link; son[3] _ P4.Rhs[son[3], type]; IF eqFlag THEN BEGIN t _ son[3]; WHILE TestTree[t, cast] DO WITH t SELECT FROM subtree => t _ tb[index].son[1]; ENDCASE; ENDLOOP; IF P4.TreeLiteral[t] THEN BEGIN val _ P4.TreeLiteralValue[t]; info _ BTNull; GO TO define END; IF ConstInit[t] THEN BEGIN WITH t SELECT FROM subtree => tb[index].info _ type; ENDCASE; AugmentSEValue[son[1], value, t, FALSE]; son[3] _ Tree.Null; val _ 0; info _ BTNull; GO TO define END; IF seb[type].typeTag = transfer THEN WITH t SELECT FROM symbol => BEGIN sei: ISEIndex = index; IF seb[sei].constant THEN BEGIN IF seb[sei].extended THEN AugmentSEValue[son[1], form, FindExtension[sei].tree, TRUE]; val _ seb[sei].idValue; info _ seb[sei].idInfo; GO TO define END; END; ENDCASE; DefineSEVar[son[1]]; EXITS define => BEGIN DefineSEValue[son[1], val, info]; son[3] _ FreeTree[son[3]]; END; END; SELECT seb[NormalType[type]].typeTag FROM pointer, arraydesc, relative => IF ListLength[son[1]] # 1 AND son[3] # Tree.Null AND ~P4.TreeLiteral[son[3]] AND ~TestTree[son[3], mwconst] THEN Log.Warning[pointerInit]; ENDCASE; P4.VPop[]; END; saveIndex: CARDINAL = dataPtr.textIndex; IF tb[node].attr3 = P4.Mark THEN RETURN; -- already processed tb[node].attr3 _ P4.Mark; dataPtr.textIndex _ tb[node].info; initFlag _ tb[node].son[3] # Tree.Null; IF tb[node].name = typedecl THEN BEGIN ENABLE VarInit => RESUME [FALSE]; TypeExp[tb[node].son[2]]; CheckDefaults[item]; END ELSE BEGIN OPEN tb[node]; IF ~initFlag THEN BEGIN IF son[2] # Tree.Null THEN TypeExp[son[2]]; type _ TypeForDecl[node]; WITH seb[type] SELECT FROM record => IF FrameVars[son[1]] AND (type = dataPtr.typeLOCK OR type = dataPtr.typeCONDITION) THEN son[3] _ ProcessInit[type]; transfer => IF mode = port THEN BEGIN PushNode[portinit, 0]; SetInfo[type]; son[3] _ PopTree[]; END; ENDCASE; END ELSE BEGIN eqFlag _ attr1; IF son[2] # Tree.Null THEN TypeExp[son[2], TestTree[son[3],body]]; type _ TypeForDecl[node]; WITH son[3] SELECT FROM symbol, literal => ExpInit[]; subtree => BEGIN expNode _ index; SELECT tb[expNode].name FROM body, procinit => BEGIN bti: CBTIndex = tb[expNode].info; IF eqFlag THEN BEGIN IF tb[expNode].attr3 -- inline THEN BEGIN DefineSEValue[son[1], 0, bti]; IF dataPtr.definitionsOnly THEN AugmentSEValue[son[1], form, TrimTree[son[3]], FALSE]; END ELSE DefineSEValue[ son[1], P4.MakeEPLink[bb[bti].entryIndex, OwnGfi], bti]; son[3] _ Tree.Null; END ELSE BEGIN PushNode[body, 0]; SetInfo[bti]; son[3] _ PopTree[]; END; END; signalinit => IF eqFlag THEN BEGIN DefineSEValue[ son[1], P4.MakeEPLink[tb[expNode].info, OwnGfi], dataPtr.mainBody]; son[3] _ FreeTree[son[3]]; END; stringinit => BEGIN OPEN exp: tb[expNode]; IF ListLength[son[1]] # 1 THEN Log.Warning[pointerInit]; exp.son[2] _ P4.Rhs[exp.son[2], dataPtr.typeCARDINAL]; P4.VPop[]; END; inline => BEGIN tb[expNode].son[1] _ UpdateList[tb[expNode].son[1], InlineOp]; DefineSEValue[son[1], 0, BTNull]; AugmentSEValue[son[1], value, son[3], FALSE]; son[3] _ Tree.Null; END; ENDCASE => ExpInit[]; END; ENDCASE; END; END; MarkAndCheckSE[tb[node].son[1], initFlag]; dataPtr.textIndex _ saveIndex; END; TypeForDecl: PROCEDURE [node: Tree.Index] RETURNS [CSEIndex] = BEGIN type: SEIndex; t: Tree.Link; IF tb[node].son[2] # Tree.Null THEN type _ TypeForTree[tb[node].son[2]] ELSE BEGIN t _ ListHead[tb[node].son[1]]; type _ WITH t SELECT FROM symbol=>seb[index].idType, ENDCASE=>ERROR; END; RETURN [UnderType[type]] END; FrameVars: PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] = BEGIN s: Tree.Link = ListHead[t]; RETURN [WITH s SELECT FROM symbol => SELECT ctxb[seb[index].idCtx].level FROM lZ => FALSE, lG => ~dataPtr.definitionsOnly, ENDCASE => TRUE, ENDCASE => FALSE] END; ConstInit: PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] = BEGIN RETURN [IF ~TestTree[t, all] THEN P4.StructuredLiteral[t] ELSE ConstInit[tb[GetNode[t]].son[1]]] END; ProcessInit: PROCEDURE [type: CSEIndex] RETURNS [Tree.Link] = BEGIN condInit: ARRAY [0..2) OF WORD _ [0, 100]; SELECT type FROM dataPtr.typeLOCK => BEGIN PushLit[LiteralOps.Find[100000B]]; PushNode[cast, 1] END; dataPtr.typeCONDITION => BEGIN PushLit[LiteralOps.FindDescriptor[DESCRIPTOR[condInit]]]; PushNode[mwconst, 1]; END; ENDCASE => ERROR; SetInfo[type]; RETURN [PopTree[]] END; InlineOp: Tree.Map = BEGIN RETURN [UpdateList[t, P4.NeutralExp]] END; DefineSEVar: PROCEDURE [ids: Tree.Link] = BEGIN UpdateSE: Tree.Scan = BEGIN WITH t SELECT FROM symbol => seb[index].constant _ FALSE; ENDCASE => ERROR; END; ScanList[ids, UpdateSE]; END; DefineSEValue: PROCEDURE [ids: Tree.Link, value, info: UNSPECIFIED] = BEGIN UpdateSE: Tree.Scan = BEGIN sei: ISEIndex; WITH t SELECT FROM symbol => BEGIN sei _ index; seb[sei].constant _ TRUE; seb[sei].idValue _ value; seb[sei].idInfo _ info; END; ENDCASE => ERROR; END; ScanList[ids, UpdateSE]; END; AugmentSEValue: PROCEDURE [ ids: Tree.Link, type: ExtensionType, extension: Tree.Link, copy: BOOLEAN] = BEGIN UpdateSE: Tree.Scan = BEGIN WITH t SELECT FROM symbol => EnterExtension[index, type, IF copy THEN IdentityMap[extension] ELSE extension]; ENDCASE => ERROR; copy _ TRUE; END; ScanList[ids, UpdateSE]; END; MarkAndCheckSE: PROCEDURE [t: Tree.Link, initialized: BOOLEAN] = BEGIN UpdateSE: Tree.Scan = BEGIN sei: ISEIndex; WITH t SELECT FROM symbol => BEGIN sei _ index; seb[sei].mark4 _ TRUE; IF dataPtr.definitionsOnly THEN CheckDefinition[sei, initialized]; END; ENDCASE => ERROR; END; ScanList[t, UpdateSE]; END; CheckDefinition: PROCEDURE [sei: ISEIndex, initialized: BOOLEAN] = BEGIN SELECT seb[sei].idCtx FROM dataPtr.mainCtx => SELECT LinkMode[sei] FROM val => IF ~initialized OR seb[sei].extended THEN RETURN; ref => IF ~initialized THEN RETURN; manifest => IF ConstantId[sei] THEN RETURN; ENDCASE; ENDCASE => RETURN; Log.ErrorSei[nonDefinition, sei]; END; CheckDefaults: PROCEDURE [t: Tree.Link] = BEGIN TestDefault: Tree.Map = BEGIN IF TestTree[t, void] THEN v _ t ELSE BEGIN v _ P4.NeutralExp[t]; IF ~(ConstInit[v] OR (SIGNAL VarInit[])) THEN Log.ErrorTree[nonConstant, v]; END; RETURN END; TestDefaults: Tree.Scan = BEGIN node: Tree.Index = GetNode[t]; saveIndex: CARDINAL = dataPtr.textIndex; id: Tree.Link = ListHead[tb[node].son[1]]; sei: ISEIndex = WITH id SELECT FROM symbol => index, ENDCASE => ERROR; dataPtr.textIndex _ tb[node].info; IF seb[sei].extended THEN [] _ FreeTree[ UpdateList[ CopyTree[[@tb, FindExtension[sei].tree], IdentityMap], TestDefault]]; dataPtr.textIndex _ saveIndex; END; IF dataPtr.definitionsOnly THEN ScanList[t, TestDefaults]; END; TrimTree: Tree.Map = BEGIN node: Tree.Index; WITH t SELECT FROM subtree => BEGIN node _ index; SELECT tb[node].name FROM body => BEGIN OPEN tb[node]; PushTree[TrimTree[son[1]]]; PushTrimDecls[son[2]]; PushTree[TrimTree[son[3]]]; PushTree[TrimTree[son[4]]]; PushNode[body, 4]; SetInfo[info]; SetAttr[1, attr1]; SetAttr[2, attr2]; SetAttr[3, attr3]; v _ PopTree[]; END; block => BEGIN OPEN tb[node]; PushTrimDecls[son[1]]; PushTree[TrimTree[son[2]]]; PushNode[block, 2]; SetInfo[info]; SetAttr[1, attr1]; SetAttr[2, attr2]; SetAttr[3, attr3]; v _ PopTree[]; END; cdot => v _ TrimTree[tb[node].son[2]]; ENDCASE => v _ CopyTree[[@tb, t], TrimTree]; END; ENDCASE => v _ t; RETURN END; PushTrimDecls: PROCEDURE [t: Tree.Link] = BEGIN n: CARDINAL; PushDecl: Tree.Scan = BEGIN node: Tree.Index = GetNode[t]; SELECT tb[node].name FROM typedecl => NULL; decl => IF tb[node].son[3] # Tree.Null THEN BEGIN OPEN tb[node]; PushTree[TrimTree[son[1]]]; PushTree[Tree.Null]; PushTree[TrimTree[son[3]]]; PushNode[decl, 3]; SetInfo[info]; SetAttr[1, attr1]; SetAttr[2, attr2]; SetAttr[3, ~P4.Mark]; n _ n+1; END; ENDCASE => ERROR; END; n _ 0; ScanList[t, PushDecl]; PushList[n]; END; DeclUpdate: PUBLIC PROCEDURE [item: Tree.Link] RETURNS [update: Tree.Link] = BEGIN node: Tree.Index = GetNode[item]; IF tb[node].name = typedecl OR tb[node].son[3] = Tree.Null THEN update _ Tree.Null ELSE BEGIN OPEN tb[node]; P4.PushAssignment[son[1], son[3], UnderType[TypeForTree[son[2]]]]; SetInfo[info]; update _ PopTree[]; son[3] _ Tree.Null; END; FreeNode[node]; RETURN END; TypeExp: PUBLIC PROCEDURE [typeExp: Tree.Link, body: BOOLEAN _ FALSE] = BEGIN -- body => arg records subsumed by frame node: Tree.Index; sei: CSEIndex; WordLength: CARDINAL = AltoDefs.wordlength; ByteLength: CARDINAL = AltoDefs.charlength; WITH typeExp SELECT FROM symbol => BEGIN iSei: ISEIndex = index; IF ~seb[iSei].mark4 THEN DeclItem[Tree.Link[subtree[index: seb[iSei].idValue]]]; END; subtree => BEGIN node _ index; SELECT tb[node].name FROM discrimTC => TypeExp[tb[node].son[1]]; cdot => TypeExp[tb[node].son[2]]; frameTC => NULL; ENDCASE => BEGIN OPEN tb[node]; sei _ info; IF ~seb[sei].mark4 THEN WITH type: seb[sei] SELECT FROM enumerated => NULL; record => BEGIN ENABLE VarInit => RESUME [FALSE]; ScanList[son[1], DeclItem]; WITH type SELECT FROM notLinked => P4.LayoutFields[LOOPHOLE[sei, RecordSEIndex], 0]; ENDCASE; ExtractFieldAttributes[LOOPHOLE[sei, RecordSEIndex]]; CheckDefaults[son[1]]; END; pointer => IF TypeConstructor[son[1]] THEN TypeExp[son[1]]; array => BEGIN IF son[1] # Tree.Null THEN TypeExp[son[1]]; TypeExp[son[2]]; type.comparable _ ComparableType[UnderType[type.componentType]]; END; arraydesc => IF TypeConstructor[son[1]] THEN TypeExp[son[1]]; transfer => BEGIN origin, newOrigin: CARDINAL; rSei: RecordSEIndex; origin _ SELECT type.mode FROM program => ControlDefs.globalbase, signal, error => ControlDefs.localbase+1, procedure => ControlDefs.localbase, ENDCASE => 0; ScanList[son[1], DeclItem]; CheckDefaults[son[1]]; rSei _ type.inRecord; IF rSei # SENull THEN BEGIN newOrigin _ P4.LayoutArgs[rSei, origin, body]; seb[rSei].length _ (newOrigin - origin)*WordLength; seb[rSei].mark4 _ TRUE; origin _ newOrigin; END; ScanList[son[2], DeclItem]; CheckDefaults[son[2]]; rSei _ type.outRecord; IF rSei # SENull THEN BEGIN seb[rSei].length _ (P4.LayoutArgs[rSei, origin, body] - origin)*WordLength; seb[rSei].mark4 _ TRUE; END; END; definition => NULL; union => BEGIN DeclItem[son[1]]; ProcessVariants[UnderType[seb[type.tagSei].idType], son[2]]; END; relative => BEGIN IF TypeConstructor[son[1]] THEN TypeExp[son[1]]; IF TypeConstructor[son[2]] THEN TypeExp[son[2]]; END; subrange => BEGIN subNode: Tree.Index; tSei: CSEIndex = UnderType[type.rangeType]; TypeExp[son[1]]; subNode _ GetNode[son[2]]; IF P4.Interval[subNode, 0, P4.both] THEN [type.origin, type.range] _ P4.ConstantInterval[subNode ! P4.EmptyInterval => BEGIN type.empty _ TRUE; RESUME END] ELSE type.origin _ type.range _ 0; type.filled _ TRUE; SELECT P4.VRep[] FROM P4.none => Log.ErrorTree[mixedRepresentation, son[2]]; P4.unsigned => IF type.origin < 0 THEN Log.Error[subrangeNesting]; ENDCASE; P4.VPop[]; WITH cover: seb[tSei] SELECT FROM subrange => -- incomplete test IF type.origin < cover.origin OR (~type.empty AND type.range > cover.range) THEN Log.Error[subrangeNesting]; ENDCASE => NULL; son[2] _ FreeTree[son[2]]; END; long => TypeExp[son[1]]; ENDCASE => ERROR; seb[sei].mark4 _ TRUE; END; END; ENDCASE => ERROR; END; TypeConstructor: PROCEDURE [t: Tree.Link] RETURNS [BOOLEAN] = BEGIN RETURN [WITH t SELECT FROM subtree => SELECT tb[index].name FROM dot, cdot, discrimTC => FALSE, ENDCASE => TRUE, ENDCASE => FALSE] END; ExtractFieldAttributes: PROCEDURE [rType: RecordSEIndex] = BEGIN -- compatibility version sei: ISEIndex; type: CSEIndex; comparable, privateFields: BOOLEAN; comparable _ TRUE; privateFields _ FALSE; FOR sei _ ctxb[seb[rType].fieldCtx].seList, NextSe[sei] UNTIL sei = SENull DO IF ~seb[sei].public THEN privateFields _ TRUE; type _ UnderType[seb[sei].idType]; WITH t: seb[type] SELECT FROM record => IF ~t.hints.comparable AND ~ComparableType[type] THEN comparable _ FALSE; array => IF ~t.comparable AND ~ComparableType[type] THEN comparable _ FALSE; union => IF ~t.equalLengths THEN comparable _ FALSE; ENDCASE; ENDLOOP; seb[rType].hints.comparable _ comparable; seb[rType].hints.privateFields _ privateFields; END; ProcessVariants: PROCEDURE [tagType: CSEIndex, list: Tree.Link] = BEGIN lb, ub: CARDINAL; CheckTag: Tree.Scan = BEGIN sei: ISEIndex = WITH t SELECT FROM symbol => index, ENDCASE => ERROR; tag: CARDINAL = seb[sei].idValue; IF tag ~IN [lb .. ub) THEN Log.ErrorSei[boundsFault, sei]; seb[sei].idValue _ tag - lb; END; ProcessVariant: Tree.Scan = BEGIN saveIndex: CARDINAL = dataPtr.textIndex; node: Tree.Index = GetNode[t]; dataPtr.textIndex _ tb[node].info; ScanList[tb[node].son[1], CheckTag]; DeclItem[t]; dataPtr.textIndex _ saveIndex; END; lb _ BiasForType[tagType]; ub _ lb + Cardinality[tagType]; ScanList[list, ProcessVariant]; END; TypeForTree: PUBLIC PROCEDURE [t: Tree.Link] RETURNS [SEIndex] = BEGIN RETURN [WITH t SELECT FROM symbol => index, subtree => tb[index].info, ENDCASE => typeANY] END; BiasForType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [INTEGER] = BEGIN ctx: CTXIndex; IF type = SENull THEN RETURN [0]; DO WITH seb[type] SELECT FROM subrange => RETURN [origin]; record => BEGIN ctx _ fieldCtx; IF ~hints.unifield OR CtxEntries[ctx] # 1 THEN RETURN [0]; type _ UnderType[seb[ctxb[ctx].seList].idType]; END; ENDCASE => RETURN [0] ENDLOOP; END; RepForType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [P4.Repr] = BEGIN ctx: CTXIndex; IF type = SENull THEN RETURN [P4.none]; DO WITH seb[type] SELECT FROM basic => RETURN [SELECT code FROM codeANY => P4.both + P4.other, codeINTEGER => P4.signed, codeCHARACTER => P4.both, ENDCASE => P4.other]; enumerated => RETURN [P4.both]; pointer => RETURN [P4.unsigned]; record => BEGIN ctx _ fieldCtx; IF ~hints.unifield OR CtxEntries[ctx] # 1 THEN RETURN [P4.other]; type _ UnderType[seb[ctxb[ctx].seList].idType]; END; relative => type _ UnderType[offsetType]; subrange => RETURN [IF origin >= 0 THEN (IF CARDINAL[origin] + range > 77777B THEN P4.unsigned ELSE P4.both) ELSE (IF range <= 77777B THEN P4.signed ELSE P4.none)]; long => type _ UnderType[rangeType]; ENDCASE => RETURN [P4.other] ENDLOOP; END; WordsForType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [nW: CARDINAL] = BEGIN WordLength: CARDINAL = AltoDefs.wordlength; IF ~seb[type].mark4 THEN nW _ (P4.BitsForType[type]+(WordLength-1))/WordLength ELSE BEGIN WITH seb[type] SELECT FROM record => lengthUsed _ TRUE; array => lengthUsed _ TRUE; ENDCASE => NULL; nW _ SymbolOps.WordsForType[type]; END; RETURN END; ComparableType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [BOOLEAN] = BEGIN -- compatibility version RETURN [WITH seb[type] SELECT FROM record => hints.comparable OR (~hints.variant OR ComparableUnion[LOOPHOLE[type]]), array => comparable OR ComparableType[UnderType[componentType]], ENDCASE => TRUE] END; ComparableUnion: PROCEDURE [rType: RecordSEIndex] RETURNS [BOOLEAN] = BEGIN sei: ISEIndex; type: CSEIndex; FOR sei _ ctxb[seb[rType].fieldCtx].seList, NextSe[sei] UNTIL sei = SENull DO type _ UnderType[seb[sei].idType]; WITH seb[type] SELECT FROM union => RETURN [equalLengths]; ENDCASE; ENDLOOP; RETURN [FALSE] END; END.