
    <<Pass4B.Mesa>>
        <<Copyright  1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, June 18, 1986 12:33:20 pm PDT>>
        <<Paul Rovner, October 5, 1983 5:03 pm>>
        <<Russ Atkinson (RRA) March 6, 1985 10:49:46 pm PST>>

    DIRECTORY
        Alloc: TYPE USING [Notifier, Top],
        BcdDefs: TYPE USING [BCD, BcdBase, CodeDesc, CTIndex, EVHandle, EVIndex, EVRecord, EXPIndex, EXPRecord, FPIndex, FTIndex, FTRecord, 
        IMPIndex, IMPRecord, Link, LFIndex, ModuleIndex, MTHandle, MTIndex, MTRecord, Namee, NameRecord, NameString, NTIndex, 
        NTRecord, PackedString, ProcIndex, RefLitIndex, RFIndex, SGIndex, SGRecord, SPIndex, TFIndex, TMIndex, TMRecord, TypeIndex, 
        TYPIndex, TYPRecord, VarIndex, VersionID, CTNull, EVNull, FTSelf, LFNull, RFNull, TFNull, NullLink, NullName, MaxNMi, 
        PageSize, ProcLimit, VarLimit],
        ComData: TYPE USING [bcdSeg, codeSeg, compilerVersion, fixupLoc, importCtx, interface, linkCount, mainCtx, moduleCtx, mtRoot, 
        mtRootSize, nBodies, nSigCodes, objectVersion, ownSymbols, pattern, source, switches, symSeg, table, textIndex],
        CompilerUtil: TYPE USING [AppendBCDString, AppendBCDWord, AppendBCDWords, EndBCD, FillBCDPage, ReadBCDIndex, ReadBCDOffset, 
        RTTableOut, StartBCD, UpdateBCDWords],
        ConvertUnsafe: TYPE USING [EqualSubStrings, AppendRope, SubString],
        Copier: TYPE USING [FreeSymbolTable, GetSymbolTable, MapSymbols, UnmapSymbols],
        Log: TYPE USING [ErrorN, ErrorSei, ErrorType, WarningSei, WarningRope, WarningSubString],
        P4: TYPE USING [ownGfi, DefaultBasicOps, OperandStruct],
        Pass4: TYPE USING [resident],
        RefText: TYPE USING [Append],
        Rope: TYPE USING [Length],
        SourceMap: TYPE USING [Loc],
        Symbols: TYPE USING [bodyType, ctxType, mdType, seType, Base, Name, Type, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, 
        IncludedCTXIndex, Linkage, MDRecord, MDIndex, BTIndex, CBTIndex, nullName, ISENull, RecordSENull, CTXNull, MDNull, BTNull, 
        nullFileIndex, OwnMdi, RootBti, typeTYPE],
        SymbolOps: TYPE USING [DecodeBitAddr, DecodeBti, DecodeCard, DecodeLink, DecodeTreeIndex, DecodeType, EncodeCard, EncodeLink, 
        FindString, FirstCtxSe, NextSe, SearchContext, SubStringForName, TypeForm, UnderType, XferMode],
        SymbolTable: TYPE USING [Base],
        SymLiteralOps: TYPE USING [RefLitItem, DescribeRefLits, DescribeTypes, EnumerateRefLits, EnumerateTypes, UTypeId, TypeIndex],
        Target: TYPE MachineParms USING [bitsPerAU],
        Tree: TYPE USING [Base, Index, Link, Map, Scan, nullIndex, treeType],
        TreeOps: TYPE USING [GetNode, GetSe, ListLength, ScanList, ToLoc],
        Types: TYPE USING [Handle, SymbolTableBase, Assignable, Equivalent],
        UnsafeStorage: TYPE USING [GetSystemUZone];

    Pass4B: PROGRAM
        IMPORTS Alloc, CompilerUtil, ConvertUnsafe, Copier, Log, P4, RefText, Rope,  SymbolOps, SymLiteralOps, TreeOps, Types, dataPtr: 
        ComData, passPtr: Pass4, UnsafeStorage
        EXPORTS P4 = {
        OPEN SymbolOps, Symbols;

        tb: Tree.Base;    -- tree base address (local copy)
        seb: Symbols.Base;    -- se table base address (local copy)
        ctxb: Symbols.Base;    -- context table base address (local copy)
        mdb: Symbols.Base;    -- body table base address (local copy)
        bb: Symbols.Base;    -- body table base address (local copy)

        BCDNotify: PUBLIC Alloc.Notifier = {
            <<called by allocator whenever table area is repacked>>
            tb _ base[Tree.treeType];
            seb _ base[seType];  ctxb _ base[ctxType];  mdb _ base[mdType];
            bb _ base[bodyType]};


    <<shared variables>>

        bitsPerAU: CARDINAL = Target.bitsPerAU;

        bcdHeader: BcdDefs.BcdBase;  -- initialized in START code, below
        BcdHeaderPage: CARDINAL = 1;        -- page 0 is reserved
        bcdOffset, mtOffset: CARD;

        nString: BcdDefs.NameString;
        nStringREFTEXT: REF TEXT;  -- NOTE SHARING with nString

        firstPorted: MDIndex = OwnMdi + MDRecord.SIZE;
        lastPorted: MDIndex;    -- im/exported files in [firstPorted..lastPorted)

        evList: BcdDefs.EVHandle;  -- initialized in START code, below

        protoMTRecord: BcdDefs.MTHandle;  -- initialized in START code, below


    <<service routines>>

        ModuleIndex: TYPE = BcdDefs.ModuleIndex;
        ProcIndex: TYPE = BcdDefs.ProcIndex;
        ProcLimit: CARDINAL = BcdDefs.ProcLimit;
        VarLimit: CARDINAL = BcdDefs.VarLimit;
        maxEVLength: CARDINAL = BcdDefs.MaxNMi*(BcdDefs.VarIndex.LAST+1) - 1;
        BcdLink: TYPE = BcdDefs.Link;

        ownGfi: ModuleIndex = P4.ownGfi;


        GFSlots: PROC[epMax: NAT] RETURNS[nGfi: NAT] = {
            nGfi _ epMax/ProcLimit + 1; RETURN};

        MakeEPLink: PUBLIC PROC[ep: CARDINAL, gfi: ModuleIndex] RETURNS[BcdLink] = {
            RETURN[[procedure[tag: TRUE, ep: ep MOD ProcLimit, gfi: gfi + ep/ProcLimit]]]};

        MakeFrameLink: PROC[ep: CARDINAL, gfi: ModuleIndex] RETURNS[BcdLink] = {
            RETURN[[variable[vtag: var, var: ep MOD VarLimit, vgfi: gfi + ep/VarLimit]]]};

        MakeTypeLink: PROC[index: BcdDefs.TYPIndex] RETURNS[BcdLink] = INLINE {
            RETURN[[type[typeID: index, type: TRUE, proc: FALSE]]]};


        MdiForCtx: PROC[ctx: CTXIndex] RETURNS[MDIndex] = {
            RETURN[WITH c: ctxb[ctx] SELECT FROM
                included => c.module,
                imported => ctxb[c.includeLink].module,
                ENDCASE => OwnMdi]
            };

        PortedCtx: PROC[ctx: CTXIndex] RETURNS[BcdDefs.FTIndex] = {
            RETURN[PortedFile[MdiForCtx[ctx]]]};

        PortedFile: PROC[mdi: MDIndex] RETURNS[fti: BcdDefs.FTIndex] = {
            n: CARDINAL;
            IF mdi = OwnMdi THEN fti _ BcdDefs.FTSelf
            ELSE {
                IF mdi IN [firstPorted .. lastPorted) THEN
                    n _ LOOPHOLE[mdi-firstPorted, CARD]/MDRecord.SIZE
                ELSE {
                    n _ LOOPHOLE[lastPorted-firstPorted, CARD]/MDRecord.SIZE;
                    SwapMdi[mdi, lastPorted];
                    lastPorted _ lastPorted + MDRecord.SIZE};
                fti _ BcdDefs.FTIndex.FIRST + n*BcdDefs.FTRecord.SIZE};
            RETURN};

        SwapMdi: PROC[mdi1, mdi2: MDIndex] = {
            IF mdi1 # mdi2 THEN {
                ctx: IncludedCTXIndex;
                t: MDRecord;
                FOR ctx _ mdb[mdi1].ctx, ctxb[ctx].chain UNTIL ctx = CTXNull DO
                    ctxb[ctx].module _ mdi2 ENDLOOP;
                FOR ctx _ mdb[mdi2].ctx, ctxb[ctx].chain UNTIL ctx = CTXNull DO
                    ctxb[ctx].module _ mdi1 ENDLOOP;
                t _ mdb[mdi1];  mdb[mdi1] _ mdb[mdi2];  mdb[mdi2] _ t}
            };

        EnterId: PROC[id: ConvertUnsafe.SubString, ignoreCase: BOOL]
              RETURNS[BcdDefs.NameRecord] = {
            i: CARDINAL;
            s: ConvertUnsafe.SubString;
            i _ 0;  s.base _ @nString.string;
            UNTIL i = nString.string.length DO
                s.offset _ i _ i+1;  s.length _ nString.size[i];
                IF id.EqualSubStrings[s2: s, case: ~ignoreCase] THEN EXIT;
                i _ i + s.length;
                REPEAT
                    FINISHED => {
                        IF nString.string.length + (id.length+1) > nString.string.maxlength THEN {
                            t: REF TEXT _ NEW[TEXT[nString.string.maxlength + MAX[(id.length+1), 512]]];
                            t _ RefText.Append[t, nStringREFTEXT];
                            nStringREFTEXT _ t;
                            nString _ LOOPHOLE[nStringREFTEXT, BcdDefs.NameString];
                            };
                        i _ nString.string.length _ nString.string.length + 1;
                        nString.size[i] _ id.length;
                        FOR j: CARDINAL IN [0..id.length) DO
                            nString.string[i+j] _ id.base[id.offset+j]
                            ENDLOOP;
                        nString.string.length _ i + id.length};
                ENDLOOP;
            RETURN[[i]]};

        EnterSymbolId: PROC[sei: ISEIndex] RETURNS[BcdDefs.NameRecord] = {
            s: ConvertUnsafe.SubString;
            s _ SubStringForName[seb[sei].hash];
            RETURN[EnterId[s, FALSE]]};

        EnterFileId: PROC[mdi: MDIndex] RETURNS[BcdDefs.NameRecord] = {
            s: ConvertUnsafe.SubString;
            extLength: CARDINAL = (".bcd"L).length;
            s _ SubStringForName[mdb[mdi].fileId];
            IF s.base[s.offset+s.length-1] = '. THEN s.length _ s.length - 1;
            IF s.length > extLength THEN {
                t: ConvertUnsafe.SubString _ [
                    base: s.base, offset: s.offset+s.length-extLength, length: extLength];
                ext: ConvertUnsafe.SubString _ [base:".bcd"L, offset:0, length:extLength];
                IF t.EqualSubStrings[s2: ext, case: FALSE] THEN s.length _ s.length - extLength};
            RETURN[EnterId[s, TRUE]]};


    <<processing directory entries (to file table)>>

        ProcessDirectory: PUBLIC Tree.Scan = {

            DirectoryItem: Tree.Scan = {
                node: Tree.Index = TreeOps.GetNode[t];
                sei: ISEIndex = TreeOps.GetSe[tb[node].son[1]];
                type: CSEIndex = UnderType[seb[sei].idType];
                WITH t: seb[type] SELECT FROM
                    definition => [] _ PortedCtx[t.defCtx];
                    transfer => {
                        bti: BTIndex = DecodeBti[seb[sei].idInfo];
                        IF bti # BTNull THEN [] _ PortedCtx[bb[bti].localCtx]};
                    ENDCASE
                };

            TreeOps.ScanList[t, DirectoryItem]};


    <<relocating imported control links>>

        ScanImports: PROC[action: PROC[ISEIndex]] = {
            FOR sei: ISEIndex _ FirstCtxSe[dataPtr.importCtx], NextSe[sei] UNTIL sei = ISENull DO
                action[sei] ENDLOOP
            };

        RelocateImports: PROC[ctx: CTXIndex, gfi: ModuleIndex] = {
            FOR sei: ISEIndex _ FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
                IF ~seb[sei].constant THEN {
                    epN: CARDINAL = DecodeCard[seb[sei].idValue];
                    seb[sei].idValue _ EncodeLink[MakeEPLink[epN, gfi]]};
                ENDLOOP;
            RETURN};

        AssignImports: PUBLIC Tree.Scan = {
            gfi: ModuleIndex;
            saveIndex: SourceMap.Loc = dataPtr.textIndex;

            ImportItem: PROC[sei: ISEIndex] = {
                node: Tree.Index = DecodeTreeIndex[seb[sei].idValue];
                type: CSEIndex = UnderType[seb[sei].idType];
                IF node # Tree.nullIndex THEN dataPtr.textIndex _ TreeOps.ToLoc[tb[node].info];
                WITH t: seb[type] SELECT FROM
                    definition => {
                        nd: CARDINAL = t.nDummyGfi;
                        IF ctxb[t.defCtx].seList = ISENull THEN Log.WarningSei[unusedImport, sei];
                        IF ~dataPtr.interface THEN RelocateImports[t.defCtx, gfi];
                        gfi _ gfi + nd;  seb[sei].idInfo _ EncodeCard[nd]};
                    ref => {
                        IF ~dataPtr.interface THEN seb[sei].idValue _ EncodeLink[MakeEPLink[ep:0, gfi:gfi]];
                        gfi _ gfi + 1};
                    ENDCASE;
                seb[sei].mark4 _ TRUE};

            dataPtr.mtRoot.gfi _ ownGfi;
            dataPtr.mtRoot.ngfi _ GFSlots[MAX[dataPtr.nBodies, dataPtr.nSigCodes]-1];
            gfi _ bcdHeader.firstdummy _ ownGfi + BcdDefs.MaxNMi;
            ScanImports[ImportItem];
            bcdHeader.nDummies _ gfi - bcdHeader.firstdummy;
            dataPtr.textIndex _ saveIndex};


    <<writing frame fragments (link fragment written by Pass4L)>>

        ProcessSymLiterals: PUBLIC PROC = {
            offset, length: CARDINAL;
            bcdHeader.rfOffset _ CompilerUtil.ReadBCDOffset[];
            bcdHeader.lfLimit _ BcdDefs.LFIndex.FIRST + (bcdHeader.rfOffset - bcdHeader.lfOffset);
            IF ~dataPtr.interface THEN {
                rfi: BcdDefs.RefLitIndex _ [0];

                AppendLitItem: PROC[SymLiteralOps.RefLitItem] = {
                    CompilerUtil.AppendBCDWords[@rfi, BcdDefs.RefLitIndex.SIZE];
                    rfi _ [rfi + 1]};

                [offset, length] _ SymLiteralOps.DescribeRefLits[];
                IF length # 0 THEN {
                    dataPtr.mtRoot.refLiterals _ BcdDefs.RFIndex.FIRST;
                    CompilerUtil.AppendBCDWord[offset];  CompilerUtil.AppendBCDWord[length];
                    SymLiteralOps.EnumerateRefLits[AppendLitItem]}
                };
            bcdHeader.tfOffset _ CompilerUtil.ReadBCDOffset[];
            bcdHeader.rfLimit _ BcdDefs.RFIndex.FIRST + (bcdHeader.tfOffset-bcdHeader.rfOffset);
            IF ~dataPtr.interface THEN {
                tfi: BcdDefs.TypeIndex _ [0];

                AppendTypeIndex: PROC[canonical: BOOL, type: Type] = {
                    CompilerUtil.AppendBCDWords[@tfi, BcdDefs.TypeIndex.SIZE];
                    tfi _ [tfi + 1]};

                [offset, length] _ SymLiteralOps.DescribeTypes[];
                IF length # 0 THEN {
                    dataPtr.mtRoot.types _ BcdDefs.TFIndex.FIRST;
                    CompilerUtil.AppendBCDWord[offset];  CompilerUtil.AppendBCDWord[length];
                    SymLiteralOps.EnumerateTypes[AppendTypeIndex]}
                };
            bcdHeader.tfLimit _
                BcdDefs.TFIndex.FIRST + (CompilerUtil.ReadBCDOffset[]-bcdHeader.tfOffset)
            };


    <<writing import records>>

        ProcessImports: PUBLIC Tree.Scan = {
            <<N.B. nextGfi must be regenerated to match AssignImports>>
            nImports: CARDINAL;
            impi: BcdDefs.IMPIndex;
            nextGfi: ModuleIndex;
            anyNamed: BOOL;

            ProcessSei: PROC[sei, tSei: ISEIndex, implicit: BOOL] = {
                type: CSEIndex = UnderType[seb[sei].idType];
                entry: BcdDefs.IMPRecord _ [
                    name: EnterSymbolId[tSei],
                    port: interface,
                    namedInstance: seb[sei].hash # seb[tSei].hash,
                    file: ,
                    gfi: nextGfi, ngfi: ];
                WITH t: seb[type] SELECT FROM
                    definition => {
                        entry.file _ PortedCtx[t.defCtx];  entry.ngfi _ DecodeCard[seb[sei].idInfo];
                        seb[sei].idValue _ EncodeCard[nextGfi];
                        nextGfi _ nextGfi + entry.ngfi};
                    ref => {
                        rType: RecordSEIndex = LOOPHOLE[UnderType[t.refType]];
                        entry.port _ module;
                        entry.file _ PortedCtx[seb[rType].fieldCtx];  entry.ngfi _ 1;
                        nextGfi _ nextGfi + 1};
                    ENDCASE;
                nImports _ nImports + 1;
                IF entry.namedInstance THEN anyNamed _ TRUE;
                CompilerUtil.AppendBCDWords[@entry, BcdDefs.IMPRecord.SIZE]};

            sei: ISEIndex;    -- updated by ImportItem

            ImportItem: Tree.Scan = {
                node: Tree.Index = TreeOps.GetNode[t];
                ProcessSei[sei, TreeOps.GetSe[tb[node].son[2]], FALSE];
                sei _ NextSe[sei]};

            NameItem: Tree.Scan = {
                node: Tree.Index = TreeOps.GetNode[t];
                sei: ISEIndex = TreeOps.GetSe[tb[node].son[1]];
                tSei: ISEIndex = TreeOps.GetSe[tb[node].son[2]];
                entry: BcdDefs.NTRecord;
                IF  seb[sei].hash # seb[tSei].hash THEN {
                    entry _ [name: EnterSymbolId[sei], item: BcdDefs.Namee[import[impi]]];
                    CompilerUtil.AppendBCDWords[@entry, BcdDefs.NTRecord.SIZE]};
                impi _ impi + BcdDefs.IMPRecord.SIZE};

            offset: CARD;
            bcdHeader.impOffset _ offset _ CompilerUtil.ReadBCDOffset[];
            nImports _ 0;  impi _ BcdDefs.IMPIndex.FIRST;
            nextGfi _ bcdHeader.firstdummy;  anyNamed _ FALSE;
            sei _ FirstCtxSe[dataPtr.importCtx];
            TreeOps.ScanList[t, ImportItem];
            UNTIL sei = ISENull DO ProcessSei[sei, sei, TRUE]; sei _ NextSe[sei] ENDLOOP;
            bcdHeader.nImports _ nImports;
            bcdHeader.impLimit _ BcdDefs.IMPIndex.FIRST + (CompilerUtil.ReadBCDOffset[]-offset);
            bcdHeader.ntOffset _ offset _ CompilerUtil.ReadBCDOffset[];
            IF anyNamed THEN TreeOps.ScanList[t, NameItem];    -- matches importCtx prefix
            bcdHeader.ntLimit _ BcdDefs.NTIndex.FIRST + (CompilerUtil.ReadBCDOffset[]-offset)};


    <<writing export records>>

        EnterEVOffset: PROC[offset: CARDINAL] RETURNS[index: CARDINAL] = {
            IF offset = 0 THEN index _ 0
            ELSE
                FOR index IN [1 .. evList.length] DO
                    IF offset = evList.offsets[index] THEN EXIT;
                    REPEAT
                        FINISHED => {
                            index _ evList.length _ evList.length + 1;
                            IF index <= maxEVLength THEN evList.offsets[index] _ offset};
                    ENDLOOP;
            RETURN};


        TypeMap: TYPE = RECORD[SEQUENCE length: CARDINAL OF
            RECORD[opaque: BcdDefs.TMRecord, concrete: BcdDefs.TYPRecord]];
        typeMap: REF TypeMap;
        mapIndex: CARDINAL;
        typeIndex: BcdDefs.TYPIndex;

        EnterType: PROC[mdi: MDIndex, offset: CARDINAL, sei: ISEIndex]
              RETURNS[typeId: BcdDefs.TYPIndex] = {
            entry: BcdDefs.TYPRecord = MakeTypeId[sei];
            IF typeMap = NIL OR mapIndex >= typeMap.length THEN AdjustTypeMap[8];
            FOR i: CARDINAL IN [0..mapIndex) DO
                IF typeMap[i].concrete = entry THEN GO TO matched;
                REPEAT
                    matched => typeId _ typeMap[i].opaque.map;
                    FINISHED => {typeId _ typeIndex; typeIndex _ typeIndex + BcdDefs.TYPRecord.SIZE};
                ENDLOOP;
            typeMap[mapIndex] _ [
                opaque: [version: mdb[mdi].stamp, offset: offset, map: typeId],
                concrete: entry];
            mapIndex _ mapIndex + 1;
            RETURN};

        MakeTypeId: PROC[id: ISEIndex] RETURNS[BcdDefs.TYPRecord] = {
            sei: ISEIndex _ id;
            next: Type;
            mdi: MDIndex;
            DO
                next _ DecodeType[seb[sei].idInfo];
                WITH seb[next] SELECT FROM
                    id => sei _ LOOPHOLE[next];
                    ENDCASE => EXIT;
                ENDLOOP;
            mdi _ MdiForCtx[seb[sei].idCtx];
            RETURN[[id: [CARDINAL[DecodeCard[seb[sei].idValue]]], version: mdb[mdi].stamp]]};

        AdjustTypeMap: PROC[delta: CARDINAL] = {
            oldN: CARDINAL = IF typeMap = NIL THEN 0 ELSE typeMap.length;
            newMap: REF TypeMap = NEW[TypeMap[oldN+delta]];
            FOR i: CARDINAL IN [0 .. oldN) DO newMap[i] _ typeMap[i] ENDLOOP;
            typeMap _ newMap};

        WriteTypeTable: PROC = {
            offset: CARD;
            next: BcdDefs.TYPIndex _ BcdDefs.TYPIndex.FIRST;
            bcdHeader.typOffset _ offset _ CompilerUtil.ReadBCDOffset[];
            FOR i: CARDINAL IN [0 .. mapIndex) DO
                FOR j: CARDINAL IN [0..i) DO
                    IF typeMap[i].opaque.map = typeMap[j].opaque.map THEN EXIT
                    REPEAT
                        FINISHED => {
                            CompilerUtil.AppendBCDWords[@typeMap[i].concrete, BcdDefs.TYPRecord.SIZE];
                            next _ next + BcdDefs.TYPRecord.SIZE};
                    ENDLOOP;
                ENDLOOP;
            bcdHeader.typLimit _
                BcdDefs.TYPIndex.FIRST + CARDINAL[CompilerUtil.ReadBCDOffset[]-offset];
            bcdHeader.tmOffset _ offset _ CompilerUtil.ReadBCDOffset[];
            FOR i: CARDINAL IN [0 .. mapIndex) DO
                CompilerUtil.AppendBCDWords[@typeMap[i].opaque, BcdDefs.TMRecord.SIZE];
                ENDLOOP;
            bcdHeader.tmLimit _ BcdDefs.TMIndex.FIRST + (CompilerUtil.ReadBCDOffset[]-offset)};


        ExportId: Tree.Map = {
            expType: CSEIndex = P4.OperandStruct[t];
            ctx: IncludedCTXIndex;
            iBase: Types.SymbolTableBase;
            id, sei, iSei: ISEIndex;
            epN: CARDINAL;
            used: BOOL;
            id _ TreeOps.GetSe[t];
            WITH v: seb[expType] SELECT FROM
                definition => {
                    ctx _ LOOPHOLE[v.defCtx];
                    iBase _ Copier.GetSymbolTable[ctxb[ctx].module];
                    IF iBase # NIL THEN {
                        BEGIN
                        header: BcdDefs.EXPRecord _ [
                            name: EnterSymbolId[id],
                            size: 0,
                            port: interface,
                            namedInstance: FALSE,
                            typeExported: FALSE,
                            file: PortedCtx[v.defCtx],
                            links: ];
                        FOR iSei _ iBase.FirstCtxSe[ctxb[ctx].map], iBase.NextSe[iSei] UNTIL iSei = ISENull DO
                            SELECT iBase.LinkMode[iSei] FROM
                                val, ref => header.size _ header.size + 1;
                                type => {header.typeExported _ TRUE; header.size _ header.size + 1};
                                ENDCASE;
                            ENDLOOP;
                        CompilerUtil.AppendBCDWords[@header, BcdDefs.EXPRecord.SIZE];
                        END;
                        used _ FALSE;  epN _ 0;
                        FOR iSei _ iBase.FirstCtxSe[ctxb[ctx].map], iBase.NextSe[iSei] UNTIL iSei = ISENull DO
                            mode: Linkage = iBase.LinkMode[iSei];
                            link: BcdLink _ BcdDefs.NullLink;
                                BEGIN
                                ss: ConvertUnsafe.SubString;
                                name: Name;
                                ss _ iBase.SubStringForName[iBase.seb[iSei].hash];
                                name _ FindString[ss];
                                IF name = nullName THEN sei _ ISENull
                                ELSE {
                                    sei _ SearchContext[name, dataPtr.mainCtx];
                                    IF sei = ISENull THEN sei _ SearchContext[name, dataPtr.moduleCtx]};
                                END;
                            IF sei # ISENull THEN {
                                public: BOOL = seb[sei].public;
                                type: CSEIndex = UnderType[seb[sei].idType];
                                iTarget: Type = iBase.seb[iSei].idType;
                                iType: CSEIndex = iBase.UnderType[iTarget];
                                SELECT mode FROM
                                    $val => {
                                        IF ~Types.Assignable[[iBase, iType], [dataPtr.ownSymbols, type]] THEN {
                                            IF public THEN
                                                Log.ErrorType[exportClash, [symbol[sei]], [iBase, iTarget]];
                                            }
                                        ELSE IF ~public AND seb[sei].idCtx = dataPtr.mainCtx THEN
                                            Log.WarningSei[privateExport, sei];
                                        IF public THEN {
                                            IF ~seb[sei].constant OR seb[sei].extended THEN
                                                Log.ErrorSei[varExport, sei];
                                            link _ (IF XferMode[type] = $program
                                                THEN MakeFrameLink[ep: EnterEVOffset[0], gfi: ownGfi]
                                                ELSE DecodeLink[seb[sei].idValue])}};
                                    $ref => {
                                        iVType: CSEIndex _ iType;
                                        iConst: BOOL _ iBase.seb[iSei].immutable;
                                        WITH t: iBase.seb[iType] SELECT FROM
                                            ref =>
                                                IF t.var THEN {
                                                    iVType _ iBase.UnderType[t.refType]; iConst _ t.readOnly}; 
                                            ENDCASE;
                                        IF ~Types.Equivalent[[iBase, iVType], [dataPtr.ownSymbols, type]] THEN {
                                            IF public THEN
                                                Log.ErrorType[exportClash, [symbol[sei]], [iBase, iTarget]]
                                            }
                                        ELSE IF ~public AND seb[sei].idCtx = dataPtr.mainCtx THEN
                                            Log.WarningSei[privateExport, sei];
                                        IF public THEN {
                                            SELECT TRUE FROM
                                                seb[sei].constant => Log.ErrorSei[varExport, sei];
                                                seb[sei].immutable AND ~iConst => Log.ErrorSei[updateClash, sei];
                                                ENDCASE;
                                        link _ MakeFrameLink[
                                            ep: EnterEVOffset[DecodeBitAddr[seb[sei].idValue].bd/bitsPerAU],
                                            gfi: ownGfi]}};
                                    $type =>
                                        IF type # typeTYPE OR TypeForm[sei] = $opaque THEN {
                                            IF public THEN Log.ErrorSei[exportClash, sei]}
                                        ELSE {
                                            iValue: CSEIndex = iBase.UnderType[iSei];
                                            IF (~public AND seb[sei].idCtx = dataPtr.mainCtx) THEN
                                                Log.WarningSei[privateExport, sei]
                                            ELSE
                                                WITH it: iBase.seb[iValue] SELECT FROM
                                                    opaque =>
                                                        IF it.lengthKnown AND ~P4.DefaultBasicOps[sei, it.length] THEN
                                                            Log.ErrorSei[exportAttr, sei];
                                                    ENDCASE => ERROR;
                                            IF public THEN {
                                                link _ MakeTypeLink[EnterType[ctxb[ctx].module, epN, sei]];
                                                bcdHeader.typeExported _ TRUE}};
                                    $manifest =>
                                        IF public
                                            AND (type # typeTYPE OR iBase.seb[iSei].idType # typeTYPE) THEN
                                                Log.WarningSei[voidExport, sei];
                                    ENDCASE};
                            IF link # BcdDefs.NullLink THEN used _ TRUE;
                            IF mode # $manifest THEN {
                                CompilerUtil.AppendBCDWords[@link, BcdLink.SIZE]; epN _ epN + 1};
                            ENDLOOP;
                    Copier.FreeSymbolTable[iBase];
                    IF ~used THEN Log.WarningSei[unusedExport, id]}};
                ENDCASE;
            RETURN[t]};

        ExportItem: Tree.Scan = {
            node: Tree.Index = TreeOps.GetNode[t];
            saveIndex: SourceMap.Loc = dataPtr.textIndex;
            dataPtr.textIndex _ TreeOps.ToLoc[tb[node].info];
            tb[node].son[2] _ ExportId[tb[node].son[2]];
            dataPtr.textIndex _ saveIndex};

        ProcessExports: PUBLIC Tree.Map = {
            offset: CARD;
            bcdHeader.nExports _ TreeOps.ListLength[t];
            bcdHeader.expOffset _ offset _ CompilerUtil.ReadBCDOffset[];
            evList^ _ [length:0, offsets:];
            typeIndex _ BcdDefs.TYPIndex.FIRST;  mapIndex _ 0;  typeMap _ NIL;
            TreeOps.ScanList[t, ExportItem];
            bcdHeader.expLimit _ BcdDefs.EXPIndex.FIRST + (CompilerUtil.ReadBCDOffset[]-offset);
            bcdHeader.evOffset _ offset _ CompilerUtil.ReadBCDOffset[];
            IF evList.length > maxEVLength THEN
                Log.ErrorN[exportedVars, evList.length-maxEVLength];
            IF evList.length = 0 THEN dataPtr.mtRoot.variables _ BcdDefs.EVNull
            ELSE {
                dataPtr.mtRoot.ngfi _ MAX[dataPtr.mtRoot.ngfi, evList.length/VarLimit+1];
                dataPtr.mtRoot.variables _ BcdDefs.EVIndex.FIRST;
                CompilerUtil.AppendBCDWords[evList,
                    BcdDefs.EVRecord.SIZE + MIN[evList.length, maxEVLength]]};
            bcdHeader.evLimit _ BcdDefs.EVIndex.FIRST + (CompilerUtil.ReadBCDOffset[]-offset);
            WriteTypeTable[];
            typeMap _ NIL;
            RETURN[t]};


    <<initialization/finalization>>

        ProcessFiles: PROC = {
            ftEntry: BcdDefs.FTRecord;
            mdi: MDIndex;
            limit: MDIndex = (dataPtr.table).Top[mdType];

            EnterCanonicalFile: PROC[canonical: BOOL, type: Type] = {
                IF ~canonical THEN {
                    mdi: MDIndex;
                    [mdi, ] _  SymLiteralOps.UTypeId[type];
                    IF mdi # MDNull THEN [] _ PortedFile[mdi]}
                };

            offset: CARD = CompilerUtil.ReadBCDOffset[];
            FOR mdi _ lastPorted, mdi + MDRecord.SIZE UNTIL mdi = limit DO
                IF mdb[mdi].file # nullFileIndex THEN
                    [] _ PortedFile[mdi];    -- add any files opened during compilation
                ENDLOOP;
            bcdHeader.ftOffset _ offset;
            SymLiteralOps.EnumerateTypes[EnterCanonicalFile];
            FOR mdi _ firstPorted, mdi + MDRecord.SIZE UNTIL mdi = lastPorted DO
                ftEntry _ [name: EnterFileId[mdi], version: mdb[mdi].stamp];
                CompilerUtil.AppendBCDWords[@ftEntry, BcdDefs.FTRecord.SIZE];
                ENDLOOP;
            bcdHeader.ftLimit _ BcdDefs.FTIndex.FIRST + (CompilerUtil.ReadBCDOffset[]-offset)};


        InitBCD: PUBLIC PROC[ids: Tree.Link] = {
            OPEN BcdDefs;
            nIds: CARDINAL;
            nIds _ TreeOps.ListLength[ids];
            IF nIds > 1 AND ~dataPtr.interface THEN {Log.ErrorN[listLong, nIds-1]; nIds _ 1};
            lastPorted _ firstPorted;
            nStringREFTEXT _ NEW[TEXT[512]];
            nString _ LOOPHOLE[nStringREFTEXT, BcdDefs.NameString];
            <<allocate the null name>>
                nString.string.length _ BcdDefs.NullName;
                nString.size[BcdDefs.NullName] _ 0;
            mdb[OwnMdi].stamp _ dataPtr.objectVersion;    -- update from DIRECTORY processing
            CompilerUtil.StartBCD[];
                bcdHeader.versionIdent _ VersionID;
                bcdHeader.version _ dataPtr.objectVersion;
                bcdHeader.creator _ dataPtr.compilerVersion;
                bcdHeader.sourceVersion _ dataPtr.source.version;
                bcdHeader.nConfigs _ 0;
                bcdHeader.nModules _ nIds;
                bcdHeader.nImports _ bcdHeader.nExports _ 0;
                bcdHeader.definitions _ dataPtr.interface;
                bcdHeader.typeExported _ FALSE;
                bcdHeader.repackaged _ bcdHeader.tableCompiled _ FALSE;
                bcdHeader.versions _ FALSE;
                bcdHeader.extended _ TRUE;
                bcdHeader.spare1 _ TRUE;    -- large eval stack
                bcdHeader.spare2 _ FALSE;
                bcdHeader.ctOffset _ 0;  bcdHeader.ctLimit _ CTIndex.FIRST;
                bcdHeader.spOffset _ 0;  bcdHeader.spLimit _ SPIndex.FIRST;
                bcdHeader.fpOffset _ 0;  bcdHeader.fpLimit _ FPIndex.FIRST;
                nString.string.length _ nString.string.length + 1;
                bcdHeader.source _ NameRecord[nString.string.length];
                    nString.size[bcdHeader.source] _ dataPtr.source.locator.Length[];
                    ConvertUnsafe.AppendRope[to: @nString.string, from: dataPtr.source.locator];
            bcdOffset _ CompilerUtil.ReadBCDOffset[];
            CompilerUtil.AppendBCDWords[bcdHeader, BcdDefs.BCD.SIZE];
            dataPtr.fixupLoc _ CompilerUtil.ReadBCDIndex[];
            bcdHeader.sgOffset _ CompilerUtil.ReadBCDOffset[];
            CompilerUtil.AppendBCDWords[@dataPtr.codeSeg, SGRecord.SIZE];
            CompilerUtil.AppendBCDWords[@dataPtr.symSeg, SGRecord.SIZE];
            bcdHeader.mtOffset _ mtOffset _ CompilerUtil.ReadBCDOffset[];
            bcdHeader.sgLimit _ SGIndex.FIRST + (mtOffset - bcdHeader.sgOffset);
            dataPtr.mtRootSize _ BcdDefs.MTRecord.SIZE;
            dataPtr.mtRoot _ protoMTRecord;
            dataPtr.mtRoot.links _
                (IF dataPtr.interface THEN BcdDefs.LFNull ELSE BcdDefs.LFIndex.FIRST);
            dataPtr.mtRoot.refLiterals _ BcdDefs.RFNull;
            dataPtr.mtRoot.types _ BcdDefs.TFNull;
            FOR i: CARDINAL IN [0..nIds) DO
                CompilerUtil.AppendBCDWords[dataPtr.mtRoot, dataPtr.mtRootSize]
                ENDLOOP;
            bcdHeader.lfOffset _ CompilerUtil.ReadBCDOffset[];
            bcdHeader.mtLimit _ BcdDefs.MTIndex.FIRST + (bcdHeader.lfOffset-bcdHeader.mtOffset)};

        FinishBCD: PUBLIC PROC[ids: Tree.Link] = {
            OPEN BcdDefs;
            pageSize: CARDINAL = BcdDefs.PageSize;
            Alignment: CARDINAL = 4;  -- Code Segments must start at 0 MOD Alignment
            nLinks: CARDINAL = dataPtr.linkCount;
            codeLinks: BOOL = dataPtr.switches['l];
            gfType: RecordSEIndex = bb[RootBti].type;
            <<fill MTRecord>>
                IF TreeOps.ListLength[ids] > 1 THEN {    -- complete nString now

                    EnterId: Tree.Scan = {[] _ EnterSymbolId[TreeOps.GetSe[t]]};

                    TreeOps.ScanList[ids, EnterId]};
                dataPtr.mtRoot.name _ EnterSymbolId[bb[RootBti].id];
                dataPtr.mtRoot.namedInstance _ FALSE;
                dataPtr.mtRoot.initial _ ~dataPtr.switches['s];
                dataPtr.mtRoot.file _ dataPtr.bcdSeg.file _ dataPtr.codeSeg.file _ dataPtr.symSeg.file _ 
                    PortedCtx[dataPtr.mainCtx];
                dataPtr.bcdSeg.base _ 0;
                dataPtr.mtRoot.linkLoc _ IF codeLinks THEN code ELSE frame;
                dataPtr.mtRoot.config _ CTNull;
                dataPtr.mtRoot.code _ CodeDesc[
                    sgi: SGIndex.FIRST,
                    packed: FALSE, linkspace: codeLinks,
                    offset: (IF codeLinks AND nLinks # 0
                        THEN (nLinks+1) + (Alignment-1 - (nLinks MOD Alignment))
                        ELSE 0),
                    length: 0];    -- will be updated
                dataPtr.mtRoot.sseg _ SGIndex.FIRST + SGRecord.SIZE;
                dataPtr.mtRoot.frameRefs _ seb[gfType].hints.refField;
                dataPtr.mtRoot.frameType _
                    IF seb[gfType].hints.refField THEN SymLiteralOps.TypeIndex[gfType] ELSE [0];
                dataPtr.mtRoot.framesize _ 0;    -- will be updated
                dataPtr.mtRoot.tableCompiled _ FALSE;
                dataPtr.mtRoot.residentFrame _ passPtr.resident;
                dataPtr.mtRoot.boundsChecks _ dataPtr.switches['b];
                dataPtr.mtRoot.nilChecks _ dataPtr.switches['n];
                dataPtr.mtRoot.long _ dataPtr.switches['c];    -- compiled for Cedar
                dataPtr.mtRoot.crossJumped _ dataPtr.switches['j];
                dataPtr.mtRoot.packageable _ TRUE;
            ProcessFiles[];
            bcdHeader.ssOffset _ CompilerUtil.ReadBCDOffset[];
            CompilerUtil.AppendBCDString[@nString.string];
            bcdHeader.ssLimit _ (CompilerUtil.ReadBCDOffset[]-bcdHeader.ssOffset);
            IF dataPtr.interface THEN bcdHeader.rtPages.relPageBase _ 0
            ELSE {
                CompilerUtil.FillBCDPage[];
                bcdHeader.rtPages.relPageBase _ CompilerUtil.ReadBCDOffset[]/pageSize;
                CompilerUtil.RTTableOut[dataPtr.table]};
            bcdHeader.nPages _ (CompilerUtil.ReadBCDOffset[] + (pageSize-1))/pageSize;
            bcdHeader.rtPages.pages _ bcdHeader.nPages - bcdHeader.rtPages.relPageBase;
            CompilerUtil.UpdateBCDWords[bcdOffset, bcdHeader, BcdDefs.BCD.SIZE];
            dataPtr.bcdSeg.base _ 0; dataPtr.bcdSeg.pages _ bcdHeader.nPages;
            IF dataPtr.interface AND TreeOps.ListLength[ids] > 1 THEN {
                offset: CARD _ mtOffset;
                saveName: BcdDefs.NameRecord = dataPtr.mtRoot.name;

                UpdateMDEntry: Tree.Scan = {
                    dataPtr.mtRoot.name _ EnterSymbolId[TreeOps.GetSe[t]];
                    CompilerUtil.UpdateBCDWords[offset, dataPtr.mtRoot, dataPtr.mtRootSize];
                    offset _ offset + dataPtr.mtRootSize};

                offset _ mtOffset;  TreeOps.ScanList[ids, UpdateMDEntry];
                dataPtr.mtRoot.name _ saveName};
            CompilerUtil.EndBCD[];
            nStringREFTEXT _ NIL;
            nString _ NIL};


        MatchBCD: PUBLIC PROC RETURNS[matched: BOOL _ FALSE] = {
            oldSymbols: SymbolTable.Base _ Copier.MapSymbols[dataPtr.pattern];
            IF oldSymbols = NIL THEN Log.WarningRope[fileName, dataPtr.pattern.locator]
            ELSE {
                matched _ MatchedBodies[
                    [oldSymbols, RootBti], [dataPtr.ownSymbols, RootBti]
                    ! Unmatched => {
                        d: ConvertUnsafe.SubString;
                        d _ id.stb.SubStringForName[id.stb.NameForSe[id.sei]];
                        SELECT attr FROM
                            $strings => Log.WarningSubString[replString, d];
                            $id => Log.WarningSubString[replId, d];
                            ENDCASE;
                        RESUME}];
                Copier.UnmapSymbols[oldSymbols]}};


    <<matching for module replacement (formerly in ReplPack)>>

        IdHandle: TYPE = RECORD [
            stb: SymbolTable.Base,
            sei: Symbols.ISEIndex];

        MatchedNames: PROC[id1, id2: IdHandle] RETURNS[BOOL] = {
            OPEN b1: id1.stb, b2: id2.stb;
            ss1, ss2: ConvertUnsafe.SubString;
            IF id1.sei = ISENull OR id2.sei = ISENull THEN RETURN [FALSE];
            ss1 _ b1.SubStringForName[b1.seb[id1.sei].hash];
            ss2 _ b2.SubStringForName[b2.seb[id2.sei].hash];
            RETURN [ConvertUnsafe.EqualSubStrings[ss1, ss2]]};


        MatchMode: PROC[id: IdHandle] RETURNS[Linkage] = {
            <<LinkMode for a virtual defs module>>
            OPEN b: id.stb;
            RETURN[IF b.seb[id.sei].idType = typeTYPE AND b.seb[id.sei].public
                THEN $type
                ELSE IF b.seb[id.sei].constant THEN
                    SELECT b.XferMode[b.seb[id.sei].idType] FROM
                        proc, program, signal, error => $val,
                        ENDCASE => $manifest
                ELSE $ref]
            };

        MatchedAttrs: PROC[idL, idR: IdHandle] RETURNS[BOOL] = {
            OPEN bL: idL.stb, bR: idR.stb;
            typeL: CSEIndex = bL.UnderType[bL.seb[idL.sei].idType];
            mode: Linkage = MatchMode[idL];
            matched: BOOL;
            IF idR.sei # ISENull THEN {
                typeR: CSEIndex = bR.UnderType[bR.seb[idR.sei].idType];
                matched _ (SELECT mode FROM
                    $val =>
                        Types.Assignable[[idL.stb, typeL], [idR.stb, typeR]]
                            AND
                        (bL.seb[idL.sei].idValue = bR.seb[idR.sei].idValue),
                    $ref =>
                        Types.Equivalent[[idL.stb, typeL], [idR.stb, typeR]]
                            AND
                        (bL.seb[idL.sei].idValue = bR.seb[idR.sei].idValue)    -- offsets
                            AND
                        (bL.seb[idL.sei].idInfo = bR.seb[idR.sei].idInfo),    -- sizes
                    $type =>
                        (bR.seb[idR.sei].idType = typeTYPE) AND (bR.seb[idR.sei].public)
                            AND
                        Types.Equivalent[
                            [idL.stb, bL.UnderType[idL.sei]], [idR.stb, bR.UnderType[idR.sei]]],
                    ENDCASE => TRUE)}
            ELSE matched _ (mode = manifest);
            IF ~matched THEN SIGNAL Unmatched[$id, idL];
            RETURN[matched]};


        CTXHandle: TYPE = RECORD [
            stb: SymbolTable.Base,
            ctx: CTXIndex];

        MatchedContexts: PROC[ctxL, ctxR: CTXHandle] RETURNS[BOOL] = {
            OPEN bL: ctxL.stb, bR: ctxR.stb;
            n: CARDINAL _ 0;
            FOR sei: ISEIndex _ bL.FirstCtxSe[ctxL.ctx], bL.NextSe[sei]
                UNTIL sei = ISENull OR n > 4 DO
                    IF bL.seb[sei].hash # nullName THEN {
                        ss: ConvertUnsafe.SubString _ bL.SubStringForName[bL.seb[sei].hash];
                        IF ~MatchedAttrs[
                            [ctxL.stb, sei], [ctxR.stb, bR.SearchContext[bR.FindString[ss], ctxR.ctx]]] THEN
                            n _ n+1};
                    ENDLOOP;
            RETURN[n = 0]};


        RecordHandle: TYPE = RECORD[
            stb: SymbolTable.Base,
            sei: RecordSEIndex];

        MatchedRecords: PROC[recL, recR: RecordHandle] RETURNS[BOOL] = {
            OPEN bL: recL.stb, bR: recR.stb;
            RETURN[IF recL.sei = RecordSENull OR recR.sei = RecordSENull
                THEN recL.sei = recR.sei
                ELSE MatchedContexts[ 
                    [recL.stb, bL.seb[recL.sei].fieldCtx], [recR.stb, bR.seb[recR.sei].fieldCtx]]]
            };

        MatchedArgLists: PROC[argL, argR: Types.Handle] RETURNS[BOOL] = {
            OPEN bL: argL.stb, bR: argR.stb;
            inL, inR, outL, outR: RecordSEIndex;
            [inL, outL] _ bL.TransferTypes[argL.sei];
            [inR, outR] _ bR.TransferTypes[argR.sei];
            RETURN[
                MatchedRecords[[argL.stb, inL], [argR.stb, inR]]
                    AND
                MatchedRecords[[argL.stb, outL], [argR.stb, outR]]]
            };


        BodyHandle: TYPE = RECORD [
            stb: SymbolTable.Base,
            bti: Symbols.CBTIndex];

        MatchAttr: TYPE = {id, strings};
        Unmatched: SIGNAL[attr: MatchAttr, id: IdHandle] = CODE;

        MatchedBodies: PROC[bodyL, bodyR: BodyHandle] RETURNS[BOOL] = {
            OPEN bL: bodyL.stb, bR: bodyR.stb;
            matched: BOOL _ TRUE;
            IF ~bL.bb[bodyL.bti].hints.noStrings THEN {
                SIGNAL Unmatched[$strings, [bodyL.stb, bL.bb[bodyL.bti].id]];
                matched _ FALSE};
            IF ~bR.bb[bodyR.bti].hints.noStrings THEN {
                IF ~matched THEN SIGNAL Unmatched[$strings, [bodyR.stb, bR.bb[bodyR.bti].id]];
                matched _ FALSE};
            IF ~(
                MatchedNames[
                    [bodyL.stb, bL.bb[bodyL.bti].id], [bodyR.stb, bR.bb[bodyR.bti].id]]
                        AND
                (bL.bb[bodyL.bti].entryIndex = bR.bb[bodyR.bti].entryIndex)
                    AND
                Types.Assignable[
                    [bodyL.stb, bL.bb[bodyL.bti].ioType],
                    [bodyR.stb, bR.bb[bodyR.bti].ioType]]
                        AND
                MatchedArgLists[
                    [bodyL.stb, bL.bb[bodyL.bti].ioType],
                    [bodyR.stb, bR.bb[bodyR.bti].ioType]])
                THEN {
                    SIGNAL Unmatched[$id, [bodyL.stb, bL.bb[bodyL.bti].id]];
                    matched _ FALSE};
            IF ~MatchedContexts[
                [bodyL.stb, bL.bb[bodyL.bti].localCtx],
                [bodyR.stb, bR.bb[bodyR.bti].localCtx]] THEN matched _ FALSE;
            RETURN[matched]};

        <<>>
    <<START HERE>>

        {
            WordSeq: TYPE = RECORD[SEQUENCE COMPUTED CARDINAL OF WORD];
            systemUZone: UNCOUNTED ZONE = UnsafeStorage.GetSystemUZone[];
            evList _ LOOPHOLE[
                    systemUZone.NEW[WordSeq[BcdDefs.EVRecord.SIZE+maxEVLength]],
                    BcdDefs.EVHandle];
            bcdHeader _ systemUZone.NEW[BcdDefs.BCD];

            protoMTRecord _ systemUZone.NEW[BcdDefs.MTRecord];
        };

    }.

