
    <<CedarLoaderImpl.mesa  >>
        <<Copyright © 1984, 1985, 1986 by Xerox Corporation.  All rights reserved.>>
        <<Doug Wyatt    March 1, 1985 6:37:49 pm PST>>
        <<Bob Hagmann May 3, 1985 10:38:15 am PDT>>
        <<Russ Atkinson (RRA) March 28, 1986 5:07:07 pm PST>>
    <<>>
        <<This module handles all of parts of loading that don't have anything to do with links: copying the bcd into VM, creating global 
        frames for each module, associating code with each frame, and initializing the start trap cm's.  Linking is handled by 
        LoaderOps.Export and LoaderOps.Bind. >>

        DIRECTORY
            BasicTime USING [FromPupTime, GMT],
            BcdDefs USING [Base, BcdBase, CTHandle, CTIndex, CTNull, FPHandle, FPIndex, FTHandle, FTIndex, FTSelf, ModuleIndex, MTHandle, 
            MTIndex, NameRecord, NameString, PackedString, SGHandle, SGIndex, SpaceID, SPHandle, SPIndex, VersionID, VersionStamp],
            BcdOps USING [ProcessConfigs, ProcessSegs, ProcessModules, ProcessFramePacks, ProcessSpaces],
            FS USING [GetInfo, OpenFile, Open, Read, Error],
            Loader USING [ErrorType, IRItem],
            LoaderOps USING [Bind, Export, FrameList, LinkSegmentLength],
            LoadState USING [Acquire, ConfigID, ConfigInfo, GlobalFrameToModule, LoadStateFull, local, ModuleIndex, ModuleInfo, NewConfig, 
            Release, SetGlobalFrame, SetType],
            IO USING [PutChar, RopeFromROS, ROS, STREAM],
            PrincOps USING [ControlModule, GlobalFrameHandle, LastAVSlot, MainBodyIndex, NullControl, PrefixHandle, wordsPerPage],
            PrincOpsUtils USING [Alloc, BITAND, Codebase, FrameSize, Free, GetReturnLink, GlobalFrame, LongZero, LowHalf, MakeFsi],
            Rope USING [Concat, Find, ROPE],
            RuntimeError USING [UNCAUGHT],
            SafeStorage USING [Type],
            SafeStorageOps USING [AcquireTypesAndLiterals],
            SystemVersion USING [bootFileDate],
            VM USING [AddressForPageNumber, Allocate, CantAllocate, Free, Interval, MakeReadOnly, PageNumber, PageNumberForAddress, 
            PagesForWords, Pin, Unpin, WordsForPages];
