<<>>
<<FileParmsImpl.mesa>>
    <<Copyright Ó 1985, 1986, 1987, 1988, 1991 by Xerox Corporation.  All rights reserved.>>
    <<Satterthwaite, June 3, 1986 11:13:40 am PDT>>
    <<Russ Atkinson (RRA) June 21, 1989 11:45:33 am PDT>>
    <<JKF August 16, 1988 10:37:20 am PDT>>
    <<Willie-s, September 24, 1991 1:37 pm PDT>>

        DIRECTORY
            ConvertUnsafe USING [EqualSubStrings, SubString],
            FileParmOps USING [],
            FileParms USING [AcquireOp, ActualId, BindingOp, BindingProc, ForgetOp, Name, nullActual, Ops, ReleaseOp, SymbolSpaceRep],
            FileParmsPrivate USING [FileRecord, SymbolSpaceRep],
            Host: TYPE MachineParms USING [bitsPerAU, bitsPerChar],
            MimCommandUtil USING [KeyValue, PairList],
            MimSysOps USING [Map, MapBase, MapLength, MappedFile, UnMap],
            MimZones USING [permZone, RegisterForReset, tempZone],
            MobDefs USING [Base, FTSelf, Mob, MobBase, MobOffset, MTIndex, MTRecord, NameRecord, NameString, NullVersion, SGIndex, SGNull, 
            VersionStamp],
            MobMapper USING [AlterMob],
            Rope USING [Concat, Equal, Find, Flatten, Length, ROPE],
            Symbols USING [HTIndex, MDFirst, MDIndex],
            SymbolSegment USING [Base, biases, bodyType, ctxType, ExtFirst, extType, FGHeader, htType, ltType, mdType, seType, ssType, 
            STHeader, stType, treeType],
            SymbolTable USING [Handle],
            SymbolTablePrivate USING [SymbolTableBaseRep];
