
    <<MBLoaderExtra.mesa  >>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Sandman on  5-Aug-81 11:56:04>>
        <<Lewis on 25-Sep-81 15:03:08>>
        <<Levin on January 11, 1984 6:01 pm>>
        <<Russ Atkinson (RRA) March 8, 1985 5:17:43 pm PST>>

    DIRECTORY
        BcdDefs USING [Base, BcdBase, EVIndex, EVNull, EXPHandle, EXPIndex, EXPNull, FTHandle, FTIndex, FTSelf, IMPHandle, IMPIndex, Link, 
        MTHandle, MTIndex, MTNull, NameRecord, NameString, PackedString, ProcLimit, TMHandle, TMIndex, TMNull, TMRecord, 
        UnboundLink, VarLimit, VersionStamp],
        BcdOps USING [ProcessExports, ProcessImports, ProcessModules],
        MB USING [BHandle, Error, Handle, MT, RopeForNameRecord],
        MBLoaderOps USING [AcquireBcd, BcdExports, BcdExportsTypes, BcdUnresolved, Binding, BindLink, CloseLinkSpace, ConfigIndex, 
        EnterModule, GetModule, GetVirtualLinks, InitBinding, ModuleInfo, OpenLinkSpace, ReadLink, UpdateLoadState, VirtualLinks, 
        WriteLink],
        PrincOps USING [ControlLink, GFTIndex, GFTNull, GlobalFrame, GlobalFrameHandle, NullGlobalFrame, NullLink, UnboundLink],
        Rope USING [ROPE];

    MBLoaderExtra: CEDAR PROGRAM
        IMPORTS BcdOps, MB, MBLoaderOps
        EXPORTS MBLoaderOps = BEGIN OPEN BcdDefs, BcdOps;

    data: MB.Handle _ NIL;

    VersionMismatch: PUBLIC SIGNAL [interface, ref1, ref2: Rope.ROPE] = CODE;

    InitLoaderExtra: PUBLIC PROC [h: MB.Handle] = {data _ h};

    FinishLoaderExtra: PUBLIC PROC = {data _ NIL};

    Bind: PUBLIC PROC [loadee: MB.BHandle, config: MBLoaderOps.ConfigIndex] = TRUSTED {
        bcd: BcdBase = loadee.bcd;
        <<bindings for loadee's imports>>
        binding: MBLoaderOps.Binding _ MBLoaderOps.InitBinding[bcd];  
        bindingsFound, resolved: BOOL;
        resolved _ (bcd.nImports = 0);
        <<bind (relocate) imports within loadee itself>>
        [] _ BindImports[bcd: loadee.bcd, system: loadee.bcd, binding: binding];
        resolved _ ProcessLinks[
            loadee: loadee, system: loadee, binding: binding, config: config, initLinkSpace: TRUE];
        <<bind into existing system>>
        FOR i: CARDINAL DECREASING IN [0..config) DO
            system: MB.BHandle _ MBLoaderOps.AcquireBcd[i];
            <<bind loadee's imports exported by existing Bcd i>>
            IF ~resolved AND MBLoaderOps.BcdExports[i] THEN {
                binding _ MBLoaderOps.InitBinding[bcd];
                bindingsFound _ BindImports[bcd: loadee.bcd, system: system.bcd, binding: binding];
                IF bindingsFound THEN
                    resolved _ ProcessLinks[
                        loadee: loadee, system: system, binding: binding, config: i, initLinkSpace: FALSE]
                ELSE resolved _ FALSE;
                };
            <<bind imports of existing Bcd i exported by loadee>>
            IF MBLoaderOps.BcdUnresolved[i] AND (bcd.nExports ~= 0 OR bcd.nModules = 1) THEN {
                binding _ MBLoaderOps.InitBinding[system.bcd];
                bindingsFound _ BindImports[bcd: system.bcd, system: loadee.bcd, binding: binding];
                IF bindingsFound THEN 
                    [] _ ProcessLinks[
                        loadee: system, system: loadee, binding: binding, config: config, initLinkSpace: FALSE
                        ];
                };
            <<check exported types>>
            IF bcd.typeExported AND MBLoaderOps.BcdExportsTypes[i] THEN
                CheckTypes[bcd, system.bcd];
            ENDLOOP;
        MBLoaderOps.UpdateLoadState[config: config, handle: loadee];
        };

    BindImports: PROC [bcd, system: BcdBase, binding: MBLoaderOps.Binding]  RETURNS [bindingsFound: BOOL] = TRUSTED {
        bcdSsb: NameString = LOOPHOLE[bcd + bcd.ssOffset];
        systemSsb: NameString = LOOPHOLE[system + system.ssOffset];
        BindOneImport: PROC [ith: IMPHandle, iti: IMPIndex] RETURNS [BOOL] = TRUSTED {
            ExpMatch: PROC [eth: EXPHandle, eti: EXPIndex] RETURNS [BOOL] = TRUSTED {
                RETURN[
                    eth.port = ith.port AND 
                    EqualNames[bcdSsb, systemSsb, ith.name, eth.name] AND
                    EqualVersions[bcd, system, ith.file, eth.file, ith.name]]
                };
            ModuleMatch: PROC [mth: MTHandle, mti: MTIndex] RETURNS [BOOL] = TRUSTED {
                RETURN[
                    EqualNames[bcdSsb, systemSsb, ith.name, mth.name] AND 
                    EqualVersions[bcd, system, ith.file, mth.file, ith.name]]
                };
            IF ith.port = interface THEN {
                eti: EXPIndex = ProcessExports[system, ExpMatch].eti;
                FOR i: CARDINAL IN [0..ith.ngfi) DO
                    IF eti = EXPNull THEN
                        binding.b[ith.gfi + i - binding.bias] _ [whichgfi: i, body: notbound[]]
                    ELSE {
                        bindingsFound _ TRUE; 
                        binding.b[ith.gfi + i - binding.bias] _ [whichgfi: i, body: interface[eti: eti]];
                        };
                    ENDLOOP;
                }
            ELSE {
                mti: MTIndex = ProcessModules[system, ModuleMatch].mti;
                FOR i: CARDINAL IN [0..ith.ngfi) DO
                    IF mti = MTNull THEN
                        binding.b[ith.gfi + i - binding.bias] _ [whichgfi: i, body: notbound[]]
                    ELSE {
                        bindingsFound _ TRUE; 
                        binding.b[ith.gfi + i - binding.bias] _ [whichgfi: i, body: module[mti: mti]];
                        };
                    ENDLOOP;
                };
            RETURN[FALSE]
            };
        bindingsFound _ FALSE;
        [] _ ProcessImports[bcd, BindOneImport];
        };

    EqualNames: PROC [ss1, ss2: NameString, n1, n2: NameRecord] RETURNS [BOOL] = TRUSTED {
        IF ss1.size[n1] ~= ss2.size[n2] THEN RETURN[FALSE];
        FOR i: CARDINAL IN [0..ss1.size[n1]) DO
            IF ss1.string.text[n1 + i] ~= ss2.string.text[n2 + i] THEN RETURN[FALSE];
            ENDLOOP;
        RETURN[TRUE]
        };

    EqualVersions: PROC [ bcd1, bcd2: BcdBase, fti1, fti2: FTIndex, iname1: NameRecord] RETURNS [BOOL] = TRUSTED {
        v1, v2: LONG POINTER TO VersionStamp;
        f1: FTHandle _ @LOOPHOLE[bcd1 + bcd1.ftOffset, Base][fti1];
        f2: FTHandle _ @LOOPHOLE[bcd2 + bcd2.ftOffset, Base][fti2];
        v1 _ (IF fti1 = FTSelf THEN @bcd1.version ELSE @f1.version);
        v2 _ (IF fti2 = FTSelf THEN @bcd2.version ELSE @f2.version);
        IF v1^ = v2^ THEN RETURN[TRUE];
        VersionMismatch[
            interface: MB.RopeForNameRecord[bcd1, iname1],
            ref1: MB.RopeForNameRecord[bcd1, bcd1.source],
            ref2: MB.RopeForNameRecord[bcd2, bcd2.source]
            ];
        RETURN[FALSE]
        };

    ProcessLinks: PROC [ loadee, system: MB.BHandle, binding: MBLoaderOps.Binding, config: MBLoaderOps.ConfigIndex, initLinkSpace: 
    BOOL]  RETURNS [completelyBound: BOOL] = TRUSTED {
        bcd: BcdBase = loadee.bcd;
        mt: MB.MT = loadee.mt;
        smtb: Base = LOOPHOLE[system.bcd + system.bcd.mtOffset];
        setb: Base = LOOPHOLE[system.bcd + system.bcd.expOffset];
        ProcessModulesLinks: PROC [mth: MTHandle, mti: MTIndex] RETURNS [BOOL] = TRUSTED {
            gfi: PrincOps.GFTIndex = (mth.gfi + loadee.gfiOffset);  -- biased
            frame: PrincOps.GlobalFrameHandle = mt[mth.gfi].frame;
            info: MBLoaderOps.ModuleInfo _ MBLoaderOps.GetModule[gfi];
            linkBound, linkJustBound, modulesLinksAllBound: BOOL;
            old, new: PrincOps.ControlLink;
            i: CARDINAL;
            virtualLinks: MBLoaderOps.VirtualLinks;
            IF frame = PrincOps.NullGlobalFrame OR info.resolved THEN RETURN[FALSE];
            MBLoaderOps.OpenLinkSpace[loadee, mth];
            virtualLinks _ MBLoaderOps.GetVirtualLinks[loadee, mth];
            IF initLinkSpace THEN
                FOR i IN [0..LENGTH[virtualLinks]) DO
                    MBLoaderOps.WriteLink[
                        offset: i,
                        link: SELECT virtualLinks[i].vtag FROM
                            var, type => PrincOps.NullLink, 
                            ENDCASE => PrincOps.UnboundLink];
                    ENDLOOP;
            modulesLinksAllBound _ TRUE;
            FOR i IN [0..LENGTH[virtualLinks]) DO  -- bind each external link
                old _ MBLoaderOps.ReadLink[i];
                [new: new, linkBound: linkBound, linkJustBound: linkJustBound] _ NewLink[
                    link: virtualLinks[i], old: old];
                IF linkJustBound THEN MBLoaderOps.WriteLink[offset: i, link: new];
                modulesLinksAllBound _ (modulesLinksAllBound AND linkBound); 
                ENDLOOP;
            FOR i IN [gfi..gfi + mth.ngfi) DO
                info _ MBLoaderOps.GetModule[i];
                info.resolved _ modulesLinksAllBound;
                MBLoaderOps.EnterModule[i, info];
                ENDLOOP;
            completelyBound _ (completelyBound AND modulesLinksAllBound);
            MBLoaderOps.CloseLinkSpace[];
            RETURN[FALSE]
            };
        NewLink: PROC [link: Link, old: PrincOps.ControlLink]  RETURNS [new: PrincOps.ControlLink, linkBound, linkJustBound: BOOL] = 
        TRUSTED {
            ConvertProcOrVarLink: PROC [link: Link] RETURNS [new: PrincOps.ControlLink, resolved: BOOL] = TRUSTED {
                insideLoadee: BOOL = (link.gfi < loadee.bcd.firstdummy);
                rgfi: PrincOps.GFTIndex _ PrincOps.GFTNull;
                new _ PrincOps.UnboundLink;
                IF insideLoadee THEN {
                    new _ ConvertLink[link];
                    IF link.gfi ~= PrincOps.GFTNull THEN rgfi _ link.gfi + loadee.gfiOffset;
                    }
                ELSE {
                    bindLink: MBLoaderOps.BindLink = binding.b[link.gfi - binding.bias];
                    WITH b: bindLink SELECT FROM
                        interface => {
                            e: EXPHandle = @setb[b.eti];
                            SELECT e.port FROM
                                interface => {
                                    link _ e.links[link.ep + (b.whichgfi * ProcLimit)];  -- matching exported link
                                    IF link.gfi ~= PrincOps.GFTNull THEN
                                        rgfi _ link.gfi + system.gfiOffset};
                                ENDCASE;
                            };
                        module => {
                            m: MTHandle = @smtb[b.mti];
                            link _ [variable[vgfi: m.gfi, var: 0, vtag: var]];
                            IF link.gfi ~= PrincOps.GFTNull THEN rgfi _ m.gfi + system.gfiOffset;
                            };
                        ENDCASE;
                    };
                SELECT link.vtag FROM
                    proc0, proc1 => {
                        new _ ConvertLink[link];  
                        new.gfi _ rgfi;  -- relocate link's gfi
                        };
                    var => new _ FindVariableLink[insideLoadee, link, rgfi];
                    ENDCASE;
                RETURN[new: new, resolved: (rgfi ~= PrincOps.GFTNull)]
                };
            FindVariableLink: PROC [ insideLoadee: BOOL, varLink: Link, rgfi: PrincOps.GFTIndex]  RETURNS [link: PrincOps.ControlLink] = 
            TRUSTED INLINE {
                mth: MTHandle;
                frame: PrincOps.GlobalFrameHandle;
                gfi: PrincOps.GFTIndex = varLink.vgfi;
                evb: Base;
                vp: CARDINAL;
                FindModule: PROC [mth: MTHandle, mti: MTIndex] RETURNS [BOOL] = TRUSTED {
                    mgfi: PrincOps.GFTIndex = mth.gfi;
                    IF gfi IN [mth.gfi..mgfi + mth.ngfi) THEN
                        {vp _ VarLimit*(gfi - mgfi);  RETURN[TRUE]};
                    RETURN[FALSE]
                    };
                IF rgfi = PrincOps.GFTNull THEN RETURN[PrincOps.NullLink];
                mth _ ProcessModules[
                    (IF insideLoadee THEN loadee.bcd ELSE system.bcd), FindModule].mth;
                IF mth = NIL THEN RETURN[PrincOps.NullLink];
                IF insideLoadee THEN {
                    evb _ LOOPHOLE[(loadee.bcd + loadee.bcd.evOffset), Base];
                    frame _ loadee.mt[rgfi - loadee.gfiOffset].frame;
                    }
                ELSE {
                    evb _ LOOPHOLE[(system.bcd + system.bcd.evOffset), Base];
                    frame _ system.mt[rgfi - system.gfiOffset].frame;
                    };
                vp _ vp + varLink.var;
                IF vp = 0 THEN RETURN[LOOPHOLE[frame]];
                IF mth.variables = EVNull THEN RETURN[PrincOps.NullLink];
                RETURN[LOOPHOLE[frame + evb[mth.variables].offsets[vp]]]
                };
            new _ old;  
            linkBound _ linkJustBound _ FALSE;
            SELECT link.vtag FROM
                proc0, proc1 =>
                    IF old = PrincOps.UnboundLink THEN { 
                        [new: new, resolved: linkJustBound] _ ConvertProcOrVarLink[link];
                        linkBound _ linkJustBound;
                        }
                    ELSE linkBound _ TRUE;
                var =>
                    IF old = PrincOps.NullLink THEN {
                        [new: new, resolved: linkJustBound] _ ConvertProcOrVarLink[link];
                        linkBound _ linkJustBound;
                        }
                    ELSE linkBound _ TRUE;
                ENDCASE => --type-- new _ LOOPHOLE[link.typeID];
            IF ~linkJustBound THEN new _ old;  -- end of NewLink
            };
        completelyBound _ TRUE;
        [] _ ProcessModules[loadee.bcd, ProcessModulesLinks];
        RETURN[completelyBound];  -- all modules completely resolved
        };

    ConvertLink: PROC [bl: Link] RETURNS [cl: PrincOps.ControlLink] = TRUSTED {
        IF bl = UnboundLink THEN RETURN[PrincOps.UnboundLink];
        SELECT bl.vtag FROM
            proc0, proc1 => cl _ [procedure[gfi: bl.gfi, ep: bl.ep, tag: TRUE]];
            var => cl _ [procedure[gfi: bl.vgfi, ep: bl.var, tag: FALSE]];
            type => cl _ LOOPHOLE[bl.typeID];
            ENDCASE;
        };

    CheckTypes: PROC [bcd1, bcd2: BcdBase] = TRUSTED {
        typb1: Base = LOOPHOLE[bcd1 + bcd1.typOffset];
        typb2: Base = LOOPHOLE[bcd2 + bcd2.typOffset];
        TypeMap1: PROC [tmh1: TMHandle, tmi1: TMIndex] RETURNS [BOOL] = TRUSTED {
            TypeMap2: PROC [tmh2: TMHandle, tmi2: TMIndex] RETURNS [BOOL] = TRUSTED {
                IF tmh2.offset = tmh1.offset AND tmh2.version = tmh1.version THEN {
                    IF typb1[tmh1.map] ~= typb2[tmh2.map] THEN MB.Error["Exported Type Clash"];
                    RETURN[TRUE]
                    }
                ELSE RETURN[FALSE]
                };
            [] _ EnumerateTypeMap[bcd2, TypeMap2];
            RETURN[FALSE]
            };
        [] _ EnumerateTypeMap[bcd1, TypeMap1];
        };

    EnumerateTypeMap: PROC [ bcd: BcdBase, proc: PROC [TMHandle, TMIndex] RETURNS [BOOL]] RETURNS [tmh: TMHandle, tmi: TMIndex] = 
    TRUSTED {
        tmb: Base = LOOPHOLE[bcd + bcd.tmOffset];
        FOR tmi _ FIRST[TMIndex], tmi + SIZE[TMRecord] 
        UNTIL tmi = bcd.tmLimit DO
            IF proc[(tmh _ @tmb[tmi]), tmi] THEN RETURN; 
            ENDLOOP;
        RETURN[NIL, TMNull]
        };

    END.