
    <<LoadStateImpl.mesa>>
        <<Copyright © 1985, 1986 by Xerox Corporation.  All rights reserved.>>
        <<Levin on September 20, 1983 4:07 pm>>
        <<Birrell and Rovner, December 2, 1983 11:13 am>>
        <<Rovner on December 8, 1983 8:32 am>>
    <<Russ Atkinson (RRA) March 28, 1986 3:33:58 pm PST>>

        DIRECTORY
            BasicLoadState USING [ConfigID, ConfigInfo, Destroy, EnumerateConfigs, EnumerateModulesInConfig, GlobalFrameToType, ModuleIndex, 
            ModuleToGlobalFrame, NullModule], 
            BasicLoadStateFormat USING [ConfigIndex, LoadState, LoadStateObject, nullModule, versionID], 
            Basics USING [DivMod],
            BcdDefs USING [Base, MTHandle, MTIndex, MTNull],
            BcdOps USING [ProcessModules],
            DebuggerSwap USING [NoteLoadstate, NoteRealLoadState],
            LoadState USING [Access, BcdBase, CopiesList, EnumerationOrder, GlobalFrameHandle, ModuleIndex, nullModule, nullType, Type],
            LoadStateFormat USING [CollisionList, CollisionTable, CollisionTableIndex, Config, ConfigObject, ConfigID, ConfigTable, CopyIndex, 
            CopyTable, Entry, fuzzyCopyIndex, Handle, HashIndex, htSize, nullCopyIndex, Object],
            PrincOps USING [ControlLink, EmptyGFTItem, EPBias, EPIndex, EPRange, FrameHandle, GFT, GFTIndex, MainBodyIndex, MaxNGfi, 
            NullGlobalFrame, PrefixHandle, sCopy, SD, sGFTLength],
            PrincOpsUtils USING [Alloc, BITAND, BITSHIFT, Codebase, Copy, Free, GetReturnFrame, GlobalFrame, MakeFsi, SetReturnLink, LongZero],
            SafeStorageOps USING [CopyTypesAndLiterals],
            VM USING [AddressForPageNumber, Interval, PagesForWords, SimpleAllocate, WordsForPages];