CedarLoaderImpl: MONITOR
    IMPORTS BasicTime, BcdOps, FS, IO, LoaderOps, LoadState, PrincOpsUtils, Rope, RuntimeError, SafeStorageOps, SystemVersion, VM
    EXPORTS Loader, LoaderOps =
    BEGIN OPEN BcdDefs, BcdOps, Rope;

    NullControlCard: CARDINAL = LOOPHOLE[PrincOps.NullControl];
    NullControlModule: PrincOps.ControlModule = LOOPHOLE[PrincOps.NullControl];

        FrameList: TYPE = LoaderOps.FrameList;
        OpenFile: TYPE = FS.OpenFile;

        GlobalFrameHandle: TYPE = PrincOps.GlobalFrameHandle;
        ControlModule: TYPE = PrincOps.ControlModule;

        SGList: TYPE = REF SGListObj;
        SGItem: TYPE = RECORD [
            sgh: SGHandle,
            interval: VM.Interval, 
            file: OpenFile, 
            bcdBase: INT
            ];
        SGListObj: TYPE = RECORD[seq: SEQUENCE maxLength: CARDINAL OF SGItem];

        CMMap: TYPE = REF CMMapObj;
        CMMapObj: TYPE = RECORD [seq: SEQUENCE maxLength: NAT OF CMMapItem];
        CMMapItem: TYPE = RECORD [cti: CTIndex, cm: PrincOps.ControlModule, level: CARDINAL];

        PaintedTime: TYPE = RECORD[BasicTime.GMT];

    <<**********************************************************>>
    <<public procedures>>
    <<**********************************************************>>

    Error: PUBLIC ERROR[type: Loader.ErrorType, message: ROPE _ NIL] = CODE;

    Instantiate: PUBLIC PROC[file: OpenFile, pageOffset: INT _ 0, codeLinks: BOOL _ TRUE] RETURNS[cm: PrincOps.ControlModule, 
    unboundImports: LIST OF Loader.IRItem] = {
        <<pageOffset: offset within the file of first page of the BCD, normally 0>>
        msg: ROPE _ NIL;
        t: Loader.ErrorType;
        {
            ENABLE {
                LoadState.LoadStateFull => {t _ loadStateFull; msg _ "load state full"; GO TO unwound};
                Error => {t _ type; msg _ message; GO TO unwound};
                VM.CantAllocate => {t _ insufficientVM; GO TO unwound};
                };
            [cm, unboundImports] _ New[LoadBcd[file, pageOffset], file, pageOffset, ~codeLinks];
            EXITS unwound => ERROR Error[t, msg];
            };    
        };


    Start: PUBLIC PROC [cm: PrincOps.ControlModule] = {
        IF cm # NullControlModule THEN START LOOPHOLE[cm, PROGRAM];
        };

    MakeProcedureResident: PUBLIC SAFE PROC [proc: PROC ANY RETURNS ANY] = TRUSTED {
        haveState: BOOL _ TRUE;
        Cleanup: PROC = INLINE {
            IF haveState THEN {haveState _ FALSE; LoadState.local.Release[]};
            };
        LoadState.local.Acquire[];
        BEGIN ENABLE {UNWIND, RuntimeError.UNCAUGHT => Cleanup[]};
            VM.Pin[IntervalForProc[proc]];
            END;
        Cleanup[];
        };

    MakeProcedureSwappable: PUBLIC PROC [proc: PROC ANY RETURNS ANY] = {
        haveState: BOOL _ TRUE;
        Cleanup: PROC = INLINE {
            IF haveState THEN {haveState _ FALSE; LoadState.local.Release[]};
            };
        LoadState.local.Acquire[];
        BEGIN ENABLE {UNWIND, RuntimeError.UNCAUGHT => Cleanup[]};
            VM.Unpin[IntervalForProc[proc]];
            END;
        Cleanup[];
        };

    MakeGlobalFrameResident: PUBLIC SAFE PROC[proc: PROC ANY RETURNS ANY] = TRUSTED {
        VM.Pin[IntervalForGlobalFrame[proc]];
        };

    MakeGlobalFrameSwappable: PUBLIC PROC[proc: PROC ANY RETURNS ANY] = {
        VM.Unpin[IntervalForGlobalFrame[proc]];
        };

    IntervalForProc: PROC [proc: PROC ANY RETURNS ANY] RETURNS [VM.Interval] = {
        gfh: PrincOps.GlobalFrameHandle = LOOPHOLE[PrincOpsUtils.GlobalFrame[LOOPHOLE[proc]]];
        codeBase: LONG POINTER = PrincOpsUtils.Codebase[gfh];
        bcd: BcdDefs.BcdBase;
        config: LoadState.ConfigID;
        module: LoadState.ModuleIndex;
        mtb: BcdDefs.Base;
        mth: BcdDefs.MTHandle;
        sgb: BcdDefs.Base;
        [config, module] _ LoadState.local.GlobalFrameToModule[gfh];
        bcd _ LoadState.local.ConfigInfo[config].bcd;
        sgb _ LOOPHOLE[bcd + bcd.sgOffset];
        mtb _ LOOPHOLE[bcd + bcd.mtOffset];
        mth _ @mtb[LoadState.local.ModuleInfo[config, module].mti];
        IF ~mth.packageable OR mth.code.packed THEN ERROR;  -- not yet implemented.
        RETURN[[VM.PageNumberForAddress[codeBase], sgb[mth.code.sgi].pages]]
        };

    IntervalForGlobalFrame: PROC [proc: PROC ANY RETURNS ANY] RETURNS [VM.Interval] = {
        gfh: PrincOps.GlobalFrameHandle = LOOPHOLE[PrincOpsUtils.GlobalFrame[LOOPHOLE[proc]]];
        codeBase: PrincOps.PrefixHandle = PrincOpsUtils.Codebase[gfh];
        pGFSize: LONG POINTER TO CARDINAL =
            LOOPHOLE[codeBase + CARDINAL[codeBase.entry[PrincOps.MainBodyIndex].initialpc] - 1];
        nLinks: CARDINAL = codeBase.header.info.nlinks;
        nLinksLowbits: CARDINAL = nLinks MOD 4;
        linkspace: CARDINAL =
            IF gfh.codelinks THEN 0 ELSE
            nLinks + (IF nLinksLowbits = 0 THEN 0 ELSE 4 - nLinksLowbits);
        nWords: CARDINAL = pGFSize^ + linkspace;
        RETURN[[VM.PageNumberForAddress[gfh-linkspace], VM.PagesForWords[nWords]]]
        };

    BCDBuildTime: PUBLIC SAFE PROC[proc: PROC ANY RETURNS ANY _ NIL] RETURNS[BasicTime.GMT] = TRUSTED {
        ref: REF ANY;
        haveState: BOOL _ TRUE;
        Cleanup: PROC = INLINE {
            IF haveState THEN {haveState _ FALSE; LoadState.local.Release[]};
            };
        IF proc = NIL THEN proc _ LOOPHOLE[PrincOpsUtils.GetReturnLink[]];
        LoadState.local.Acquire[];
        BEGIN ENABLE {UNWIND, RuntimeError.UNCAUGHT => Cleanup[]};
            gfh: PrincOps.GlobalFrameHandle = LOOPHOLE[PrincOpsUtils.GlobalFrame[LOOPHOLE[proc]]];
            ref _ LoadState.local.ConfigInfo[LoadState.local.GlobalFrameToModule[gfh].config].ref;
            END;
        Cleanup[];
        IF ref = NIL
            THEN RETURN[BasicTime.FromPupTime[SystemVersion.bootFileDate]]
            ELSE RETURN[NARROW[ref, REF PaintedTime]^]
        };

    <<**********************************************************>>
    <<The central loading procedures.  LoadBcd copies the bcd into VM, and New calls the procedures that do the work.>>
    <<**********************************************************>>

    LoadBcd: PROC [file: OpenFile, pageOffset: INT] RETURNS [bcd: BcdBase] = {
        bcdSpace: VM.Interval;
        pages, rtPages: INT;
        bcdSpace _ VM.Allocate[count: 1];
        bcd _ VM.AddressForPageNumber[bcdSpace.page];
        FS.Read[file: file, from: pageOffset, nPages: 1, to: bcd];
        IF bcd.versionIdent # VersionID OR bcd.definitions OR ~bcd.spare1 THEN {
            VM.Free[bcdSpace];
            ERROR Error[invalidBcd]};
        pages _ bcd.nPages;
        rtPages _ bcd.rtPages.pages;
        IF pages > 1 THEN {
            VM.Free[bcdSpace];
            bcdSpace _ VM.Allocate[count: pages];
            bcd _ VM.AddressForPageNumber[bcdSpace.page];
            FS.Read[file: file, from: pageOffset, nPages: pages, to: bcd];
            };
        VM.MakeReadOnly[bcdSpace];
        };

    New: ENTRY PROC [bcd: BcdBase, file: OpenFile, pageOffset: INT, framelinks: BOOL]
    RETURNS [cm: PrincOps.ControlModule, unboundImports: LIST OF Loader.IRItem _ NIL] = {
        ENABLE UNWIND => NULL;
            <<to release the monitor lock>>
        fl: FrameList _ NIL;
        cid: LoadState.ConfigID;
        haveState: BOOL _ TRUE;
        Cleanup: PROC [error: BOOL] = INLINE {
            IF haveState THEN {haveState _ FALSE; LoadState.local.Release[commit: NOT error]};
            IF error AND fl # NIL THEN {fl _ NIL; ReleaseFrames[fl, cid]};
            };

        LoadState.local.Acquire[exclusive];  -- acquire the lock on the loadstate
        BEGIN
            ENABLE {
                UNWIND, RuntimeError.UNCAUGHT => Cleanup[TRUE];
                };
            moduleToGFH: PROC[mx: ModuleIndex] RETURNS[PrincOps.GlobalFrameHandle] = {
                RETURN[LoadState.local.ModuleInfo[cid, mx].gfh];
                };
            setType: PROC[gfh: PrincOps.GlobalFrameHandle, type: SafeStorage.Type] = {
                LoadState.local.SetType[gfh, type];
                };
            cid _ LoadState.local.NewConfig[bcd, NEW[PaintedTime _ [FS.GetInfo[file].created]]];
            fl _ CreateGlobalFrames[cid, framelinks];
            AssignCodeToFrames[cid, file, pageOffset];
            cm _ AssignControlModules[cid];
            unboundImports _ LoaderOps.Bind[cid];
            LoaderOps.Export[cid];
            SafeStorageOps.AcquireTypesAndLiterals[bcd, moduleToGFH, setType];
            END;
        Cleanup[FALSE];
        };

    CreateGlobalFrames: PUBLIC PROC [cid: LoadState.ConfigID, allframelinks: BOOL]
    RETURNS [fl: FrameList _ NIL] = {
        <<CreateGlobalFrames allocates and initializes global frames for the modules in the bcd, constructs the loadstate info for these 
        modules and returns the list of frames.>>
        bcd: BcdBase = LoadState.local.ConfigInfo[cid].bcd;
        f: FrameList;
        frames: POINTER;
        space: CARDINAL;
        single: BOOL _ (bcd.nModules = 1);
        resident: BOOL;
        GetFrameSizes: PROC [mth: MTHandle] = {
            IF allframelinks OR mth.linkLoc = frame OR ~mth.code.linkspace
                THEN space _ space + LoaderOps.LinkSegmentLength[mth, bcd];
            space _ NextMultipleOfFour[space] + mth.framesize;
            resident _ resident OR mth.residentFrame;};
        FrameInit: PROC [mth: MTHandle] = {
            frame: GlobalFrameHandle;
            framelinks: BOOL _ allframelinks OR mth.linkLoc = frame OR ~mth.code.linkspace;
            IF framelinks THEN frames _ frames + LoaderOps.LinkSegmentLength[mth, bcd];
            frame _ LOOPHOLE[NextMultipleOfFour[LOOPHOLE[frames]]];
            frames _ frame + mth.framesize;
            LoadState.local.SetGlobalFrame[cid, mth.gfi, frame];
            frame.copied _ frame.shared _ frame.started _ frame.trapxfers _ FALSE;
            frame.alloced _ single;
            frame.codelinks _ NOT framelinks;
            frame.code.longbase _ NIL;
            };
        DoFramePack: PROC [fph: FPHandle, fpi: FPIndex] RETURNS [stop: BOOL _ FALSE] = {
            mtb: Base = LOOPHOLE[bcd + bcd.mtOffset];
            space _ 0;
            resident _ FALSE;
            FOR i: CARDINAL IN [0..fph.length) DO GetFrameSizes[@mtb[fph.modules[i]]] ENDLOOP;
            [f, frames]
                _ AllocateFrames[size: NextMultipleOfFour[space], single: single, resident: resident];
            f.rest _ fl;
            fl _ f;
            FOR i: CARDINAL IN [0..fph.length) DO FrameInit[@mtb[fph.modules[i]]] ENDLOOP;
            };
        OtherFrameSizes: PROC [mth: MTHandle, mti: MTIndex] RETURNS[stop: BOOL _ FALSE] = {
            IF LoadState.local.ModuleInfo[cid, mth.gfi].gfh = NIL THEN GetFrameSizes[mth];
            };
        OtherFrameInit: PROC [mth: MTHandle, mti: MTIndex] RETURNS[stop: BOOL _ FALSE] = {
            IF LoadState.local.ModuleInfo[cid, mth.gfi].gfh = NIL THEN FrameInit[mth];
            };
        <<>>
        BEGIN ENABLE UNWIND => ReleaseFrames[fl, cid];
            [] _ BcdOps.ProcessFramePacks[bcd, DoFramePack];
            space _ 0;
            resident _ FALSE;
            [] _ BcdOps.ProcessModules[bcd, OtherFrameSizes];
            IF space # 0 THEN {
                [f, frames]
                    _ AllocateFrames[size: NextMultipleOfFour[space], single: single, resident: resident];
                f.rest _ fl;
                fl _ f;
                [] _ BcdOps.ProcessModules[bcd, OtherFrameInit];
                };
            END;
        };

