DIRECTORY A3: TYPE USING [BaseType, CanonicalType, LongPath, OperandLhs, OperandType, OrderedType, TargetType, TypeForTree], Alloc: TYPE USING [Notifier], ComData: TYPE USING [idCARDINAL, idCHAR, idINT, typeStringBody], Copier: TYPE USING [SEToken, nullSEToken, CtxFirst, CtxNext, CtxValue], Log: TYPE USING [Error, ErrorN, ErrorNode, ErrorNodeOp, ErrorTree, ErrorTreeOp], P3: TYPE USING [Attr, fullAttr, NPUse, MergeNP, phraseNP, And, Exp, ForceType, Interval, MakeLongType, MakeRefType, RAttr, Rhs, RPop, RPush, RType, SequenceField, TypeExp, VoidExp], P3S: TYPE USING [safety], Symbols: TYPE USING [Base, SERecord, Type, ISEIndex, CSEIndex, CTXIndex, nullType, ISENull, typeANY, seType], SymbolOps: TYPE USING [EqTypes, MakeNonCtxSe, NormalType, RCType, ReferentType, TypeForm, UnderType], Tree: TYPE USING [Base, Index, Link, Null, treeType], TreeOps: TYPE USING [FreeNode, GetNode, IdentityMap, ListLength, NthSon, OpName, PopTree, PushSe, PushTree, PushNode, SetAttr, SetInfo, UpdateList]; Pass3Xc: PROGRAM IMPORTS A3, Copier, Log, P3, P3S, SymbolOps, TreeOps, dataPtr: ComData EXPORTS P3 = { OPEN SymbolOps, Symbols, TreeOps, A3, P3; tb: Tree.Base; -- tree base address (local copy) seb: Symbols.Base; -- se table base address (local copy) ExpCNotify: PUBLIC Alloc.Notifier = { seb _ base[seType]; tb _ base[Tree.treeType]}; Range: PUBLIC PROC[t: Tree.Link, type: Type] RETURNS[val: Tree.Link] = { subType: Type; SELECT OpName[t] FROM subrangeTC => { val _ RewriteSubrange[GetNode[t]]; Interval[val, IF type # typeANY THEN type ELSE dataPtr.idINT, FALSE]}; IN [intOO .. intCC] => { val _ t; Interval[val, IF type # typeANY THEN type ELSE dataPtr.idINT, FALSE]}; ENDCASE => IF TypeForm[type] # $long THEN { val _ TypeExp[t]; RPush[TargetType[TypeForTree[val]], fullAttr]; phraseNP _ none} ELSE { val _ MakeEndPoints[t]; Interval[val, type, FALSE]}; subType _ RType[]; IF ~OrderedType[subType] AND subType # typeANY THEN Log.Error[nonOrderedType]; RETURN}; RewriteSubrange: PROC[node: Tree.Index] RETURNS[Tree.Link] = { subNode: Tree.Index = GetNode[tb[node].son[2]]; PushTree[tb[subNode].son[1]]; PushTree[IdentityMap[tb[node].son[1]]]; PushNode[apply, -2]; tb[subNode].son[1] _ PopTree[]; PushTree[tb[subNode].son[2]]; PushTree[tb[node].son[1]]; PushNode[apply, -2]; tb[subNode].son[2] _ PopTree[]; tb[node].son[1] _ tb[node].son[2] _ Tree.Null; FreeNode[node]; RETURN[[subtree[subNode]]]}; MakeEndPoints: PROC[t: Tree.Link] RETURNS[Tree.Link] = { PushTree[t]; PushNode[first, 1]; PushTree[IdentityMap[t]]; PushNode[last, 1]; PushNode[intCC, 2]; RETURN[PopTree[]]}; SEToken: TYPE = Copier.SEToken; Span: PUBLIC PROC[type: CSEIndex] RETURNS[first, last: SEToken] = { subType: CSEIndex = UnderType[TargetType[type]]; vCtx: CTXIndex = WITH s: seb[subType] SELECT FROM enumerated => s.valueCtx, ENDCASE => ERROR; WITH t: seb[type] SELECT FROM enumerated => {first _ CtxFirst[vCtx]; last _ CtxLast[vCtx]}; subrange => { IF t.mark4 THEN { first _ Copier.CtxValue[vCtx, t.origin]; last _ Copier.CtxValue[vCtx, t.origin + t.range]} ELSE { node: Tree.Index = LOOPHOLE[t.range]; subNode: Tree.Index = GetNode[tb[node].son[2]]; first _ EnumeratedValue[tb[subNode].son[1], vCtx]; last _ EnumeratedValue[tb[subNode].son[2], vCtx]; SELECT tb[subNode].name FROM intOO, intOC => first _ CtxSucc[vCtx, first]; ENDCASE; SELECT tb[subNode].name FROM intOO, intCO => last _ CtxPred[vCtx, last]; ENDCASE}}; ENDCASE => first _ last _ Copier.nullSEToken; RETURN}; EnumeratedValue: PROC[t: Tree.Link, vCtx: CTXIndex] RETURNS[SEToken] = { WITH t SELECT FROM symbol => { sei: ISEIndex = index; RETURN[SELECT TRUE FROM ~seb[sei].constant => Copier.nullSEToken, (seb[sei].idCtx = vCtx) OR seb[sei].mark4 => Copier.CtxValue[vCtx, seb[sei].idValue], ENDCASE => EnumeratedValue[InitTree[sei], vCtx]]}; subtree => { node: Tree.Index = index; RETURN[SELECT tb[node].name FROM first => Span[UnderType[TypeForTree[tb[node].son[1]]]].first, last => Span[UnderType[TypeForTree[tb[node].son[1]]]].last, pred => CtxPred[vCtx, EnumeratedValue[tb[node].son[1], vCtx]], succ => CtxSucc[vCtx, EnumeratedValue[tb[node].son[1], vCtx]], ENDCASE => Copier.nullSEToken]}; ENDCASE => RETURN[Copier.nullSEToken]}; CtxFirst: PROC[ctx: CTXIndex] RETURNS[SEToken] = Copier.CtxFirst; CtxLast: PROC[ctx: CTXIndex] RETURNS[last: SEToken] = { last _ Copier.nullSEToken; FOR t: SEToken _ Copier.CtxFirst[ctx], Copier.CtxNext[ctx, t] UNTIL t = Copier.nullSEToken DO last _ t ENDLOOP; RETURN}; CtxSucc: PROC[ctx: CTXIndex, t: SEToken] RETURNS[SEToken] = Copier.CtxNext; CtxPred: PROC[ctx: CTXIndex, t: SEToken] RETURNS[pred: SEToken] = { next: SEToken; pred _ Copier.nullSEToken; IF t # Copier.nullSEToken THEN { next _ Copier.CtxFirst[ctx]; UNTIL next = t OR next = Copier.nullSEToken DO pred _ next; next _ Copier.CtxNext[ctx, next] ENDLOOP}; RETURN}; InitTree: PROC[sei: ISEIndex] RETURNS[Tree.Link] = INLINE { RETURN[tb[LOOPHOLE[seb[sei].idValue, Tree.Index]].son[3]]}; AddrOp: PUBLIC PROC[node: Tree.Index, target: Type] = { SELECT tb[node].name FROM addr => Addr[node, target]; base => Base[node, target]; length => Length[node]; arraydesc => Desc[node, target]; ENDCASE => ERROR}; Addr: PROC[node: Tree.Index, target: Type] = { OPEN tb[node]; type: Type; attr: Attr; subType: CSEIndex = NormalType[target]; var: BOOL = WITH t: seb[subType] SELECT FROM ref => t.var, ENDCASE => FALSE; counted: BOOL _ FALSE; IF P3S.safety = checked AND ~(var OR attr1) THEN Log.ErrorNodeOp[unsafeOp, node, addr]; son[1] _ Exp[son[1], typeANY]; FOR t: Tree.Link _ son[1], NthSon[t, 1] DO SELECT OpName[t] FROM uparrow => { subType: CSEIndex = NormalType[OperandType[NthSon[t, 1]]]; WITH p: seb[subType] SELECT FROM ref => IF p.counted THEN counted _ TRUE; ENDCASE; EXIT}; cast, openx => NULL; ENDCASE => EXIT; ENDLOOP; SELECT OperandLhs[son[1]] FROM counted => IF var THEN { son[1] _ SafenRef[son[1]]; IF RCType[RType[]] # none THEN Log.ErrorTree[unimplemented, son[1]]}; none => Log.ErrorTree[nonAddressable, son[1]]; ENDCASE; type _ MakeRefType[ cType: RType[], hint: subType, counted: counted AND ~var, var: var]; IF var THEN {Log.ErrorNode[unimplemented, node]; attr2 _ FALSE} ELSE IF (attr2 _ LongPath[son[1]]) THEN type _ MakeLongType[type, target]; attr _ RAttr[]; RPop[]; RPush[type, attr]}; SafenRef: PROC[t: Tree.Link] RETURNS[v: Tree.Link] = { WITH t SELECT FROM subtree => { node: Tree.Index = index; SELECT tb[node].name FROM dot, uparrow, dindex, reloc => { PushTree[tb[node].son[1]]; PushNode[safen, 1]; SetInfo[OperandType[tb[node].son[1]]]; tb[node].son[1] _ PopTree[]; v _ t}; dollar, index, seqindex, loophole, cast, openx, pad, chop => { tb[node].son[1] _ SafenRef[tb[node].son[1]]; v _ t}; cdot => { tb[node].son[2] _ SafenRef[tb[node].son[2]]; v _ t}; apply, safen => v _ t; ENDCASE => ERROR}; ENDCASE => v _ t; RETURN}; StripRelative: PROC[rType: Type] RETURNS[type, baseType: Type] = { rSei: CSEIndex = UnderType[rType]; WITH r: seb[rSei] SELECT FROM relative => {type _ r.offsetType; baseType _ r.baseType}; ENDCASE => {type _ rType; baseType _ nullType}; RETURN}; MakeRelativeType: PROC[type: Type, bType: Type, hint: Type] RETURNS[Type] = { tType: Type; rType: CSEIndex; protoType: CSEIndex = UnderType[hint]; WITH p: seb[protoType] SELECT FROM relative => IF EqTypes[p.offsetType, type] AND EqTypes[p.baseType, bType] THEN RETURN[hint]; ENDCASE; tType _ IF TypeForm[bType] = $long OR TypeForm[type] = $long THEN MakeLongType[BaseType[type], type] ELSE type; rType _ MakeNonCtxSe[SERecord.cons.relative.SIZE]; seb[rType].typeInfo _ relative[ baseType: bType, offsetType: type, resultType: tType]; seb[rType].mark3 _ seb[rType].mark4 _ TRUE; RETURN[rType]}; Base: PROC[node: Tree.Index, target: Type] = { OPEN tb[node]; type, aType, bType, subTarget: Type; nType: CSEIndex; attr: Attr; long: BOOL; IF P3S.safety = checked THEN Log.ErrorNodeOp[unsafeOp, node, base]; IF ListLength[son[1]] = 1 THEN { son[1] _ Exp[son[1], typeANY]; [aType, bType] _ StripRelative[CanonicalType[RType[]]]; attr _ RAttr[]; RPop[]; nType _ NormalType[aType]; [subTarget, ] _ StripRelative[target]; WITH n: seb[nType] SELECT FROM array => { name _ addr; IF OperandLhs[son[1]] = none THEN Log.ErrorTree[nonAddressable, son[1]]; long _ LongPath[son[1]]}; arraydesc => { long _ (TypeForm[aType] = $long); nType _ UnderType[n.describedType]; attr1 _ TRUE}; ENDCASE => IF nType # typeANY THEN Log.ErrorTreeOp[missingOp, son[1], base]} ELSE { Log.ErrorN[listLong, ListLength[son[1]]-1]; son[1] _ UpdateList[son[1], VoidExp]; long _ FALSE}; type _ MakeRefType[nType, BaseType[subTarget]]; IF (attr2 _ long) THEN type _ MakeLongType[type, subTarget]; IF bType # nullType THEN type _ MakeRelativeType[type, bType, target]; attr.const _ FALSE; RPush[type, attr]; RETURN}; Length: PROC[node: Tree.Index] = { OPEN tb[node]; type: Type; subType: CSEIndex; attr: Attr; IF ListLength[son[1]] = 1 THEN { son[1] _ Exp[son[1], typeANY]; type _ RType[]; attr _ RAttr[]; RPop[]; subType _ IF seb[type].mark3 THEN NormalType[StripRelative[CanonicalType[type]].type] ELSE typeANY; WITH seb[subType] SELECT FROM array => { IF ~EqTypes[subType, type] THEN son[1] _ ForceType[son[1], subType]; attr.const _ TRUE}; arraydesc => {attr.const _ FALSE; attr1 _ TRUE}; ENDCASE => { attr.const _ TRUE; IF type # typeANY THEN Log.ErrorTreeOp[missingOp, son[1], length]}} ELSE { attr.const _ TRUE; Log.ErrorN[listLong, ListLength[son[1]]-1]; son[1] _ UpdateList[son[1], VoidExp]}; RPush[dataPtr.idINT, attr]; RETURN}; Desc: PROC[node: Tree.Index, target: Type] = { OPEN tb[node]; type, subType: Type; attr: Attr; saveNP: NPUse; aType, bType: Type _ nullType; cType, iType: Type; fixed: {none, range, both} _ none; packed: BOOL _ FALSE; long: BOOL; subTarget: Type = StripRelative[target].type; cSei: CSEIndex; nTarget: CSEIndex = NormalType[subTarget]; IF P3S.safety = checked THEN Log.ErrorNodeOp[unsafeOp, node, arraydesc]; SELECT ListLength[son[1]] FROM 1 => { rType: Type; nType: CSEIndex; nDerefs: CARDINAL _ 0; son[1] _ Exp[son[1], typeANY]; IF OperandLhs[son[1]] = none THEN Log.ErrorTree[nonAddressable, son[1]]; long _ LongPath[son[1]]; cSei _ UnderType[CanonicalType[RType[]]]; attr _ RAttr[]; IF ~EqTypes[cSei, RType[]] THEN son[1] _ ForceType[son[1], cSei]; RPop[]; nType _ NormalType[cSei]; WHILE seb[nType].typeTag = ref AND (nDerefs _ nDerefs+1) < 64 DO long _ seb[cSei].typeTag = long; cSei _ UnderType[CanonicalType[ReferentType[nType]]]; PushTree[son[1]]; PushNode[uparrow, 1]; SetInfo[cSei]; SetAttr[2, long]; SetAttr[3, FALSE]; son[1] _ PopTree[]; nType _ NormalType[cSei]; ENDLOOP; PushTree[son[1]]; IF seb[cSei].typeTag = record THEN { sei: ISEIndex = SequenceField[LOOPHOLE[cSei]]; SELECT TRUE FROM (sei # ISENull) => { cSei _ UnderType[seb[sei].idType]; WITH s: seb[cSei] SELECT FROM sequence => { PushSe[sei]; PushNode[dollar, 2]; SetInfo[cSei]; SetAttr[2, long]}; ENDCASE => ERROR}; (cSei = dataPtr.typeStringBody) => NULL; -- fake sequence ENDCASE => { Log.ErrorTreeOp[missingOp, son[1], arraydesc]; cSei _ typeANY} }; WITH t: seb[cSei] SELECT FROM array => {rType _ aType _ OperandType[son[1]]; fixed _ both}; sequence => { rType _ cType _ t.componentType; packed _ t.packed; iType _ seb[t.tagSei].idType; fixed _ both; IF ~t.controlled THEN Log.ErrorTreeOp[missingOp, son[1], arraydesc]}; record => { -- StringBody rType _ cType _ dataPtr.idCHAR; packed _ TRUE; iType _ dataPtr.idCARDINAL; fixed _ both}; ENDCASE => { rType _ cType _ typeANY; IF cSei # typeANY THEN Log.ErrorTreeOp[missingOp, son[1], arraydesc]}; subType _ MakeRefType[rType, typeANY]; IF long THEN subType _ MakeLongType[subType, typeANY]; PushNode[addr, 1]; SetInfo[subType]; SetAttr[2, long]; son[1] _ PopTree[]}; 3 => { subNode: Tree.Index = GetNode[son[1]]; tb[subNode].son[1] _ Exp[tb[subNode].son[1], typeANY]; [subType, bType] _ StripRelative[CanonicalType[RType[]]]; attr _ RAttr[]; RPop[]; saveNP _ phraseNP; SELECT TypeForm[NormalType[subType]] FROM $basic, $ref => NULL; ENDCASE => Log.ErrorTree[typeClash, tb[subNode].son[1]]; long _ (TypeForm[subType] = $long); tb[subNode].son[2] _ Rhs[tb[subNode].son[2], dataPtr.idINT]; attr _ And[RAttr[], attr]; RPop[]; phraseNP _ MergeNP[saveNP][phraseNP]; IF tb[subNode].son[3] # Tree.Null THEN { tb[subNode].son[3] _ TypeExp[tb[subNode].son[3]]; cType _ TypeForTree[tb[subNode].son[3]]; fixed _ range}}; ENDCASE; IF aType = nullType THEN { WITH n: seb[nTarget] SELECT FROM arraydesc => { cSei _ UnderType[n.describedType]; WITH t: seb[cSei] SELECT FROM array => IF fixed = none OR (fixed = range AND EqTypes[t.componentType, cType]) THEN { aType _ n.describedType; GO TO old}; ENDCASE}; ENDCASE; GO TO new; EXITS old => NULL; new => { aType _ MakeNonCtxSe[SERecord.cons.array.SIZE]; seb[aType] _ [mark3: TRUE, mark4: TRUE, body: cons[array[ packed: packed, indexType: IF fixed < both THEN dataPtr.idCARDINAL ELSE iType, componentType: IF fixed > none THEN cType ELSE typeANY]]]}}; BEGIN WITH t: seb[nTarget] SELECT FROM arraydesc => IF EqTypes[t.describedType, aType] THEN GO TO old; ENDCASE => IF fixed = none AND target = typeANY THEN Log.ErrorNode[noTarget, node]; GO TO new; EXITS old => type _ nTarget; new => { type _ MakeNonCtxSe[SERecord.cons.arraydesc.SIZE]; seb[type] _ [mark3: TRUE, mark4: TRUE, body: cons[arraydesc[readOnly: FALSE, var: FALSE, describedType: aType]]]; }; END; IF (attr2 _ long) THEN type _ MakeLongType[type, subTarget]; IF bType # nullType THEN type _ MakeRelativeType[type, bType, target]; attr.const _ FALSE; RPush[type, attr]; RETURN}; }. 8Pass3Xc.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Satterthwaite, April 14, 1986 2:00:33 pm PST Russ Atkinson (RRA) March 6, 1985 10:47:43 pm PST called by allocator whenever table area is repacked ranges operations on enumerated types operations on addresses make type description Κ e˜codešœ ™ Kšœ Οmœ1™K˜/K˜FK˜5K˜9K˜5K˜?Kšžœ˜K˜—š  œžœžœ˜8K˜!K˜-Kšœžœ ˜(K˜K˜——Kšœ™˜Kšœ žœ˜K˜š œžœžœžœ˜CK˜0šœžœžœž˜1K˜Kšžœžœ˜—šžœžœž˜K˜=˜ šžœ žœ˜K˜(K˜1—šžœ˜Kšœžœ ˜%K˜/K˜2K˜1šžœž˜K˜-Kšžœ˜—šžœž˜K˜+Kšžœ˜ ———Kšžœ&˜-—Kšžœ˜K˜—š œžœžœ ˜Hšžœžœž˜˜ K˜šžœžœžœž˜K˜)šœžœ˜,K˜(—Kšžœ+˜2——˜ K˜šžœžœž˜ K˜=K˜;K˜>K˜>Kšžœ˜ ——Kšžœžœ˜'K˜——Kš œžœžœ˜AK˜š œžœžœ˜7K˜šžœ;žœž˜]Kšœ žœ˜—Kšžœ˜K˜—Kš œžœžœ˜KK˜š œžœžœ˜CK˜K˜šžœžœ˜ K˜šžœ žœž˜.Kšœ.žœ˜7——Kšžœ˜K˜—š œžœžœžœ˜;Kšžœžœ)˜;K˜——šœ™K˜š œžœžœ$˜7šžœž˜K˜K˜K˜K˜ Kšžœžœ˜K˜K˜——š œžœ$˜.Kšžœ ˜K˜ K˜ K˜'šœžœžœžœž˜,K˜ Kšžœžœ˜—Kšœ žœžœ˜Kšžœžœžœžœ'˜WK˜šžœ%ž˜*šžœ ž˜˜ K˜:šžœžœž˜ Kšœžœ žœ žœ˜(Kšžœ˜—Kšžœ˜—Kšœžœ˜Kšžœžœ˜—Kšžœ˜—šžœž˜˜ šžœžœ˜ K˜Kšžœžœ'˜E——K˜.Kšžœ˜—˜Kšœ0žœ˜D—Kšžœžœ.žœ˜?Kšžœžœžœ#˜JK˜-K˜—š œžœžœ˜6šžœžœž˜˜ K˜šžœž˜˜ K˜K˜:K˜%—˜>K˜4—˜ K˜4—K˜Kšžœžœ˜——Kšžœ ˜—Kšžœ˜K˜K˜—š  œžœžœ˜BKšœ"˜"šžœžœž˜Kšœ9˜9Kšžœ(˜/—Kšžœ˜K˜—š œžœ%žœ ˜MK˜ K˜K˜&šžœžœž˜"˜ Kšžœžœžœžœ˜P—Kšžœ˜—šœžœžœ˜˜>—Kšœ˜——šžœžœž˜K˜=˜ K˜4K˜,Kšžœžœ0˜E—šœ Ÿ ˜Kšœ*žœ˜/K˜+—šžœ˜ K˜Kšžœžœ0˜F——K˜&Kšžœžœ*˜6K˜N—˜K˜&K˜6K˜9K˜,šžœž˜)Kšœžœ˜Kšžœ1˜8—K˜#K˜Kšœžœžœžœ˜<—————šœ™Kšž˜šžœžœž˜ ˜ Kšžœ!žœžœžœ˜2—šžœ˜ Kšžœžœžœ˜H——Kšžœžœ˜ šž˜K˜˜Kšœ,žœ˜2šœžœ žœ˜&Kšœžœžœ˜J—Kšœ˜——Kšžœ˜—Kšžœžœ&˜