<<>>
    <<LiteralOpsImpl.mesa>>
        <<Copyright Ó 1985, 1986, 1988, 1991 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, June 19, 1986 9:45:28 am PDT>>
        <<Russ Atkinson (RRA) June 21, 1989 11:50:46 am PDT>>
        <<JKF August 16, 1988 12:44:27 pm PDT>>
        <<Willie-s, September 24, 1991 1:45 pm PDT>>
        <<>>
        DIRECTORY
            Alloc USING [AddNotify, Bounds, DropNotify, Failure, Handle, Notifier, OrderedIndex, Top, Units],
            Basics USING [HighHalf, LowHalf],
            ConvertUnsafe USING [EqualSubStrings, SubString],
            Host: TYPE MachineParms USING [bitsPerLongWord],
            LiteralOps USING [],
            Literals,
            MimZonePort,
            MimZones USING [RegisterForReset, permZone, tempUZ],
            SymbolOps USING [DecodeCard],
            Symbols USING [Type, UNSPEC],
            Target: TYPE MachineParms USING [bitsPerByte, bitsPerLongWord];
LiteralOpsImpl: PROGRAM
    IMPORTS Alloc, Basics, ConvertUnsafe, MimZonePort, MimZones, SymbolOps
    EXPORTS LiteralOps = {
    OPEN Literals, Target;

    UNSPEC: TYPE = Symbols.UNSPEC;

    table: Alloc.Handle Ź NIL;

    ltb: Literals.Base Ź NIL;    -- literal table base
    stb: Literals.Base Ź NIL;    -- string table base

    UpdateBases: Alloc.Notifier = {
        <<called whenever the main symbol table is repacked>>
        ltb Ź base[ltType];
        stb Ź base[stType];
        };

    ltbZoneScratch: MimZonePort.Scratch;
    ltbZone: UNCOUNTED ZONE Ź MimZonePort.MakeZone[
    alloc: LtbZoneProc, free: NIL, scratch: @ltbZoneScratch];
    LtbZoneProc: PROC
    [self: UNCOUNTED ZONE, size: CARDINAL] RETURNS [ptr: LONG POINTER] = {
        index: Alloc.OrderedIndex = table.Units[ltType, size];
        IF index > ltMax THEN ERROR table.Failure[ltType];
        ptr Ź @ltb[index];
        };
    LTBRelative: PROC [ptr: LONG POINTER TO LTRecord] RETURNS [LTIndex] = INLINE {
        RETURN [LOOPHOLE[ptr-LOOPHOLE[ltb, LONG POINTER TO LTRecord]]];
        };

    stbZoneScratch: MimZonePort.Scratch;
    stbZone: UNCOUNTED ZONE Ź MimZonePort.MakeZone[
    alloc: StbZoneProc, free: NIL, scratch: @stbZoneScratch];
    StbZoneProc: PROC
    [self: UNCOUNTED ZONE, size: CARDINAL] RETURNS [ptr: LONG POINTER] = {
        index: Alloc.OrderedIndex = table.Units[stType, size];
        IF index > stMax THEN ERROR table.Failure[stType];
        stLimit Ź stLimit + size;
        ptr Ź @stb[index];
        };
    STBRelative: PROC [ptr: LONG POINTER TO STRecord] RETURNS [STIndex] = INLINE {
        RETURN [LOOPHOLE[ptr-LOOPHOLE[stb, LONG POINTER TO STRecord]]];
        };

    RoundUpBytes: PROC [bytes: CARDINAL] RETURNS [CARDINAL] = INLINE {
        bytesPerLongWord: CARDINAL = bitsPerLongWord/bitsPerByte;
        mod: CARDINAL = bytes MOD bytesPerLongWord;
        IF mod # 0 THEN bytes Ź bytes + (bytesPerLongWord-mod);
        RETURN [bytes];
        };

    ltMax: Alloc.OrderedIndex = LOOPHOLE[LTLast];
    stMax: Alloc.OrderedIndex = LOOPHOLE[STLast];
    bitsPerHostUnspec: NAT = BITS[UNSPEC];
        checkThisOut: [Host.bitsPerLongWord..Host.bitsPerLongWord] = bitsPerHostUnspec;
    bytesPerLongWord: NAT = Target.bitsPerLongWord/Target.bitsPerByte;

    initialized: BOOL Ź FALSE;

    Initialize: PUBLIC PROC [ownTable: Alloc.Handle] = { 
        <<called to set up the compiler's literal table >>
        IF initialized THEN Finalize[];
        table Ź ownTable;
        table.AddNotify[UpdateBases];
        [] Ź ForgetEntries[];
        stLimit Ź localStart Ź STFirst;
        locals Ź markBit Ź FALSE;
        initialized Ź TRUE;
        };

    Finalize: PUBLIC PROC = {
        IF table # NIL THEN {table.DropNotify[UpdateBases]; table Ź NIL};
        initialized Ź FALSE;
        };

    ClassError: PUBLIC ERROR = CODE;

    <<literal table management>>

        litHVLength: INTEGER = 53;
        LitHVIndex: TYPE = [0..litHVLength);

        hashVec: REF ARRAY LitHVIndex OF LTIndex
        Ź MimZones.permZone.NEW[ARRAY LitHVIndex OF LTIndex];

        IsShort: PUBLIC PROC [lti: LTIndex] RETURNS [BOOL] = {
            WITH entry: ltb[lti] SELECT FROM
                short => RETURN [TRUE];
                ENDCASE => RETURN [FALSE];
            };

        Find: PUBLIC PROC [class: LitClass, val: UNSPEC] RETURNS [lti: LTIndex] = {
            hvi: LitHVIndex = Basics.LowHalf[SymbolOps.DecodeCard[val]] MOD litHVLength;
            FOR lti Ź hashVec[hvi], ltb[lti].link UNTIL lti = LTNull DO
                WITH entry: ltb[lti] SELECT FROM
                    short => IF entry.value = val AND entry.class = class THEN RETURN [lti];
                    ENDCASE;
                ENDLOOP;
            hashVec[hvi] Ź lti Ź LTBRelative[ltbZone.NEW[LTRecord.short
            Ź [link: hashVec[hvi], class: class, datum: short[value: val]]]];
            };

        FindMultiWord: PROC [baseP: Literals.Finger, desc: LitDescriptor] RETURNS [lti: LTIndex] = {
            bits: INT = desc.bits;
            words: NAT = (bits + bitsPerHostUnspec - 1) / bitsPerHostUnspec;
                <<Don't trust the # of words coming in.>>
            v: CARD Ź bits;
            hvi: LitHVIndex;
            FOR i: CARDINAL IN [0..words) DO
                <<Try to get a good hash value>>
                v Ź v + Basics.HighHalf[v] + i + SymbolOps.DecodeCard[baseP­[desc.offset][i]];
                ENDLOOP;
            hvi Ź Basics.LowHalf[v] MOD litHVLength;
            FOR lti Ź hashVec[hvi], ltb[lti].link UNTIL lti = LTNull DO
                WITH entry: ltb[lti] SELECT FROM
                    long =>
                        IF bits = entry.bits THEN
                            FOR i: CARDINAL IN [0 .. words) DO
                                IF entry.value[i] # baseP­[desc.offset][i] THEN EXIT;
                                REPEAT
                                    FINISHED => GO TO found;
                                ENDLOOP;
                    ENDCASE;
                REPEAT
                    found => NULL;
                    FINISHED => {
                        ptr: LONG POINTER TO LTRecord.long Ź ltbZone.NEW[LTRecord.long[words]];
                        ptr.link Ź hashVec[hvi];
                        ptr.bits Ź bits;
                        ptr.class Ź desc.class;
                        hashVec[hvi] Ź lti Ź LTBRelative[ptr];
                        FOR i: CARDINAL IN [0 .. words) DO
                            ptr[i] Ź baseP­[desc.offset][i];
                            ENDLOOP;
                        };
                ENDLOOP;
            RETURN [lti];
            };

        Value: PUBLIC PROC [lti: LTIndex] RETURNS [class: LitClass, val: UNSPEC] = {
            WITH entry: ltb[lti] SELECT FROM
                short => RETURN [entry.class, entry.value];
                ENDCASE;
            ERROR;
            };

        FindDescriptor: PUBLIC PROC [bits: INT, ptr: WordSequencePtr] RETURNS [LTIndex] = {
            desc: LitDescriptor Ź [bits: bits, class: bits, words: 0, offset: LOOPHOLE[(0).LONG]];
            base: Literals.Base Ź LOOPHOLE[ptr];
            RETURN [FindMultiWord[@base, desc]];
            };

        deltaShort: CARDINAL = LTRecord.short.SIZE - Symbols.UNSPEC.SIZE;
        deltaLong: CARDINAL = SIZE[LTRecord.long[0]];

        DescriptorValue: PUBLIC PROC [lti: LTIndex] RETURNS [LitDescriptor] = {
            WITH entry: ltb[lti] SELECT FROM
                short => RETURN [[class: entry.class, offset: LOOPHOLE[lti + deltaShort],
                bits: bitsPerHostUnspec, words: 1]];
                long => RETURN [[class: entry.class, offset: LOOPHOLE[lti + deltaLong],
                bits: entry.bits, words: entry.max]];
                ENDCASE => ERROR;
            };

        CopyLiteral: PUBLIC PROC [literal: LTId] RETURNS [lti: LTIndex] = {
            desc: LitDescriptor;
            WITH entry: literal.baseP­[literal.index] SELECT FROM
                short => lti Ź Find[entry.class, entry.value];
                long => {
                    desc Ź [class: bits, offset: LOOPHOLE[literal.index + deltaLong],
                    bits: entry.bits, words: 0];
                    lti Ź FindMultiWord[literal.baseP, desc];
                    };
                ENDCASE => ERROR;
            };

        ForgetEntries: PUBLIC PROC RETURNS [ltBias: CARD, stBias: CARD] = {
            hashVec­ Ź ALL[LTNull];
            sHashVec­ Ź ALL[MSTNull];
            RETURN [table.Bounds[ltType].size, table.Bounds[stType].size];
            };

    <<string literal table management>>

        MSTNull: MSTIndex = LOOPHOLE[STNull];
        SLitHVLength: INTEGER = 23;
        SLitHVIndex: TYPE = [0..SLitHVLength);

        sHashVec: REF ARRAY SLitHVIndex OF MSTIndex
        Ź MimZones.permZone.NEW[ARRAY SLitHVIndex OF MSTIndex];

        stLimit: STIndex Ź STNull;
        localStart: STIndex Ź STNull;
        locals: BOOL Ź FALSE;
        markBit: BOOL Ź FALSE;

        sizeSTPrefix: NAT = STRecord.master.SIZE - StringBody[0].SIZE;

        CopyStringLiteral: PUBLIC PROC [baseP: Literals.Finger, index: Literals.STIndex]
        RETURNS [sti: Literals.STIndex Ź STNull] = {
            DO
                ptr: LONG POINTER TO Literals.STRecord Ź @baseP­[index];
                WITH s: ptr­ SELECT FROM
                    master => {
                        scratchLen: NAT = 80;
                        scratch: STRING Ź [scratchLen];
                        len: NAT = s.length;
                        new: LONG STRING Ź scratch;
                        IF len > scratchLen THEN new Ź MimZones.tempUZ.NEW[StringBody[len]];
                        FOR i: NAT IN [0..len) DO
                            new[i] Ź s[i];
                            ENDLOOP;
                        new.length Ź len;
                        sti Ź FindString[[new, 0, len]];
                        IF len > scratchLen THEN MimZones.tempUZ.FREE[@new];
                        EXIT;
                        };
                    copy => index Ź s.link;
                    heap => index Ź s.link;
                    ENDCASE => EXIT;
                ENDLOOP;
            };

        FindString: PUBLIC PROC [s: ConvertUnsafe.SubString] RETURNS [sti: STIndex] = {
            hash: WORD Ź 0;
            hvi: SLitHVIndex;
            FOR i: CARDINAL IN [s.offset .. s.offset+s.length) DO
                hash Ź hash + i + LOOPHOLE[s.base[i], CARDINAL];
                ENDLOOP;
            hvi Ź hash MOD SLitHVLength;
            FOR sti Ź sHashVec[hvi], stb[sti].link UNTIL sti = MSTNull DO
                v: LONG STRING = StringValue[sti];
                vs: ConvertUnsafe.SubString Ź [base: v, offset: 0, length: v.length];
                IF s.EqualSubStrings[vs] THEN EXIT;
                REPEAT
                    FINISHED => {
                        len: CARDINAL = s.length;
                        max: CARDINAL = RoundUpBytes[len];
                        ptr: LONG POINTER TO STRecord.master Ź stbZone.NEW[STRecord.master[max]];
                        ptr.info Ź 0;
                        ptr.codeIndex Ź 0;
                        ptr.local Ź FALSE;
                        ptr.link Ź sHashVec[hvi];
                        ptr.length Ź len;
                        FOR i: CARDINAL IN [0 .. len) DO
                            ptr[i] Ź s.base[s.offset+i];
                            ENDLOOP;
                        FOR i: CARDINAL IN [len .. max) DO
                            ptr[i] Ź '\000;
                            ENDLOOP;
                        sHashVec[hvi] Ź LOOPHOLE[sti Ź STBRelative[ptr]];
                        };
                ENDLOOP;
            RETURN [sti];
            };

        MasterString: PUBLIC PROC [sti: STIndex] RETURNS [MSTIndex] = {
            RETURN [WITH s: stb[sti] SELECT FROM
                master => LOOPHOLE[sti],
                copy => s.link,
                heap => s.link,
                ENDCASE => MSTNull];
            };

        StringReference: PUBLIC PROC [sti: STIndex] = {
            WITH s: stb[sti] SELECT FROM
                master => s.info Ź s.info + 1;
                ENDCASE;
            };

        StringValue: PUBLIC PROC [sti: STIndex] RETURNS [LONG STRING] = {
            ptr: LONG POINTER TO STRecord.master = @stb[MasterString[sti]];
            RETURN [LOOPHOLE[ptr + SIZE[STRecord.master[0]] - SIZE[StringBody[0]]]];
            };

        TextType: PUBLIC PROC [sti: STIndex] RETURNS [Symbols.Type] = {
            RETURN [WITH s: stb[sti] SELECT FROM heap => s.type, ENDCASE => ERROR];
            };

        ResetLocalStrings: PUBLIC PROC RETURNS [key: STIndex] = {
            IF ~locals THEN key Ź STNull ELSE {key Ź localStart; markBit Ź ~markBit};
            locals Ź FALSE;
            localStart Ź table.Top[stType];
            };

        FindHeapString: PUBLIC PROC [key: STIndex, type: Symbols.Type] RETURNS [sti: STIndex] = {
            master: MSTIndex = MasterString[key];
            FOR sti Ź localStart, sti UNTIL sti = stLimit DO
                WITH s: stb[sti] SELECT FROM
                    master => sti Ź sti + STRecord.master[s.maxLength].SIZE;
                    copy => sti Ź sti + STRecord.copy.SIZE;
                    heap => {
                        IF s.type = type AND s.link = master THEN RETURN;
                        sti Ź sti + STRecord.heap.SIZE;
                        };
                    ENDCASE;
                ENDLOOP;
            sti Ź STBRelative[stbZone.NEW[STRecord.heap
            Ź [link: master, cases: heap[type: type, info: 0]]]];
            };

        FindLocalString: PUBLIC PROC [key: STIndex] RETURNS [sti: STIndex] = {
            master: MSTIndex = MasterString[key];
            FOR sti Ź localStart, sti UNTIL sti = stLimit DO
                WITH s: stb[sti] SELECT FROM
                    master => sti Ź sti + STRecord.master[s.maxLength].SIZE;
                    copy => {
                        IF s.link = master THEN RETURN;
                        sti Ź sti + STRecord.copy.SIZE;
                        };
                    heap => sti Ź sti + STRecord.heap.SIZE;
                    ENDCASE => ERROR;
                REPEAT
                    FINISHED => {
                        sti Ź STBRelative[stbZone.NEW[STRecord.copy
                        Ź [link: master, cases: copy[mark: markBit]]]];
                        locals Ź TRUE;
                        };
                ENDLOOP;
            };

        <<EnumerateHeapStrings: PUBLIC PROC [proc: PROC [STIndex]] = {>>
            <<sti: STIndex _ STFirst;>>
            <<WHILE sti # stLimit DO>>
                <<WITH s: stb[sti] SELECT FROM>>
                    <<master => sti _ sti + STRecord.master[s.maxLength].SIZE;>>
                    <<copy => sti _ sti + STRecord.copy.SIZE;>>
                    <<heap => {proc[sti]; sti _ sti + STRecord.heap.SIZE};>>
                    <<ENDCASE => ERROR;>>
                <<ENDLOOP;>>
            <<};>>
            <<>>
        <<EnumerateLocalStrings: PUBLIC PROC [key: STIndex, proc: PROC [MSTIndex]] = {>>
            <<sti: STIndex _ STFirst;>>
            <<started, mark: BOOL;>>
            <<IF key = STNull THEN RETURN;>>
            <<started _ FALSE;>>
            <<WHILE sti # stLimit DO>>
                <<WITH s: stb[sti] SELECT FROM>>
                    <<master => sti _ sti + STRecord.master[s.maxLength].SIZE;>>
                    <<copy => {>>
                        <<IF ~started THEN {mark _ s.mark; started _ TRUE};>>
                        <<IF s.mark # mark THEN EXIT;>>
                        <<proc[s.link];>>
                        <<sti _ sti + STRecord.copy.SIZE;>>
                        <<};>>
                    <<heap => sti _ sti + STRecord.heap.SIZE;>>
                    <<ENDCASE => ERROR;>>
                <<ENDLOOP;>>
            <<};>>
                <<>>
        <<EnumerateMasterStrings: PUBLIC PROC [proc: PROC [MSTIndex]] = {>>
            <<sti: STIndex _ STFirst;>>
            <<WHILE sti # stLimit DO>>
                <<WITH s: stb[sti] SELECT FROM>>
                    <<master => {>>
                        <<proc[LOOPHOLE[sti]];>>
                        <<sti _ sti + STRecord.master[s.maxLength].SIZE;>>
                        <<};>>
                    <<copy => sti _ sti + STRecord.copy.SIZE;>>
                    <<heap => sti _ sti + STRecord.heap.SIZE;>>
                    <<ENDCASE => ERROR;>>
                <<ENDLOOP;>>
            <<};>>
                <<>>
    MimZones.RegisterForReset[Finalize];
    }.