<<>>
    <<MobBind.mesa>>
        <<Copyright Ó 1985, 1989, 1991 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite on February 27, 1986 12:28:49 pm PST>>
        <<Lewis on 16-Dec-80 10:12:01>>
        <<Maxwell, August 4, 1983 10:58 am>>
        <<Paul Rovner, September 8, 1983 5:30 pm>>
        <<Russ Atkinson (RRA) March 7, 1985 0:19:30 am PST>>
        <<Andy Litman May 11, 1988 6:13:15 pm PDT>>
        <<JKF July 22, 1989 3:50:17 pm PDT>>

    DIRECTORY
        Alloc USING [AddNotify, Bounds, DropNotify, Handle, Notifier, Top],
        MobBindDefs USING [RelocHandle],
        MobComData USING [data],
        MobControlDefs USING [],
        MobDefs USING [CTIndex, cttype, cxtype, EXPIndex, EXPNull, exptype, FTIndex, FTNull, fttype, IMPIndex, IMPNull, IMPRecord, imptype, 
        LFIndex, LFNull, lftype, Link, ModuleIndex, MTIndex, MTRecord, mttype, NameRecord, nullLink, NullName, sstype, sttype, 
        treetype, unboundLink],
        MobErrorDefs USING [ErrorHti, ErrorInterface, ErrorSti, Error2Files, GetModule, GetSti],
        MobUtilDefs USING [EqVersions, GetDummyGfi, GetGfi, InstanceName, NameForSti],
        ConvertUnsafe USING [SubString],
        MobHashOps USING [FindString],
        MobSymbols USING [CXIndex, cxNull, HTIndex, HTNull, STIndex, stNull, STRecord],
        Table USING [Base],
        MobTree USING [Scan, null, Link],
        MobTreeOps USING [ScanList];

    MobBind: PROGRAM
          IMPORTS Alloc, MobErrorDefs, MobUtilDefs, MobHashOps, MobTreeOps, MobComData
          EXPORTS MobControlDefs = {
        OPEN MobDefs, MobSymbols; 

        BindError: PUBLIC ERROR ~ CODE;

        table: Alloc.Handle;
        tb, stb, ctb, cxb, mtb, lfb, etb, itb, ftb: Table.Base;
        ssb: LONG STRING;

        Notifier: Alloc.Notifier ~ {
            tb  Ź base[treetype];  stb Ź base[sttype];  cxb Ź base[cxtype];
            ctb Ź base[cttype];    mtb Ź base[mttype];  lfb Ź base[lftype];
            etb Ź base[exptype];   itb Ź base[imptype];
            ftb Ź base[fttype];
            ssb Ź base[sstype]};


        Error: PROC ~ {ERROR BindError};

        ItiToIndex: PROC[impi: IMPIndex] RETURNS[CARD] ~ INLINE {
            RETURN[LOOPHOLE[impi, CARD]/IMPRecord.SIZE]};

        relocationHead: MobBindDefs.RelocHandle;
        rel: MobBindDefs.RelocHandle;

        BindRoot: PUBLIC PROC[relocationRoot: MobBindDefs.RelocHandle] ~ {
            table Ź MobComData.data.table; 
            table.AddNotify[Notifier];
            relocationHead Ź relocationRoot;
            SetupGFMap[];
            AssignImports[
                ! MobErrorDefs.GetSti => {
                    IF rel # NIL THEN
                        RESUME [StiForContext[
                            IF rel.type = $inner THEN rel.parentcx ELSE rel.context]]}];
            BindModules[];
            ReleaseGFMap[];
            table.DropNotify[Notifier];  
            table Ź NIL};

        LinkType: TYPE ~ RECORD[
            SELECT tag:* FROM
                gfi => [gfi: ModuleIndex],
                import => [impi: IMPIndex],
                ENDCASE];

        GFOffset: TYPE = INT;

        GFMapItem: TYPE ~ RECORD[
            linkItem: LinkType,
            expi: EXPIndex,
            offset: GFOffset];

        GFMap: TYPE ~ RECORD[SEQUENCE length: CARDINAL OF GFMapItem];
        RelMap: TYPE ~ RECORD[SEQUENCE length: CARDINAL OF CARDINAL];

        finalFirstDummy: ModuleIndex;
        gfMap: REF GFMap Ź NIL;
        relMap: REF RelMap Ź NIL;

        SetupGFMap: PROC ~ {
            nDummies: CARDINAL Ź MobUtilDefs.GetDummyGfi[0]-1;
            nImports: CARDINAL ~ table.Bounds[imptype].size/IMPRecord.SIZE;
            finalFirstDummy Ź MobUtilDefs.GetGfi[0];
            IF nDummies # 0 THEN nDummies Ź nDummies + 1;
            gfMap Ź NEW[GFMap[nDummies]];
            FOR i: CARDINAL IN [0..nDummies) DO gfMap[i] Ź [[gfi[0]], EXPNull, 0] ENDLOOP;
            relMap Ź NEW[RelMap[nImports]];
            FOR rel: MobBindDefs.RelocHandle Ź relocationHead, rel.link UNTIL rel = NIL DO
                FOR iti: IMPIndex Ź IMPIndex.FIRST+rel.import, iti+IMPRecord.SIZE
                    UNTIL iti = rel.importLimit DO
                        relMap[ItiToIndex[iti]] Ź itb[iti].modIndex + rel.dummygfi-rel.originalfirstdummy;
                        ENDLOOP;
                ENDLOOP};

        RelocatedGfi: PROC[iti: IMPIndex] RETURNS[CARDINAL] ~ {
            RETURN[IF iti = IMPNull THEN 0 ELSE relMap[ItiToIndex[iti]]]};

        ReleaseGFMap: PROC ~ {
            gfMap Ź NIL;
            relMap Ź NIL};


        NameToHti: PROC[name: NameRecord] RETURNS[hti: HTIndex] ~ {
            ss: ConvertUnsafe.SubString ~ [base~ssb, offset~name+1, length~ssb.text[name].ORD];
            hti Ź MobHashOps.FindString[ss];
            IF hti = HTNull THEN Error[]};

        ExpiForSti: PROC[sti: STIndex] RETURNS[EXPIndex] ~ {
            RETURN [IF sti = stNull
                THEN EXPNull
                ELSE
                    WITH s~~stb[sti] SELECT FROM
                        external => WITH m~~s.map SELECT FROM interface => m.expi, ENDCASE => EXPNull,
                        ENDCASE => EXPNull]
            };


        AssignImports: PROC ~ {
            saveIndex: CARDINAL ~ MobComData.data.textIndex;
            saveName: NameRecord ~ MobComData.data.currentName;
            FOR rel Ź relocationHead, rel.link UNTIL rel = NIL DO
                MobComData.data.textIndex Ź rel.textIndex;
                MobComData.data.currentName Ź MobUtilDefs.NameForSti[StiForContext[rel.context]];
                SELECT TRUE FROM
                    (rel.type = $outer) =>  AssignOuter[rel];
                    (rel.parameters # MobTree.null) =>  AssignByPosition[rel];
                    ENDCASE =>  AssignByName[rel];
                ENDLOOP;
            MobComData.data.textIndex Ź saveIndex;  MobComData.data.currentName Ź saveName};

        AssignOuter: PROC[rel: MobBindDefs.RelocHandle] ~ {
            FOR iti: IMPIndex Ź IMPIndex.FIRST+rel.import, iti+IMPRecord.SIZE 
                UNTIL iti = rel.importLimit DO
                    sti: STIndex ~ LookupInstance[iti, rel.context];
                    IF sti = stNull THEN LOOP;
                    IF stb[sti].impi # IMPNull
                        THEN {
                            stb[sti].impgfi Ź itb[stb[sti].impi].modIndex Ź MobUtilDefs.GetGfi[1]}
                        ELSE MobErrorDefs.ErrorSti[$error, "is not imported by any module"L, sti];
                    ENDLOOP
            };

        AssignByName: PROC[rel: MobBindDefs.RelocHandle] ~ {
            iti, import: IMPIndex;
            export: EXPIndex;
            defgfi: CARDINAL;
            sti, parentSti: STIndex;
            FOR iti Ź IMPIndex.FIRST+rel.import, iti+IMPRecord.SIZE UNTIL iti = rel.importLimit DO
                sti Ź IF rel.type = $inner
                    THEN LookupInstance[iti, rel.context]
                    ELSE LookupInterface[iti, rel.context];
                IF sti = stNull THEN LOOP;
                defgfi Ź stb[sti].impgfi;
                IF stb[sti].impi # IMPNull
                    THEN
                        SELECT rel.type FROM
                            $inner => {
                                IF (parentSti Ź LookupInterface[iti, rel.parentcx]) = stNull
                                    THEN LOOP;
                                import Ź stb[parentSti].impi;  export Ź ExpiForSti[parentSti];
                                defgfi Ź stb[parentSti].impgfi;
                                sti Ź parentSti};
                            ENDCASE => {import Ź stb[sti].impi; export Ź ExpiForSti[sti]}
                    ELSE {import Ź IMPNull; export Ź ExpiForSti[sti]};
                WITH s~~stb[sti] SELECT FROM
                    external =>
                        WITH m~~s.map SELECT FROM
                            module => AssignModule[defgfi, m.mti, iti];
                            interface => AssignInterface[defgfi, import, export, iti];
                            unknown => AssignImport[defgfi, import, iti];
                            ENDCASE => Error[];
                    unknown => AssignImport[defgfi, import, iti];
                    ENDCASE => Error[];
                ENDLOOP
            };

        LookupInstance: PROC[iti: IMPIndex, cxi: CXIndex] RETURNS[STIndex] ~ {
            RETURN[IF cxi = cxNull
                THEN stNull
                ELSE Lookup[
                    hti~NameToHti[IF itb[iti].namedInstance
                        THEN MobUtilDefs.InstanceName[[0,0,import[iti]]]
                        ELSE itb[iti].name],
                    cxi~rel.context]]
            };

        LookupInterface: PROC[iti: IMPIndex, cxi: CXIndex] RETURNS[STIndex] ~ {
            RETURN[IF cxi = cxNull THEN stNull ELSE Lookup[NameToHti[itb[iti].name], cxi]]};


        AssignByPosition: PROC[rel: MobBindDefs.RelocHandle] ~ {
            iti: IMPIndex;
            TooManyParameters: ERROR ~ CODE;

            AssignPosition: MobTree.Scan ~ {
                sti: STIndex ~ NARROW[t, MobTree.Link.symbol].index;
                import: IMPIndex ~ stb[sti].impi;
                export: EXPIndex ~ ExpiForSti[sti];
                defgfi: CARDINAL ~ stb[sti].impgfi;
                IF iti = rel.importLimit THEN ERROR TooManyParameters;
                WITH s~~stb[sti] SELECT FROM
                    external =>
                        WITH m~~s.map SELECT FROM
                            module => AssignModule[defgfi, m.mti, iti];
                            interface => AssignInterface[defgfi, import, export, iti];
                            unknown => AssignImport[defgfi, import, iti];
                            ENDCASE => Error[];
                    ENDCASE => MobErrorDefs.ErrorSti[$error, "is undeclared"L, sti];
                iti Ź iti + MobDefs.IMPRecord.SIZE};

            iti Ź IMPIndex.FIRST + rel.import;
            MobTreeOps.ScanList[rel.parameters, AssignPosition
                ! TooManyParameters => {GOTO tooMany}];
            IF iti # rel.importLimit THEN GOTO tooFew;
            EXITS
                tooMany =>  MobErrorDefs.ErrorHti[$error,
                    "has too many parameters"L, HtiForRelocation[rel]];
                tooFew =>  MobErrorDefs.ErrorHti[$error,
                    "has too few parameters"L, HtiForRelocation[rel]]};

        MakeLink: PROC[defgfi: CARDINAL, import: IMPIndex, offset: CARDINAL]
            RETURNS[LinkType] ~ {
            RETURN[SELECT TRUE FROM
                (defgfi # 0) => [gfi[defgfi+offset]],
                (import = IMPNull) => [gfi[0]],
                ENDCASE => [import[import]]]};

        AssignModule: PROC[defgfi: ModuleIndex, mti: MTIndex, iti: IMPIndex] ~ {
            gfi: CARDINAL ~ RelocatedGfi[iti];
            IF itb[iti].port # $module OR ~MobUtilDefs.EqVersions[itb[iti].file, mtb[mti].file] THEN
                MobErrorDefs.Error2Files[
                    class~$error,
                    s~"is required for import, but available version is"L,
                    ft1~itb[iti].file, ft2~mtb[mti].file];
            gfMap[gfi] Ź [
                linkItem~[gfi[IF defgfi # 0 THEN defgfi ELSE mtb[mti].modIndex]],
                expi~EXPNull, offset~0]};

        AssignInterface: PROC[defgfi: ModuleIndex, import: IMPIndex, expi: EXPIndex, iti: IMPIndex] ~ {
            gfi: CARDINAL ~ RelocatedGfi[iti];
            IF expi # EXPNull AND
                (itb[iti].port # etb[expi].port OR ~MobUtilDefs.EqVersions[itb[iti].file, etb[expi].file]) THEN
                    MobErrorDefs.Error2Files[
                        class~$error,
                        s~"is required for import, but available version is"L,
                        ft1~itb[iti].file, ft2~etb[expi].file];
            IF itb[iti].port = $module THEN
                gfMap[gfi] Ź [
                    linkItem~[gfi[etb[expi].links[0].from.modIndex]],
                    expi~EXPNull, offset~0]
            ELSE FOR i: GFOffset IN [0..1) DO
                gfMap[gfi+i] Ź [
                    linkItem~MakeLink[defgfi, import, i],
                    expi~expi, offset~i];
                ENDLOOP};

        AssignImport: PROC[defgfi: ModuleIndex, import: IMPIndex, iti: IMPIndex] ~ {
            gfi: CARDINAL ~ RelocatedGfi[iti];
            IF import # IMPNull AND
                (itb[iti].port # itb[import].port OR
                    ~MobUtilDefs.EqVersions[itb[iti].file, itb[import].file]) THEN
                        MobErrorDefs.Error2Files[
                            class~$error,
                            s~"is required for import, but available version is"L,
                            ft1~itb[iti].file, ft2~itb[import].file];
            FOR i: GFOffset IN [0..1) DO
                gfMap[gfi+i] Ź [
                    linkItem~MakeLink[defgfi, import, i],
                    expi~EXPNull, offset~i];
                ENDLOOP};

        Lookup: PROC[hti: HTIndex, cxi: CXIndex] RETURNS[sti: STIndex] ~ {
            FOR sti Ź cxb[cxi].link, stb[sti].link UNTIL sti = stNull DO
                IF stb[sti].hti = hti THEN RETURN ENDLOOP;
            RETURN [stNull]};

        StiForContext: PROC[cxi: CXIndex] RETURNS[sti: STIndex] ~ {
            stLimit: STIndex ~ LOOPHOLE[table.Top[sttype]];
            FOR sti Ź STIndex.FIRST, sti+STRecord.SIZE UNTIL sti = stLimit DO
                WITH s~~stb[sti] SELECT FROM
                    local => IF s.context = cxi THEN RETURN;
                    ENDCASE;
                ENDLOOP;
            RETURN [stNull]};

        HtiForRelocation: PROC[rel: MobBindDefs.RelocHandle] RETURNS[HTIndex] ~ {
            sti: STIndex;
            mti: MTIndex;
            cti: CTIndex;
            IF rel.type # $file THEN {
                sti Ź StiForContext[rel.context];  RETURN [stb[sti].hti]};
            mti Ź MTIndex.FIRST + rel.module;  cti Ź CTIndex.FIRST + rel.config;
            RETURN [NameToHti[IF mtb[mti].config = cti THEN ctb[cti].name ELSE mtb[mti].name]]};

        BindModules: PROC ~ {
            saveIndex: CARDINAL ~ MobComData.data.textIndex;
            saveName: NameRecord ~ MobComData.data.currentName;
            mtLimit: MTIndex ~ LOOPHOLE[table.Top[mttype]];
            rel Ź relocationHead;
            FOR mti: MTIndex Ź MTIndex.FIRST, (mti + MTRecord.SIZE)
                UNTIL mti = mtLimit DO
                SetRelocationForModule[mti];
                FOR i: CARDINAL IN [0 .. lfb[mtb[mti].links].length) DO
                    saveLink: MobDefs.Link Ź lfb[mtb[mti].links].frag[i];
                    lfb[mtb[mti].links].frag[i] Ź RelocateLink[saveLink
                        ! MobErrorDefs.GetModule => {RESUME [mti, i, saveLink]}];
                    ENDLOOP;
                ENDLOOP;
            MobComData.data.textIndex Ź saveIndex;  MobComData.data.currentName Ź saveName};

        SetRelocationForModule: PROC[mti: MTIndex] ~ {
            gfi: ModuleIndex ~ mtb[mti].modIndex;
            FOR rel Ź rel, rel.link UNTIL rel = NIL DO
                IF gfi IN [rel.firstgfi..rel.lastgfi] THEN GOTO found ENDLOOP;
            FOR rel Ź relocationHead, rel.link UNTIL rel = NIL DO
                IF gfi IN [rel.firstgfi..rel.lastgfi] THEN GOTO found ENDLOOP;
            Error[];
            EXITS found => {
                MobComData.data.textIndex Ź rel.textIndex;
                MobComData.data.currentName Ź MobUtilDefs.NameForSti[StiForContext[rel.context]]}};

        BindFragment: PROC[mti: MTIndex, lfi: LFIndex] ~ {
            IF lfi # LFNull THEN
                FOR i: CARDINAL IN [0 .. lfb[lfi].length) DO
                    saveLink: MobDefs.Link Ź lfb[lfi].frag[i];
                    lfb[lfi].frag[i] Ź RelocateLink[saveLink
                        ! MobErrorDefs.GetModule => RESUME [mti, i, saveLink]];
                    ENDLOOP
            };

        RelocateLink: PROC[cl: MobDefs.Link] RETURNS[MobDefs.Link] ~ {
            SELECT TRUE FROM
                (cl.tag = $type) => ERROR;
                (cl.modIndex = 0) => NULL;
                (cl.modIndex < rel.originalfirstdummy) =>  cl.modIndex Ź cl.modIndex + rel.firstgfi-1;
                ENDCASE => {
                    gfi: CARDINAL;
                    expi: EXPIndex;
                    map: LONG POINTER TO GFMapItem;
                    gfi Ź cl.modIndex + rel.dummygfi-rel.originalfirstdummy;
                    DO
                        map Ź @gfMap[gfi];
                        IF (expiŹmap.expi) # EXPNull THEN {
                            newCl: MobDefs.Link ~ 
                            etb[expi].links[cl.offset + map.offset*0].from;
                            IF newCl # nullLink THEN RETURN [newCl]};
                        WITH map.linkItem SELECT FROM
                            m: LinkType.gfi => {
                                IF (gfiŹm.gfi) = 0 THEN GOTO unbindable;
                                IF gfi < finalFirstDummy AND cl.offset = 0 THEN 
                                    cl Ź [tag: $var, modIndex: 0, offset: 0];
                                EXIT};
                            m: LinkType.import => gfi Ź RelocatedGfi[m.impi]+map.offset;
                            ENDCASE;
                        REPEAT
                            unbindable => {
                                importName: NameRecord;
                                offset: CARDINAL;
                                importFti: FTIndex;
                                [importName, offset, importFti] Ź LookupImport[cl.modIndex];
                                MobErrorDefs.ErrorInterface[
                                    class~$warning, s~"is unbindable"L, 
                                    import~[name~importName, fti~importFti], ep~(cl.offset + offset)];
                                RETURN [IF cl.tag = $var THEN nullLink ELSE unboundLink]};
                        ENDLOOP;
                    cl.modIndex Ź gfi};
            RETURN [cl]};

        LookupImport: PROC[gfi: ModuleIndex] 
            RETURNS[importName: NameRecord, offset: CARDINAL, importFti: FTIndex] ~ {
            FOR iti: IMPIndex Ź (IMPIndex.FIRST + rel.import), 
                (iti + IMPRecord.SIZE) UNTIL iti = rel.importLimit DO  
                    IF gfi IN [itb[iti].modIndex..itb[iti].modIndex+1) THEN
                        RETURN[
                            importName~itb[iti].name, offset~(gfi-itb[iti].modIndex)*0 <<MobDefs.ProcLimit>>, 
                            importFti~itb[iti].file];
                    ENDLOOP;
            RETURN[importName~NullName, offset~0, importFti~FTNull]};

        }.