FileParmsImpl: MONITOR
    IMPORTS ConvertUnsafe, MimCommandUtil, MimSysOps, MimZones, MobMapper, Rope
    EXPORTS FileParms, FileParmOps, SymbolTable = {

    ROPE: TYPE = Rope.ROPE;

    MappedFile: TYPE = MimSysOps.MappedFile;

    Name: TYPE = FileParms.Name;
    ActualId: TYPE = FileParms.ActualId;
    BindingProc: TYPE = FileParms.BindingProc;
    nullActual: ActualId = FileParms.nullActual;
    VersionStamp: TYPE = MobDefs.VersionStamp;

    SymbolSpace: TYPE = REF SymbolSpaceRep;
    SymbolSpaceRep: PUBLIC TYPE = FileParmsPrivate.SymbolSpaceRep;
        <<Exported to FileParms>>

    FileIndex: TYPE = NAT;
    nullFileIndex: FileIndex = FileIndex.LAST;

    bytesPerUnit: NAT = Host.bitsPerAU / Host.bitsPerChar;

    <<primary operations for read-only access>>

        BindingOpImpl: FileParms.BindingOp = {
            i: FileIndex Ź nullFileIndex;
            name: ROPE Ź FileName[formalId, defaultLocator];
            IF name # NIL THEN {
                file: MappedFile Ź NIL;
                version: MobDefs.VersionStamp;
                start: INT;
                length: INT;
                FOR i IN [0 .. nextFile) DO
                    space: SymbolSpace Ź fileTable[i].space;
                    IF space # NIL AND Rope.Equal[name, fileTable[i].name, FALSE] THEN
                        IF Rope.Equal[formalType, fileTable[i].type, FALSE] THEN GO TO found;
                    ENDLOOP;
                file Ź MimSysOps.Map[name].mf;
                    <<Mapping will result in the same file if already mapped.  Usage counts are maintaed via MimSysOps, so play the game straight.>>
                IF file = NIL THEN GO TO empty;
                    <<If not found, then not mapped, so flake out now.>>
                [version, start, length] Ź ReadHeader[file, formalType];
                IF version = nullActual.version THEN {
                    <<The file has been mapped, but it does not have a valid version.>>
                    MimSysOps.UnMap[file];
                    GO TO empty;
                    };
                i Ź SearchCache[version];
                    <<Now that we have the version, check it against the cache.>>
                IF i = nullFileIndex OR NOT Rope.Equal[formalId, fileTable[i].formal] THEN {
                    <<This is really a new version (or at least a new formal name), so it needs to stay mapped.>>
                    space: SymbolSpace Ź NEW[SymbolSpaceRep Ź [
                        file: file, start: start, length: length]];
                    i Ź NewCacheEntry[version: version, space: space, name: name, formal: formalId, type: formalType];
                    GO TO found;
                    };
                <<This is an old version, already in the cache, so unmap the new file to keep the usage counts OK.>>
                MimSysOps.UnMap[file];
                GO TO found;
                EXITS
                    found => {binder[[fileTable[i].version, fileTable[i].name]]; RETURN};
                    empty => {};
                };
            binder[nullActual];
            };

        AcquireOpImpl: FileParms.AcquireOp = {
            i: FileIndex Ź SearchCache[actual.version];
            space: SymbolSpace Ź NIL;
            IF i = nullFileIndex THEN
                i Ź NewCacheEntry[version: actual.version, space: NIL, name: actual.locator, formal: actual.locator, type: name];
            space Ź fileTable[i].space;
            IF space = NIL THEN {
                file: MappedFile Ź MimSysOps.Map[fileTable[i].name].mf;
                IF file # NIL THEN {
                    version: MobDefs.VersionStamp;
                    start: INT;
                    length: INT;
                    [version, start, length] Ź ReadHeader[file, fileTable[i].type];
                    IF version # fileTable[i].version
                        THEN ClearCacheEntry[i]
                        ELSE
                            space Ź fileTable[i].space Ź NEW[SymbolSpaceRep Ź [
                                file: file, start: start, length: length]];
                    };
                };
            RETURN [space];
            };

        ReleaseOpImpl: FileParms.ReleaseOp = {
            NULL;    -- ref counts?
            };

        ForgetOpImpl: FileParms.ForgetOp = {
            i: NAT Ź 0;
            WHILE i < nextFile DO
                name: ROPE Ź fileTable[i].name;
                IF fileTable[i].version = actual.version OR
                (name # NIL AND Rope.Equal[name, actual.locator, FALSE]) THEN {
                    ClearCacheEntry[i];
                    nextFile Ź nextFile - 1;
                    IF i = nextFile THEN EXIT;
                    fileTable[i] Ź fileTable[nextFile];
                    fileTable[nextFile] Ź [];
                    LOOP;
                    };
                i Ź i + 1;
                ENDLOOP;
            };

    <<command line arguments>>

        aList: MimCommandUtil.PairList;

        SetAList: PUBLIC PROC [map: MimCommandUtil.PairList] = {aList Ź map};

        ClearAList: PUBLIC PROC = {aList Ź NIL};

    <<initialization/finalization>>

        Initialize: PUBLIC PROC RETURNS [FileParms.Ops] = {
            Finalize[];
            AdjustFileTable[16];
            nextFile Ź 0;
            RETURN [[BindingOpImpl, AcquireOpImpl, ReleaseOpImpl, ForgetOpImpl]];
            };

        Finalize: PUBLIC PROC = {
            IF fileTable # NIL THEN {
                FOR i: NAT IN [0..nextFile) DO ClearCacheEntry[i] ENDLOOP;
                MimZones.tempZone.FREE[@fileTable];
                };
            Cleanup[];
            };

    <<interpretation of file names (Pilot PreCascade conventions)>>

        FileName: PROC [key: Name, default: Name] RETURNS [ROPE] = {
            t: ROPE Ź MimCommandUtil.KeyValue[key, aList];
            IF t = NIL THEN t Ź default;
            IF t = NIL THEN t Ź key;
            RETURN [NormalizeFileName[t]];
            };

        NormalizeFileName: PROC [formal: Name] RETURNS [s: ROPE Ź NIL] = INLINE {
            IF NOT Rope.Equal[formal, "$"] THEN {
                dotIndex: INT Ź Rope.Find[formal, "."];
                s Ź IF dotIndex < 0 THEN Rope.Concat[formal, ".mob"] ELSE formal;
                };
            };

    <<low-level file manipulation and cache management>>

        FileRecord: TYPE = FileParmsPrivate.FileRecord;
        FileTable: TYPE = RECORD [
            SEQUENCE length: FileIndex OF FileRecord
            ];

        fileTable: REF FileTable Ź NIL;
        nextFile: NAT Ź 0;

    <<file table management>>

        SearchCache: PROC [version: MobDefs.VersionStamp] RETURNS [FileIndex] = {
            FOR i: FileIndex IN [0 .. nextFile) DO
                IF fileTable[i].version = version THEN RETURN [i];
                ENDLOOP;
            RETURN [nullFileIndex];
            };

        NewCacheEntry: PROC
        [version: VersionStamp, space: SymbolSpace, name: Name, formal: Name, type: Name]
        RETURNS [i: FileIndex] = {
            WHILE nextFile >= fileTable.length DO AdjustFileTable[fileTable.length + 16] ENDLOOP;
            i Ź nextFile;
            fileTable[i] Ź [version: version, space: space, name: name, formal: formal, type: type];
            nextFile Ź nextFile + 1;
            };

        AdjustFileTable: PROC [newSize: NAT] = {
            newTable: REF FileTable Ź NIL;
            oldSize: NAT = IF fileTable = NIL THEN 0 ELSE fileTable.length;
            IF newSize = 0
                THEN newTable Ź NIL
                ELSE {
                    i: FileIndex;
                    newTable Ź MimZones.tempZone.NEW[FileTable[newSize]];
                    FOR i IN [0..MIN[oldSize, newSize]) DO newTable[i] Ź fileTable[i] ENDLOOP;
                    FOR i IN [oldSize..newSize) DO newTable[i] Ź [version: nullActual.version] ENDLOOP;
                    };
            MimZones.tempZone.FREE[@fileTable];
            fileTable Ź newTable;
            };

        ClearCacheEntry: PROC [i: FileIndex] = {
            space: SymbolSpace Ź fileTable[i].space;
            fileTable[i] Ź [];
            IF space # NIL THEN {
                file: MappedFile = space.file;
                IF file # NIL THEN MimSysOps.UnMap[file];
                };
            };

    <<file setup>>

        ReadHeader: PROC [file: MappedFile, formalId: Name]
        RETURNS [version: MobDefs.VersionStamp, start: INT, length: INT] = {
            IF file # NIL THEN {
                MakeBase: PROC [p: LONG POINTER, units: INT] RETURNS [MobDefs.Base] = INLINE {
                    RETURN [LOOPHOLE[p+units, MobDefs.Base]];
                    };
                mob: MobDefs.MobBase = LOOPHOLE[MimSysOps.MapBase[file]];
                IF mob # NIL AND mob.nConfigs = 0 THEN {
                    limit: CARD = MimSysOps.MapLength[file] / BYTES[UNIT];
                    IF MobMapper.AlterMob[mob, LOOPHOLE[mob], limit] # badVersion THEN {
                        nString: MobDefs.NameString Ź LOOPHOLE[mob + mob.ssOffset.units];
                        d: ConvertUnsafe.SubString Ź [base: LOOPHOLE[nString], offset: 0, length: 0];
                        typeId: ConvertUnsafe.SubString Ź [
                            base: LOOPHOLE[formalId Ź Rope.Flatten[formalId]],
                            offset: 0,
                            length: Rope.Length[formalId]];
                        ftb: MobDefs.Base Ź MakeBase[mob, mob.ftOffset.units];
                        mtb: MobDefs.Base Ź MakeBase[mob, mob.mtOffset.units];
                        sgb: MobDefs.Base Ź MakeBase[mob, mob.sgOffset.units];
                        mti: MobDefs.MTIndex Ź MobDefs.MTIndex.FIRST;
                        sSeg: MobDefs.SGIndex;
                        UNTIL mti = mob.mtLimit DO
                            name: MobDefs.NameRecord Ź mtb[mti].name;
                            d.length Ź nString[name].ORD;
                            d.offset Ź name+1;
                            IF ConvertUnsafe.EqualSubStrings[typeId, d] THEN EXIT;
                            mti Ź mti + MobDefs.MTRecord.SIZE;
                            REPEAT
                                FINISHED =>
                                    IF mob.nModules = 1 THEN
                                        mti Ź MobDefs.MTIndex.FIRST ELSE GO TO badFile;
                            ENDLOOP;
                        version Ź IF mtb[mti].file = MobDefs.FTSelf
                            THEN mob.version
                            ELSE ftb[mtb[mti].file].version;
                        sSeg Ź mtb[mti].sseg;
                        IF sSeg = MobDefs.SGNull OR sgb[sSeg].units.units = 0 THEN GO TO badFile;
                        start Ź LOOPHOLE[sgb[sSeg].base];
                        length Ź LOOPHOLE[sgb[sSeg].units];
                        RETURN;
                        };
                    };
                EXITS badFile => {}
                };
            version Ź MobDefs.NullVersion;
            start Ź 0;
            length Ź 0;
            };