LoadStateImpl: MONITOR
    IMPORTS BasicLoadState, Basics, BcdOps, DebuggerSwap, PrincOpsUtils, SafeStorageOps, VM
    EXPORTS LoadState
    = BEGIN OPEN LoadState, LoadStateFormat;

    <<Types and Constants>>

        Handle: TYPE = LoadStateFormat.Handle;
        Object: PUBLIC TYPE = LoadStateFormat.Object;

        ConfigID: PUBLIC TYPE = LoadStateFormat.ConfigID;

        nullConfig: PUBLIC ConfigID _ LoadStateFormat.ConfigID.LAST;

        local: PUBLIC Handle;

        UndoLog: TYPE = LIST OF UndoLogEntry;

        UndoLogEntry: TYPE = RECORD [loadState: Handle, configID: ConfigID];

    <<Global variables>>

        released: CONDITION _ [timeout: 0];
        undoLog: UndoLog _ NIL;

    <<Synchronization>>
        <<>>
        Acquire: PUBLIC ENTRY SAFE PROC [loadState: Handle, access: Access] = TRUSTED {
            DO
                SELECT TRUE FROM
                    access = shared AND loadState.useCount >= 0 => {
                        loadState.useCount _ loadState.useCount.SUCC; EXIT};
                    access = exclusive AND loadState.useCount = 0 => {
                        loadState.useCount _ -1; EXIT};
                    ENDCASE;
                WAIT released;
                ENDLOOP;
            };

        Release: PUBLIC SAFE PROC [loadState: Handle, commit: BOOL] = TRUSTED {
            LogProcessingNeeded: ENTRY PROC RETURNS [doLog: BOOL] = {
                SELECT loadState.useCount FROM
                    < 0 => RETURN [TRUE];
                    > 0 => {
                        loadState.useCount _ loadState.useCount.PRED;
                        BROADCAST released;
                        RETURN [FALSE]
                        };
                    ENDCASE => RETURN WITH ERROR CallerBug;
                };
            LogProcessingDone: ENTRY PROC = {
                loadState.useCount _ 0;
                BROADCAST released;
                };
            IF LogProcessingNeeded[] THEN {
                IF commit THEN {
                    loadState.changeCount _ loadState.changeCount.SUCC;
                    DiscardUndoLog[loadState];
                    }
                ELSE Undo[loadState];
                LogProcessingDone[];
                };
            };
        <<>>
    <<Interrogation Procedures>>
        <<>>
        GetChangeCount: PUBLIC SAFE PROC [loadState: Handle] RETURNS [INT] = TRUSTED {
            RETURN[loadState.changeCount];
            };

        ConfigInfo: PUBLIC SAFE PROC [loadState: Handle, config: ConfigID] RETURNS [bcd: BcdBase, ref: REF ANY] = TRUSTED {
            c: Config;
            CheckAccess[loadState];
            c _ loadState.configTable.configs[config];
            RETURN[c.bcd, c.ref]
            };

        ModuleInfo: PUBLIC SAFE PROC [loadState: Handle, config: ConfigID, module: ModuleIndex] RETURNS [gfh: GlobalFrameHandle, mti: 
        BcdDefs.MTIndex, type: Type, copies: CopiesList] = TRUSTED {
            c: Config;
            CheckAccess[loadState];
            c _ loadState.configTable.configs[config];
            IF module >= c.nModules THEN ERROR CallerBug;
            IF (mti _ c.modules[module].mti) = BcdDefs.MTNull THEN ERROR CallerBug;
            type _ c.modules[module].type;
            IF  (gfh _ c.modules[module].gfh) = NIL
                THEN copies _ NIL
                ELSE {
                    ci: CopyIndex = FindCopyIndex[loadState, gfh];
                    copies _ IF ci = nullCopyIndex THEN NIL ELSE loadState.copyTable.copies[ci].copies;
                    };
            };

        GlobalFrameToModule: PUBLIC SAFE PROC [loadState: Handle, gfh: GlobalFrameHandle] RETURNS [config: ConfigID, module: ModuleIndex] = 
        TRUSTED {
            entry: Entry;
            CheckAccess[loadState];
            ValidateGlobalFrame[loadState, gfh];
            entry _ FindEntry[loadState, gfh];
            WITH e: entry SELECT FROM
                original => RETURN[e.configID, e.module];
                copy => 
                    [config, module] _
                        GlobalFrameToModule[loadState, loadState.copyTable.copies[e.copyIndex].parent];
                ENDCASE => {config _ nullConfig; module _ BasicLoadState.NullModule};
            };

        BuildProcDescUsingModule: PUBLIC SAFE PROC [loadState: Handle, config: ConfigID, module: ModuleIndex, ep: PrincOps.EPIndex] RETURNS 
        [PrincOps.ControlLink] = TRUSTED {
            gfh: GlobalFrameHandle;
            c: Config;
            firstModule: ModuleIndex _ module;
            CheckAccess[loadState];
            c _ loadState.configTable.configs[config];
            IF module >= c.nModules THEN ERROR CallerBug;
            IF  (gfh _ c.modules[module].gfh) = NIL THEN ERROR CallerBug;
            FOR i: ModuleIndex DECREASING IN [0..module) UNTIL c.modules[i].gfh ~= gfh DO
                firstModule _ i;
                ENDLOOP;
            <<See note in interface for an explanation of the following ugliness.>>
            RETURN[
                [procedure[
                    gfi: (IF loadState = local THEN gfh.gfi ELSE 0) + module - firstModule,
                    ep: ep,
                    tag: TRUE]]
                ]
            };

        BuildProcDescUsingGlobalFrame: PUBLIC SAFE PROC [loadState: Handle, gfh: GlobalFrameHandle, ep: NAT] RETURNS [PrincOps.ControlLink] 
        = TRUSTED {
            epb: PrincOps.EPBias;
            epi: PrincOps.EPIndex;
            CheckLocal[loadState];
            IF ep >= PrincOps.MaxNGfi*PrincOps.EPRange THEN ERROR CallerBug;
            [epb, epi] _ Basics.DivMod[ep, PrincOps.EPRange];
            RETURN[[procedure[gfi: gfh.gfi + epb, ep: epi, tag: TRUE]]]
            };

    <<Modification Procedures>>
        <<>>
        LoadStateFull: PUBLIC SAFE ERROR = CODE;

        NewConfig: PUBLIC SAFE PROC [loadState: Handle, bcd: BcdBase, ref: REF ANY] RETURNS [configID: ConfigID] = TRUSTED {
            NewConfigObject: PROC [bcd: BcdBase] RETURNS [c: Config] = {
                nModules: NAT _ 0;
                ComputeSize: PROC [mth: BcdDefs.MTHandle, mti: BcdDefs.MTIndex]
                    RETURNS [BOOL _ FALSE] = {
                    nModules _ MAX[nModules, mth.gfi+mth.ngfi];
                    };
                FillInModules: PROC [mth: BcdDefs.MTHandle, mti: BcdDefs.MTIndex]
                    RETURNS [BOOL _ FALSE] = {
                    FOR i: NAT IN [0..mth.ngfi) DO
                        c.modules[mth.gfi+i].mti _ mti;
                        ENDLOOP;
                    };
                [] _ BcdOps.ProcessModules[bcd, ComputeSize];
                c _ NEW[ConfigObject[nModules]];
                c.bcd _ bcd;
                c.ref _ ref;
                c.nModules _ nModules;
                FOR mi: ModuleIndex IN [0..nModules) DO
                    c.modules[mi] _ [mti: BcdDefs.MTNull, gfh: NIL, type: nullType];
                    ENDLOOP;
                [] _ BcdOps.ProcessModules[bcd, FillInModules];
                };
            ct: REF ConfigTable;
            CheckAccess[loadState, exclusive];
            CheckLocal[loadState];
            ct _ loadState.configTable;
            IF ct.nConfigs = ct.length THEN 
                IF ct.length = ConfigID.LAST THEN ERROR LoadStateFull
                ELSE {
                    newCT: REF ConfigTable = NEW[ConfigTable[MIN[3*ct.length/2, ConfigID.LAST]]];
                    newCT.nConfigs _ ct.nConfigs;
                    FOR ci: ConfigID IN [0..newCT.nConfigs) DO
                        newCT.configs[ci] _ ct.configs[ci];
                        ENDLOOP;
                    loadState.configTable _ ct _ newCT;
                    };
            ct.configs[configID _ ct.nConfigs] _ NewConfigObject[bcd];
            ct.nConfigs _ ct.nConfigs.SUCC;
            AppendToUndoLog[loadState, configID];
            };

        SetGlobalFrame: PUBLIC SAFE PROC [ loadState: Handle, config: ConfigID, module: ModuleIndex, gfh: GlobalFrameHandle] = TRUSTED {
            c: Config;
            mth: BcdDefs.MTHandle;
            CheckAccess[loadState, exclusive];
            CheckLocal[loadState];
            c _ loadState.configTable.configs[config];
            IF c.modules[module].gfh ~= NIL OR c.modules[module].mti = BcdDefs.MTNull THEN
                ERROR CallerBug;
            mth _ @LOOPHOLE[c.bcd + c.bcd.mtOffset, BcdDefs.Base][c.modules[module].mti];
            EnterGlobalFrame[gfh, mth.ngfi];
            FOR i: NAT IN [0..mth.ngfi) DO
                c.modules[module+i].gfh _ gfh;
                ENDLOOP;
            AddEntry[
                loadState, gfh, [original[copyIndex: nullCopyIndex, configID: config, module: module]]];
            };

        SetType: PUBLIC SAFE PROC [ loadState: Handle, gfh: GlobalFrameHandle, type: Type] = TRUSTED {
            entry: Entry;
            CheckAccess[loadState, exclusive];
            CheckLocal[loadState];
            ValidateGlobalFrame[loadState, gfh];
            entry _ FindEntry[loadState, gfh];
            WITH e: entry SELECT FROM
                original =>
                    loadState.configTable.configs[e.configID].modules[e.module].type _ type;
                copy => NULL;  -- could verify that it matches the type of the original... 
                ENDCASE => ERROR;
            };

        CopyNew: PUBLIC SAFE PROC [loadState: Handle, old: PROGRAM] RETURNS [new: PROGRAM] = TRUSTED {
            frame: GlobalFrameHandle = LOOPHOLE[old];
            CheckLocal[loadState];
            RETURN[LOOPHOLE[LocalCopyNew[frame]]]
            };

        UnNew: PUBLIC UNSAFE PROC [loadState: Handle, program: PROGRAM] = {
            frame: GlobalFrameHandle = LOOPHOLE[program];
            CheckLocal[loadState];
            ValidateGlobalFrame[loadState, frame];
            LocalUnNew[frame];
            };

        SelfDestruct: PUBLIC UNSAFE PROC = {
            destructee: PrincOps.FrameHandle = PrincOpsUtils.GetReturnFrame[];
            PrincOpsUtils.SetReturnLink[destructee.returnlink];
            LocalUnNew[PrincOpsUtils.GlobalFrame[LOOPHOLE[destructee]]];
            PrincOpsUtils.Free[destructee];
            };
        <<>>
    <<Enumerators>>
        <<>>
        EnumerateConfigs: PUBLIC SAFE PROC [loadState: Handle, order: EnumerationOrder, proc: PROC [ConfigID] RETURNS [--stop:--BOOL]] 
        RETURNS [config: ConfigID] = TRUSTED {
            CheckAccess[loadState];
            SELECT order FROM
                newestFirst =>
                    FOR config DECREASING IN [0..loadState.configTable.nConfigs) DO
                        IF proc[config] THEN EXIT;
                        REPEAT
                            FINISHED => RETURN [nullConfig];
                        ENDLOOP;
                oldestFirst =>
                    FOR config IN [0..loadState.configTable.nConfigs) DO
                        IF proc[config] THEN EXIT;
                        REPEAT
                            FINISHED => RETURN [nullConfig];
                        ENDLOOP;
                ENDCASE;
            };

        EnumerateModulesInConfig: PUBLIC SAFE PROC [loadState: Handle, config: ConfigID, proc: PROC [ModuleIndex] RETURNS [--stop:--BOOL]] 
        RETURNS [module: ModuleIndex, gfh: GlobalFrameHandle] = TRUSTED {
            c: Config;
            prev: GlobalFrameHandle _ NIL;
            CheckAccess[loadState];
            c _ loadState.configTable.configs[config];
            FOR module IN [1..c.nModules) DO  -- index 0 is always unused
                gfh _ c.modules[module].gfh;
                IF gfh ~= NIL AND gfh ~= prev THEN {
                    IF proc[module] THEN RETURN;
                    prev _ gfh;
                    };
                ENDLOOP;
            RETURN [nullModule, NIL]
            };

        EnumerateAllModules: PUBLIC SAFE PROC [loadState: Handle, order: EnumerationOrder, proc: PROC [ConfigID, ModuleIndex] RETURNS 
        [--stop:--BOOL]] RETURNS [config: ConfigID _ nullConfig, module: ModuleIndex _ nullModule] = TRUSTED {
            DoOneConfig: PROC [c: ConfigID] RETURNS [BOOL] = {
                PassItOn: PROC [m: ModuleIndex] RETURNS [stop: BOOL] = {
                    IF (stop _ proc[c, m]) THEN {config _ c; module _ m};
                    };
                RETURN[EnumerateModulesInConfig[loadState, c, PassItOn].module ~= nullModule]
                };
            CheckAccess[loadState];
            [] _ EnumerateConfigs[loadState, order, DoOneConfig];
            };
    <<>>
    <<Internal procedures>>

        CallerBug: ERROR = CODE;

    <<Validation>>
        <<>>
        CheckAccess: ENTRY PROC [loadState: Handle, access: Access _ shared] = {
            IF loadState.useCount = 0 OR (loadState.useCount > 0 AND access = exclusive) THEN
                RETURN WITH ERROR CallerBug;
            };

        CheckLocal: PROC [loadState: Handle] = {
            IF loadState ~= local THEN ERROR CallerBug;
            };

        ValidateGlobalFrame: PROC [loadState: Handle, frame: GlobalFrameHandle] = {
            WITH FindEntry[loadState, frame] SELECT FROM
                empty => ERROR CallerBug;
                ENDCASE => RETURN;
            };

    <<LoadState Maintenance>>
        <<>>
        FindEntry: PROC [loadState: Handle, gfh: GlobalFrameHandle] RETURNS [entry: Entry] = {
            Match: PROC [entry: Entry] RETURNS [BOOL _ FALSE] = {
                WITH e: entry SELECT FROM
                    original =>
                        IF loadState.configTable.configs[e.configID].modules[e.module].gfh = gfh THEN
                            RETURN[TRUE];
                    copy => IF e.gfh = gfh THEN RETURN[TRUE];
                    ENDCASE;
                };
            IF Match[entry _ loadState.gfht[Hash[gfh]]] THEN RETURN;
            WITH e: entry SELECT FROM
                collision =>
                    FOR list: CollisionList _ loadState.collisionTable.collisions[e.list], list.rest UNTIL list = NIL DO
                        IF Match[list.first] THEN RETURN[list.first];
                        ENDLOOP;
                ENDCASE;
            RETURN[[empty[]]]
            };

        FindCopyIndex: PROC [loadState: Handle, gfh: GlobalFrameHandle] RETURNS [CopyIndex _ nullCopyIndex] = {
            entry: Entry = FindEntry[loadState, gfh];
            WITH e: entry SELECT FROM
                original => {
                    SELECT e.copyIndex FROM
                        nullCopyIndex => RETURN;
                        fuzzyCopyIndex =>
                            FOR ci: CopyIndex IN [fuzzyCopyIndex..loadState.copyTable.nCopies) DO
                                IF loadState.copyTable.copies[ci].parent = gfh THEN RETURN [ci];
                                ENDLOOP;
                        ENDCASE => RETURN[e.copyIndex]
                        };
                copy => RETURN[e.copyIndex]
                ENDCASE;
            };

        SetCopyIndex: PROC [loadState: Handle, gfh: GlobalFrameHandle, copyIndex: CopyIndex] = {
            entry: LONG POINTER TO Entry = @loadState.gfht[Hash[gfh]];
            copyIndex _ MIN[copyIndex, fuzzyCopyIndex];
            WITH e: entry SELECT FROM
                original => e.copyIndex _ copyIndex;
                collision =>
                    FOR list: CollisionList _ loadState.collisionTable.collisions[e.list], list.rest UNTIL list = NIL DO
                        WITH f: list.first SELECT FROM
                            original =>
                                IF loadState.configTable.configs[f.configID].modules[f.module].gfh = gfh THEN
                                    {f.copyIndex _ copyIndex; EXIT};
                            copy => NULL;
                            ENDCASE => ERROR;
                        REPEAT
                            FINISHED => ERROR;
                        ENDLOOP;
                ENDCASE => ERROR;
            };

        AddEntry: PROC [loadState: Handle, gfh: GlobalFrameHandle, entry: Entry] = {
            hi: HashIndex = Hash[gfh];
            oldEntry: Entry = loadState.gfht[hi];
            WITH e: oldEntry SELECT FROM
                empty => loadState.gfht[hi] _ entry;
                collision =>
                    loadState.collisionTable.collisions[e.list] _
                        CONS[entry, loadState.collisionTable.collisions[e.list]];
                ENDCASE => {
                    ct: REF CollisionTable _ loadState.collisionTable;
                    ci: CollisionTableIndex;
                    FOR ci IN [0..ct.nCollisions) DO
                        IF ct.collisions[ci] = NIL THEN EXIT;
                        REPEAT
                            FINISHED => {
                                IF ct.nCollisions = ct.length THEN {
                                    newCT: REF CollisionTable = NEW[CollisionTable[3*ct.length/2]];
                                    newCT.nCollisions _ ct.nCollisions;
                                    FOR ci: CollisionTableIndex IN [0..newCT.nCollisions) DO
                                        newCT.collisions[ci] _ ct.collisions[ci];
                                        ENDLOOP;
                                    loadState.collisionTable _ ct _ newCT;
                                    };
                                ci _ ct.nCollisions;
                                ct.nCollisions _ ct.nCollisions.SUCC;
                                };
                        ENDLOOP;
                    ct.collisions[ci] _ CONS[entry, CONS[loadState.gfht[hi], NIL]];
                    loadState.gfht[hi] _ [collision[list: ci]];
                    };
            };

        RemoveEntry: PROC [loadState: Handle, gfh: GlobalFrameHandle] = {
            hi: HashIndex = Hash[gfh];
            oldEntry: Entry = loadState.gfht[hi];
            WITH e: oldEntry SELECT FROM
                original => loadState.gfht[hi] _ [empty[]];
                copy => loadState.gfht[hi] _ [empty[]];
                collision => {
                    list: CollisionList _ loadState.collisionTable.collisions[e.list];
                    prev: CollisionList _ NIL;
                    UNTIL list = NIL DO
                        WITH f: list.first SELECT FROM
                            original =>
                                IF loadState.configTable.configs[f.configID].modules[f.module].gfh = gfh THEN
                                    GO TO found;
                            copy => IF f.gfh = gfh THEN GO TO found;
                            ENDCASE => ERROR;
                        prev _ list;
                        list _ list.rest;
                        REPEAT
                            found =>
                                IF prev = NIL THEN loadState.collisionTable.collisions[e.list] _ list.rest
                                ELSE prev.rest _ list.rest;
                            FINISHED => ERROR;
                        ENDLOOP;
                    IF loadState.collisionTable.collisions[e.list].rest = NIL THEN { -- collisions gone
                        loadState.gfht[hi] _ loadState.collisionTable.collisions[e.list].first;
                        loadState.collisionTable.collisions[e.list] _ NIL;
                        };
                    };
                ENDCASE => ERROR;
            };

        Hash: PROC [gfh: GlobalFrameHandle] RETURNS [HashIndex] = INLINE {
            RETURN [PrincOpsUtils.BITSHIFT[LOOPHOLE[gfh], -2] MOD htSize]
            };

    <<Undo Log Maintenance>>
        <<>>
        Undo: PROC [loadState: Handle] = {
            <<Note:  This code assumes that, if there are multiple configs to be undone, they appear in descending order of configID on the 
            undo list.>>
            prev: UndoLog _ NIL;
            FOR list: UndoLog _ undoLog, list.rest UNTIL list = NIL DO
                IF list.first.loadState = loadState THEN {
                    configID: ConfigID = list.first.configID;
                    RemoveModule: PROC [module: ModuleIndex] RETURNS [BOOL _ FALSE] = {
                        gfh: GlobalFrameHandle = ModuleInfo[loadState, configID, module].gfh;
                        RemoveGlobalFrame[gfh];
                        RemoveEntry[loadState, gfh];
                        };
                    IF loadState ~= local OR configID ~= loadState.configTable.nConfigs.PRED THEN ERROR;
                    [] _ EnumerateModulesInConfig[loadState, configID, RemoveModule];
                    loadState.configTable.configs[configID] _ NIL;  -- make collector happy
                    loadState.configTable.nConfigs _ configID;
                    IF prev = NIL THEN undoLog _ list.rest ELSE prev.rest _ list.rest;
                    }
                ELSE prev _ list;
                ENDLOOP;
            };

        AppendToUndoLog: PROC [loadState: Handle, config: ConfigID] = {
            undoLog _ CONS[UndoLogEntry[loadState, config], undoLog];
            };

        DiscardUndoLog: PROC [loadState: Handle] = {
            ConfigList: TYPE = LIST OF ConfigID;
            prev: UndoLog _ NIL;
            debuggerLSList: ConfigList _ NIL;
            FOR list: UndoLog _ undoLog, list.rest UNTIL list = NIL DO
                IF list.first.loadState = loadState THEN {
                    IF loadState ~= local THEN ERROR;
                    debuggerLSList _ CONS[list.first.configID, debuggerLSList];
                    IF prev = NIL THEN undoLog _ list.rest ELSE prev.rest _ list.rest;
                    }
                ELSE prev _ list;
                ENDLOOP;
            <<We can now do the debugger loadstate list in the proper order (ascending configIDs).>>
            FOR list: ConfigList _ debuggerLSList, list.rest UNTIL list = NIL DO
                UpdateDebuggerLoadState[list.first];
                ENDLOOP;
            };

    <<New and UnNew>>
        <<>>
        LocalCopyNew: PROC [old: GlobalFrameHandle] RETURNS [new: GlobalFrameHandle] =  {
            FindOriginal: PROC [old: GlobalFrameHandle] RETURNS [GlobalFrameHandle] = {
                entry: Entry = FindEntry[local, old];
                WITH e: entry SELECT FROM
                    original => RETURN[old];
                    copy => RETURN[local.copyTable.copies[e.copyIndex].parent];
                    ENDCASE => RETURN [NIL];
                };
            AllocGlobalFrame: PROC [old: GlobalFrameHandle, cp: PrincOps.PrefixHandle] RETURNS [frame: GlobalFrameHandle, linkspace: CARDINAL] 
            = {
                pGFSize: LONG POINTER TO CARDINAL =
                    LOOPHOLE[cp + CARDINAL[cp.entry[PrincOps.MainBodyIndex].initialpc] - 1];
                nLinks: CARDINAL = cp.header.info.nlinks;
                nWords: CARDINAL;
                linkspace _
                    IF old.codelinks THEN 0 ELSE
                    nLinks + PrincOpsUtils.BITAND[-LOOPHOLE[nLinks, INTEGER], 3B];
                nWords _ pGFSize^ + linkspace;
                frame _ PrincOpsUtils.Alloc[PrincOpsUtils.MakeFsi[nWords]];
                [] _ PrincOpsUtils.LongZero[LONG[frame], nWords];
                };
            AddCopy: PROC [original: GlobalFrameHandle, copy: GlobalFrameHandle] = {
                ct: REF CopyTable _ local.copyTable;
                ci: CopyIndex _ FindCopyIndex[local, original];
                IF ci = nullCopyIndex THEN {
                    FOR ci IN [1..ct.nCopies) DO  -- slot 0 is never used ( = nullCopyIndex)
                        IF ct.copies[ci].copies = NIL THEN EXIT;  -- reuse an available slot
                        REPEAT
                            FINISHED => {
                                IF ct.nCopies = ct.length THEN {
                                    newCT: REF CopyTable = NEW[CopyTable[3*ct.length/2]];
                                    newCT.nCopies _ ct.nCopies;
                                    FOR ci: CopyIndex IN [0..newCT.nCopies) DO
                                        newCT.copies[ci] _ ct.copies[ci];
                                        ENDLOOP;
                                    local.copyTable _ ct _ newCT;
                                    };
                                ci _ ct.nCopies;
                                ct.nCopies _ ct.nCopies.SUCC;
                                };
                        ENDLOOP;
                    ct.copies[ci] _ [parent: original, copies: NIL];
                    SetCopyIndex[local, original, ci];
                    };
                ct.copies[ci].copies _ CONS[copy, ct.copies[ci].copies];
                AddEntry[local, copy, [copy[copyIndex: ci, gfh: copy]]];
                };
            linkspace: CARDINAL;
            codebase: PrincOps.PrefixHandle;
            entry: Entry;
            ValidateGlobalFrame[local, old];
            Acquire[local, exclusive];
            old _ FindOriginal[old];
            IF old = NIL THEN RETURN;
            [new, linkspace] _ AllocGlobalFrame[old, codebase _ PrincOpsUtils.Codebase[old]];
            new _ new + linkspace;
            new.alloced _ new.shared _ new.copied _ TRUE;
            new.started _ new.trapxfers _ FALSE;
            new.codelinks _ old.codelinks;
            new.code _ old.code;
            new.code.out _ TRUE;  -- will cause start trap
            new.global[0] _ LOOPHOLE[PrincOps.NullGlobalFrame];
            IF linkspace ~= 0 THEN
                PrincOpsUtils.Copy[from: old - linkspace, to: new - linkspace, nwords: linkspace];
            EnterGlobalFrame[new, codebase.header.info.ngfi
                ! LoadStateFull => {
                    PrincOpsUtils.Free[new - linkspace];
                    Release[loadState: local, commit: FALSE];
                    }
                ];
            old.shared _ TRUE;
            entry _ FindEntry[local, old];
            WITH e: entry SELECT FROM
                original =>
                    SafeStorageOps.CopyTypesAndLiterals[
                        bcd: local.configTable[e.configID].bcd, mi: e.module, old: old, new: new];
                ENDCASE => ERROR;
            AddCopy[original: old, copy: new];
            Release[loadState: local, commit: TRUE];
            };

        LocalUnNew: UNSAFE PROC [frame: GlobalFrameHandle] = {
            RemoveCopy: PROC [copy: GlobalFrameHandle] = {
                prev: CopiesList _ NIL;
                ct: REF CopyTable = local.copyTable;
                ci: CopyIndex = FindCopyIndex[local, copy];
                IF ci = nullCopyIndex THEN ERROR;
                FOR list: CopiesList _ ct.copies[ci].copies, list.rest UNTIL list = NIL DO
                    IF list.first = copy THEN {
                        IF prev = NIL THEN ct.copies[ci].copies _ list.rest ELSE prev.rest _ list.rest;
                        EXIT
                        };
                    prev _ list;
                    REPEAT
                        FINISHED => ERROR;
                    ENDLOOP;
                IF ct.copies[ci].copies = NIL THEN  -- last copy of parent has been UnNewed
                    SetCopyIndex[local, ct.copies[ci].parent, nullCopyIndex];
                RemoveEntry[local, copy];
                };
            entry: Entry;
            Acquire[local, exclusive];
            entry _ FindEntry[local, frame];
            WITH e: entry SELECT FROM
                original => {Release[loadState: local, commit: FALSE]; ERROR CallerBug};
                copy => {
                    codebase: PrincOps.PrefixHandle = PrincOpsUtils.Codebase[frame];
                    Align: PROC [POINTER, WORD] RETURNS [POINTER] = LOOPHOLE[PrincOpsUtils.BITAND];
                    IF ~frame.alloced THEN ERROR;
                    RemoveGlobalFrame[frame];
                    RemoveCopy[frame];
                    PrincOpsUtils.Free[Align[frame - codebase.header.info.nlinks, 177774B]]
                    };
                ENDCASE => ERROR;
            Release[loadState: local, commit: TRUE];
            };
        <<>>
    <<GFT Maintenance>>
        <<>>
        gftRover: [1..LAST[PrincOps.GFTIndex]+1] _ 1;
            <<for creation of new GFT entries. 0 is reserved, and we must be able to handle gftRover = LAST[PrincOps.GFTIndex]+1!>>

        EnterGlobalFrame: PROC [frame: GlobalFrameHandle, nSlots: [1..PrincOps.MaxNGfi]] = {
            kMax: PrincOps.GFTIndex = PrincOps.SD[PrincOps.sGFTLength] - nSlots;
            start: PrincOps.GFTIndex _ MIN[kMax, gftRover];
            DO
                FOR gfi: PrincOps.GFTIndex IN [start..kMax] DO
                    IF PrincOps.GFT[gfi] = PrincOps.EmptyGFTItem THEN {
                        <<We have one free slot so far, try for more (if needed)>>
                        IF nSlots # 1 THEN
                            FOR k: PrincOps.GFTIndex IN [gfi+1..gfi+nSlots) DO
                                IF PrincOps.GFT[k] # PrincOps.EmptyGFTItem THEN GO TO fail;
                                ENDLOOP;
                        <<We now have enough free slots (starting at gfi)>>
                        frame.gfi _ gfi;
                        FOR epOffset: PrincOps.EPBias IN [0..nSlots) DO
                            PrincOps.GFT[gfi + epOffset].framePtr _ frame;
                            PrincOps.GFT[gfi + epOffset].epbias _ epOffset;
                            ENDLOOP;
                        gftRover _ gfi+nSlots;
                        RETURN;
                        EXITS fail => {};
                        };
                    ENDLOOP;
                IF start = 1 THEN EXIT;
                start _ 1;
                ENDLOOP;
            ERROR LoadStateFull;
            };

        RemoveGlobalFrame: PROC [frame: GlobalFrameHandle] = {
            gfi: PrincOps.GFTIndex = frame.gfi;
            data: [0..37777B] = PrincOps.GFT[gfi].data;
            IF gfi < gftRover THEN gftRover _ gfi;
            FOR k: PrincOps.GFTIndex IN [gfi..PrincOps.SD[PrincOps.sGFTLength]) DO
                IF PrincOps.GFT[k].data # data THEN EXIT;
                PrincOps.GFT[k] _ PrincOps.EmptyGFTItem;
                ENDLOOP;
            };
        <<>>
    <<Debugger LoadState>>
        <<>>
        debuggerLoadState: BasicLoadStateFormat.LoadState;

        InitializeLoadState: PROC = {
            debuggerLSInterval: VM.Interval;
            InitializeDebuggerLoadstate: PROC = {
                maxConfigs: NAT = BasicLoadStateFormat.ConfigIndex.LAST;
                debuggerLSInterval _ VM.SimpleAllocate[
                    count: VM.PagesForWords[SIZE[BasicLoadStateFormat.LoadStateObject[maxConfigs]]]];
                debuggerLoadState _ VM.AddressForPageNumber[debuggerLSInterval.page];
                [] _ PrincOpsUtils.LongZero[debuggerLoadState, VM.WordsForPages[debuggerLSInterval.count]];
                debuggerLoadState.versionident _ BasicLoadStateFormat.versionID;
                FOR gfi: PrincOps.GFTIndex IN PrincOps.GFTIndex DO
                    debuggerLoadState.gft[gfi] _ BasicLoadStateFormat.nullModule;
                    ENDLOOP;
                LOOPHOLE[@debuggerLoadState.bcds, LONG POINTER TO CARDINAL]^ _ maxConfigs;
                };
            nConfigs: ConfigID _ 0;
            CountConfigs: PROC [bc: BasicLoadState.ConfigID] RETURNS [BOOL _ FALSE] = {
                nConfigs _ nConfigs.SUCC;
                };
            DoOneConfig: PROC [bc: BasicLoadState.ConfigID] RETURNS [BOOL _ FALSE] = {
                configID: ConfigID = NewConfig[local, BasicLoadState.ConfigInfo[bc].bcd, NIL];
                c: Config = local.configTable.configs[configID];
                mtb: BcdDefs.Base = LOOPHOLE[c.bcd + c.bcd.mtOffset];
                DoOneModule: PROC [bm: BasicLoadState.ModuleIndex]
                    RETURNS [BOOL _ FALSE] = {
                    gfh: GlobalFrameHandle = BasicLoadState.ModuleToGlobalFrame[bc, bm];
                    IF c.modules[bm].gfh ~= NIL OR c.modules[bm].mti = BcdDefs.MTNull THEN ERROR;
                    FOR i: NAT IN [0..mtb[c.modules[bm].mti].ngfi) DO
                        c.modules[bm+i].gfh _ gfh;
                        ENDLOOP;
                    AddEntry[
                        local, gfh, [original[copyIndex: nullCopyIndex, configID: configID, module: bm]]];
                    SetType[local, gfh, LOOPHOLE[BasicLoadState.GlobalFrameToType[gfh]]];
                    };
                [] _ BasicLoadState.EnumerateModulesInConfig[bc, DoOneModule];
                <<The configuration will be entered in the debugger loadstate at commit time.>>
                };
            InitializeDebuggerLoadstate[];
            [] _ BasicLoadState.EnumerateConfigs[CountConfigs];
            local _ NEW[Object _ [
                useCount: 0,
                configTable: NEW[ConfigTable[MIN[MAX[3*nConfigs/2, 2], ConfigID.LAST]]],
                copyTable: NEW[CopyTable[5]],
                collisionTable: NEW[CollisionTable[10]],
                gfht: ALL[[empty[]]]
                ]];
            local.configTable.nConfigs _ local.collisionTable.nCollisions _ 0;
            local.copyTable.nCopies _ 1;  -- because slot 0 isn't used
            Acquire[local, exclusive];
            [] _ BasicLoadState.EnumerateConfigs[DoOneConfig];
            Release[loadState: local, commit: TRUE];  -- enters all configurations in the debugger loadstate
            DebuggerSwap.NoteLoadstate[debuggerLSInterval.page];
            DebuggerSwap.NoteRealLoadState[LOOPHOLE[local, LONG POINTER]];
            BasicLoadState.Destroy[];
            };

        UpdateDebuggerLoadState: PROC [configID: ConfigID] = {
            bcd: BcdBase = ConfigInfo[local, configID].bcd;
            mtb: BcdDefs.Base = LOOPHOLE[bcd + bcd.mtOffset];
            DoOneModule: PROC [module: ModuleIndex] RETURNS [BOOL _ FALSE] = {
                gfh: GlobalFrameHandle;
                mti: BcdDefs.MTIndex;
                [gfh: gfh, mti: mti] _ ModuleInfo[local, configID, module];
                FOR i: NAT IN [0..mtb[mti].ngfi) DO
                    debuggerLoadState.gft[gfh.gfi+i] _ [resolved: FALSE, config: configID, module: module];
                    ENDLOOP;
                };
            IF configID ~= debuggerLoadState.nBcds THEN ERROR;
            debuggerLoadState.bcds[configID] _ [ptr[bcd]];
            debuggerLoadState.nBcds _ debuggerLoadState.nBcds.SUCC;
            [] _ EnumerateModulesInConfig[local, configID, DoOneModule];
            };

    <<Initialization>>

        InitializeLoadState[];
        PrincOps.SD[PrincOps.sCopy] _ LOOPHOLE[LocalCopyNew];

    END.