<<Frame allocation/deallocation>>
    AllocateFrames: PUBLIC PROC [size: CARDINAL, single, resident: BOOL]
    RETURNS [fl: FrameList, frames: POINTER] = {
        IF single
            THEN {
                index: CARDINAL;
                FOR index IN [0..PrincOps.LastAVSlot]
                    DO IF PrincOpsUtils.FrameSize[index] >= size THEN EXIT; ENDLOOP;
                frames _ PrincOpsUtils.Alloc[index];
                [] _ PrincOpsUtils.LongZero[LONG[frames], size];
                fl _ CONS[[frame[ptr: frames]], NIL];
                }
            ELSE {
                pages: INT = VM.PagesForWords[size];
                interval: VM.Interval _ VM.Allocate[count: pages, partition: mds];
                IF resident THEN VM.Pin[interval];
                frames
                    _ LOOPHOLE[PrincOpsUtils.LowHalf[VM.AddressForPageNumber[interval.page]], POINTER];
                [] _ PrincOpsUtils.LongZero[LONG[frames], VM.WordsForPages[pages]];
                fl _ CONS[[mdsInterval[interval: interval]], NIL];
                };
        };

    NextMultipleOfFour: PROC [n: CARDINAL] RETURNS [CARDINAL] = INLINE {
        RETURN[PrincOpsUtils.BITAND[n+3, 177774B]];
        };

    ReleaseFrames: PUBLIC PROC [fl: FrameList, cid: LoadState.ConfigID] = {
        FOR f: FrameList _ fl, f.rest UNTIL f = NIL
            DO
                WITH v: f.first SELECT FROM
                    frame => PrincOpsUtils.Free[v.ptr];
                    mdsInterval => VM.Free[v.interval];
                    ENDCASE;
            ENDLOOP;
        };


