<<>> <> <> <> <> <> DIRECTORY Basics USING [BITXOR, LowHalf], ConstArith USING [Add, Compare, Const, FromCard, FromInt, Overflow, Sub, ToCard, ToInt], LiteralOps USING [Value], Literals USING [LitClass], MimData USING [base, bitsToAlignment, idCARDINAL, interface, mainCtx, textIndex], MimosaLog USING [Error, ErrorSei, ErrorTree, WarningSei], MimosaEvents USING [Callback, Register], MimP4 USING [AdjustBias, Bias, BitsForType, Bounds, CheckFields, ConstantInterval, currentLevel, EmptyInterval, ForceType, Interval, IsSize, LayoutArgs, LayoutFields, MakeEPLink, mark, nullBias, ownGfi, Prop, RepForType, Repr, RewriteAssign, Rhs, SetType, StructuredLiteral, TreeLiteral, TreeLiteralCard, TreeLiteralInt, VPop, VProp, VRep, WordsForType], MimZones USING [tempZone], MobDefs USING [Link, ModuleIndex], SourceMap USING [Loc, nullLoc], SymbolOps USING [ArgRecord, BitsPerElement, Cardinality, ConstantId, CtxEntries, CtxLevel, DecodeBti, DecodeCard, DecodeTreeIndex, DecodeType, EncodeBti, EncodeCard, EncodeLink, EnterExtension, FindExtension, FirstCtxSe, FromBti, LinkMode, NextSe, NormalType, own, RCType, SearchContext, SetCtxLevel, ToBti, ToType, TypeLink, UnderType, XferMode], Symbols USING [Base, BitCount, BitOrder, bodyType, CBTIndex, CBTNull, codeANY, codeCHAR, ContextLevel, CSEIndex, CSENull, CSEPointer, CTXIndex, ctxType, ExtensionType, ISEFirst, ISEIndex, ISENull, lG, lZ, nullType, RecordSEIndex, RecordSENull, RootBti, SEPointer, seType, Type, typeANY, TypeClass, typeTYPE, UNSPEC], Target: TYPE MachineParms USING [bitOrder, bitsPerAU, bitsPerWord, maxWord], Tree USING [Base, Index, Link, Map, NodeName, Null, Scan, treeType], TreeOps USING [CopyTree, FreeNode, FreeTree, GetNode, GetTag, IdentityMap, ListHead, ListLength, NthSon, OpName, PopTree, PushList, PushNode, PushTree, ScanList, SetAttr, SetAttrs, SetInfo, ToCard, ToLoc, UpdateList], Types USING [OpaqueValue]; Pass4D: PROGRAM IMPORTS Basics, ConstArith, LiteralOps, MimData, MimosaEvents, MimosaLog, MimP4, MimZones, SymbolOps, TreeOps, Types EXPORTS MimP4 = { OPEN Symbols, TreeOps; <> suspectFlaw: BOOL ¬ FALSE; <> Bias: TYPE = MimP4.Bias; Repr: TYPE = MimP4.Repr; ownGfi: MobDefs.ModuleIndex = MimP4.ownGfi; bitsPerAU: NAT = Target.bitsPerAU; bitsPerWord: NAT = Target.bitsPerWord; grain: NAT ¬ bitsPerAU; targetBitOrder: Symbols.BitOrder ¬ SELECT Target.bitOrder FROM msBit => msBit, lsBit => lsBit, ENDCASE => ERROR; nullValue: UNSPEC = SymbolOps.EncodeCard[0]; <> tb: Tree.Base ¬ NIL; -- tree base address (local copy) seb: Symbols.Base ¬ NIL; -- se table base address (local copy) ctxb: Symbols.Base ¬ NIL; -- context table base address (local copy) bb: Symbols.Base ¬ NIL; -- body table base address (local copy) <> TypeStack: TYPE = RECORD [ next: NAT, elems: SEQUENCE len: NAT OF Type]; typeStack: REF TypeStack ¬ NIL; <> VarInit: PUBLIC SIGNAL RETURNS [BOOL] = CODE; DeclItem: PUBLIC PROC [item: Tree.Link] = { node: Tree.Index = GetNode[item]; son1: Tree.Link = tb[node].son[1]; -- the id list son2: Tree.Link ¬ tb[node].son[2]; -- the type expression (optional) son3: Tree.Link ¬ tb[node].son[3]; -- the initialization (optional) initFlag: BOOL ¬ son3 # Tree.Null; saveIndex: SourceMap.Loc = MimData.textIndex; newIndex: SourceMap.Loc = ToLoc[tb[node].info]; checkTypeSize: BOOL ¬ FALSE; IF tb[node].attr3 = MimP4.mark THEN RETURN; -- already processed tb[node].attr3 ¬ MimP4.mark; IF newIndex # SourceMap.nullLoc THEN MimData.textIndex ¬ newIndex; IF tb[node].name = typedecl THEN { ENABLE VarInit => {RESUME[FALSE]}; TypeExp[son2]; CheckDefaults[item]; } ELSE { op: Tree.NodeName = OpName[son3]; IF son2 # Tree.Null THEN TypeExp[son2, op = body]; IF initFlag THEN { <> eqFlag: BOOL = tb[node].attr1; SELECT op FROM body, procinit => { expNode: Tree.Index = GetNode[son3]; bti: CBTIndex = LOOPHOLE[SymbolOps.ToBti[tb[expNode].info]]; IF eqFlag THEN { IF tb[expNode].attr3 THEN { <> DefineSEValue[ids: son1, info: bti]; AugmentSEValue[son1, form, IF MimData.interface THEN TrimTree[son3] ELSE Tree.Null]; } ELSE DefineSEValue[ ids: son1, value: SymbolOps.EncodeLink[ MimP4.MakeEPLink[bb[bti].entryIndex, ownGfi]], info: bti]; son3 ¬ tb[node].son[3] ¬ Tree.Null; } ELSE { PushNode[body, 0]; SetInfo[SymbolOps.FromBti[bti]]; son3 ¬ tb[node].son[3] ¬ PopTree[]; }; }; signalinit => IF eqFlag THEN { expNode: Tree.Index = GetNode[son3]; link: MobDefs.Link ¬ MimP4.MakeEPLink[ToCard[tb[expNode].info], ownGfi]; DefineSEValue[ son1, SymbolOps.EncodeLink[link], RootBti]; son3 ¬ tb[node].son[3] ¬ FreeTree[son3]; }; inline => { expNode: Tree.Index = GetNode[son3]; tb[expNode].son[1] ¬ UpdateList[tb[expNode].son[1], InlineOp]; DefineSEValue[ids: son1]; AugmentSEValue[son1, value, son3]; son3 ¬ tb[node].son[3] ¬ Tree.Null; }; ENDCASE => { type: Type = TypeForDecl[node]; ut: CSEIndex = SymbolOps.UnderType[SymbolOps.own, type]; IF MimP4.IsSize[son3] THEN ScanList[son1, MarkSize]; <> son3 ¬ tb[node].son[3] ¬ MimP4.Rhs[son3, type, $init]; <> < IF se.empty THEN { MimosaLog.ErrorTree[boundsFault, son3]; GO TO donePop; }; ENDCASE;>> IF eqFlag THEN { <> t: Tree.Link ¬ son3; prop: MimP4.Prop = MimP4.VProp[]; isTransfer: BOOL ¬ seb[ut].typeTag = transfer; WHILE OpName[t] = cast DO t ¬ NthSon[t, 1] ENDLOOP; WITH e: t SELECT GetTag[t] FROM literal => { val: Symbols.UNSPEC; class: Literals.LitClass; [class, val] ¬ LiteralOps.Value[e.index]; DefineSEValue[ids: son1, value: val]; GO TO definedFree; }; ENDCASE; SELECT SymbolOps.XferMode[SymbolOps.own, ut] FROM proc, signal, error, program => { isTransfer ¬ TRUE; WITH e: t SELECT GetTag[t] FROM symbol => { sei: ISEIndex = e.index; IF seb[sei].constant THEN { DefineSEValue[ids: son1, value: seb[sei].idValue, info: SymbolOps.DecodeBti[seb[sei].idInfo]]; IF seb[sei].extended THEN { ext: Tree.Link = SymbolOps.FindExtension[SymbolOps.own, sei].tree; AugmentSEValue[son1, form, ext, TRUE]; }; GO TO definedFree; }; }; ENDCASE; }; ENDCASE; IF (prop.noFreeVar AND prop.noXfer AND NOT isTransfer) OR OpName[t] = nil THEN { DefineSEValue[ids: son1]; AugmentSEValue[son1, value, son3]; GO TO donePop; }; DefineSEVar[ids: son1]; EXITS definedFree => son3 ¬ tb[node].son[3] ¬ FreeTree[son3]; }; MimP4.VPop[]; EXITS donePop => {son3 ¬ tb[node].son[3] ¬ Tree.Null; MimP4.VPop[]}; }; }; }; MarkAndCheckSE[son1, initFlag]; MimData.textIndex ¬ saveIndex; }; DeclUpdate: PUBLIC PROC [item: Tree.Link] RETURNS [update: Tree.Link ¬ Tree.Null] = { node: Tree.Index = GetNode[item]; IF tb[node].name # typedecl AND tb[node].son[3] # Tree.Null THEN { type: Type = TypeForDecl[node]; rewrite: BOOL = SELECT OpName[tb[node].son[3]] FROM body, signalinit => FALSE, ENDCASE => TRUE; n: CARDINAL = ListLength[tb[node].son[1]]; ScanList[tb[node].son[1], PushTree]; PushTree[tb[node].son[3]]; FOR i: CARDINAL IN [1 .. n] DO IF i = n THEN PushNode[assign, 2] ELSE {PushNode[assignx, 2]; MimP4.SetType[type]}; SetInitAttr[type, ConstInit[tb[node].son[3]]]; IF rewrite THEN PushTree[MimP4.RewriteAssign[GetNode[PopTree[]], type]]; ENDLOOP; SetInfo[tb[node].info]; update ¬ PopTree[]; tb[node].son[3] ¬ Tree.Null; }; FreeNode[node]; }; TypeExp: PUBLIC PROC [typeExp: Tree.Link, body: BOOL ¬ FALSE, avoidId: BOOL ¬ FALSE] = { < arg records subsumed by frame>> WITH typeExp SELECT GetTag[typeExp] FROM symbol => IF NOT avoidId THEN { iSei: ISEIndex = index; IF NOT seb[iSei].mark4 THEN DeclItem[[subtree[index: SymbolOps.DecodeTreeIndex[seb[iSei].idValue]]]]; }; subtree => { node: Tree.Index = index; SELECT tb[node].name FROM discrimTC => TypeExp[tb[node].son[1], FALSE, avoidId]; -- RRA: avoidId?? longTC, optionTC => TypeExp[tb[node].son[1]]; -- RRA: no avoidId?? cdot => TypeExp[tb[node].son[2], body, avoidId]; implicitTC, linkTC => NULL; frameTC => NULL; ENDCASE => { sei: CSEIndex = SymbolOps.UnderType[SymbolOps.own, SymbolOps.ToType[tb[node].info]]; IF NOT seb[sei].mark4 THEN { oldLen: NAT ¬ IF typeStack = NIL THEN 0 ELSE typeStack.next; FOR i: NAT IN [0..oldLen) DO IF typeStack[i] = sei THEN { MimosaLog.ErrorTree[circularType, typeExp]; GO TO noProcess; }; ENDLOOP; IF oldLen = 0 OR oldLen = typeStack.len THEN { <> newLen: NAT ¬ oldLen+16; newStack: REF TypeStack ¬ MimZones.tempZone.NEW[TypeStack[newLen]]; FOR i: NAT IN [0..oldLen) DO newStack[i] ¬ typeStack[i]; ENDLOOP; MimZones.tempZone.FREE[@typeStack]; typeStack ¬ newStack; }; typeStack[oldLen] ¬ sei; typeStack.next ¬ oldLen + 1; WITH type: seb[sei] SELECT FROM enumerated => IF type.machineDep THEN [empty: type.empty, range: type.range, sparse: type.sparse] ¬ LayoutEnum[tb[node].son[1], type.valueCtx]; record => { ENABLE VarInit => {RESUME[FALSE]}; son1: Tree.Link ¬ tb[node].son[1]; machineDepCons: BOOL = tb[node].attr1; oldGrain: NAT ¬ grain; oldBitOrder: Symbols.BitOrder ¬ targetBitOrder; rSei: RecordSEIndex = LOOPHOLE[sei, RecordSEIndex]; targetBitOrder ¬ type.bitOrder; grain ¬ type.grain; type.align ¬ MimData.bitsToAlignment[grain]; ScanList[son1, DeclItem]; IF machineDepCons THEN ScanList[son1, AssignPositions]; WITH st: type SELECT FROM notLinked => IF machineDepCons THEN MimP4.CheckFields[rSei, 0] ELSE MimP4.LayoutFields[rSei, 0]; ENDCASE; ExtractFieldAttributes[rSei]; CheckDefaults[son1]; targetBitOrder ¬ oldBitOrder; grain ¬ oldGrain; }; ref => { seb[sei].mark4 ¬ TRUE; <> TypeExp[tb[node].son[1], FALSE, TRUE]; }; array => { maxArraySize: CARD = BitCount.LAST/bitsPerAU; packed: BOOL = type.packed; et: Type = type.componentType; son1: Tree.Link ¬ tb[node].son[1]; IF son1 # Tree.Null THEN TypeExp[son1]; TypeExp[tb[node].son[2], FALSE, avoidId]; -- RRA: avoidId?? IF SymbolOps.Cardinality[SymbolOps.own, type.indexType] > MaxCardinality[et, packed, maxArraySize] THEN MimosaLog.Error[arraySize]; seb[sei].mark4 ¬ TRUE; <> IF packed THEN { <> nb: BitCount ¬ MimP4.BitsForType[sei]; IF nb < bitsPerWord THEN { elemBits: BitCount = SymbolOps.BitsPerElement[SymbolOps.own, et, TRUE]; IF elemBits < bitsPerWord THEN type.align ¬ MimData.bitsToAlignment[elemBits]; }; }; }; arraydesc => { seb[sei].mark4 ¬ TRUE; <> TypeExp[tb[node].son[1], FALSE, TRUE]; }; transfer => { origin: CARDINAL ¬ 0; newOrigin: CARDINAL ¬ 0; rSei: RecordSEIndex; son1: Tree.Link ¬ tb[node].son[1]; son2: Tree.Link ¬ tb[node].son[2]; seb[sei].mark4 ¬ TRUE; <> IF OpName[son1] # anyTC THEN { ScanList[son1, DeclItem]; CheckDefaults[son1]; }; rSei ¬ SymbolOps.ArgRecord[SymbolOps.own, type.typeIn]; IF rSei # RecordSENull THEN { seb[rSei].hints.comparable ¬ TRUE; -- for now newOrigin ¬ MimP4.LayoutArgs[rSei, origin, body]; seb[rSei].length ¬ newOrigin - origin; seb[rSei].mark4 ¬ TRUE; }; IF OpName[son2] # anyTC THEN { ScanList[son2, DeclItem]; CheckDefaults[son2]; }; rSei ¬ SymbolOps.ArgRecord[SymbolOps.own, type.typeOut]; IF rSei # RecordSENull THEN { seb[rSei].hints.comparable ¬ TRUE; -- for now seb[rSei].length ¬ MimP4.LayoutArgs[rSei, origin, body] - origin; seb[rSei].mark4 ¬ TRUE; } }; definition => NULL; union => { son1: Tree.Link = tb[node].son[1]; son2: Tree.Link = tb[node].son[2]; DeclItem[son1]; IF tb[node].attr1 AND type.controlled THEN AssignPositions[son1]; ProcessVariants[seb[type.tagSei].idType, son2]; }; sequence => { son1: Tree.Link = tb[node].son[1]; son2: Tree.Link = tb[node].son[2]; DeclItem[son1]; IF tb[node].attr1 AND type.controlled THEN AssignPositions[son1]; TypeExp[son2, FALSE, avoidId]; -- RRA: avoidId?? }; relative => { seb[sei].mark4 ¬ TRUE; <> TypeExp[tb[node].son[1], FALSE, TRUE]; TypeExp[tb[node].son[2], FALSE, TRUE]; }; opaque => { son1: Tree.Link ¬ tb[node].son[1]; IF son1 # Tree.Null THEN { son1 ¬ tb[node].son[1] ¬ MimP4.Rhs[son1, MimData.idCARDINAL]; MimP4.VPop[]; IF MimP4.TreeLiteral[son1] THEN type.length ¬ MimP4.TreeLiteralInt[son1]*bitsPerAU; }; }; zone => NULL; subrange => { tSei: CSEIndex = SymbolOps.UnderType[SymbolOps.own, type.rangeType]; tRep: Repr = MimP4.RepForType[tSei]; son1: Tree.Link ¬ tb[node].son[1]; son2: Tree.Link ¬ tb[node].son[2]; TypeExp[son1, FALSE, avoidId]; -- RRA: avoidId?? IF MimP4.Interval[son2, MimP4.nullBias, tRep] THEN { origin, range: Bias; [origin, range] ¬ MimP4.ConstantInterval[son2 ! MimP4.EmptyInterval => {type.empty ¬ TRUE; RESUME}]; type.origin ¬ ConstArith.ToInt[origin]; IF type.empty THEN type.range ¬ 0 ELSE type.range ¬ ConstArith.ToCard[range]; } ELSE type.origin ¬ type.range ¬ 0; type.filled ¬ TRUE; { rep: Repr = MimP4.VRep[]; MimP4.VPop[]; SELECT TRUE FROM rep = Repr.none => MimosaLog.ErrorTree[mixedRepresentation, son2]; type.empty => {}; ENDCASE => { ENABLE ConstArith.Overflow => GO TO dreck; start: ConstArith.Const = ConstArith.FromInt[type.origin]; stop: ConstArith.Const = ConstArith.Add[start, ConstArith.FromCard[type.range]]; lb, ub: ConstArith.Const; [lb, ub] ¬ MimP4.Bounds[tSei, MimP4.RepForType[tSei]]; IF ConstArith.Compare[start, lb] = less THEN GO TO dreck; IF ConstArith.Compare[stop, ub] = greater THEN GO TO dreck; EXITS dreck => MimosaLog.Error[subrangeNesting]; }; }; tb[node].son[2] ¬ FreeTree[son2]; }; any => NULL; ENDCASE => ERROR; typeStack.next ¬ oldLen; EXITS noProcess => {}; }; seb[sei].mark4 ¬ TRUE; }; }; ENDCASE => ERROR; }; MaxCardinality: PUBLIC PROC [type: Type, packed: BOOL, maxSize: CARD] RETURNS [CARD] = { eSize: BitCount = SymbolOps.BitsPerElement[SymbolOps.own, type, packed]; maxBits: CARD ¬ maxSize*bitsPerAU; IF maxBits > CARD[BitCount.LAST] OR maxBits < maxSize THEN maxBits ¬ BitCount.LAST; IF eSize > 1 THEN RETURN [maxBits/eSize]; RETURN [maxBits]; }; TypeForTree: PUBLIC PROC [t: Tree.Link] RETURNS [Type] = { RETURN [WITH t SELECT GetTag[t] FROM symbol => index, subtree => SymbolOps.ToType[tb[index].info], ENDCASE => typeANY] }; ClearType: PUBLIC PROC [type: Type] RETURNS [CSEIndex] = { DO sei: CSEIndex = SymbolOps.UnderType[SymbolOps.own, type]; IF sei # CSENull THEN WITH t: seb[sei] SELECT FROM opaque => { nSei: CSEIndex ¬ Types.OpaqueValue[ [SymbolOps.own, sei], SymbolOps.own].sei; IF nSei # sei THEN {type ¬ nSei; LOOP}; }; record => IF t.hints.unifield AND SymbolOps.CtxEntries[SymbolOps.own, t.fieldCtx] = 1 THEN { type ¬ seb[ctxb[t.fieldCtx].seList].idType; LOOP; }; ENDCASE; RETURN [sei]; ENDLOOP; }; CanonicalType: PUBLIC PROC [type: Type] RETURNS [Type] = { DO sei: CSEIndex = SymbolOps.UnderType[SymbolOps.own, type]; IF sei # CSENull THEN WITH t: seb[sei] SELECT FROM opaque => { nSei: CSEIndex ¬ Types.OpaqueValue[ [SymbolOps.own, sei], SymbolOps.own].sei; IF nSei # sei THEN {type ¬ nSei; LOOP}; }; record => IF t.hints.unifield AND SymbolOps.CtxEntries[SymbolOps.own, t.fieldCtx] = 1 THEN { type ¬ seb[ctxb[t.fieldCtx].seList].idType; LOOP; }; subrange => {type ¬ t.rangeType; LOOP}; ENDCASE; RETURN [type]; ENDLOOP; }; BiasForType: PUBLIC PROC [type: Type] RETURNS [Bias] = { DO sei: CSEIndex = ClearType[type]; IF sei # CSENull THEN WITH t: seb[sei] SELECT FROM subrange => IF t.biased THEN RETURN [ConstArith.FromInt[t.origin]]; ENDCASE; RETURN [MimP4.nullBias]; ENDLOOP; }; RepForType: PUBLIC PROC [type: Type] RETURNS [MimP4.Repr] = { eitherOK: BOOL ¬ FALSE; lastInt: CARD = CARD[INT.LAST]; DO sei: CSEIndex = ClearType[type]; IF sei = CSENull THEN RETURN [MimP4.Repr.none] ELSE { sep: Symbols.CSEPointer = @seb[sei]; WITH t: sep­ SELECT FROM basic => SELECT t.code FROM codeANY => RETURN [MimP4.Repr.all]; codeCHAR => GO TO retEither; ENDCASE; enumerated => { IF eitherOK OR t.range <= lastInt THEN GO TO retEither; RETURN [MimP4.Repr.unsigned]; }; ref => RETURN [MimP4.Repr.addr]; relative => { type ¬ t.offsetType; LOOP; }; subrange => { org: CARD = LOOPHOLE[t.origin]; lim: CARD = org + t.range; IF NOT eitherOK THEN SELECT TRUE FROM t.empty => eitherOK ¬ TRUE; org > lastInt, lim > lastInt, lim < org => eitherOK ¬ FALSE; ENDCASE => eitherOK ¬ TRUE; type ¬ t.rangeType; LOOP; }; real => RETURN [MimP4.Repr.real]; signed => IF eitherOK THEN GO TO retEither ELSE RETURN [MimP4.Repr.signed]; unsigned => IF eitherOK THEN GO TO retEither ELSE RETURN [MimP4.Repr.unsigned]; ENDCASE; }; RETURN [MimP4.Repr.other]; ENDLOOP; EXITS retEither => RETURN [MimP4.Repr.either]; }; ComparableType: PUBLIC PROC [type: Type] RETURNS [BOOL] = { <> sei: CSEIndex = ClearType[type]; sep: Symbols.CSEPointer = @seb[sei]; WITH t: sep­ SELECT FROM record => RETURN [t.hints.comparable OR t.argument]; array => RETURN [~SparseRep[t.indexType] AND ComparableType[t.componentType]]; opaque => RETURN [t.lengthKnown]; any => RETURN [FALSE]; ENDCASE => RETURN [TRUE]; }; DefaultBasicOps: PUBLIC PROC [type: Type, size: BitCount] RETURNS [BOOL] = { next: Type; FOR s: Type ¬ type, next DO sep: Symbols.SEPointer = @seb[s]; WITH se: sep­ SELECT FROM id => { sei: ISEIndex = LOOPHOLE[s]; IF se.extended THEN { IF OpName[SymbolOps.FindExtension[SymbolOps.own, sei].tree] # void THEN RETURN [FALSE]; EXIT; }; next ¬ SymbolOps.DecodeType[se.idInfo]; }; cons => WITH t: se SELECT FROM ref => IF t.counted THEN RETURN [FALSE] ELSE EXIT; array => next ¬ t.componentType; record => IF t.hints.default THEN RETURN [FALSE] ELSE EXIT; transfer => IF t.mode = port THEN RETURN [FALSE] ELSE EXIT; zone => IF t.counted THEN RETURN [FALSE] ELSE EXIT; ENDCASE => EXIT; ENDCASE; ENDLOOP; IF MimP4.BitsForType[type] > size THEN RETURN [FALSE]; IF MimP4.WordsForType[type] # CARD[size+bitsPerWord-1]/bitsPerWord THEN RETURN [FALSE]; IF NOT ComparableType[type] THEN RETURN [FALSE]; IF SymbolOps.TypeLink[SymbolOps.own, type] # nullType THEN RETURN [FALSE]; RETURN [TRUE]; }; <> ItemId: PROC [t: Tree.Link] RETURNS [ISEIndex] = { DO WITH t SELECT GetTag[t] FROM symbol => RETURN [index]; subtree => t ¬ tb[index].son[1]; ENDCASE => ERROR; ENDLOOP; }; FirstId: PROC [node: Tree.Index] RETURNS [ISEIndex] = { RETURN [ItemId[ListHead[tb[node].son[1]]]]; }; TypeForDecl: PROC [node: Tree.Index] RETURNS [Type] = { RETURN [IF tb[node].son[2] # Tree.Null THEN TypeForTree[tb[node].son[2]] ELSE seb[FirstId[node]].idType] }; ConstInit: PROC [t: Tree.Link] RETURNS [BOOL] = { DO IF OpName[t] = all THEN {t ¬ NthSon[t, 1]; LOOP}; RETURN [MimP4.StructuredLiteral[t]]; ENDLOOP; }; InlineByte: Tree.Map = { v ¬ MimP4.Rhs[t, MimData.idCARDINAL]; MimP4.VPop[]; IF ~MimP4.TreeLiteral[v] THEN MimosaLog.ErrorTree[nonConstant, v]; }; InlineOp: Tree.Map = { WITH t SELECT GetTag[t] FROM string => {v ¬ MimP4.Rhs[t, typeANY]; MimP4.VPop[]}; ENDCASE => v ¬ UpdateList[t, InlineByte]; }; DefineSEVar: PROC [ids: Tree.Link] = { UpdateSE: Tree.Scan = { sei: ISEIndex = ItemId[t]; seb[sei].constant ¬ FALSE}; ScanList[ids, UpdateSE]; }; DefineSEValue: PROC [ids: Tree.Link, value: UNSPEC¬nullValue, info: CBTIndex¬CBTNull] = { UpdateSE: Tree.Scan = { sei: ISEIndex = ItemId[t]; seb[sei].constant ¬ TRUE; seb[sei].idValue ¬ value; seb[sei].idInfo ¬ SymbolOps.EncodeBti[info]; }; ScanList[ids, UpdateSE]; }; MarkSize: Tree.Scan = { sei: ISEIndex = ItemId[t]; seb[sei].flags.sized ¬ TRUE; }; AugmentSEValue: PROC [ids: Tree.Link, type: ExtensionType, extension: Tree.Link, copy: BOOL ¬ FALSE] = { UpdateSE: Tree.Scan = { sei: ISEIndex = ItemId[t]; SymbolOps.EnterExtension[sei, type, IF copy THEN IdentityMap[extension] ELSE extension]; copy ¬ TRUE; }; ScanList[ids, UpdateSE]; }; MarkAndCheckSE: PROC [ids: Tree.Link, initialized: BOOL] = { UpdateSE: Tree.Scan = { sei: ISEIndex = ItemId[t]; level: ContextLevel = SymbolOps.CtxLevel[SymbolOps.own, seb[sei].idCtx]; seb[sei].mark4 ¬ TRUE; IF MimData.interface THEN CheckDefinition[sei, initialized]; IF seb[sei].idType = typeTYPE AND level # lZ THEN seb[sei].idValue ¬ SymbolOps.EncodeCard[sei - ISEFirst]; IF seb[sei].idType # typeTYPE AND level > lG AND level < MimP4.currentLevel THEN { IF suspectFlaw THEN MimosaLog.WarningSei[other, sei]; SymbolOps.SetCtxLevel[seb[sei].idCtx, MimP4.currentLevel]; }; }; ScanList[ids, UpdateSE]; }; CheckDefinition: PROC [sei: ISEIndex, initialized: BOOL] = { SELECT seb[sei].idCtx FROM MimData.mainCtx => SELECT SymbolOps.LinkMode[SymbolOps.own, sei] FROM val => IF ~initialized OR seb[sei].extended THEN RETURN; ref => IF ~initialized THEN RETURN; manifest, type => IF SymbolOps.ConstantId[sei] THEN RETURN; ENDCASE; ENDCASE => RETURN; MimosaLog.ErrorSei[nonDefinition, sei]; }; CheckDefaults: PROC [t: Tree.Link] = { TestDefaults: Tree.Scan = { node: Tree.Index = GetNode[t]; saveIndex: SourceMap.Loc = MimData.textIndex; sei: ISEIndex = FirstId[node]; MimData.textIndex ¬ ToLoc[tb[node].info]; IF seb[sei].extended THEN { type: Type = (IF seb[sei].idType = typeTYPE THEN sei ELSE seb[sei].idType); nType: CSEIndex = SymbolOps.NormalType[SymbolOps.own, type]; TestDefault: Tree.Map = { IF OpName[t] = void THEN v ¬ t ELSE { v ¬ MimP4.Rhs[t, type, $init]; v ¬ MimP4.AdjustBias[v, MimP4.VRep[], BiasForType[type], TRUE]; IF MimP4.TreeLiteral[v] THEN { WITH n: seb[nType] SELECT FROM signed => IF MimP4.VRep[] = MimP4.Repr.signed THEN GO TO noForce; unsigned => IF MimP4.VRep[] = MimP4.Repr.unsigned THEN GO TO noForce; real => IF MimP4.VRep[] = MimP4.Repr.real THEN GO TO noForce; ENDCASE; v ¬ MimP4.ForceType[v, type]; EXITS noForce => {}; }; IF ~(MimP4.VProp[].noFreeVar OR (SIGNAL VarInit[])) THEN MimosaLog.ErrorTree[nonConstant, v]; MimP4.VPop[]; }; }; t: Tree.Link ¬ SymbolOps.FindExtension[SymbolOps.own, sei].tree; v: Tree.Link ¬ UpdateList[IdentityMap[t], TestDefault]; IF GetTag[t] # symbol AND MimP4.StructuredLiteral[v] THEN UpdateDefaults[tb[node].son[1], v] ELSE v ¬ FreeTree[v]; }; MimData.textIndex ¬ saveIndex; }; IF MimData.interface THEN ScanList[t, TestDefaults]; }; UpdateDefaults: PROC [ids: Tree.Link, v: Tree.Link] = { copy: BOOL ¬ FALSE; UpdateDefault: Tree.Scan = { sei: ISEIndex = ItemId[t]; old: Tree.Link ¬ SymbolOps.FindExtension[SymbolOps.own, sei].tree; SymbolOps.EnterExtension[sei, default, IF copy THEN IdentityMap[v] ELSE v]; copy ¬ TRUE; [] ¬ FreeTree[old]; }; ScanList[ids, UpdateDefault]; }; TrimTree: Tree.Map = { v ¬ t; WITH t SELECT GetTag[t] FROM subtree => { node: Tree.Index = index; SELECT tb[node].name FROM body => { PushTree[TrimTree[tb[node].son[1]]]; PushTrimDecls[tb[node].son[2]]; PushTree[TrimTree[tb[node].son[3]]]; PushTree[TrimTree[tb[node].son[4]]]; PushNode[body, 4]; SetInfo[tb[node].info]; SetAttrs[tb[node].attr1, tb[node].attr2, tb[node].attr3]; v ¬ PopTree[]; }; block => { PushTrimDecls[tb[node].son[1]]; PushTree[TrimTree[tb[node].son[2]]]; PushNode[block, 2]; SetInfo[tb[node].info]; SetAttrs[tb[node].attr1, tb[node].attr2, tb[node].attr3]; v ¬ PopTree[]; }; cdot => v ¬ TrimTree[tb[node].son[2]]; ENDCASE => IF t # Tree.Null THEN v ¬ CopyTree[[@tb, t], TrimTree]}; ENDCASE; }; PushTrimDecls: PROC [t: Tree.Link] = { IF OpName[t] = initlist THEN { node: Tree.Index = GetNode[t]; PushTree[TrimTree[tb[node].son[1]]]; PushTrimDecls[tb[node].son[2]]; PushNode[initlist, 2]; SetInfo[tb[node].info]; } ELSE { n: CARDINAL ¬ 0; PushDecl: Tree.Scan = { node: Tree.Index = GetNode[t]; SELECT tb[node].name FROM typedecl => NULL; decl => { init: Tree.Link = tb[node].son[3]; PushTree[TrimTree[tb[node].son[1]]]; PushTree[Tree.Null]; PushTree[TrimTree[init]]; PushNode[decl, 3]; SetInfo[tb[node].info]; SetAttrs[tb[node].attr1, tb[node].attr2, ~MimP4.mark]; n ¬ n+1; }; ENDCASE => ERROR; }; ScanList[t, PushDecl]; PushList[n]; }; }; SetInitAttr: PROC [type: Type, const: BOOL] = INLINE { SetAttr[1, TRUE]; IF MimP4.currentLevel = lG AND ~const THEN SELECT SymbolOps.RCType[SymbolOps.own, type] FROM simple => {SetAttr[2, TRUE]; SetAttr[3, FALSE]}; composite => {SetAttr[2, TRUE]; SetAttr[3, TRUE]}; ENDCASE => SetAttr[2, FALSE] ELSE SetAttr[2, FALSE]; }; EvalUnsigned: PROC [t: Tree.Link, default: CARD] RETURNS [v: Tree.Link, n: CARD] = { v ¬ MimP4.Rhs[t, MimData.idCARDINAL]; MimP4.VPop[]; IF MimP4.TreeLiteral[v] THEN n ¬ MimP4.TreeLiteralCard[v] ELSE {MimosaLog.ErrorTree[nonConstant, v]; n ¬ default}; }; LayoutEnum: PROC [t: Tree.Link, ctx: CTXIndex] RETURNS [empty: BOOL ¬ TRUE, range: CARD ¬ 0, sparse: BOOL ¬ FALSE] = { AssignElement: Tree.Scan = { val: CARD ¬ range; WITH e: t SELECT GetTag[t] FROM subtree => [tb[e.index].son[2], val] ¬ EvalUnsigned[tb[e.index].son[2], val]; ENDCASE; IF val > Target.maxWord THEN MimosaLog.ErrorSei[addressOverflow, sei]; IF empty THEN { IF val # 0 THEN sparse ¬ TRUE; empty ¬ FALSE; } ELSE { IF val < range THEN MimosaLog.ErrorSei[enumOrder, sei]; IF val # range THEN sparse ¬ TRUE; }; range ¬ val+1; seb[sei].idValue ¬ SymbolOps.EncodeCard[val]; sei ¬ SymbolOps.NextSe[SymbolOps.own, sei]; }; sei: ISEIndex ¬ SymbolOps.FirstCtxSe[SymbolOps.own, ctx]; ScanList[t, AssignElement]; IF NOT empty THEN range ¬ range - 1; }; AssignPositions: PROC [item: Tree.Link] = { node: Tree.Index = GetNode[item]; saveIndex: SourceMap.Loc = MimData.textIndex; type: Type = TypeForTree[tb[node].son[2]]; nB: CARD; lastSei: ISEIndex ¬ ISENull; AssignPosition: Tree.Scan = { fStart: CARD; fBits: CARD; ud, bL, bR: CARD; sei: ISEIndex = ItemId[t]; node: Tree.Index = GetNode[NthSon[t, 2]]; son2: Tree.Link ¬ tb[node].son[2]; [tb[node].son[1], ud] ¬ EvalUnsigned[tb[node].son[1], 0]; SELECT targetBitOrder FROM msBit => {bL ¬ 0; bR ¬ nB-1}; lsBit => {bL ¬ nB-1; bR ¬ 0}; ENDCASE => ERROR; IF son2 = Tree.Null THEN { <> mod: NAT = Basics.LowHalf[nB] MOD grain; IF mod # 0 THEN { nB ¬ nB + (grain - mod); SELECT targetBitOrder FROM msBit => bR ¬ nB-1; lsBit => bL ¬ nB-1; ENDCASE => ERROR; }; } ELSE { <> subNode: Tree.Index = GetNode[son2]; [tb[subNode].son[1], bL] ¬ EvalUnsigned[tb[subNode].son[1], bL]; [tb[subNode].son[2], bR] ¬ EvalUnsigned[tb[subNode].son[2], bR]; }; <> ud ¬ ud * grain; bL ¬ bL + ud; bR ¬ bR + ud; fStart ¬ bL; -- most significant bit order is always the left number SELECT targetBitOrder FROM msBit => fBits ¬ bR-bL+1; lsBit => fBits ¬ bL-bR+1; ENDCASE => ERROR; IF fBits < nB OR LOOPHOLE[fBits, INT] < 0 THEN { <> MimosaLog.ErrorSei[fieldPosition, sei]; fBits ¬ nB; }; IF targetBitOrder = lsBit THEN <> fStart ¬ Basics.BITXOR[fStart, bitsPerWord-1]; IF SymbolOps.RCType[SymbolOps.own, seb[sei].idType] # none THEN <> IF (Basics.LowHalf[bL] MOD bitsPerWord) # 0 THEN MimosaLog.ErrorSei[fieldPosition, sei]; seb[sei].idValue ¬ SymbolOps.EncodeCard[fStart]; seb[sei].idInfo ¬ SymbolOps.EncodeCard[fBits]; }; MimData.textIndex ¬ ToLoc[tb[node].info]; nB ¬ MimP4.BitsForType[type]; ScanList[tb[node].son[1], AssignPosition]; MimData.textIndex ¬ saveIndex; }; ExtractFieldAttributes: PROC [rType: RecordSEIndex] = { <> comparable: BOOL ¬ TRUE; privateFields: BOOL ¬ FALSE; FOR sei: ISEIndex ¬ SymbolOps.FirstCtxSe[SymbolOps.own, seb[rType].fieldCtx], SymbolOps.NextSe[SymbolOps.own, sei] UNTIL sei = ISENull DO type: CSEIndex ¬ SymbolOps.UnderType[SymbolOps.own, seb[sei].idType]; sep: Symbols.CSEPointer = @seb[type]; WITH t: sep­ SELECT FROM record => IF ~t.hints.comparable AND ~ComparableType[type] THEN comparable ¬ FALSE; array => IF ~ComparableType[type] THEN comparable ¬ FALSE; union => IF ~t.hints.equalLengths THEN comparable ¬ FALSE; sequence => comparable ¬ FALSE; ENDCASE; IF ~seb[sei].public THEN privateFields ¬ TRUE; ENDLOOP; seb[rType].hints.comparable ¬ comparable; seb[rType].hints.privateFields ¬ privateFields; }; ProcessVariants: PROC [tt: Type, list: Tree.Link] = { MapTag: PROC [vSei: ISEIndex] RETURNS [CARD] = { WITH t: seb[tagType] SELECT FROM enumerated => IF t.machineDep THEN { sei: ISEIndex = SymbolOps.SearchContext[ SymbolOps.own, seb[vSei].hash, t.valueCtx]; IF sei # ISENull THEN vSei ¬ sei; }; ENDCASE; RETURN [SymbolOps.DecodeCard[seb[vSei].idValue]]; }; CheckTag: Tree.Scan = { sei: ISEIndex = ItemId[t]; tag: Bias = ConstArith.FromCard[MapTag[sei]]; SELECT TRUE FROM ConstArith.Compare[tag, lb] = less, ConstArith.Compare[tag, ub] # less => { MimosaLog.ErrorSei[boundsFault, sei]; seb[sei].idValue ¬ SymbolOps.EncodeCard[0]; }; ENDCASE => { delta: CARD ¬ ConstArith.ToCard[ConstArith.Sub[tag, lb]]; seb[sei].idValue ¬ SymbolOps.EncodeCard[delta]; }; }; ProcessVariant: Tree.Scan = { saveIndex: SourceMap.Loc = MimData.textIndex; node: Tree.Index = GetNode[t]; MimData.textIndex ¬ ToLoc[tb[node].info]; ScanList[tb[node].son[1], CheckTag]; DeclItem[t]; MimData.textIndex ¬ saveIndex; }; tagType: CSEIndex = SymbolOps.UnderType[SymbolOps.own, tt]; lb: Bias ¬ BiasForType[tagType]; ub: Bias ¬ ConstArith.Add[lb, ConstArith.FromCard[SymbolOps.Cardinality[SymbolOps.own, tagType]]]; ScanList[list, ProcessVariant]; }; SparseRep: PROC [type: Type] RETURNS [BOOL] = { nType: CSEIndex = SymbolOps.NormalType[SymbolOps.own, type]; RETURN [WITH t: seb[nType] SELECT FROM enumerated => t.sparse, ENDCASE => FALSE] }; <> DeclNotify: MimosaEvents.Callback = { <> SELECT class FROM relocate => { tb ¬ MimData.base[Tree.treeType]; seb ¬ MimData.base[seType]; ctxb ¬ MimData.base[ctxType]; bb ¬ MimData.base[bodyType]; }; cleanup => { MimZones.tempZone.FREE[@typeStack]; }; ENDCASE; }; MimosaEvents.Register[DeclNotify, relocate]; MimosaEvents.Register[DeclNotify, cleanup]; }.