<<Stuff formerly in SymbolCacheImpl>>
    STB: TYPE = REF SymbolTableBaseRep;
    SymbolTableBaseRep: PUBLIC TYPE = SymbolTablePrivate.SymbolTableBaseRep;

    <<public interface>>

        Handle: TYPE = SymbolTable.Handle;

        STBMissing: PUBLIC ERROR [Handle] = CODE;
        IllegalSTB: PUBLIC ERROR [base: STB] = CODE;

        Cleanup: PUBLIC ENTRY PROC = {
            ENABLE UNWIND => NULL;
            WHILE header # NIL DO
                node: CachePointer Ź header;
                header Ź node.next;
                ReleaseCacheEntry[node];
                ENDLOOP;
            WHILE free # NIL DO
                node: CachePointer Ź free;
                free Ź free.next;
                ReleaseCacheEntry[node];
                ENDLOOP;
            };

        AcquireSTB: PUBLIC ENTRY PROC [handle: Handle] RETURNS [base: STB] = {
            ENABLE UNWIND => NULL;
            node: CachePointer Ź MakeCacheEntry[handle];
            IF freeTables = NIL
                THEN {base Ź MimZones.permZone.NEW[SymbolTableBaseRep]; Bump[@stats.nNew]}
                ELSE {base Ź freeTables; freeTables Ź freeTables.link};
            base.link Ź busyTables;
            busyTables Ź base;
            InstallTable[base, node];
            Bump[@stats.nAcquire];
            };

        ReleaseSTB: PUBLIC ENTRY PROC [base: STB] = {
            ENABLE UNWIND => {NULL};
            cacheNode: CachePointer = LOOPHOLE[base.cacheInfo];
            FOR node: CachePointer Ź header, node.next UNTIL node = NIL DO
                IF node = cacheNode THEN {
                    prev: STB Ź NIL;
                    FOR table: STB Ź busyTables, table.link UNTIL table = NIL DO
                        IF table = base THEN {
                            IF prev # NIL THEN prev.link Ź table.link ELSE busyTables Ź table.link;
                            FreeCacheEntry[node];
                            base.link Ź freeTables;
                            freeTables Ź base;
                            Bump[@stats.nRelease];
                            RETURN;
                            };
                        prev Ź table;
                        ENDLOOP;
                    RETURN WITH ERROR IllegalSTB[base];
                    };
                ENDLOOP;
            RETURN WITH ERROR IllegalSTB[base];
            };

        LockedSTB: PUBLIC ERROR [handle: SymbolTable.Handle, nLocks: NAT] = CODE;

        ForgetSTB: PUBLIC ENTRY PROC [handle: SymbolTable.Handle] = {
            ENABLE UNWIND => {NULL};
            space: SymbolSpace Ź NARROW[handle.space];
            nLocks: INT Ź 0;
            prev: CachePointer Ź NIL;
            node: CachePointer Ź header;
            WHILE node # NIL DO
                next: CachePointer Ź node.next;
                IF space = node.space THEN {
                    IF node.refCount # 0
                        THEN nLocks Ź nLocks + node.refCount
                        ELSE {
                            IF prev = NIL THEN header Ź next ELSE prev.next Ź header;
                            ReleaseCacheEntry[node];
                            node Ź prev;
                            };
                    };
                prev Ź node;
                node Ź next;
                ENDLOOP;
            node Ź free;
            prev Ź NIL;
            WHILE node # NIL DO
                next: CachePointer Ź node.next;
                IF space = node.space THEN {
                    IF node.refCount # 0
                        THEN nLocks Ź nLocks + node.refCount
                        ELSE {
                            IF prev = NIL THEN free Ź next ELSE prev.next Ź free;
                            ReleaseCacheEntry[node];
                            node Ź prev;
                            };
                    };
                prev Ź node;
                node Ź next;
                ENDLOOP;
            IF nLocks # 0 THEN RETURN WITH ERROR LockedSTB[handle, nLocks];
            };

        STBToHandle: PUBLIC ENTRY PROC
        [base: STB] RETURNS [SymbolTable.Handle] = {
            ENABLE UNWIND => NULL;
            cacheNode: CachePointer = LOOPHOLE[base.cacheInfo];
            RETURN [[cacheNode.space, FALSE]];
            };

        busyTables: STB Ź NIL;
        freeTables: STB Ź NIL;

        cachePageLimit: INT Ź 0;  -- number of pages for symbol tables

        STBCacheSize: PUBLIC PROC RETURNS [pages: CARDINAL] = {
            RETURN [cachePageLimit];
            };

        SetSTBCacheSize: PUBLIC ENTRY PROC [pages: CARDINAL] = {
            ENABLE UNWIND => NULL;
            cachePageLimit Ź pages;
            };

    <<statistics>>

        takingStatistics: BOOL = TRUE;
        Count: TYPE = INT Ź 0;
        stats: RECORD [nAcquire, nNew, nRelease: Count] Ź [];

        Bump: PROC [p: POINTER TO Count, delta: Count Ź 1] = INLINE {
            IF takingStatistics THEN p­ Ź p­ + delta;
            };

    <<internal cache management>>

        CacheNode: TYPE = RECORD [
            next: CachePointer Ź NIL,
            space: SymbolSpace Ź NIL,
            refCount: INT Ź 0,
            nUses: INT Ź 0];

        CachePointer: TYPE = REF CacheNode;

        header: CachePointer Ź NIL;
        free: CachePointer Ź NIL;
        unused: CachePointer Ź NIL;
        nNodes: NAT Ź 0;
        mappedPages: INT Ź 0;

    <<Cache Organization>>

        <<There are three lists:>>
            <<header => cache nodes that are being used>>
            <<free => cache nodes with spaces but not in use>>
            <<unused => cache nodes without spaces>>
            <<>>
        MakeCacheEntry: INTERNAL PROC [handle: Handle]
        RETURNS [node: CachePointer Ź NIL] = {
            space: SymbolSpace Ź NARROW[handle.space];
            prev: CachePointer Ź NIL;
            node Ź header;
            <<Try to find a busy cache node with the proper file and span.>>
            WHILE node # NIL DO
                next: CachePointer Ź node.next;
                IF node.space = space THEN GO TO found;
                node Ź next;
                ENDLOOP;
            <<Try to find a free cache node with the proper file and span.>>
            node Ź free;
            WHILE node # NIL DO
                next: CachePointer Ź node.next;
                IF node.space = space THEN {
                    IF prev = NIL THEN free Ź next ELSE prev.next Ź NIL;
                    GO TO first;
                    };
                prev Ź node;
                node Ź next;
                ENDLOOP;
            <<At this point there is no free cache node with the proper file and span.>>
            node Ź GetEmptyNode[];
            node.space Ź space;
            GO TO first;
            EXITS
                first => {
                    node.next Ź header;
                    header Ź node;
                    node.refCount Ź 1;
                    node.nUses Ź node.nUses + 1;
                    };
                found => {
                    node.refCount Ź node.refCount+1;
                    node.nUses Ź node.nUses + 1;
                    };
            };

        FreeCacheEntry: INTERNAL PROC [node: CachePointer] = {
            IF (node.refCount Ź node.refCount-1) = 0 THEN {
                each: CachePointer Ź header;
                lag: CachePointer Ź NIL;
                WHILE each # NIL DO
                    next: CachePointer Ź each.next;
                    IF each = node THEN {
                        IF lag = NIL THEN header Ź next ELSE lag.next Ź next;
                        node.next Ź free;
                        free Ź node;
                        RETURN;
                        };
                    lag Ź each;
                    each Ź next;
                    ENDLOOP;
                ERROR;
                };
            };

        ReleaseCacheEntry: INTERNAL PROC [node: CachePointer] = {
            space: SymbolSpace Ź node.space;
            IF space # NIL THEN node.space Ź NIL;
            node.refCount Ź node.nUses Ź 0;
            node.next Ź unused;
            unused Ź node;
            };

        GetEmptyNode: INTERNAL PROC RETURNS [node: CachePointer] = {
            IF unused = NIL
                THEN {node Ź MimZones.permZone.NEW[CacheNode]; nNodes Ź nNodes + 1}
                ELSE {node Ź unused; unused Ź unused.next};
            node.refCount Ź node.nUses Ź 0;
            node.next Ź NIL;
            };

    <<symbol table setup>>

        InstallTable: INTERNAL PROC [base: STB, node: CachePointer] = {
            b: LONG POINTER = MimSysOps.MapBase[node.space.file]+node.space.start;
            tB: SymbolSegment.Base = LOOPHOLE[b];
            p: LONG POINTER TO SymbolSegment.STHeader = b;
            base.cacheInfo Ź LOOPHOLE[node];
            base.hashVec Ź b+p.hvBlock.offset;
            base.htb Ź tB + p.htBlock.offset - SymbolSegment.biases[SymbolSegment.htType];
            base.ssb Ź b + p.ssBlock.offset - SymbolSegment.biases[SymbolSegment.ssType];
            base.seb Ź tB + p.seBlock.offset - SymbolSegment.biases[SymbolSegment.seType];
            base.ctxb Ź tB + p.ctxBlock.offset - SymbolSegment.biases[SymbolSegment.ctxType];
            base.mdb Ź tB + p.mdBlock.offset - SymbolSegment.biases[SymbolSegment.mdType];
            base.bb Ź tB + p.bodyBlock.offset - SymbolSegment.biases[SymbolSegment.bodyType];
            base.tb Ź tB + p.treeBlock.offset - SymbolSegment.biases[SymbolSegment.treeType];
            base.ltb Ź tB + p.litBlock.offset - SymbolSegment.biases[SymbolSegment.ltType];
            base.stb Ź tB + p.sLitBlock.offset - SymbolSegment.biases[SymbolSegment.stType];
            base.extb Ź tB + p.extBlock.offset - SymbolSegment.biases[SymbolSegment.extType];
            base.mdLimit Ź Symbols.MDFirst + p.mdBlock.size;
            base.extLimit Ź SymbolSegment.ExtFirst + p.extBlock.size;
            base.mainCtx Ź p.outerCtx;
            base.stHandle Ź p;
            IF p.fgRelBase = 0 OR p.fgCount = 0
                THEN {
                    base.sourceFile Ź NIL;
                    base.fgTable Ź NIL;
                    }
                ELSE {
                    q: LONG POINTER TO SymbolSegment.FGHeader = LOOPHOLE[b + p.fgRelBase];
                    source: LONG STRING = LOOPHOLE[q + SIZE[SymbolSegment.FGHeader[0]]
                    - SIZE[StringBody[0]]];
                    base.sourceFile Ź source;
                    base.fgTable Ź DESCRIPTOR[q + q.offset, q.length];
                    };
            };

        bytesPerAU: NAT = BYTES[UNIT];
    <<>>
    MimZones.RegisterForReset[Finalize];
}.