<<Assign & release code>>
    AssignCodeToFrames: PUBLIC PROC [config: LoadState.ConfigID, bcdCap: OpenFile, pageOffset: INT--within file--] = {
        <<AssignCodeToFrames: Makes up a list of code segments, maps them in, and associates each code segment with the appropriate global 
        frame.>>
        sgList: SGList;
        allCodeInSelf: BOOL;
        bcd: BcdBase = LoadState.local.ConfigInfo[config].bcd;

        GetCode: PROC [mth: MTHandle, mti: MTIndex] RETURNS [BOOL] = {
            <<MatchCSeg: PROC [mmth: MTHandle, mmti: MTIndex] RETURNS [BOOL] = {>>
                <<IF mth # mmth>>
                    <<AND mth.code.sgi = mmth.code.sgi>>
                    <<AND mth.code.offset = mmth.code.offset>>
                <<THEN>>
                    <<frame.shared _ LoadState.local.ModuleInfo[config, mmth.gfi].gfh.shared _ TRUE;>>
                <<RETURN[FALSE];>>
                <<};>>
            frame: PrincOps.GlobalFrameHandle = LoadState.local.ModuleInfo[config, mth.gfi].gfh;
            IF mth.altoCode THEN InvalidModule[bcd, mth];
            frame.code.longbase _ SgiToLP[bcd, mth.code.sgi, sgList] + mth.code.offset;
            frame.code.out _ TRUE;
            <<Don't do the MatchCSeg stuff;  Roy and I (Andrew) think it does no good, and it costs an n-squared enumeration of the modules!>>
            <<[] _ BcdOps.ProcessModules[bcd, MatchCSeg];>>
            RETURN[FALSE];
            };

        <<START AssignCodeToFrames HERE>>
        [sgList, allCodeInSelf] _ FindSegments[bcd, bcdCap, pageOffset];
        IF bcd.nModules = 1 
            THEN AllocateCodeSpace[bcd, sgList, pageOffset, bcdCap]
            ELSE AllocateCodeSpaces[bcd, sgList, allCodeInSelf];
        [] _ BcdOps.ProcessModules[bcd, GetCode ! UNWIND => ReleaseCode[sgList]];
        };

    ReleaseCode: PROC [sgList: SGList] = {
        FOR i: CARDINAL _ 0, i+1 UNTIL i = sgList.maxLength DO
            VM.Free[sgList[i].interval];
            ENDLOOP;
        };
    <<>>
    FindSegments: PROC [bcd: BcdBase, bcdCap: OpenFile, pageOffset: INT--page number--] 
    RETURNS [sgList: SGList, allCodeInSelf: BOOL _ TRUE] = {
        <<called only from AssignCodeToFrames>>
        n: CARDINAL;
        sgItem: SGItem;

        GetFileFromSGH: PROC [sgh: SGHandle] RETURNS [file: OpenFile _ [NIL]] = {
            fth: FTHandle = @LOOPHOLE[bcd + bcd.ftOffset, Base][sgh.file];
            name: ROPE _ NameToRope[ssb: LOOPHOLE[bcd + bcd.ssOffset], name: fth.name];
            dot: BOOL _ Rope.Find[name, "."] # -1;
            bcd: BcdBase;
            interval: VM.Interval;

            IF ~dot THEN name _ Rope.Concat[name, ".bcd"];
            file _ FS.Open[name: name ! FS.Error => CONTINUE];
            IF file = OpenFile[NIL] THEN ERROR Error[fileNotFound, name];

            interval _ VM.Allocate[count: 1];
            bcd _ LOOPHOLE[VM.AddressForPageNumber[interval.page]];
            FS.Read[file: file, from: 0, nPages: 1, to: bcd];
            IF fth.version # bcd.version THEN {
                VM.Free[interval]; 
                ERROR Error[versionMismatch, name];
                };
            VM.Free[interval];
            };

        CountSegs: PROC [sgh: SGHandle, sgi: SGIndex] RETURNS [BOOL] = {
            IF sgh.class # code THEN RETURN[FALSE];
            IF sgh.file # FTSelf THEN allCodeInSelf _ FALSE;
            n _ n + 1;
            RETURN[FALSE];
            };

        AddSeg: PROC [sgh: SGHandle, sgi: SGIndex] RETURNS [BOOL] = {
            file: OpenFile;
            base: INT;
            IF sgh.class # code THEN RETURN[FALSE];
            IF sgh.file = FTSelf
                THEN {file _ bcdCap; base _ pageOffset}
                ELSE {file _ GetFileFromSGH[sgh]; base _ 0};
            sgList[n] _ [sgh: sgh, interval: [0, 0], file: file, bcdBase: base];
            n _ n + 1;
            RETURN[FALSE];
            };

        SiftUp: PROC [low, high: CARDINAL] = {
            k, son: CARDINAL;
            sgItem: SGItem;
            k _ low;
            DO
                IF k*2 > high THEN EXIT;
                IF k*2 + 1 > high OR sgList[k*2 + 1 - 1].sgh.base < sgList[
                    k*2 - 1].sgh.base THEN son _ k*2
                ELSE son _ k*2 + 1;
                IF sgList[son - 1].sgh.base < sgList[k - 1].sgh.base THEN EXIT;
                sgItem _ sgList[son - 1];
                sgList[son - 1] _ sgList[k - 1];
                sgList[k - 1] _ sgItem;
                k _ son;
                ENDLOOP;
            RETURN;
            };

        <<START FindSegments HERE>>
        n _ 0;
        [] _ BcdOps.ProcessSegs[bcd, CountSegs];
        sgList _ NEW[SGListObj[n]];
        n _ 0;
        [] _ BcdOps.ProcessSegs[bcd, AddSeg];
        IF allCodeInSelf THEN {
            FOR n DECREASING IN [1..sgList.maxLength/2] DO SiftUp[n, sgList.maxLength] ENDLOOP;
            FOR n DECREASING IN [1..sgList.maxLength)
                DO
                    sgItem _ sgList[1 - 1];
                    sgList[1 - 1] _ sgList[n + 1 - 1];
                    sgList[n + 1 - 1] _ sgItem;
                    SiftUp[1, n];
                ENDLOOP;
            };
        };

    NameToRope: PROC [ssb: NameString, name: NameRecord] RETURNS [ROPE] = {
        ros: IO.STREAM = IO.ROS[];
        FOR i: NAT IN [0..ssb.size[name]) DO IO.PutChar[ros, ssb.string.text[name+i]] ENDLOOP;
        RETURN [IO.RopeFromROS[ros]];
        };

    AllocateCodeSpace: PROC [bcd: BcdBase, sgList: SGList, pageOffset: INT, bcdCap: OpenFile] = {
        <<this is a bcd produced by the compiler>>
        interval: VM.Interval;
        mth: MTHandle;
        pages, biaspages: CARDINAL;
        IF sgList.maxLength ~= 1 THEN ERROR;
        mth _ @LOOPHOLE[bcd + bcd.mtOffset, Base][FIRST[MTIndex]];
        <<non-0 if code links>>
        biaspages _ IF mth.linkLoc = code 
            THEN (LoaderOps.LinkSegmentLength[mth, bcd]/PrincOps.wordsPerPage)+1 
            ELSE 0;
        pages _ sgList[0].sgh.pages;
        <<ncodepages _ pages + biaspages;>>
        interval _ VM.Allocate[count: pages + biaspages, in64K: TRUE];  -- won't cross a 64K VM bdry
        <<if the bcd is being loaded with code links, the cedar compiler will have left room for them>>
        FS.Read[
            file: bcdCap,
            from: pageOffset + sgList[0].sgh.base - 1,
            nPages: pages + biaspages,
            to: VM.AddressForPageNumber[interval.page]
            ];
        VM.MakeReadOnly[interval];
        sgList[0].interval _ interval;
        };

    AllocateCodeSpaces: PROC [bcd: BcdBase, sgList: SGList, allCodeInSelf: BOOL] = {
        start, end, startBase, pages: CARDINAL;
        pageOfInterval: VM.PageNumber;
        interval: VM.Interval;
        start _ end _ 0;
        DO
            startBase _ sgList[start].sgh.base;
            pages _ sgList[start].sgh.pages;
            DO
                end _ end + 1;
                IF end = sgList.maxLength OR pages + sgList[end].sgh.pages > 255 OR ~ allCodeInSelf 
                    THEN EXIT;
                pages _ pages + sgList[end].sgh.pages;
                ENDLOOP;
            interval _ VM.Allocate[count: pages, in64K: TRUE];
            FS.Read[
                file: sgList[start].file,
                from: sgList[start].bcdBase + sgList[start].sgh.base - 1,
                nPages: pages,
                to: VM.AddressForPageNumber[interval.page]
                ];
            VM.MakeReadOnly[interval];
            pageOfInterval _ interval.page;
            FOR index: CARDINAL IN [start..end) DO
                sgh: SGHandle = sgList[index].sgh;
                sph: SPHandle _ FindSPHandle[bcd, sgh];
                subInterval: VM.Interval;
                IF sph = NIL
                    THEN subInterval _ [page: pageOfInterval, count: sgh.pages]
                    ELSE {
                        FOR sp: CARDINAL DECREASING IN [0..sph.length) DO
                            subInterval _
                                [page: pageOfInterval + sph.spaces[sp].offset, count: sph.spaces[sp].pages];
                                <<Hmm. Does this work? who remembers subInterval; apparently only the last one is remembered (below) for this sgList entry.  Is it 
                                the "first" one?>>
                            IF sph.spaces[sp].resident THEN VM.Pin[subInterval];
                        ENDLOOP;
                        };
                sgList[index].interval _ subInterval;
                pageOfInterval _ pageOfInterval + sgh.pages;
            ENDLOOP;
            IF end = sgList.maxLength THEN EXIT ELSE start _ end;
        ENDLOOP;
        };

    FindSPHandle: PUBLIC PROC [bcd: BcdBase, sgh: SGHandle] RETURNS [sph: SPHandle] = {
        sgb: Base = LOOPHOLE[bcd + bcd.sgOffset];
        proc: PROC [sph: SPHandle, spi: SPIndex]
            RETURNS [stop: BOOL] = {RETURN[@sgb[sph.seg] = sgh]};
        RETURN[BcdOps.ProcessSpaces[bcd: bcd, proc: proc].sph];
        };

    SgiToLP: PROC[bcd: BcdBase, sgi: SGIndex, sgList: SGList]
        RETURNS[LONG POINTER] = {
        sgb: Base = LOOPHOLE[bcd + bcd.sgOffset];
        FOR i: CARDINAL IN [0..sgList.maxLength) DO
            IF @sgb[sgi] = sgList[i].sgh
                THEN RETURN[VM.AddressForPageNumber[sgList[i].interval.page]];
            ENDLOOP;
        RETURN[NIL];
        };

    InvalidModule: PROC [bcd: BcdBase, mth: MTHandle] = {
        name: ROPE = NameToRope[ssb: LOOPHOLE[bcd + bcd.ssOffset], name: mth.name];
        ERROR Error[invalidBcd, name];
        };

