-- file SymbolCopier.mesa -- last modified by Satterthwaite, May 21, 1982 2:04 pm DIRECTORY Alloc: TYPE USING [Handle, Notifier, AddNotify, DropNotify, Top, Words], Copier: TYPE USING [FindMdEntry, FreeSymbolTable, GetSymbolTable], Inline: TYPE USING [LongDivMod, LongMult], LiteralOps: TYPE USING [CopyLiteral], OSMiscOps: TYPE USING [FreeWords, Words], Strings: TYPE USING [SubString, SubStringDescriptor], SymbolTable: TYPE USING [Base], Symbols: TYPE, SymbolOps: TYPE USING [ EnterExtension, EnterString, FirstCtxSe, LinkBti, MakeCtxSe, MakeNonCtxSe, MakeSeChain, NewCtx, NextSe, ParentBti, RCType, ResetCtxList, SearchContext, SetSeLink, SubStringForHash, UnderType], SymbolPack: TYPE, Tree: TYPE USING [Base, Index, Link, Map, Scan, NullIndex, treeType], TreeOps: TYPE USING [ CopyTree, GetNode, OpName, PopTree, PushNode, PushTree, ScanList, SetAttr, SetInfo]; SymbolCopier: PROGRAM IMPORTS Alloc, Copier, Inline, LiteralOps, OSMiscOps, TreeOps, ownSymbols: SymbolPack, SymbolOps EXPORTS Copier = { OPEN SymbolOps, Symbols; -- tables defining the current symbol table table: Alloc.Handle; seb: Symbols.Base; -- se table ctxb: Symbols.Base; -- context table mdb: Symbols.Base; -- module directory base bb: Symbols.Base; -- body table tb: Tree.Base; -- tree table CopierNotify: Alloc.Notifier = { -- called whenever the main symbol table is repacked seb ← base[seType]; ctxb ← base[ctxType]; mdb ← base[mdType]; bb ← base[bodyType]; tb ← base[Tree.treeType]; IF iBase # NIL AND iBase = ownSymbols THEN INotify[]}; -- table bases for the current include module iBase: SymbolTable.Base; iHt: LONG DESCRIPTOR FOR ARRAY HTIndex OF HTRecord; iSeb: Symbols.Base; iCtxb: Symbols.Base; INotify: PROC = { -- called whenever iBase switches or tables moved iHt ← iBase.ht; iSeb ← iBase.seb; iCtxb ← iBase.ctxb}; MemoCacheSize: CARDINAL = 509; -- prime < 512 SearchCache: TYPE = ARRAY [0..MemoCacheSize) OF RECORD[ hti: HTIndex, ctx: CTXIndex]; memoCache: LONG POINTER TO SearchCache; -- initialization/finalization CopierInit: PUBLIC PROC [ ownTable: Alloc.Handle, symbolCachePages: CARDINAL, useMemo: BOOLEAN] = { iBase ← NIL; table ← ownTable; table.AddNotify[CopierNotify]; IF useMemo THEN { memoCache ← OSMiscOps.Words[SIZE[SearchCache]]; memoCache↑ ← ALL[ [hti:HTNull, ctx:CTXNull] ]; typeCache ← OSMiscOps.Words[SIZE[TypeCache]]; typeCache↑ ← ALL[ [mdi:MDNull, iSei:SENull, sei: SENull] ]} ELSE {memoCache ← NIL; typeCache ← NIL}; currentBody ← BTNull}; ResetCaches: PROC = INLINE { -- see ResetIncludeContexts IF typeCache # NIL THEN OSMiscOps.FreeWords[typeCache]; IF memoCache # NIL THEN OSMiscOps.FreeWords[memoCache]}; CopierReset: PUBLIC PROC = { ResetIncludeContexts[]; table.DropNotify[CopierNotify]; table ← NIL}; -- manipulation of symbol tokens (without copying) SEToken: PUBLIC TYPE = RECORD[ISEIndex]; nullSEToken: PUBLIC SEToken ← [ISENull]; CtxValue: PUBLIC PROC [ctx: CTXIndex, value: CARDINAL] RETURNS [t: SEToken] = { mdi: MDIndex; iCtx: CTXIndex; [mdi, iCtx] ← InverseMapCtx[ctx]; IF OpenIncludedTable[mdi] THEN { t ← [iBase.SeiForValue[value, iCtx]]; CloseIncludedTable[]} ELSE t ← nullSEToken; RETURN}; CtxFirst: PUBLIC PROC [ctx: CTXIndex] RETURNS [t: SEToken] = { mdi: MDIndex; iCtx: CTXIndex; [mdi, iCtx] ← InverseMapCtx[ctx]; IF OpenIncludedTable[mdi] THEN { t ← [iBase.FirstCtxSe[iCtx]]; CloseIncludedTable[]} ELSE t ← nullSEToken; RETURN}; CtxNext: PUBLIC PROC [ctx: CTXIndex, t: SEToken] RETURNS [next: SEToken] = { mdi: MDIndex; iCtx: CTXIndex; [mdi, iCtx] ← InverseMapCtx[ctx]; IF t # nullSEToken AND OpenIncludedTable[mdi] THEN { next ← [iBase.NextSe[t]]; CloseIncludedTable[]} ELSE next ← nullSEToken; RETURN}; TokenHash: PUBLIC PROC [ctx: CTXIndex, t: SEToken] RETURNS [hti: HTIndex] = { mdi: MDIndex = InverseMapCtx[ctx].mdi; IF t # nullSEToken AND OpenIncludedTable[mdi] THEN { hti ← MapHti[iBase.seb[t].hash]; CloseIncludedTable[]} ELSE hti ← HTNull; RETURN}; TokenValue: PUBLIC PROC [ctx: CTXIndex, t: SEToken] RETURNS [v: WORD] = { mdi: MDIndex = InverseMapCtx[ctx].mdi; IF t # nullSEToken AND OpenIncludedTable[mdi] THEN { v ← iBase.seb[t].idValue; CloseIncludedTable[]} ELSE v ← 0; RETURN}; TokenSymbol: PUBLIC PROC [ctx: CTXIndex, t: SEToken] RETURNS [sei: ISEIndex] = { mdi: MDIndex = InverseMapCtx[ctx].mdi; SELECT TRUE FROM (mdi = OwnMdi) => sei ← t; OpenIncludedTable[mdi] => { sei ← LOOPHOLE[CopyIncludedSymbol[t, mdi]]; CloseIncludedTable[]}; ENDCASE => sei ← ISENull; RETURN}; -- copying across table boundaries SubString: TYPE = Strings.SubString; SubStringDescriptor: TYPE = Strings.SubStringDescriptor; SearchFileCtx: PUBLIC PROC [hti: HTIndex, ctx: IncludedCTXIndex] RETURNS [found: BOOLEAN, sei: ISEIndex] = { desc: SubStringDescriptor; s: SubString = @desc; hash: [0..MemoCacheSize); iHti: HTIndex; iSei: ISEIndex; mdi: MDIndex = ctxb[ctx].module; SubStringForHash[s, hti]; hash ← Inline.LongDivMod[ Inline.LongMult[LOOPHOLE[hti], LOOPHOLE[ctx]], MemoCacheSize].remainder; IF memoCache # NIL AND memoCache[hash].hti = hti AND memoCache[hash].ctx = ctx THEN RETURN [FALSE, ISENull]; IF OpenIncludedTable[mdi] THEN { iHti ← iBase.FindString[s]; IF iHti # HTNull AND (iHt[iHti].anyPublic OR iHt[iHti].anyInternal) THEN { iSei ← iBase.SearchContext[iHti, ctxb[ctx].map]; IF (found ← iSei # SENull) THEN sei ← CopyCtxSe[iSei, hti, ctx, mdi]} ELSE {found ← FALSE; sei ← ISENull}; CloseIncludedTable[]} ELSE {found ← FALSE; sei ← ISENull}; IF ~found AND memoCache # NIL THEN memoCache[hash] ← [hti:hti, ctx:ctx]; RETURN}; Delink: PUBLIC PROC [sei: ISEIndex] = { 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 { IF sei = ctxb[ctx].seList THEN ctxb[ctx].seList ← prev; SetSeLink[prev, NextSe[sei]]}; SetSeLink[sei, ISENull]}; CopySymbol: PUBLIC PROC [mdi: MDIndex, iSei: SEIndex, depth: Closure] RETURNS [sei: SEIndex] = { SELECT TRUE FROM (mdi = OwnMdi) => sei ← iSei; OpenIncludedTable[mdi] => { sei ← CopyIncludedSymbol[iSei, mdi]; WITH s: seb[sei] SELECT FROM id => { CompleteType[s.idType, mdi, depth]; IF s.idType = typeTYPE THEN CompleteType[s.idInfo, mdi, depth]} ENDCASE => CompleteType[sei, mdi, depth]; CloseIncludedTable[]}; ENDCASE => sei ← SENull; RETURN}; -- context completion CompleteContext: PUBLIC PROC [ctx: IncludedCTXIndex, depth: Closure ← unit] = { IF ctxb[ctx].copied < depth AND OpenIncludedTable[ctxb[ctx].module] THEN { FillContext[ctx, depth]; CloseIncludedTable[]}}; AugmentContext: PUBLIC PROC [ctx: IncludedCTXIndex, mdi: MDIndex] = { mdRoot: MDIndex; target: CTXIndex; [mdRoot, target] ← InverseMapCtx[ctx]; IF ~ctxb[ctx].reset AND OpenIncludedTable[mdi] THEN { newMdi: MDIndex = iBase.FindMdi[mdb[mdRoot].stamp]; IF newMdi # MDNull THEN FOR iCtx: IncludedCTXIndex ← iBase.mdb[newMdi].ctx, iBase.ctxb[iCtx].chain UNTIL iCtx = CTXNull DO IF iBase.ctxb[iCtx].map = target THEN { CopyCtxEntries[ctx, iCtx, mdi, unit]; IF ~iBase.ctxb[iCtx].complete THEN ctxb[ctx].complete ← FALSE; IF ctxb[ctx].complete THEN ResetCtx[ctx]; EXIT}; ENDLOOP; CloseIncludedTable[]}}; FillContext: PROC [ctx: IncludedCTXIndex, depth: Closure] = { mdi: MDIndex = ctxb[ctx].module; CopyCtxEntries[ctx, ctxb[ctx].map, mdi, depth]; ResetCtx[ctx]}; CopyContext: PROC [ctx, iCtx: CTXIndex, mdi: MDIndex, depth: Closure] = { WITH ctxb[ctx] SELECT FROM included => { tCtx: IncludedCTXIndex = LOOPHOLE[ctx]; IF ctxb[tCtx].copied < depth AND (~ctxb[tCtx].closed OR depth > unit) THEN { ctxb[tCtx].closed ← TRUE; CopyCtxEntries[tCtx, iCtx, mdi, depth]; ResetCtx[tCtx]}}; ENDCASE => NULL}; CopyCtxEntries: PROC [ctx: IncludedCTXIndex, iCtx: CTXIndex, mdi: MDIndex, depth: Closure] = { IF ctxb[ctx].copied < depth THEN { pSei: ISEIndex ← ISENull; ctxb[ctx].copied ← depth; FOR iSei: ISEIndex ← iBase.FirstCtxSe[iCtx], iBase.NextSe[iSei] UNTIL iSei = SENull DO hti: HTIndex = MapHti[iSeb[iSei].hash]; sei: ISEIndex ← IF hti = HTNull AND ctxb[ctx].reset THEN FirstCtxSe[ctx] ELSE SearchContext[hti, ctx]; IF ~ctxb[ctx].reset THEN { IF sei = SENull THEN sei ← CopyCtxSe[iSei, hti, ctx, mdi]; IF pSei # SENull AND NextSe[pSei] # sei THEN { Delink[sei]; SetSeLink[sei, NextSe[pSei]]; SetSeLink[pSei, sei]}; ctxb[ctx].seList ← pSei ← sei}; IF depth > unit AND sei # SENull THEN { subType: CSEIndex = UnderType[IF seb[sei].idType = typeTYPE THEN sei ELSE seb[sei].idType]; IF (depth = rc AND RCType[subType] # none) OR depth > rc THEN IF seb[sei].idType = typeTYPE THEN CompleteVariant[sei, mdi, depth] ELSE CompleteType[subType, mdi, depth]}; ENDLOOP; ctxb[ctx].complete ← TRUE}}; -- recursive type completion CompleteType: PROC [sei: SEIndex, mdi: MDIndex, depth: Closure] = { -- N.B. still incomplete if depth > rc type: CSEIndex = UnderType[sei]; WITH t: seb[type] SELECT FROM enumerated => IF depth > rc THEN CompleteEnumeration[type, mdi, depth]; record => CompleteRecord[type, mdi, TRUE, depth]; ref => IF depth > rc THEN CompleteType[t.refType, mdi, depth]; array => { CompleteType[t.indexType, mdi, depth]; CompleteType[t.componentType, mdi, depth]}; arraydesc => IF depth > rc THEN CompleteType[t.describedType, mdi, depth]; transfer, definition => NULL; -- *** temporary *** union => CompleteUnion[type, mdi, depth]; sequence => { CompleteType[seb[t.tagSei].idType, mdi, depth]; CompleteType[t.componentType, mdi, depth]}; relative => { CompleteType[t.baseType, mdi, depth]; CompleteType[t.offsetType, mdi, depth]}; subrange => CompleteType[t.rangeType, mdi, depth]; long, real => CompleteType[t.rangeType, mdi, depth]; ENDCASE => NULL}; CompleteEnumeration: PROC [sei: CSEIndex, mdi: MDIndex, depth: Closure] = { WITH type: seb[sei] SELECT FROM enumerated => { WITH c: ctxb[type.valueCtx] SELECT FROM included => IF c.copied < depth THEN { IF c.module = mdi THEN FillContext[LOOPHOLE[type.valueCtx], depth] ELSE { CloseIncludedTable[]; CompleteContext[LOOPHOLE[type.valueCtx], depth]; [] ← OpenIncludedTable[mdi]}}; ENDCASE => NULL}; ENDCASE => NULL}; CompleteRecord: PROC [sei: CSEIndex, mdi: MDIndex, doLink: BOOLEAN, depth: Closure ← unit] = { WITH type: seb[sei] SELECT FROM record => { WITH type SELECT FROM linked => IF doLink THEN CompleteRecord[UnderType[linkType], mdi, TRUE, depth]; ENDCASE => NULL; WITH c: ctxb[type.fieldCtx] SELECT FROM included => IF c.copied < depth THEN { IF c.module = mdi THEN FillContext[LOOPHOLE[type.fieldCtx], depth] ELSE { CloseIncludedTable[]; CompleteContext[LOOPHOLE[type.fieldCtx], depth]; [] ← OpenIncludedTable[mdi]}}; ENDCASE => NULL}; ENDCASE => NULL}; CompleteUnion: PROC [sei: CSEIndex, mdi: MDIndex, depth: Closure] = { WITH type: seb[sei] SELECT FROM union => { CompleteType[seb[type.tagSei].idType, mdi, depth]; WITH c: ctxb[type.caseCtx] SELECT FROM included => IF c.copied < depth THEN { IF c.module = mdi THEN FillContext[LOOPHOLE[type.caseCtx], depth] ELSE { CloseIncludedTable[]; CompleteContext[LOOPHOLE[type.caseCtx], depth]; [] ← OpenIncludedTable[mdi]}}; ENDCASE => NULL}; ENDCASE => NULL}; CompleteVariant: PROC [sei: ISEIndex, mdi: MDIndex, depth: Closure] = { type: CSEIndex = UnderType[sei]; WITH seb[type] SELECT FROM record => CompleteRecord[type, mdi, FALSE, depth]; ENDCASE => NULL}; -- variant copying CopyUnion: PUBLIC PROC [ctx: CTXIndex, depth: Closure ← none] = { WITH c: ctxb[ctx] SELECT FROM included => IF ~c.reset AND OpenIncludedTable[c.module] THEN { FillUnionPart[LOOPHOLE[ctx], depth]; CloseIncludedTable[]}; ENDCASE}; FillUnionPart: PROC [ctx: IncludedCTXIndex, depth: Closure ← none] = { iRoot: ISEIndex = iCtxb[ctxb[ctx].map].seList; iSei: ISEIndex ← iRoot; DO IF iSei = SENull THEN EXIT; SELECT iBase.TypeForm[iSeb[iSei].idType] FROM union, sequence => { IF iSeb[iSei].hash # HTNull THEN [] ← CopyIncludedSymbol[iSei, ctxb[ctx].module] ELSE FillContext[LOOPHOLE[ctx], MAX[unit, depth]]; EXIT}; ENDCASE; IF (iSei ← iBase.NextSe[iSei]) = iRoot THEN EXIT; ENDLOOP}; FillUnion: PROC [sei: CSEIndex, mdi: MDIndex] = { WITH type: seb[sei] SELECT FROM record => { WITH c: ctxb[type.fieldCtx] SELECT FROM included => IF ~c.reset THEN { IF c.module = mdi THEN FillUnionPart[LOOPHOLE[type.fieldCtx]] ELSE { CloseIncludedTable[]; CopyUnion[type.fieldCtx]; [] ← OpenIncludedTable[mdi]}}; ENDCASE => NULL}; ENDCASE => NULL}; -- mappings MapHti: PROC [iHti: HTIndex] RETURNS [hti: HTIndex] = { desc: SubStringDescriptor; s: SubString = @desc; IF iHti = HTNull THEN hti ← HTNull ELSE { iBase.SubStringForHash[s, iHti]; hti ← EnterString[s ! TableRelocated => {s.base ← iBase.ssb}]}; RETURN}; MissingHti: ERROR = CODE; InverseMapHti: PROC [hti: HTIndex] RETURNS [iHti: HTIndex] = { desc: SubStringDescriptor; s: SubString = @desc; IF hti = HTNull THEN iHti ← HTNull ELSE { SubStringForHash[s, hti]; iHti ← iBase.FindString[s]; IF iHti = HTNull THEN ERROR MissingHti}; RETURN}; FindExternalCtx: PUBLIC PROC [mdi: MDIndex, iCtx: CTXIndex] RETURNS [ctx: IncludedCTXIndex] = { IF mdi # MDNull AND OpenIncludedTable[mdi] THEN { ctx ← MapCtx[mdi, iCtx]; CloseIncludedTable[]} ELSE ctx ← IncludedCTXNull; RETURN}; MapCtx: PROC [mdi: MDIndex, iCtx: CTXIndex] RETURNS [IncludedCTXIndex] = { ctx, last: IncludedCTXIndex; target: CTXIndex; mdRoot: MDIndex; IF iCtx = CTXNull THEN {mdRoot ← mdi; target ← CTXNull} ELSE { WITH iCtxb[iCtx] SELECT FROM included => [mdRoot, target] ← IncludedTargets[LOOPHOLE[iCtx]]; imported => { IF iBase.mdb[iCtxb[includeLink].module].defaultImport # iCtx THEN ERROR; -- need a signal to raise [mdRoot, target] ← IncludedTargets[includeLink]}; ENDCASE => {mdRoot ← mdi; target ← iCtx}}; last ← IncludedCTXNull; FOR ctx ← mdb[mdRoot].ctx, ctxb[ctx].chain UNTIL ctx = CTXNull DO IF ctxb[ctx].map = target AND target # CTXNull THEN RETURN [ctx]; last ← ctx; ENDLOOP; ctx ← table.Words[ctxType, SIZE[included CTXRecord]]; ctxb[ctx] ← CTXRecord[ mark: FALSE, varUpdated: FALSE, seList: ISENull, level: IF iCtx = CTXNull THEN lZ ELSE iCtxb[iCtx].level, extension: included[ chain: IncludedCTXNull, module: mdRoot, map: target, restricted: FALSE, complete: FALSE, closed: FALSE, reset: FALSE]]; IF last = IncludedCTXNull THEN mdb[mdRoot].ctx ← ctx ELSE ctxb[last].chain ← ctx; RETURN [ctx]}; InverseMapCtx: PROC [ctx: CTXIndex] RETURNS [mdi: MDIndex, iCtx: CTXIndex] = { WITH ctxb[ctx] SELECT FROM included => {mdi ← module; iCtx ← map}; imported => [mdi, iCtx] ← InverseMapCtx[includeLink]; ENDCASE => {mdi ← OwnMdi; iCtx ← ctx}; RETURN}; IncludedTargets: PROC [iCtx: IncludedCTXIndex] RETURNS [mdi: MDIndex, ctx: CTXIndex] = { 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}; UnknownModule: PUBLIC SIGNAL [HTIndex] = CODE; FillModule: PUBLIC PROC [sei: ISEIndex, typeId: HTIndex, mdi: MDIndex] = { iHti: HTIndex; iSei: ISEIndex; IF mdi = MDNull OR ~OpenIncludedTable[mdi] THEN DummyCtxSe[sei] ELSE { -- allow failure exit BEGIN iHti ← InverseMapHti[typeId ! MissingHti => {GO TO failed}]; iSei ← iBase.SearchContext[iHti, iBase.stHandle.directoryCtx]; IF iSei = ISENull OR ~iSeb[iSei].public THEN GO TO failed; CopyCtxSeInfo[sei, iSei, mdi]; seb[sei].public ← FALSE; EXITS failed => {SIGNAL UnknownModule[seb[sei].hash]; DummyCtxSe[sei]}; END; CloseIncludedTable[]}}; DummyCtxSe: PROC [sei: ISEIndex] = { seb[sei].idType ← typeANY; seb[sei].idInfo ← seb[sei].idValue ← 0; seb[sei].extended ← seb[sei].public ← seb[sei].linkSpace ← FALSE; seb[sei].immutable ← seb[sei].constant ← TRUE; seb[sei].mark3 ← seb[sei].mark4 ← TRUE}; -- 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: LONG POINTER TO TypeCache; TypeHash: PROC [mdi: MDIndex, iSei: SEIndex] RETURNS [TypeCacheIndex] = INLINE { RETURN [(LOOPHOLE[mdi,CARDINAL]*LOOPHOLE[iSei,CARDINAL]) MOD TypeCacheSize]}; CacheType: PROC [mdi: MDIndex, iSei, sei: SEIndex] = { IF typeCache # NIL THEN typeCache[TypeHash[mdi, iSei]] ← [mdi:mdi, iSei:iSei, sei:sei]}; -- copying symbols CopyIncludedSymbol: PROC [iSei: SEIndex, mdi: MDIndex] RETURNS [sei: SEIndex] = { IF iSei = SENull THEN RETURN [SENull]; WITH iSe: iSeb[iSei] SELECT FROM id => { hti: HTIndex = MapHti[iSe.hash]; IF iSe.idCtx IN StandardContext THEN { sei ← SearchContext[hti, iSe.idCtx]; IF sei = SENull THEN ERROR} ELSE { ctx: IncludedCTXIndex = MapCtx[mdi, iSe.idCtx]; tSei: ISEIndex = SearchContext[hti, ctx]; sei ← tSei; IF sei # SENull THEN seb[tSei].idCtx ← ctx ELSE { iMdi: MDIndex ← ctxb[ctx].module; IF iMdi = mdi OR ( iBase.stHandle.extended AND (~iSe.extended OR iBase.stHandle.definitionsFile) AND ~mdb[iMdi].shared) THEN sei ← CopyCtxSe[LOOPHOLE[iSei, ISEIndex], hti, ctx, mdi] ELSE { CloseIncludedTable[]; IF OpenIncludedTable[iMdi] THEN iSei ← iBase.SearchContext[InverseMapHti[hti], ctxb[ctx].map] ELSE [] ← OpenIncludedTable[iMdi←mdi]; sei ← CopyCtxSe[LOOPHOLE[iSei, ISEIndex], hti, ctx, iMdi]; CloseIncludedTable[]; [] ← OpenIncludedTable[mdi]}}}}; cons => WITH iType: iSe SELECT FROM mode => sei ← typeTYPE; basic => sei ← MapBasicType[iType.code]; ENDCASE => { i: TypeCacheIndex = TypeHash[mdi, iSei]; IF typeCache # NIL AND typeCache[i].iSei = iSei AND typeCache[i].mdi = mdi THEN sei ← typeCache[i].sei ELSE sei ← CopyNonCtxSe[LOOPHOLE[iSei, CSEIndex], mdi]}; ENDCASE; RETURN}; CopyCtxSe: PROC [iSei: ISEIndex, hti: HTIndex, ctx: CTXIndex, mdi: MDIndex] RETURNS [sei: ISEIndex] = { sei ← MakeCtxSe[hti, ctx]; CopyCtxSeInfo[sei, iSei, mdi]; RETURN}; CopyCtxSeInfo: PROC [sei, iSei: ISEIndex, mdi: MDIndex] = { 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 proc, program=> TRUE, ENDCASE=> FALSE) THEN id.idInfo ← CopyIncludedBody[iSeb[iSei].idInfo, sei, mdi] ELSE id.idInfo ← iSeb[iSei].idInfo; IF iSeb[iSei].idType = typeTYPE AND iCtxb[iSeb[iSei].idCtx].level # lZ AND ~iBase.stHandle.extended THEN id.idValue ← iSei - FIRST[ISEIndex] ELSE 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}; currentBody: BTIndex; CopyExtension: PROC [sei, iSei: ISEIndex, mdi: MDIndex] = { 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}; InputExtension: PROC [t: Tree.Link, mdi: MDIndex] RETURNS [Tree.Link] = { InputTree: Tree.Map = { 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 => { iNode: Tree.Index = link.index; v ← SELECT iBase.tb[iNode].name FROM block, ditem => InputBlock[iNode], IN [forseq .. downthru] => InputBlock[iNode], openx => TreeOps.CopyTree[[baseP:@iBase.tb, link:iBase.tb[iNode].son[1]], InputTree], ENDCASE => TreeOps.CopyTree[[baseP:@iBase.tb, link:link], InputTree]; WITH v SELECT FROM subtree => { node: Tree.Index = index; SELECT tb[node].name FROM body => tb[node].info ← currentBody; block, ditem => ExitBlock[node]; IN [basicTC..discrimTC], cdot, IN [apply..typecode], exlist => { tb[node].info ← CopyIncludedSymbol[iBase.tb[iNode].info, mdi]; SELECT tb[node].name FROM construct, exlist => CompleteRecord[tb[node].info, mdi, TRUE]; dollar => UpdateDollar[node]; union => WITH tb[node].son[1] SELECT FROM symbol => CompleteRecord[UnderType[index], mdi, FALSE]; ENDCASE => ERROR; apply => FillUnion[UnderType[tb[node].info], mdi]; bindx => FillBinding[node, mdi]; ENDCASE}; IN [forseq..downthru] => NULL; do => { IF TreeOps.OpName[tb[node].son[1]] IN [forseq..downthru] THEN ExitBlock[TreeOps.GetNode[tb[node].son[1]]]; tb[node].info ← LAST[CARDINAL]}; bind => FillBinding[node, mdi]; catch => { TreeOps.ScanList[tb[node].son[1], UpdateType]; tb[node].info ← LAST[CARDINAL]}; IN [assign..join], decl, typedecl => tb[node].info ← LAST[CARDINAL]; ENDCASE => NULL}; ENDCASE => NULL}; ENDCASE => ERROR; RETURN}; UpdateDollar: PROC [node: Tree.Index] = INLINE { WITH tb[node].son[1] SELECT FROM subtree => { sei: CSEIndex = tb[index].info; WITH type: seb[sei] SELECT FROM record => IF type.argument THEN WITH tb[node].son[2] SELECT FROM symbol => index ← SearchContext[seb[index].hash, type.fieldCtx]; ENDCASE => ERROR; ENDCASE}; ENDCASE}; UpdateType: Tree.Scan = { WITH t SELECT FROM subtree => tb[index].info ← CopyIncludedSymbol[tb[index].info, mdi]; ENDCASE}; FillBinding: PROC [node: Tree.Index, mdi: MDIndex] = { WITH tb[node].son[1] SELECT FROM subtree => { subNode: Tree.Index = index; rType: CSEIndex = WITH tb[subNode].son[2] SELECT FROM symbol => UnderType[seb[index].idType], subtree => tb[index].info, ENDCASE => ERROR; CompleteRecord[rType, mdi, FALSE]}; ENDCASE => ERROR}; InputLiteral: PROC [t: literal Tree.Link] RETURNS [Tree.Link] = { WITH t.info SELECT FROM word => index ← LiteralOps.CopyLiteral[[baseP:@iBase.ltb, index:index]]; ENDCASE => ERROR; RETURN [t]}; InputBlock: PROC [iNode: Tree.Index] RETURNS [v: Tree.Link] = { OPEN TreeOps; iBti: BTIndex = iBase.tb[iNode].info; n: CARDINAL = iBase.tb[iNode].nSons; bti: BTIndex; IF iBti = BTNull THEN bti ← BTNull ELSE { ctx: IncludedCTXIndex = MapCtx[mdi, iBase.bb[iBti].localCtx]; bti ← table.Words[bodyType, SIZE[Other BodyRecord]]; bb[bti] ← BodyRecord[ link: , firstSon: BTNull, type: LOOPHOLE[CopyIncludedSymbol[iBase.bb[iBti].type, mdi]], localCtx: ctx, level: iBase.bb[iBti].level, sourceIndex: LAST[CARDINAL], info: , extension: Other[relOffset: ]]; LinkBti[bti: bti, parent: currentBody]; currentBody ← bti}; FOR i: CARDINAL IN [1 .. n] DO PushTree[InputTree[iBase.tb[iNode].son[i]]] ENDLOOP; PushNode[iBase.tb[iNode].name, n]; SetAttr[1, iBase.tb[iNode].attr1]; SetAttr[2, iBase.tb[iNode].attr2]; SetAttr[3, iBase.tb[iNode].attr3]; SetInfo[bti]; v ← PopTree[]; IF bti # BTNull THEN bb[bti].info ← [Internal[bodyTree: GetNode[v], thread: Tree.NullIndex, frameSize: ]]; RETURN}; ExitBlock: PROC [node: Tree.Index] = INLINE { IF tb[node].info # BTNull THEN currentBody ← ParentBti[tb[node].info]}; RETURN [InputTree[t]]}; CopyExternalBody: PUBLIC PROC [mdi: MDIndex, iBti: CBTIndex] RETURNS [bti: CBTIndex] = { IF iBti # CBTNull AND mdi # MDNull AND OpenIncludedTable[mdi] THEN { sei: ISEIndex; iSei: ISEIndex = iBase.bb[iBti].id; IF iSei # ISENull THEN { sei ← LOOPHOLE[CopyIncludedSymbol[iSei, mdi]]; bti ← seb[sei].idInfo} ELSE bti ← CopyIncludedBody[iBti, ISENull, mdi]; CloseIncludedTable[]} ELSE bti ← CBTNull; RETURN}; CopyIncludedBody: PROC [iBti: CBTIndex, sei: ISEIndex, mdi: MDIndex] RETURNS [bti: CBTIndex] = { iCtx: CTXIndex; IF iBti = BTNull THEN bti ← CBTNull ELSE { iCtx ← iBase.bb[iBti].localCtx; WITH body: iBase.bb[iBti] SELECT FROM Outer => { bti ← table.Words[bodyType, SIZE[Outer Callable BodyRecord]]; bb[LOOPHOLE[bti, OCBTIndex]] ← body}; Inner => { bti ← table.Words[bodyType, SIZE[Inner Callable BodyRecord]]; bb[LOOPHOLE[bti, ICBTIndex]] ← body}; ENDCASE => ERROR; bb[bti].link ← [parent, BTNull]; bb[bti].firstSon ← BTNull; bb[bti].id ← sei; IF iCtx = CTXNull THEN {bb[bti].localCtx ← CTXNull; bb[bti].type ← RecordSENull} ELSE { bb[bti].localCtx ← MapCtx[mdi, iCtx]; bb[bti].type ← LOOPHOLE[CopyIncludedSymbol[iBase.bb[iBti].type, mdi]]}; IF iBase.bb[iBti].inline THEN { bb[bti].ioType ← CopyBodyType[iBase.bb[iBti].ioType, mdi]; WITH body: bb[bti].info SELECT FROM Internal => body.thread ← body.bodyTree ← Tree.NullIndex; ENDCASE} ELSE bb[bti].ioType ← IF sei = ISENull OR seb[seb[sei].idType].seTag = id THEN CopyBodyType[iBase.bb[iBti].ioType, mdi] ELSE UnderType[seb[sei].idType]}; RETURN}; MapBasicType: PROC [code: CARDINAL] RETURNS [CSEIndex] = { FOR sei: ISEIndex ← FirstCtxSe[FIRST[StandardContext]], NextSe[sei] UNTIL sei = ISENull DO IF seb[sei].idType = typeTYPE THEN { tSei: CSEIndex = UnderType[sei]; WITH t: seb[tSei] SELECT FROM basic => IF t.code = code THEN RETURN [tSei]; ENDCASE}; ENDLOOP; ERROR}; CopyNonCtxSe: PROC [iSei: CSEIndex, mdi: MDIndex] RETURNS [sei: CSEIndex] = { tSei1, tSei2: SEIndex; WITH iType: iSeb[iSei] SELECT FROM enumerated => { tCtx: CTXIndex; sei ← MakeNonCtxSe[SIZE[enumerated cons SERecord]]; tCtx ← IF iType.valueCtx IN StandardContext THEN iType.valueCtx ELSE CopyIncludedValues[iType.unpainted, iType.valueCtx, mdi, sei]; seb[sei].typeInfo ← enumerated[ ordered: iType.ordered, machineDep: iType.machineDep, unpainted: iType.unpainted, sparse: iType.sparse, valueCtx: tCtx, nValues: iType.nValues]; CacheType[mdi, iSei, sei]}; record => { tCtx: CTXIndex = IF iType.fieldCtx IN StandardContext THEN iType.fieldCtx ELSE MapCtx[mdi, iType.fieldCtx]; WITH iType SELECT FROM notLinked => { sei ← MakeNonCtxSe[SIZE[notLinked record cons SERecord]]; CacheType[mdi, iSei, sei]; seb[sei].typeInfo ← record[ machineDep: iType.machineDep, painted: iType.painted, argument: iType.argument, hints: iType.hints, fieldCtx: tCtx, length: iType.length, monitored: iType.monitored, linkPart: notLinked[]]}; linked => { sei ← MakeNonCtxSe[SIZE[linked record cons SERecord]]; CacheType[mdi, iSei, sei]; tSei1 ← CopyIncludedSymbol[linkType, mdi]; seb[sei].typeInfo ← record[ machineDep: iType.machineDep, painted: iType.painted, argument: iType.argument, hints: iType.hints, fieldCtx: tCtx, length: iType.length, monitored: iType.monitored, linkPart: linked[linkType: tSei1]]}; ENDCASE; IF ~iType.painted OR (iType.hints.refField AND iType.hints.unifield) THEN CopyContext[tCtx, iType.fieldCtx, mdi, unit]}; ref => { sei ← MakeNonCtxSe[SIZE[ref cons SERecord]]; CacheType[mdi, iSei, sei]; tSei1 ← CopyIncludedSymbol[iType.refType, mdi]; seb[sei].typeInfo ← ref[ refType: tSei1, counted: iType.counted, var: iType.var, readOnly: iType.readOnly, ordered: iType.ordered, list: iType.list, basing: iType.basing]}; array => { sei ← MakeNonCtxSe[SIZE[array cons SERecord]]; CacheType[mdi, iSei, sei]; tSei1 ← CopyIncludedSymbol[iType.indexType, mdi]; tSei2 ← CopyIncludedSymbol[iType.componentType, mdi]; seb[sei].typeInfo ← array[ packed: iType.packed, indexType: tSei1, componentType: tSei2]}; arraydesc => { sei ← MakeNonCtxSe[SIZE[arraydesc cons SERecord]]; CacheType[mdi, iSei, sei]; tSei1 ← CopyIncludedSymbol[iType.describedType, mdi]; seb[sei].typeInfo ← arraydesc[ readOnly: iType.readOnly, var: iType.var, describedType: tSei1]}; transfer => { -- do not use cache (in case of importing) argSei1, argSei2: CSEIndex; sei ← MakeNonCtxSe[SIZE[transfer cons SERecord]]; argSei1 ← CopyArgs[iType.typeIn, mdi, FALSE]; argSei2 ← CopyArgs[iType.typeOut, mdi, FALSE]; seb[sei].typeInfo ← transfer[ mode: iType.mode, safe: iType.safe, typeIn: argSei1, typeOut: argSei2]}; definition => { sei ← MakeNonCtxSe[SIZE[definition cons SERecord]]; seb[sei].typeInfo ← definition[ nGfi: iType.nGfi, named: iType.named, defCtx: MapCtx[mdi, iType.defCtx]]}; union => { tag: ISEIndex; tCtx: CTXIndex; sei ← MakeNonCtxSe[SIZE[union cons SERecord]]; CacheType[mdi, iSei, sei]; tCtx ← MapCtx[mdi, iType.caseCtx]; tag ← CopyCtxSe[iType.tagSei, MapHti[iSeb[iType.tagSei].hash], CTXNull, mdi]; seb[sei].typeInfo ← union[ caseCtx: tCtx, machineDep: iType.machineDep, overlaid: iType.overlaid, controlled: iType.controlled, tagSei: tag, hints: iType.hints]}; sequence => { tag: ISEIndex; sei ← MakeNonCtxSe[SIZE[sequence cons SERecord]]; CacheType[mdi, iSei, sei]; tSei1 ← CopyIncludedSymbol[iType.componentType, mdi]; tag ← CopyCtxSe[iType.tagSei, MapHti[iSeb[iType.tagSei].hash], CTXNull, mdi]; seb[sei].typeInfo ← sequence[ packed: iType.packed, controlled: iType.controlled, machineDep: iType.machineDep, tagSei: tag, componentType: tSei1]}; relative => { tSei3: SEIndex; sei ← MakeNonCtxSe[SIZE[relative cons SERecord]]; CacheType[mdi, iSei, sei]; 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]}; opaque => { sei ← MakeNonCtxSe[SIZE[opaque cons SERecord]]; CacheType[mdi, iSei, sei]; tSei1 ← CopyIncludedSymbol[iType.id, mdi]; seb[sei].typeInfo ← opaque[ lengthKnown: iType.lengthKnown, length: iType.length, id: LOOPHOLE[tSei1]]}; zone => { sei ← MakeNonCtxSe[SIZE[zone cons SERecord]]; seb[sei].typeInfo ← zone[mds: iType.mds, counted: iType.counted]; CacheType[mdi, iSei, sei]}; subrange => { sei ← MakeNonCtxSe[SIZE[subrange cons SERecord]]; tSei1 ← CopyIncludedSymbol[iType.rangeType, mdi]; seb[sei].typeInfo ← subrange[ filled: iType.filled, empty: iType.empty, rangeType: tSei1, origin: iType.origin, range: iType.range]; CacheType[mdi, iSei, sei]}; long => { sei ← MakeNonCtxSe[SIZE[long cons SERecord]]; CacheType[mdi, iSei, sei]; tSei1 ← CopyIncludedSymbol[iType.rangeType, mdi]; seb[sei].typeInfo ← long[rangeType: tSei1]}; real => { sei ← MakeNonCtxSe[SIZE[real cons SERecord]]; CacheType[mdi, iSei, sei]; tSei1 ← CopyIncludedSymbol[iType.rangeType, mdi]; seb[sei].typeInfo ← real[rangeType: tSei1]}; any => { sei ← MakeNonCtxSe[SIZE[any cons SERecord]]; seb[sei].typeInfo ← any[]; CacheType[mdi, iSei, sei]}; ENDCASE => ERROR; seb[sei].mark3 ← seb[sei].mark4 ← TRUE; RETURN}; CopyBodyType: PROC [iSei: CSEIndex, mdi: MDIndex] RETURNS [sei: CSEIndex] = { argSei1, argSei2: CSEIndex; WITH iType: iSeb[iSei] SELECT FROM transfer => { sei ← MakeNonCtxSe[SIZE[transfer cons SERecord]]; argSei1 ← CopyArgs[iType.typeIn, mdi, TRUE]; argSei2 ← CopyArgs[iType.typeOut, mdi, TRUE]; seb[sei].typeInfo ← transfer[ mode: iType.mode, safe: iType.safe, typeIn: argSei1, typeOut: argSei2]}; ENDCASE => ERROR; seb[sei].mark3 ← seb[sei].mark4 ← TRUE; RETURN}; CopyArgs: PROC [iargSei: CSEIndex, mdi: MDIndex, mapped: BOOLEAN] RETURNS [argSei: CSEIndex] = { IF iargSei = CSENull THEN argSei ← CSENull ELSE WITH t: iSeb[iargSei] SELECT FROM record => { iCtx: CTXIndex = t.fieldCtx; ctx: CTXIndex; argSei ← MakeNonCtxSe[SIZE[notLinked record cons SERecord]]; IF ~mapped THEN ctx ← NewCtx[iCtxb[iCtx].level] ELSE { tCtx: IncludedCTXIndex = MapCtx[mdi, iCtx]; ctxb[tCtx].complete ← TRUE; ResetCtx[tCtx]; ctx ← tCtx}; IF ctxb[ctx].seList = ISENull THEN { seChain: ISEIndex ← MakeSeChain[ctx, iBase.CtxEntries[iCtx], FALSE]; sei, iSei: ISEIndex; 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}; seb[argSei] ← SERecord[ mark3: TRUE, mark4: TRUE, body: cons[ record[ machineDep: FALSE, painted: FALSE, argument: TRUE, hints: t.hints, fieldCtx: ctx, length: t.length, monitored: FALSE, linkPart: notLinked[]]]]; IF typeCache # NIL THEN { i: TypeCacheIndex = TypeHash[mdi, iargSei]; typeCache[i] ← [mdi:mdi, iSei:iargSei, sei:argSei]}}; ENDCASE => argSei ← CopyNonCtxSe[iargSei, mdi]; RETURN}; CopyIncludedValues: PROC [ full: BOOLEAN, iCtx: CTXIndex, mdi: MDIndex, type: SEIndex] RETURNS [ctx: IncludedCTXIndex] = { iSei, sei, seChain: ISEIndex; ctx ← MapCtx[mdi, iCtx]; iSei ← iCtxb[iCtx].seList; IF full OR (iSei # SENull AND iSeb[iSeb[iSei].idType].seTag # id) THEN { 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].copied ← full; ctxb[ctx].complete ← TRUE}; RETURN}; -- included module accounting ResetCtx: PROC [ctx: IncludedCTXIndex] = { IF ~ctxb[ctx].reset THEN {ResetCtxList[ctx]; ctxb[ctx].closed ← ctxb[ctx].reset ← TRUE}}; ResetIncludeContexts: PROC = { mdi: MDIndex; limit: MDIndex = table.Top[mdType]; 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 ctxb[ctx].copied ← none; -- clear bits (**** until bootstrap ****) ResetCtx[ctx] ENDLOOP; ENDLOOP; ResetCaches[]}; Outer: PUBLIC PROC [mdi: MDIndex, inner: PROC [SymbolTable.Base]] = { IF mdi # MDNull AND OpenIncludedTable[mdi] THEN { inner[iBase ! UNWIND => {CloseIncludedTable[]}]; CloseIncludedTable[]}}; TableRelocated: PUBLIC SIGNAL = CODE; OpenIncludedTable: PROC [mdi: MDIndex] RETURNS [success: BOOLEAN] = { base: SymbolTable.Base = IF mdi = OwnMdi THEN ownSymbols ELSE Copier.GetSymbolTable[mdi]; IF success ← (base # NIL) THEN { iBase ← base; IF mdi # OwnMdi THEN iBase.notifier ← IRelocNotify; INotify[]}; RETURN}; IRelocNotify: PROC [base: SymbolTable.Base] = { IF base = iBase THEN {INotify[]; SIGNAL TableRelocated}}; CloseIncludedTable: PROC = { IF iBase # ownSymbols THEN { iBase.notifier ← iBase.NullNotifier; Copier.FreeSymbolTable[iBase]}; iBase ← NIL}; }.