
    <<MBLoader.mesa  >>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Sandman on 6-Aug-81 15:40:23>>
        <<Lewis on 25-Sep-81 13:33:58>>
        <<Levin on January 16, 1984 11:37 am>>
        <<Russ Atkinson (RRA) March 8, 1985 5:03:22 pm PST>>

    DIRECTORY
        Basics USING [LongMult],
        BcdDefs USING [Base, BcdBase, FTIndex, IMPHandle, IMPIndex, LinkFrag, MTHandle, ProcLimit, SGHandle, SGIndex, SPHandle, SPIndex],
        BcdOps USING [ProcessImports, ProcessSegs, ProcessSpaces],
        FS USING [Close, Error, ExpandName, nullOpenFile, Open, OpenFile, Read],
        IO USING [card, PutChar, PutF, PutRope, rope, STREAM],
        MB USING [Abort, BHandle, FileList, Handle, MT, RopeForFTI, RopeForNameRecord, VirtualGlobalFrame],
        MBLoaderOps USING [AcquireBcd, EnumerateModules, FinishLoaderCore, FinishLoaderExtra, FinishLoadState, GetVirtualLinks, 
        InitLoaderCore, InitLoaderExtra, InitLoadState, ModuleInfo, RealLinks, VirtualLinks],
        MBVM USING [AllocCode, Base, Code, CodePiece, CodePieceList, CodeSeg, CopyRead, CopyWrite, File, Links, LongCopyWrite,  
        LongPointerFromSeg, LongRead, LongWrite],
        PrincOps USING [ControlLink, EPIndex, GFTIndex, GFTNull, GlobalFrame, GlobalFrameHandle, NullLink, UnboundLink, wordsPerPage],
        Rope USING [Concat, ROPE],
        VM USING [AddressForPageNumber, Allocate, Free, Interval];

    MBLoader: CEDAR PROGRAM
        IMPORTS Basics, BcdOps, FS, IO, MB, MBLoaderOps, MBVM, Rope, VM
        EXPORTS MB, MBLoaderOps = BEGIN

    ROPE: TYPE = Rope.ROPE;

    data: MB.Handle _ NIL;

    InitLoader: PUBLIC PROC [h: MB.Handle] = {
        data _ h;
        frameLinks _ NIL; codeLinks _ NIL;
        MBLoaderOps.InitLoaderCore[h];
        MBLoaderOps.InitLoaderExtra[h];
        MBLoaderOps.InitLoadState[h];
        };

    FinishLoader: PUBLIC PROC = {
        MBLoaderOps.FinishLoadState[];
        MBLoaderOps.FinishLoaderExtra[];
        MBLoaderOps.FinishLoaderCore[];
        data _ NIL;
        };

    <<Locate code files for bcd>>

    FileNotFound: PUBLIC SIGNAL [name: ROPE] = CODE;

    FindFiles: PUBLIC SAFE PROC [loadee: MB.BHandle] = TRUSTED {  
        bcd: BcdDefs.BcdBase _ loadee.bcd;
        invalidFile: BOOL _ FALSE;
        AddCodeSeg: PROC [sgh: BcdDefs.SGHandle, sgi: BcdDefs.SGIndex]
            RETURNS [BOOL _ FALSE] = TRUSTED {
            IF sgh.class = $code THEN {
                FOR list: MB.FileList _ loadee.files, list.rest UNTIL list = NIL DO
                    IF sgh.file = list.first THEN RETURN;
                    ENDLOOP;
                loadee.files _ CONS[sgh.file, loadee.files];
                };
            };
        LookupCodeFiles: PROC = TRUSTED {
            ftb: BcdDefs.Base;
            buffer: VM.Interval = VM.Allocate[1];
            referentBcd: BcdDefs.BcdBase = VM.AddressForPageNumber[buffer.page];
            TRUSTED {ftb _ LOOPHOLE[bcd + bcd.ftOffset]};
            FOR list: MB.FileList _ loadee.files, list.rest UNTIL list = NIL DO
                ENABLE UNWIND => TRUSTED {VM.Free[buffer]};
                name: ROPE _ MB.RopeForFTI[bcd, list.first];
                IF name ~= NIL THEN {
                    <<'name' is a file other than the present BCD.  We must check to see if it exists locally in the correct version.>>
                    file: FS.OpenFile _ FS.nullOpenFile;
                    IF FS.ExpandName[name].cp.ext.length = 0 THEN {
                        <<no extension on file name in file table.  Try ".bcd" first.>>
                        withExt: ROPE = name.Concat[".bcd"];
                        file _ FS.Open[withExt ! FS.Error => IF error.group = $user THEN CONTINUE];
                        IF file = NIL THEN 
                            file _ FS.Open[name
                                ! FS.Error => IF error.group = $user THEN {name _ withExt; GO TO notFound}
                                ]
                        ELSE name _ withExt;
                        }
                    ELSE file _ FS.Open[name ! FS.Error => IF error.group = $user THEN GO TO notFound];
                    TRUSTED {
                        FS.Read[file: file, from: 0, nPages: 1, to: referentBcd];
                        IF referentBcd.version ~= ftb[list.first].version THEN {
                            data.typescript.PutF["\N! %g has incorrect version", IO.rope[name]];
                            invalidFile _ TRUE;
                            };
                        };
                    file.Close[];
                    EXITS
                        notFound => SIGNAL FileNotFound[name];
                    };
                ENDLOOP;
            TRUSTED {VM.Free[buffer]};
            };
        [] _ BcdOps.ProcessSegs[bcd, AddCodeSeg];
        LookupCodeFiles[];
        IF invalidFile THEN ERROR MB.Abort;
        };


    <<Load bcd's code segments into MBVM>>

    FindCode: PUBLIC PROC [loadee: MB.BHandle] = TRUSTED { 
        bcd: BcdDefs.BcdBase = loadee.bcd;
        mt: MB.MT = loadee.mt;
        invalidCode: BOOLEAN _ FALSE;
        FindCodeSegment: PROC [mth: BcdDefs.MTHandle]
            RETURNS [cseg: MBVM.CodeSeg] = TRUSTED { 
            sgh: BcdDefs.SGHandle = @LOOPHOLE[bcd+bcd.sgOffset, BcdDefs.Base][mth.code.sgi];
            file: MBVM.File;
            FindSpace: PROC [sph: BcdDefs.SPHandle, spi: BcdDefs.SPIndex]
                RETURNS [BOOLEAN] = TRUSTED {
                RETURN[sph.seg = mth.code.sgi]
                };
            FOR i: CARDINAL IN [1..mt.length) DO
                IF mt[i].mth.code.sgi = mth.code.sgi AND (cseg _ mt[i].code) ~= NIL THEN {
                    cseg.shared _ TRUE;  -- code is shared and was already loaded  
                    RETURN[cseg]
                    };
                ENDLOOP;
            IF (file _ MB.RopeForFTI[bcd, sgh.file]) = NIL THEN file _ loadee.name;
            <<Note:  The "-1" in the 'fileBase' parameter corrects for old-style, 1-origin page numbering that dates from the Alto world!>>
            cseg _ MBVM.AllocCode[
                file: file, base: MBVM.Code, fileBase: sgh.base-1, pages: sgh.pages + sgh.extraPages,
                sph: BcdOps.ProcessSpaces[bcd, FindSpace].sph
                ];
            };
        AddLinksToSeg: PROC [seg: MBVM.CodeSeg, offset: CARDINAL, links: MBVM.Links] = TRUSTED {
            pieceL: MBVM.CodePieceList =
                CONS[MBVM.CodePiece[offset: offset, body: link[links: links]], NIL];
            prev: MBVM.CodePieceList _ NIL;
            FOR list: MBVM.CodePieceList _ seg.pieces, list.rest UNTIL list = NIL DO
                WITH p: list.first SELECT FROM
                    code =>
                        SELECT p.offset FROM
                            < offset => {
                                nextStart: CARDINAL = p.offset + p.length;
                                IF nextStart > offset THEN {
                                    <<first part of old piece ("p"), then links ("pieceL.first"), then rest (less link space) of old piece ("newCodePiece").>>
                                    firstPartLength: CARDINAL = offset - p.offset;
                                    newPartOffset: CARDINAL = offset + links.length;
                                    newPartLength: CARDINAL = p.length - (firstPartLength + links.length);
                                    newCodePieceL: MBVM.CodePieceList = CONS [
                                        MBVM.CodePiece[offset: newPartOffset, body: code[length: newPartLength]],
                                        list.rest
                                        ];
                                    IF newPartOffset > nextStart THEN ERROR;
                                    list.rest _ pieceL;
                                    pieceL.rest _ newCodePieceL;
                                    p.length _ firstPartLength;
                                    EXIT
                                    };
                                };
                            = offset => {
                                <<new piece is at start of existing one.>>
                                pieceL.rest _ list;
                                IF prev = NIL THEN seg.pieces _ pieceL ELSE prev.rest _ pieceL;
                                p.offset _ p.offset + links.length;
                                p.length _ p.length - links.length;
                                EXIT
                                };
                            ENDCASE => ERROR;
                    link =>
                        IF p.offset = offset THEN
                            IF p.links.length = links.length THEN RETURN ELSE ERROR;
                    ENDCASE => ERROR;
                prev _ list;
                REPEAT
                    FINISHED => ERROR;
                ENDLOOP;
            };
        FOR gfi: PrincOps.GFTIndex IN [1..mt.length) DO
            mth: BcdDefs.MTHandle = mt[gfi].mth;
            cseg: MBVM.CodeSeg;
            TRUSTED {
                IF mth.gfi ~= gfi THEN LOOP;
                IF mth.altoCode THEN {
                    data.typescript.PutF[
                        "\N! %g is compiled for the Alto!",
                        IO.rope[MB.RopeForNameRecord[bcd, mth.name]]];
                    invalidCode _ TRUE;
                    LOOP
                    };
                cseg _ FindCodeSegment[mth];
                FOR i: CARDINAL IN [gfi..gfi+mth.ngfi) DO mt[i].code _ cseg; ENDLOOP;
                };
            ENDLOOP;
        IF invalidCode THEN ERROR MB.Abort;
        FOR gfi: PrincOps.GFTIndex IN [1..mt.length) DO
            mth: BcdDefs.MTHandle;
            frame: PrincOps.GlobalFrameHandle;
            cseg: MBVM.CodeSeg;
            codeLinks: MBVM.Links;
            gf: PrincOps.GlobalFrame;
            [mth: mth, frame: frame, code: cseg, codeLinks: codeLinks] _ mt[gfi];
            TRUSTED {IF mth.gfi ~= gfi THEN LOOP};
            IF codeLinks ~= NIL THEN
                AddLinksToSeg[seg: cseg, offset: (mth.code.offset - codeLinks.length), links: codeLinks];
            MBVM.CopyRead[to: @gf, from: frame, nwords: SIZE[PrincOps.GlobalFrame]];
            gf.code.longbase _ MBVM.LongPointerFromSeg[cseg] + mth.code.offset;
            gf.code.out _ TRUE;
            gf.shared _ cseg.shared;
            MBVM.CopyWrite[from: @gf, to: frame, nwords: SIZE[PrincOps.GlobalFrame]];
            ENDLOOP;
        };


    <<Unbound import processing>>

    ProcessUnboundImports: PUBLIC PROC = {
        typescript: IO.STREAM = data.typescript;
        loadmap: IO.STREAM = data.loadmap;
        anyUnbound, anyUnboundCodeLinks: BOOL _ FALSE;
        CheckIfUnresolved: PROC [rgfi: PrincOps.GFTIndex, module: MBLoaderOps.ModuleInfo]
            RETURNS [BOOL] = TRUSTED {
            IF ~module.resolved THEN {
                bh: MB.BHandle = MBLoaderOps.AcquireBcd[module.config];
                vgf: PrincOps.GlobalFrameHandle = MB.VirtualGlobalFrame[bh.mt[module.module].frame];
                IF vgf.gfi = rgfi THEN {
                    codeLinks: BOOL = vgf.codelinks;
                    bcd: BcdDefs.BcdBase = bh.bcd;
                    mth: BcdDefs.MTHandle = bh.mt[module.module].mth;
                    vLinks: MBLoaderOps.VirtualLinks = MBLoaderOps.GetVirtualLinks[bh, mth];
                    first: BOOL _ TRUE;
                    MapDummy: PROC [gfi: PrincOps.GFTIndex, ep: PrincOps.EPIndex]
                        RETURNS [imp: BcdDefs.IMPHandle, offset: CARDINAL] = TRUSTED {
                        CheckImport: PROC [imph: BcdDefs.IMPHandle, impi: BcdDefs.IMPIndex]
                            RETURNS [BOOL] = TRUSTED {
                            IF gfi IN [imph.gfi..imph.gfi+imph.ngfi) THEN {
                                imp _ imph;
                                offset _ (gfi-imph.gfi)*BcdDefs.ProcLimit + ep;
                                RETURN[TRUE]
                                };
                            RETURN[FALSE]
                            };
                        [] _ BcdOps.ProcessImports[bcd, CheckImport];
                        };
                    OpenLinkSpace[bh, mth];
                    FOR i: CARDINAL IN [0..LENGTH[vLinks]) DO
                        SELECT ReadLink[i] FROM
                            PrincOps.NullLink, PrincOps.UnboundLink => {
                                <<Things are quite confusing here.  An unbound imported procedure or>>
                                <<variable will show up as a virtual link of type 'proc0' or 'proc1'.>>
                                <<An unbound imported program module will show up as a virtual link>>
                                <<of type 'var'.  An unbound imported type will show up as a virtual>>
                                <<link of type 'proc0' or 'proc1', while a bound, imported type will>>
                                <<have type 'type'.>>
                                imp: BcdDefs.IMPHandle;
                                offset: CARDINAL;
                                SELECT vLinks[i].vtag FROM
                                    type => LOOP;
                                    var => {
                                        IF vLinks[i].vgfi = PrincOps.GFTNull THEN LOOP;  -- link was unbindable
                                        [imp, offset] _ MapDummy[vLinks[i].vgfi, vLinks[i].var --should be 0--];
                                        };
                                    ENDCASE --proc-- => {
                                        IF vLinks[i].gfi = PrincOps.GFTNull THEN LOOP;  -- link was unbindable
                                        [imp, offset] _ MapDummy[vLinks[i].gfi, vLinks[i].ep];
                                        };
                                IF ~anyUnbound THEN {
                                    loadmap.PutRope["\NUnbound Imports:\N"];
                                    typescript.PutRope["! Warning: the following modules have unbound imports:\N"];
                                    anyUnbound _ TRUE;
                                    };
                                IF first THEN {
                                    loadmap.PutF["  %g:  ", IO.rope[MB.RopeForNameRecord[bcd, mth.name]]];
                                    typescript.PutF["  %g:  ", IO.rope[MB.RopeForNameRecord[bcd, mth.name]]];
                                    first _ FALSE;
                                    }
                                ELSE {loadmap.PutChar[',]; typescript.PutChar[',]};
                                loadmap.PutF[
                                    " %g[%d]",
                                    IO.rope[MB.RopeForNameRecord[bcd, imp.name]], IO.card[offset]
                                    ];
                                typescript.PutF[
                                    " %g[%d]",
                                    IO.rope[MB.RopeForNameRecord[bcd, imp.name]], IO.card[offset]
                                    ];
                                };
                            ENDCASE;
                        ENDLOOP;
                    IF ~first THEN {
                        loadmap.PutChar['\N];
                        typescript.PutChar['\N];
                        };
                    CloseLinkSpace[];
                    };
                };
            RETURN[FALSE]
            };
        [] _ MBLoaderOps.EnumerateModules[CheckIfUnresolved];
        };


    <<Link management>>

    PCL: TYPE = LONG POINTER TO PrincOps.ControlLink;

    <<While the link space is open, precisely one of the following is non-NIL.>>
    frameLinks: PCL _ NIL;
    codeLinks: MBVM.Links _ NIL;

    OpenLinkSpace: PUBLIC PROC [loadee: MB.BHandle, mth: BcdDefs.MTHandle] =  TRUSTED {
        frame: PrincOps.GlobalFrameHandle;
        nLinks: CARDINAL = LinkFragLength[loadee, mth];
        IF frameLinks ~= NIL OR codeLinks ~= NIL THEN ERROR;
        [frame: frame, codeLinks: codeLinks] _ loadee.mt[mth.gfi];
        IF codeLinks = NIL THEN {
            <<frame links>>
            frameLinks _ LOOPHOLE[Basics.LongMult[data.mdsBase, PrincOps.wordsPerPage]];
            frameLinks _ frameLinks + LOOPHOLE[frame - nLinks, CARDINAL];
            };
        };

    CloseLinkSpace: PUBLIC PROC = {
        frameLinks _ NIL;
        codeLinks _ NIL;
        };

    WriteLinks: PUBLIC PROC [
        loadee: MB.BHandle, mth: BcdDefs.MTHandle, links: MBLoaderOps.RealLinks] = TRUSTED {
        nLinks: CARDINAL = LinkFragLength[loadee, mth];
        OpenLinkSpace[loadee, mth];
        IF codeLinks = NIL THEN
            MBVM.LongCopyWrite[from: LOOPHOLE[links], to: frameLinks, nwords: nLinks]
        ELSE
            FOR i: CARDINAL IN [0..nLinks) DO 
                codeLinks[i] _ links[i];
                ENDLOOP;
        CloseLinkSpace[];
        };

    WriteLink: PUBLIC PROC [offset: CARDINAL, link: PrincOps.ControlLink] = TRUSTED {
        IF codeLinks = NIL THEN MBVM.LongWrite[frameLinks + offset, link]
        ELSE codeLinks[offset] _ link;
        };

    ReadLink: PUBLIC PROC [offset: CARDINAL] RETURNS [link: PrincOps.ControlLink] = TRUSTED {
        RETURN[
            IF codeLinks = NIL THEN MBVM.LongRead[frameLinks + offset]
            ELSE codeLinks[offset]
            ]
        };

    LinkFragLength: PUBLIC PROC [loadee: MB.BHandle, mth: BcdDefs.MTHandle]
        RETURNS [nLinks: CARDINAL] = TRUSTED {
        bcd: BcdDefs.BcdBase = loadee.bcd;
        lfTable: BcdDefs.Base = LOOPHOLE[bcd + bcd.lfOffset];
        WITH mth: mth SELECT FROM
            direct => RETURN[mth.length];
            indirect => RETURN[lfTable[mth.links].length];
            multiple => RETURN[lfTable[mth.links].length];
            ENDCASE;
        };

    GetVirtualLinks: PUBLIC PROC [loadee: MB.BHandle, mth: BcdDefs.MTHandle]
        RETURNS [virtualLinks: MBLoaderOps.VirtualLinks] = TRUSTED {
        bcd: BcdDefs.BcdBase = loadee.bcd;
        linkFrag: LONG POINTER TO BcdDefs.LinkFrag;
        lfTable: BcdDefs.Base = LOOPHOLE[bcd + bcd.lfOffset];
        WITH mth: mth SELECT FROM
            direct => RETURN[DESCRIPTOR[@mth.frag, mth.length]];
            indirect => linkFrag _ @lfTable[mth.links];
            multiple => linkFrag _ @lfTable[mth.links];
            ENDCASE;
        RETURN[DESCRIPTOR[linkFrag.frag]]
        };

    END.