<<Assigning control modules>>
    AssignControlModules: PUBLIC PROC[cid: LoadState.ConfigID]
    RETURNS [cm: PrincOps.ControlModule] = {
        OPEN PrincOps;
        bcd: BcdBase _ LoadState.local.ConfigInfo[cid].bcd;
        ctb: Base _ LOOPHOLE[bcd + bcd.ctOffset];
        mtb: Base _ LOOPHOLE[bcd + bcd.mtOffset];
        cti: CTIndex;
        mapIndex, maxLevel: NAT _ 0;
        i: NAT;
        cmMap: CMMap;

        MapControls: PROC[cth: CTHandle, cti: CTIndex] RETURNS [stop: BOOL _ FALSE] = {
            OPEN PrincOpsUtils;
            cm: ControlModule;
            level: CARDINAL _ 0;
            IF cth.nControls = 0
                THEN cm _ NullControlModule
                ELSE {
                    cm.list _ PrincOpsUtils.Alloc[
                        MakeFsi[cth.nControls + SIZE[CARDINAL] + SIZE[ControlModule]]];
                    cm.list.nModules _ cth.nControls + 1;
                    FOR i: CARDINAL IN [0..cth.nControls)
                        DO
                            WITH ci: cth.controls[i] SELECT FROM
                                module =>
                                    cm.list.frames[i+1] _ LoadState.local.ModuleInfo[cid, mtb[ci.mti].gfi].gfh;
                                config => ERROR;
                                ENDCASE => ERROR;
                        ENDLOOP;
                    cm.multiple _ TRUE;
                    };
            FOR c: CTIndex _ ctb[cti].config, ctb[c].config UNTIL c = CTNull
                DO level _ level + 1 ENDLOOP;
            cmMap[mapIndex] _ [cti: cti, cm: cm, level: level];
            mapIndex _ mapIndex + 1;
            maxLevel _ MAX[maxLevel, level];
            };

        GetControl: PROC [mth: MTHandle, mti: MTIndex] RETURNS [BOOL] = {
            OPEN PrincOps, PrincOpsUtils;
            frame: GlobalFrameHandle _ LoadState.local.ModuleInfo[cid, mth.gfi].gfh;
            IF mth.config # cti THEN RETURN[FALSE];
            IF frame.global[0] = NullControlCard THEN frame.global[0] _ LOOPHOLE[GetModule[cm]];
            RETURN[FALSE];
            };

        IF bcd.nModules = 1 THEN {
            frame: GlobalFrameHandle _ LoadState.local.ModuleInfo[cid, 1].gfh;
            frame.global[0] _ NullControlCard;
            RETURN[[frame[frame]]];
            };
        cmMap _ NEW[CMMapObj[bcd.nConfigs]];
        [] _ BcdOps.ProcessConfigs[bcd, MapControls];
        FOR level: CARDINAL DECREASING IN [0..maxLevel] DO
            FOR index: CARDINAL IN [0..mapIndex) DO
                list: ControlModule;
                IF cmMap[index].level # level OR (cm _ cmMap[index].cm) = NullControlModule THEN LOOP;
                list _ cm;
                list.multiple _ FALSE;
                list.list.frames[1] _ SetLink[cm, list.list.frames[1]].frame;
                FOR i: CARDINAL IN [2..list.list.nModules) DO
                    list.list.frames[i] _ SetLink[GetModule[[frame[list.list.frames[1]]]], list.list.frames[i]].frame;
                    ENDLOOP;
                cti _ cmMap[index].cti;
                [] _ BcdOps.ProcessModules[bcd, GetControl];
                ENDLOOP;
            ENDLOOP;
        FOR index: CARDINAL IN [0..mapIndex) DO
            parent: CARDINAL;
            list: ControlModule;
            IF (list _ cmMap[index].cm) = NullControlModule THEN LOOP;
            list.multiple _ FALSE;
            IF (cti _ ctb[cmMap[index].cti].config) = CTNull
                THEN cm _ NullControlModule
                ELSE {
                    FOR parent IN [0..mapIndex) DO IF cmMap[parent].cti = cti THEN EXIT; ENDLOOP;
                    cm _ GetModule[cmMap[parent].cm];
                    };
            list.list.frames[0] _ LOOPHOLE[cm.frame];
            ENDLOOP;
        FOR i IN [0..mapIndex) DO
            IF ctb[cmMap[i].cti].config = CTNull THEN {
                cm _ GetModule[cmMap[i].cm];
                EXIT};
            ENDLOOP;
        };

    SetLink: PROC[cm: ControlModule, frame: GlobalFrameHandle] RETURNS [ControlModule] = {
        t: ControlModule = LOOPHOLE[frame.global[0]];
        frame.global[0] _ LOOPHOLE[cm];
        RETURN[IF t = NullControlModule THEN [frame[frame]] ELSE t];
        };

    GetModule: PROC [cm: ControlModule] RETURNS [ControlModule] = {
        list: ControlModule;
        DO
            IF ~cm.multiple THEN RETURN[cm];
            list _ cm;
            list.multiple _ FALSE;
            cm.frame _ list.list.frames[1];
            ENDLOOP;
        };

    END.


    <<Bob Hagmann May 3, 1985 10:28:33 am PDT>>
        <<changes to: IntervalForGlobalFrame>>
    <<>>