-- file SymbolCopier.Mesa -- last modified by Satterthwaite, October 31, 1979 1:12 PM DIRECTORY Copier: FROM "copier" USING [FindMdEntry, FreeSymbolTable, GetSymbolTable, HtiToMdi], InlineDefs: FROM "inlinedefs" USING [LongDivMod, LongMult], LiteralOps: FROM "literalops" USING [CopyLiteral], StringDefs: FROM "stringdefs" USING [SubString, SubStringDescriptor], SymbolTable: FROM "symboltable" USING [Base, SetCacheSize], Symbols: FROM "symbols", SymbolOps: FROM "symbolops" USING [ CtxEntries, EnterExtension, EnterString, LinkBti, MakeCtxSe, MakeNonCtxSe, MakeSeChain, NewCtx, NextSe, ParentBti, ResetCtxList, SearchContext, SetSeLink, SubStringForHash, UnderType], SystemDefs: FROM "systemdefs" USING [AllocateSegment, FreeSegment], Table: FROM "table" USING [Base, Notifier, AddNotify, Allocate, Bounds, DropNotify], Tree: FROM "tree" USING [treeType, Index, Link, Map, NullIndex], TreeOps: FROM "treeops" USING [CopyTree, GetNode, PopTree, PushNode, PushTree, SetAttr, SetInfo]; SymbolCopier: PROGRAM IMPORTS Copier, InlineDefs, LiteralOps, SymbolTable, SymbolOps, SystemDefs, Table, TreeOps EXPORTS Copier SHARES Copier = BEGIN OPEN SymbolOps, Symbols; -- tables defining the current symbol table seb: Table.Base; -- se table ctxb: Table.Base; -- context table mdb: Table.Base; -- module directory base bb: Table.Base; -- body table tb: Table.Base; -- tree table CopierNotify: Table.Notifier = BEGIN -- called whenever the main symbol table is repacked seb _ base[seType]; ctxb _ base[ctxType]; mdb _ base[mdType]; bb _ base[bodyType]; tb _ base[Tree.treeType]; END; -- table bases for the current include module iBase: SymbolTable.Base; iHt: DESCRIPTOR FOR ARRAY HTIndex OF HTRecord; iSeb: Table.Base; iCtxb: Table.Base; INotify: PROCEDURE = BEGIN -- called whenever iBase switches or tables moved iHt _ iBase.ht; iSeb _ iBase.seb; iCtxb _ iBase.ctxb; END; MemoCacheSize: CARDINAL = 509; -- prime < 512 SearchCache: TYPE = ARRAY [0..MemoCacheSize) OF RECORD[ hti: HTIndex, ctx: CTXIndex]; memoCache: POINTER TO SearchCache; -- initialization/finalization CopierInit: PUBLIC PROCEDURE = BEGIN Table.AddNotify[CopierNotify]; memoCache _ SystemDefs.AllocateSegment[SIZE[SearchCache]]; memoCache^ _ ALL[ [hti:HTNull, ctx:CTXNull] ]; typeCache _ SystemDefs.AllocateSegment[SIZE[TypeCache]]; typeCache^ _ ALL[ [mdi:MDNull, iSei:SENull, sei: SENull] ]; SymbolTable.SetCacheSize[100]; currentBody _ BTNull; END; ResetCaches: PROCEDURE = INLINE -- see ResetIncludeContexts BEGIN SymbolTable.SetCacheSize[0]; SystemDefs.FreeSegment[typeCache]; SystemDefs.FreeSegment[memoCache]; END; CopierReset: PUBLIC PROCEDURE = BEGIN Table.DropNotify[CopierNotify] END; -- copying within current table CopyXferType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [copy: CSEIndex] = BEGIN WITH master: seb[type] SELECT FROM transfer => BEGIN copy _ MakeNonCtxSe[SIZE[transfer cons SERecord]]; seb[copy].mark3 _ master.mark3; seb[copy].mark4 _ master.mark4; seb[copy] _ SERecord[ mark3: master.mark3, mark4: master.mark4, body: cons[transfer[ mode: master.mode, inRecord: CopyArgs[master.inRecord], outRecord: CopyArgs[master.outRecord]]]]; END; ENDCASE => copy _ typeANY; RETURN END; CopyArgs: PROCEDURE [rSei: RecordSEIndex] RETURNS [copy: RecordSEIndex] = BEGIN ctx1, ctx2: CTXIndex; sei1, sei2, seChain: ISEIndex; IF rSei = RecordSENull THEN copy _ RecordSENull ELSE BEGIN copy _ LOOPHOLE[MakeNonCtxSe[SIZE[notLinked record cons SERecord]]]; ctx1 _ seb[rSei].fieldCtx; ctx2 _ NewCtx[ctxb[ctx1].level]; seChain _ MakeSeChain[ctx2, CtxEntries[ctx1], FALSE]; sei1 _ ctxb[ctx1].seList; sei2 _ ctxb[ctx2].seList _ seChain; UNTIL sei1 = SENull DO CopyArgSe[sei2, sei1]; sei1 _ NextSe[sei1]; sei2 _ NextSe[sei2]; ENDLOOP; seb[copy] _ SERecord[mark3: seb[rSei].mark3, mark4: seb[rSei].mark4, body: cons[ record[ machineDep: FALSE, argument: TRUE, hints: seb[rSei].hints, fieldCtx: ctx2, length: seb[rSei].length, lengthUsed: FALSE, monitored: FALSE, linkPart: notLinked[]]]]; END; RETURN END; CopyArgSe: PUBLIC PROCEDURE [copy, master: ISEIndex] = BEGIN seb[copy].hash _ seb[master].hash; seb[copy].extended _ FALSE; seb[copy].public _ seb[master].public; seb[copy].immutable _ seb[master].immutable; seb[copy].constant _ seb[master].constant; seb[copy].linkSpace _ seb[master].linkSpace; seb[copy].idType _ seb[master].idType; seb[copy].idInfo _ seb[master].idInfo; seb[copy].idValue _ seb[master].idValue; seb[copy].mark3 _ seb[master].mark3; seb[copy].mark4 _ seb[master].mark4; END; -- copying across table boundaries SubString: TYPE = StringDefs.SubString; SubStringDescriptor: TYPE = StringDefs.SubStringDescriptor; SearchFileCtx: PUBLIC PROCEDURE [hti: HTIndex, ctx: IncludedCTXIndex] RETURNS [found: BOOLEAN, sei: ISEIndex] = BEGIN desc: SubStringDescriptor; s: SubString = @desc; hash: [0..MemoCacheSize); iHti: HTIndex; iSei: ISEIndex; mdi: MDIndex = ctxb[ctx].module; ignorePrivate: BOOLEAN = mdb[mdi].shared; SubStringForHash[s, hti]; hash _ InlineDefs.LongDivMod[ InlineDefs.LongMult[LOOPHOLE[hti], LOOPHOLE[ctx]], MemoCacheSize].remainder; IF memoCache[hash].hti = hti AND memoCache[hash].ctx = ctx THEN RETURN [FALSE, ISENull]; IF OpenIncludedTable[mdi] THEN BEGIN iHti _ iBase.FindString[s]; IF iHti # HTNull AND (iHt[iHti].anyPublic OR (ignorePrivate AND iHt[iHti].anyInternal)) THEN BEGIN iSei _ iBase.SearchContext[iHti, ctxb[ctx].map]; found _ iSei # SENull AND (iSeb[iSei].public OR ignorePrivate); IF found THEN sei _ CopyCtxSe[iSei, hti, ctx, mdi]; END ELSE found _ FALSE; CloseIncludedTable[]; END ELSE BEGIN found _ FALSE; sei _ ISENull END; IF ~found THEN memoCache[hash] _ [hti:hti, ctx:ctx]; RETURN END; CompleteContext: PUBLIC PROCEDURE [ctx: IncludedCTXIndex, ignorePrivate: BOOLEAN] = BEGIN IF ~ctxb[ctx].reset AND OpenIncludedTable[ctxb[ctx].module] THEN BEGIN FillContext[ctx, ignorePrivate]; CloseIncludedTable[] END; END; CopyUnion: PUBLIC PROCEDURE [ctx: CTXIndex] = BEGIN iSei, iRoot: ISEIndex; WITH ctxb[ctx] SELECT FROM included => IF ~reset AND OpenIncludedTable[module] THEN BEGIN iSei _ iRoot _ iCtxb[map].seList; DO IF iSei = SENull THEN EXIT; IF iBase.TypeForm[iSeb[iSei].idType] = union THEN BEGIN IF iSeb[iSei].hash # HTNull THEN [] _ CopyIncludedSymbol[iSei, module] ELSE FillContext[LOOPHOLE[ctx], TRUE]; EXIT END; IF (iSei _ iBase.NextSe[iSei]) = iRoot THEN EXIT; ENDLOOP; CloseIncludedTable[]; END; ENDCASE; END; FillContext: PROCEDURE [ctx: IncludedCTXIndex, ignorePrivate: BOOLEAN] = BEGIN sei, iSei, pSei: ISEIndex; complete: BOOLEAN; mdi: MDIndex = ctxb[ctx].module; hti: HTIndex; ignorePrivate _ ignorePrivate OR mdb[mdi].shared; complete _ TRUE; pSei _ ISENull; FOR iSei _ iBase.FirstCtxSe[ctxb[ctx].map], iBase.NextSe[iSei] UNTIL iSei = SENull DO IF ~(iSeb[iSei].public OR ignorePrivate) THEN complete _ FALSE ELSE BEGIN hti _ MapHti[iSeb[iSei].hash]; sei _ SearchContext[hti, ctx]; IF sei = SENull THEN sei _ CopyCtxSe[iSei, hti, ctx, mdi]; IF pSei # SENull AND NextSe[pSei] # sei THEN BEGIN Delink[sei]; SetSeLink[sei, NextSe[pSei]]; SetSeLink[pSei, sei]; END; ctxb[ctx].seList _ pSei _ sei; END; ENDLOOP; ResetCtx[ctx]; ctxb[ctx].complete _ complete; END; Delink: PUBLIC PROCEDURE [sei: ISEIndex] = BEGIN prev, next: ISEIndex; ctx: CTXIndex = seb[sei].idCtx; -- assumed not reset prev _ ctxb[ctx].seList; DO next _ NextSe[prev]; SELECT next FROM sei => EXIT; ctxb[ctx].seList, ISENull => ERROR; ENDCASE => prev _ next; ENDLOOP; IF NextSe[sei] = sei THEN ctxb[ctx].seList _ ISENull ELSE BEGIN IF sei = ctxb[ctx].seList THEN ctxb[ctx].seList _ prev; SetSeLink[prev, NextSe[sei]]; END; SetSeLink[sei, ISENull]; END; FillRecord: PROCEDURE [sei: CSEIndex, mdi: MDIndex] = BEGIN WITH type: seb[sei] SELECT FROM record => BEGIN WITH type SELECT FROM linked => FillRecord[UnderType[linkType], mdi]; ENDCASE => NULL; WITH c: ctxb[type.fieldCtx] SELECT FROM included => IF ~c.reset THEN BEGIN IF c.module = mdi THEN FillContext[LOOPHOLE[type.fieldCtx], TRUE] ELSE BEGIN CloseIncludedTable[]; CompleteContext[LOOPHOLE[type.fieldCtx], TRUE]; [] _ OpenIncludedTable[mdi]; END; END; ENDCASE => NULL; END; ENDCASE => NULL; END; MapHti: PROCEDURE [iHti: HTIndex] RETURNS [hti: HTIndex] = BEGIN desc: SubStringDescriptor; s: SubString = @desc; IF iHti = HTNull THEN hti _ HTNull ELSE BEGIN iBase.SubStringForHash[s, iHti]; hti _ EnterString[s ! TableRelocated => s.base _ iBase.ssb]; END; RETURN END; MissingHti: ERROR = CODE; InverseMapHti: PROCEDURE [hti: HTIndex] RETURNS [iHti: HTIndex] = BEGIN -- N.B. assumes that the included table has been selected desc: SubStringDescriptor; s: SubString = @desc; IF hti = HTNull THEN iHti _ HTNull ELSE BEGIN SubStringForHash[s, hti]; iHti _ iBase.FindString[s]; IF iHti = HTNull THEN ERROR MissingHti; END; RETURN END; FindIncludedCtx: PUBLIC PROCEDURE [mdi: MDIndex, iCtx: CTXIndex] RETURNS [IncludedCTXIndex] = BEGIN ctx, last: IncludedCTXIndex; target: CTXIndex; mdRoot: MDIndex; WITH iCtxb[iCtx] SELECT FROM included => [mdRoot, target] _ IncludedTargets[LOOPHOLE[iCtx]]; imported => BEGIN IF iBase.mdb[iCtxb[includeLink].module].defaultImport # iCtx THEN ERROR; -- need a signal to raise [mdRoot, target] _ IncludedTargets[includeLink]; END; ENDCASE => BEGIN mdRoot _ mdi; target _ iCtx END; last _ IncludedCTXNull; FOR ctx _ mdb[mdRoot].ctx, ctxb[ctx].chain UNTIL ctx = CTXNull DO IF ctxb[ctx].map = target THEN RETURN [ctx]; last _ ctx; ENDLOOP; ctx _ Table.Allocate[ctxType, SIZE[included CTXRecord]]; ctxb[ctx] _ CTXRecord[ mark: FALSE, varUpdated: FALSE, seList: ISENull, level: iCtxb[iCtx].level, extension: included[ chain: IncludedCTXNull, module: mdRoot, map: target, restricted: FALSE, complete: FALSE, closed: FALSE, reset: FALSE]]; IF last = CTXNull THEN mdb[mdRoot].ctx _ ctx ELSE ctxb[last].chain _ ctx; RETURN [ctx] END; IncludedTargets: PROCEDURE [iCtx: IncludedCTXIndex] RETURNS [mdi: MDIndex, ctx: CTXIndex] = BEGIN oldMdi: MDIndex = iCtxb[iCtx].module; desc: SubStringDescriptor; s: SubString = @desc; iBase.SubStringForHash[s, iBase.mdb[oldMdi].fileId]; mdi _ Copier.FindMdEntry[ id: MapHti[iBase.mdb[oldMdi].moduleId], version: iBase.mdb[oldMdi].stamp, file: MapHti[iBase.mdb[oldMdi].fileId]]; ctx _ iCtxb[iCtx].map; RETURN END; UnknownModule: PUBLIC SIGNAL [HTIndex] = CODE; FillModule: PUBLIC PROCEDURE [sei: ISEIndex] = BEGIN mdi: MDIndex = Copier.HtiToMdi[seb[sei].hash]; iHti: HTIndex; iSei: ISEIndex; IF mdi = MDNull OR ~OpenIncludedTable[mdi] THEN DummyCtxSe[sei] ELSE BEGIN BEGIN iHti _ InverseMapHti[seb[sei].hash !MissingHti => GO TO failed]; iSei _ iBase.SearchContext[iHti, iBase.stHandle.directoryCtx]; IF iSei = SENull OR ~iSeb[iSei].public THEN GO TO failed; CopyCtxSeInfo[sei, iSei, mdi]; seb[sei].public _ FALSE; EXITS failed => BEGIN SIGNAL UnknownModule[seb[sei].hash]; DummyCtxSe[sei] END; END; CloseIncludedTable[]; END; END; DummyCtxSe: PROCEDURE [sei: ISEIndex] = BEGIN OPEN seb[sei]; idType _ typeANY; idInfo _ idValue _ 0; extended _ public _ linkSpace _ FALSE; mark3 _ mark4 _ immutable _ constant _ TRUE; END; -- caching of (cons) types TypeCacheSize: CARDINAL = 83; -- prime < 256/3 TypeCacheIndex: TYPE = [0..TypeCacheSize); TypeCache: TYPE = ARRAY TypeCacheIndex OF RECORD [ mdi: MDIndex, iSei: SEIndex, -- the search keys sei: SEIndex]; -- the result typeCache: POINTER TO TypeCache; TypeHash: PROCEDURE [mdi: MDIndex, iSei: SEIndex] RETURNS [TypeCacheIndex] = BEGIN RETURN [(LOOPHOLE[mdi, CARDINAL]*LOOPHOLE[iSei, CARDINAL]) MOD TypeCacheSize] END; -- copying symbols CopyIncludedSymbol: PUBLIC PROCEDURE [iSei: SEIndex, mdi: MDIndex] RETURNS [sei: SEIndex] = BEGIN IF iSei = SENull THEN RETURN [SENull]; WITH iSeb[iSei] SELECT FROM id => BEGIN ctx: IncludedCTXIndex; hti, iHti: HTIndex; iMdi: MDIndex; tSei: ISEIndex; IF idCtx IN StandardContext THEN RETURN [iSei]; ctx _ FindIncludedCtx[mdi, idCtx]; hti _ MapHti[hash]; sei _ tSei _ SearchContext[hti, ctx]; IF sei # SENull THEN seb[tSei].idCtx _ ctx ELSE BEGIN iMdi _ ctxb[ctx].module; IF iMdi = mdi OR ~mdb[iMdi].shared THEN sei _ CopyCtxSe[LOOPHOLE[iSei, ISEIndex], hti, ctx, mdi] ELSE BEGIN CloseIncludedTable[]; IF OpenIncludedTable[iMdi] THEN BEGIN iHti _ InverseMapHti[hti]; iSei _ iBase.SearchContext[iHti, ctxb[ctx].map]; END ELSE [] _ OpenIncludedTable[iMdi_mdi]; sei _ CopyCtxSe[LOOPHOLE[iSei, ISEIndex], hti, ctx, iMdi]; CloseIncludedTable[]; [] _ OpenIncludedTable[mdi]; END; END; END; cons => SELECT typeTag FROM mode => sei _ typeTYPE; basic => sei _ iSei; transfer => sei _ CopyNonCtxSe[LOOPHOLE[iSei, CSEIndex], mdi]; ENDCASE => BEGIN i: TypeCacheIndex = TypeHash[mdi, iSei]; IF typeCache[i].iSei = iSei AND typeCache[i].mdi = mdi THEN sei _ typeCache[i].sei ELSE BEGIN sei _ CopyNonCtxSe[LOOPHOLE[iSei, CSEIndex], mdi]; typeCache[i] _ [mdi:mdi, iSei:iSei, sei:sei]; END; END; ENDCASE; RETURN END; CopyCtxSe: PROCEDURE [iSei: ISEIndex, hti: HTIndex, ctx: CTXIndex, mdi: MDIndex] RETURNS [sei: ISEIndex] = BEGIN sei _ MakeCtxSe[hti, ctx]; CopyCtxSeInfo[sei, iSei, mdi]; RETURN END; CopyCtxSeInfo: PROCEDURE [sei, iSei: ISEIndex, mdi: MDIndex] = BEGIN OPEN id: seb[sei]; IF iSeb[iSei].idCtx = CTXNull THEN id.idCtx _ CTXNull; id.extended _ iSeb[iSei].extended; id.public _ iSeb[iSei].public; id.immutable _ iSeb[iSei].immutable; id.constant _ iSeb[iSei].constant; id.linkSpace _ iSeb[iSei].linkSpace; id.idType _ CopyIncludedSymbol[iSeb[iSei].idType, mdi]; IF iSeb[iSei].idType = typeTYPE THEN id.idInfo _ CopyIncludedSymbol[iSeb[iSei].idInfo, mdi] ELSE IF iSeb[iSei].constant AND (SELECT iBase.XferMode[iSeb[iSei].idType] FROM procedure, program => TRUE, ENDCASE => FALSE) THEN id.idInfo _ CopyIncludedBody[iSeb[iSei].idInfo, sei, mdi] ELSE id.idInfo _ iSeb[iSei].idInfo; id.idValue _ iSeb[iSei].idValue; id.mark3 _ id.mark4 _ TRUE; IF id.extended THEN CopyExtension[sei, iSei, mdi] ELSE IF id.linkSpace THEN id.idInfo _ 0; END; currentBody: BTIndex; CopyExtension: PROCEDURE [sei, iSei: ISEIndex, mdi: MDIndex] = BEGIN iType: ExtensionType; iTree: Tree.Link; saveCurrentBody: BTIndex = currentBody; currentBody _ BTNull; [iType, iTree] _ iBase.FindExtension[iSei]; WITH iTree SELECT FROM subtree => IF iBase.tb[index].name = body THEN currentBody _ seb[sei].idInfo; ENDCASE; EnterExtension[sei, iType, InputExtension[iTree, mdi]]; currentBody _ saveCurrentBody; END; InputExtension: PROCEDURE [t: Tree.Link, mdi: MDIndex] RETURNS [Tree.Link] = BEGIN InputTree: Tree.Map = BEGIN WITH link: t SELECT FROM hash => v _ [hash[index: MapHti[link.index]]]; symbol => v _ [symbol[index: LOOPHOLE[CopyIncludedSymbol[link.index, mdi]]]]; literal => v _ InputLiteral[link]; subtree => BEGIN iNode: Tree.Index = link.index; node: Tree.Index; SELECT iBase.tb[iNode].name FROM block => v _ InputBlock[iNode]; openx => v _ TreeOps.CopyTree[ [baseP:@iBase.tb, link:iBase.tb[iNode].son[1]], InputTree]; ENDCASE => BEGIN v _ TreeOps.CopyTree[[baseP:@iBase.tb, link:link], InputTree]; WITH v SELECT FROM subtree => BEGIN node _ index; SELECT tb[node].name FROM body => tb[node].info _ currentBody; IN [basicTC..discrimTC], cdot, IN [callx..typecode], exlist => BEGIN tb[node].info _ CopyIncludedSymbol[iBase.tb[iNode].info, mdi]; SELECT tb[node].name FROM construct, exlist => FillRecord[tb[node].info, mdi]; union => WITH tb[node].son[1] SELECT FROM symbol => FillRecord[UnderType[index], mdi]; ENDCASE => ERROR; ENDCASE; END; IN [assign..join] => tb[node].info _ LAST[CARDINAL]; ENDCASE; END; ENDCASE => NULL; END; END; ENDCASE => ERROR; RETURN END; InputLiteral: PROCEDURE [t: literal Tree.Link] RETURNS [Tree.Link] = BEGIN WITH t.info SELECT FROM word => index _ LiteralOps.CopyLiteral[[baseP:@iBase.ltb, index:index]]; ENDCASE => ERROR; RETURN [t] END; InputBlock: PROCEDURE [iNode: Tree.Index] RETURNS [v: Tree.Link] = BEGIN OPEN TreeOps; iBti: BTIndex = iBase.tb[iNode].info; bti: BTIndex = Table.Allocate[bodyType, SIZE[Other BodyRecord]]; ctx: IncludedCTXIndex = FindIncludedCtx[mdi, iBase.bb[iBti].localCtx]; bb[bti] _ BodyRecord[ link: , firstSon: BTNull, localCtx: ctx, level: iBase.bb[iBti].level, info: , extension: Other[]]; LinkBti[bti: bti, parent: currentBody]; currentBody _ bti; PushTree[InputTree[iBase.tb[iNode].son[1]]]; PushTree[InputTree[iBase.tb[iNode].son[2]]]; PushNode[block, 2]; SetAttr[1, iBase.tb[iNode].attr1]; SetAttr[2, iBase.tb[iNode].attr2]; SetAttr[3, iBase.tb[iNode].attr3]; SetInfo[bti]; v _ PopTree[]; bb[bti].info _ BodyInfo[Internal[ bodyTree: GetNode[v], sourceIndex: , thread: Tree.NullIndex, frameSize: ]]; currentBody _ ParentBti[bti]; RETURN END; RETURN [InputTree[t]] END; CopyIncludedBody: PROCEDURE [iBti: CBTIndex, sei: ISEIndex, mdi: MDIndex] RETURNS [bti: CBTIndex] = BEGIN iCtx: CTXIndex; IF iBti = BTNull THEN bti _ CBTNull ELSE BEGIN iCtx _ iBase.bb[iBti].localCtx; WITH body: iBase.bb[iBti] SELECT FROM Outer => BEGIN bti _ Table.Allocate[bodyType, SIZE[Outer Callable BodyRecord]]; bb[LOOPHOLE[bti, OCBTIndex]] _ body; END; Inner => BEGIN bti _ Table.Allocate[bodyType, SIZE[Inner Callable BodyRecord]]; bb[LOOPHOLE[bti, ICBTIndex]] _ body; END; ENDCASE => ERROR; bb[bti].link _ [parent, BTNull]; bb[bti].firstSon _ BTNull; bb[bti].id _ sei; IF iBase.bb[iBti].inline THEN BEGIN bb[bti].ioType _ CopyBodyType[iBase.bb[iBti].ioType, mdi]; bb[bti].localCtx _ IF iCtx = CTXNull THEN CTXNull ELSE FindIncludedCtx[mdi, iCtx]; WITH body: bb[bti].info SELECT FROM Internal => BEGIN body.thread _ Tree.NullIndex; body.bodyTree _ Tree.NullIndex; END; ENDCASE; END ELSE BEGIN bb[bti].ioType _ UnderType[seb[sei].idType]; bb[bti].localCtx _ IF iBase.bb[iBti].level = lG THEN FindIncludedCtx[mdi, iCtx] ELSE CTXNull; END; END; RETURN END; CopyNonCtxSe: PROCEDURE [iSei: CSEIndex, mdi: MDIndex] RETURNS [sei: CSEIndex] = BEGIN tSei1, tsei2, tsei3: SEIndex; rSei1, rSei2: RecordSEIndex; tag: ISEIndex; tCtx: CTXIndex; WITH iType: iSeb[iSei] SELECT FROM enumerated => BEGIN sei _ MakeNonCtxSe[SIZE[enumerated cons SERecord]]; tCtx _ IF iType.valueCtx IN StandardContext THEN iType.valueCtx ELSE CopyIncludedValues[iType.valueCtx, mdi, sei]; seb[sei].typeInfo _ enumerated[ ordered: iType.ordered, valueCtx: tCtx, nValues: iType.nValues]; END; record => BEGIN tCtx _ IF iType.fieldCtx IN StandardContext THEN iType.fieldCtx ELSE FindIncludedCtx[mdi, iType.fieldCtx]; WITH iType SELECT FROM notLinked => BEGIN sei _ MakeNonCtxSe[SIZE[notLinked record cons SERecord]]; seb[sei].typeInfo _ record[ machineDep: iType.machineDep, argument: iType.argument, hints: iType.hints, fieldCtx: tCtx, length: iType.length, lengthUsed: FALSE, monitored: iType.monitored, linkPart: notLinked[]]; END; linked => BEGIN sei _ MakeNonCtxSe[SIZE[linked record cons SERecord]]; tSei1 _ CopyIncludedSymbol[linkType, mdi]; seb[sei].typeInfo _ record[ machineDep: iType.machineDep, argument: iType.argument, hints: iType.hints, fieldCtx: tCtx, length: iType.length, lengthUsed: FALSE, monitored: iType.monitored, linkPart: linked[linkType: tSei1]]; END; ENDCASE; END; pointer => BEGIN sei _ MakeNonCtxSe[SIZE[pointer cons SERecord]]; tSei1 _ CopyIncludedSymbol[iType.refType, mdi]; seb[sei].typeInfo _ pointer[ refType: tSei1, readOnly: iType.readOnly, ordered: iType.ordered, basing: iType.basing, dereferenced: FALSE]; END; array => BEGIN sei _ MakeNonCtxSe[SIZE[array cons SERecord]]; tSei1 _ CopyIncludedSymbol[iType.indexType, mdi]; tsei2 _ CopyIncludedSymbol[iType.componentType, mdi]; seb[sei].typeInfo _ array[ oldPacked: iType.oldPacked, indexType: tSei1, componentType: tsei2, comparable: iType.comparable, lengthUsed: FALSE]; END; arraydesc => BEGIN sei _ MakeNonCtxSe[SIZE[arraydesc cons SERecord]]; tSei1 _ CopyIncludedSymbol[iType.describedType, mdi]; seb[sei].typeInfo _ arraydesc[ readOnly: iType.readOnly, describedType: tSei1]; END; transfer => BEGIN sei _ MakeNonCtxSe[SIZE[transfer cons SERecord]]; rSei1 _ CopyArgRecord[iType.inRecord, mdi, FALSE]; rSei2 _ CopyArgRecord[iType.outRecord, mdi, FALSE]; seb[sei].typeInfo _ transfer[ mode: iType.mode, inRecord: rSei1, outRecord: rSei2]; END; definition => BEGIN sei _ MakeNonCtxSe[SIZE[definition cons SERecord]]; tCtx _ FindIncludedCtx[mdi, iType.defCtx]; seb[sei].typeInfo _ definition[ nGfi: iType.nGfi, named: iType.named, defCtx: tCtx]; END; union => BEGIN sei _ MakeNonCtxSe[SIZE[union cons SERecord]]; tCtx _ FindIncludedCtx[mdi, iType.caseCtx]; tag _ CopyCtxSe[iType.tagSei, MapHti[iSeb[iType.tagSei].hash], CTXNull, mdi]; seb[sei].typeInfo _ union[ caseCtx: tCtx, overlayed: iType.overlayed, controlled: iType.controlled, tagSei: tag, equalLengths: iType.equalLengths]; END; relative => BEGIN sei _ MakeNonCtxSe[SIZE[relative cons SERecord]]; tSei1 _ CopyIncludedSymbol[iType.baseType, mdi]; tsei2 _ CopyIncludedSymbol[iType.offsetType, mdi]; tsei3 _ IF iType.resultType = iType.offsetType THEN tsei2 ELSE CopyIncludedSymbol[iType.resultType, mdi]; seb[sei].typeInfo _ relative[ baseType: tSei1, offsetType: tsei2, resultType: tsei3]; END; subrange => BEGIN sei _ MakeNonCtxSe[SIZE[subrange cons SERecord]]; tSei1 _ CopyIncludedSymbol[iType.rangeType, mdi]; seb[sei].typeInfo _ subrange[ filled: iType.filled, empty: iType.empty, flexible: iType.flexible, rangeType: tSei1, origin: iType.origin, range: iType.range]; END; long => BEGIN sei _ MakeNonCtxSe[SIZE[long cons SERecord]]; tSei1 _ CopyIncludedSymbol[iType.rangeType, mdi]; seb[sei].typeInfo _ long[rangeType: tSei1]; END; real => BEGIN sei _ MakeNonCtxSe[SIZE[real cons SERecord]]; tSei1 _ CopyIncludedSymbol[iType.rangeType, mdi]; seb[sei].typeInfo _ real[rangeType: tSei1]; END; ENDCASE => ERROR; seb[sei].mark3 _ seb[sei].mark4 _ TRUE; RETURN END; CopyBodyType: PROCEDURE [iSei: CSEIndex, mdi: MDIndex] RETURNS [sei: CSEIndex] = BEGIN rSei1, rSei2: RecordSEIndex; WITH iType: iSeb[iSei] SELECT FROM transfer => BEGIN sei _ MakeNonCtxSe[SIZE[transfer cons SERecord]]; rSei1 _ CopyArgRecord[iType.inRecord, mdi, TRUE]; rSei2 _ CopyArgRecord[iType.outRecord, mdi, TRUE]; seb[sei].typeInfo _ transfer[ mode: iType.mode, inRecord: rSei1, outRecord: rSei2]; END; ENDCASE => ERROR; seb[sei].mark3 _ seb[sei].mark4 _ TRUE; RETURN END; CopyArgRecord: PROCEDURE [ irSei: RecordSEIndex, mdi: MDIndex, mapped: BOOLEAN] RETURNS [rSei: RecordSEIndex] = BEGIN ctx, iCtx: CTXIndex; sei, iSei, seChain: ISEIndex; i: TypeCacheIndex; IF irSei = SENull THEN rSei _ RecordSENull ELSE BEGIN rSei _ LOOPHOLE[MakeNonCtxSe[SIZE[notLinked record cons SERecord]]]; iCtx _ iSeb[irSei].fieldCtx; IF ~mapped THEN ctx _ NewCtx[iCtxb[iCtx].level] ELSE BEGIN ctx _ FindIncludedCtx[mdi, iCtx]; ResetCtx[LOOPHOLE[ctx]]; END; IF ctxb[ctx].seList = ISENull THEN BEGIN seChain _ MakeSeChain[ctx, iBase.CtxEntries[iCtx], FALSE]; ctxb[ctx].seList _ seChain; FOR iSei _ iCtxb[iCtx].seList, iBase.NextSe[iSei] UNTIL iSei = ISENull DO sei _ seChain; seChain _ NextSe[seChain]; seb[sei].hash _ MapHti[iSeb[iSei].hash]; CopyCtxSeInfo[sei, iSei, mdi]; ENDLOOP; END; seb[rSei] _ SERecord[ mark3: TRUE, mark4: TRUE, body: cons[ record[ machineDep: FALSE, argument: TRUE, hints: iSeb[irSei].hints, fieldCtx: ctx, length: iSeb[irSei].length, lengthUsed: FALSE, monitored: FALSE, linkPart: notLinked[]]]]; i _ TypeHash[mdi, irSei]; typeCache[i] _ [mdi:mdi, iSei:irSei, sei:rSei]; END; RETURN END; CopyIncludedValues: PROCEDURE [iCtx: CTXIndex, mdi: MDIndex, type: SEIndex] RETURNS [ctx: IncludedCTXIndex] = BEGIN iSei, sei, seChain: ISEIndex; ctx _ FindIncludedCtx[mdi, iCtx]; iSei _ iCtxb[iCtx].seList; IF iSei # SENull AND iSeb[iSeb[iSei].idType].seTag # id THEN BEGIN seChain _ MakeSeChain[ctx, iBase.CtxEntries[iCtx], FALSE]; ctxb[ctx].seList _ seChain; ctxb[ctx].closed _ ctxb[ctx].reset _ TRUE; UNTIL iSei = SENull DO sei _ seChain; seChain _ NextSe[seChain]; seb[sei].hash _ MapHti[iSeb[iSei].hash]; seb[sei].extended _ seb[sei].linkSpace _ FALSE; seb[sei].immutable _ seb[sei].constant _ TRUE; seb[sei].public _ iSeb[iSei].public; seb[sei].idType _ type; seb[sei].idInfo _ 0; seb[sei].idValue _ iSeb[iSei].idValue; seb[sei].mark3 _ seb[sei].mark4 _ TRUE; iSei _ iBase.NextSe[iSei]; ENDLOOP; ctxb[ctx].complete _ TRUE; END; RETURN END; -- included module accounting ResetCtx: PROCEDURE [ctx: IncludedCTXIndex] = BEGIN IF ~ctxb[ctx].reset THEN BEGIN ResetCtxList[ctx]; ctxb[ctx].closed _ ctxb[ctx].reset _ TRUE; END; END; ResetIncludeContexts: PUBLIC PROCEDURE = BEGIN mdi: MDIndex; limit: MDIndex = LOOPHOLE[Table.Bounds[mdType].size]; ctx: IncludedCTXIndex; FOR mdi _ FIRST[MDIndex], mdi + SIZE[MDRecord] UNTIL mdi = limit DO FOR ctx _ mdb[mdi].ctx, ctxb[ctx].chain UNTIL ctx = CTXNull DO ResetCtx[ctx] ENDLOOP; ENDLOOP; ResetCaches[]; END; TableRelocated: PUBLIC SIGNAL = CODE; OpenIncludedTable: PUBLIC PROCEDURE [mdi: MDIndex] RETURNS [success: BOOLEAN] = BEGIN base: SymbolTable.Base = Copier.GetSymbolTable[mdi]; IF success _ (base # NIL) THEN BEGIN iBase _ base; iBase.notifier _ IRelocNotify; INotify[] END; RETURN END; IRelocNotify: PROCEDURE [base: SymbolTable.Base] = BEGIN IF base = iBase THEN BEGIN INotify[]; SIGNAL TableRelocated END; END; CloseIncludedTable: PUBLIC PROCEDURE = BEGIN iBase.notifier _ iBase.NullNotifier; Copier.FreeSymbolTable[iBase]; END; END.