<<>>
<<TypeStringsImpl.mesa>>
    <<Copyright Ó 1984, 1985, 1986, 1987, 1988, 1989, 1991 by Xerox Corporation.  All rights reserved.>>
    <<Satterthwaite, June 18, 1986 11:15:31 am PDT>>
    <<Russ Atkinson (RRA) December 19, 1989 7:42:24 pm PST>>
    <<Willie-s, September 24, 1991 4:48 pm PDT>>

    DIRECTORY
        Basics USING [LongNumber],
        ConvertUnsafe USING [SubString],
        MobDefs USING [NullVersion, VersionStamp],
        OSMiscOps USING [Copy],
        SymbolOps USING [DecodeCard, FindMdi, FindString, FirstCtxSe, NameForSe, NextSe, SearchContext, STB, SubStringForName, TypeForm, 
        UnderType],
        Symbols USING [Base, codeANY, codeCHAR, CSEIndex, CSENull, CTXFirst, CTXIndex, CTXNull, CTXRecord, FirstStandardCtx, HTRecord, 
        IncludedCTXIndex, IncludedCTXNull, ISEIndex, ISENull, LastStandardCtx, MDIndex, MDNull, Name, nullName, nullType, OwnMdi, 
        Type, TypeClass, typeTYPE],
        SymbolTable USING [],
        SymbolTablePrivate USING [SymbolTableBaseRep],
        Target: TYPE MachineParms USING [bitsPerLongWord, bitsPerReal, bitsPerWord, maxWord, maxLongWord],
        TypeStrings USING [Code, TypeString];
TypeStringsImpl: PROGRAM 
    IMPORTS OSMiscOps, SymbolOps
    EXPORTS TypeStrings, SymbolTable = {
    OPEN Symbols, TypeStrings;

    STB: TYPE = REF SymbolTableBaseRep;
    SymbolTableBaseRep: PUBLIC TYPE = SymbolTablePrivate.SymbolTableBaseRep;
<<Basic algorithm>>
    stb: STB Ź NIL;
    zone: UNCOUNTED ZONE Ź NIL;
    ts: TypeString Ź NIL;

    stackQuick: INT Ź 0;
    defsQuick: INT Ź 0;
    stateQuick: INT Ź 0;
    listQuick: INT Ź 0;
    createCalls: INT Ź 0;

    Create: PUBLIC PROC [base: STB, sei: Type, z: UNCOUNTED ZONE] RETURNS [TypeString] = {
        IF base = NIL THEN RETURN [NIL];
        stb Ź base;
        zone Ź z;
        ts Ź zone.NEW[StringBody[32]];

        <<Allocate the various state holders if they have not been already allocated.>>
        createCalls Ź createCalls + 1;
        IF stack = NIL
            THEN stack Ź zone.NEW[StackVector[4]]
            ELSE stackQuick Ź stackQuick + 1;
        IF defs = NIL
            THEN defs Ź zone.NEW[DefsVector[4]]
            ELSE defsQuick Ź defsQuick + 1;
        IF state = NIL
            THEN state Ź zone.NEW[StateTable[4]]
            ELSE stateQuick Ź stateQuick + 1;
        IF list = NIL
            THEN list Ź zone.NEW[ListVector[4]]
            ELSE listQuick Ź listQuick + 1;
        stack.index Ź defs.index Ź state.index Ź list.index Ź 0;

        lastName Ź '\000;
        AppendTypeString[sei];
        IF InsertDefinitions[] THEN Canonicalize[sei];

        <<Free the various holders if they have grown a lot.  We try to hold on to little ones to reduce the cost for quick type string 
        construction in the (hopefully common) small cases.>>
        IF defs.len > 16 THEN zone.FREE[@defs];
        IF stack.len > 16 THEN zone.FREE[@stack];
        IF state.max > 16 THEN zone.FREE[@state];
        IF list.max > 16 THEN zone.FREE[@list];
        IF ts.length + 16 < ts.maxlength THEN {
            <<The length is substantially less than the maxLength, so we can make the string shorter>>
            old: TypeString Ź ts;
            oldLen: CARDINAL Ź old.length;
            ts Ź zone.NEW[StringBody[oldLen]];
            OSMiscOps.Copy[
                from: @old.text,
                nwords: StringBody[oldLen].WORDS - StringBody[0].WORDS,
                to: @ts.text];
            ts.length Ź oldLen;
            zone.FREE[@old];
            };
        RETURN [ts];
        };

    Expand: PROC [s: TypeString] RETURNS [new: TypeString] = {
        n: NAT = s.length + (s.length + 4)/2;
        new Ź zone.NEW[StringBody[n]];
        OSMiscOps.Copy[
            from: @s.text,
            nwords: StringBody[s.length].WORDS - StringBody[0].WORDS,
            to: @new.text];
        new.length Ź s.length;
        zone.FREE[@s];
        };

    Append: PROC [c: CHAR] = {  
        len: NAT Ź ts.length;
        IF len = ts.maxlength THEN {ts Ź Expand[ts]; len Ź ts.length};
        IF ts = NIL OR len >= ts.maxlength THEN ERROR;
        ts[len] Ź c;
        ts.length Ź len + 1;
        };

    AppendByte: PROC [b: BYTE] = LOOPHOLE[Append];

    AppendCode: PROC [code: Code] = LOOPHOLE[Append];

    AppendCard: PROC [c: CARD32] = {
        encodeMod: NAT = 64;
        ln: Basics.LongNumber = [card[c]];
        SELECT c FROM
            < encodeMod =>
                AppendByte[ln.ll];
            < encodeMod*256 => {
                AppendByte[encodeMod*1+ln.lh];
                AppendByte[ln.ll];
                };
            < encodeMod*LONG[256]*256 => {
                AppendByte[encodeMod*2+ln.hl];
                AppendByte[ln.lh];
                AppendByte[ln.ll];
                };
            ENDCASE => {
                prefix: NAT Ź encodeMod*3;
                IF ln.int < 0 AND ln.int > - encodeMod THEN {
                    <<Special case for small negative numbers>>
                    AppendByte[prefix-ln.int];
                    RETURN;
                    };
                AppendByte[prefix];
                AppendByte[ln.hh];
                AppendByte[ln.hl];
                AppendByte[ln.lh];
                AppendByte[ln.ll];
                };
        };

    AppendPaint: PROC [type: CSEIndex] = {
        form: Symbols.TypeClass = SymbolOps.TypeForm[stb, type];
        SELECT form FROM
            $enumerated, $definition, $record, $union, $opaque => {
                version: MobDefs.VersionStamp Ź MobDefs.NullVersion;
                ctx: CTXIndex Ź TypeContext[type];
                mdi: MDIndex;
                WITH c~~stb.ctxb[ctx] SELECT FROM
                    simple => mdi Ź OwnMdi;
                    included => {mdi Ź c.module; ctx Ź c.map};
                    imported => {
                        link: Symbols.IncludedCTXIndex Ź c.includeLink;
                        IF link = Symbols.IncludedCTXNull THEN ERROR;
                        mdi Ź stb.ctxb[link].module;
                        ctx Ź stb.ctxb[link].map;
                        };
                    ENDCASE => ERROR;
                IF ctx NOT IN [FirstStandardCtx..LastStandardCtx] THEN
                    version Ź LOOPHOLE[stb.mdb[mdi].stamp];
                WITH t: stb.seb[type] SELECT FROM
                    opaque => {
                        <<RRA: Opaque types do not really have their own contexts, so we can't just rely on the context index within the BCD.  Therefore we 
                        add in the name.>>
                        AppendName[SymbolOps.NameForSe[stb, t.id]];
                        AppendCard[version[0]];
                        AppendCard[version[1]];
                        };
                    ENDCASE => {
                        index: CARD Ź CARD[ctx-CTXFirst];
                        index Ź index * BYTES[UNIT];
                            <<Note, must use absolute, not machine relative, units!>>
                                <<RRA: March 11, 1989>>
                        AppendCard[version[0]];
                        AppendCard[version[1]];
                        AppendCard[index];
                        };
                };
            ENDCASE => ERROR;
        };

    AppendName: PROC [name: Name] = {
        IF name = nullName
            THEN Append[VAL[0]]
            ELSE {
                offset: CARDINAL = stb.htb[name-HTRecord.SIZE].ssIndex <<+ 1>>;
                length: CARDINAL = stb.htb[name].ssIndex - offset;
                IF length >= 200b THEN ERROR;
                    <<avoid code for leftParen and rightParen>>
                Append[VAL[length]];
                FOR i: CARDINAL IN [offset..offset+length) DO Append[stb.ssb[i]]; ENDLOOP;
                };
        };

    AppendField: PROC [iSei: ISEIndex] = INLINE {
        AppendName[SymbolOps.NameForSe[stb, iSei]];
        AppendTypeString[stb.seb[iSei].idType];
        };

    AppendTypeString: PROC [type: Type] = {
        csei: CSEIndex Ź SymbolOps.UnderType[stb, type];
        class: Code;
        e: StackElement;
        <<substitute concrete type for opaque type>>
        IF SymbolOps.TypeForm[stb, csei]=$opaque THEN csei Ź OpaqueValue[csei, stb];
        <<replace type with its set representative>>
        FOR i: CARDINAL IN [0..state.index) DO
            IF state[i].type = csei THEN {csei Ź state[i].current; EXIT};
            ENDLOOP;
        <<check to see if type is recursive>>
        IF (e Ź Find[csei]) # NIL THEN {
            IF e.name='\000 THEN e.name Ź NewName[]; 
            AppendCode[$name]; Append[e.name]; RETURN};
        <<general cases>>
        Push[csei];
        SELECT (class Ź TypeClass[csei]) FROM
            $definition => ERROR;
            $enumerated => {
                ctx: CTXIndex = TypeContext[csei];
                IF (ctx-CTXNull) = CTXRecord.nil.SIZE + CTXRecord.simple.SIZE
                    THEN
                        AppendCode[$boolean]    -- This is the special common case for BOOLEAN
                    ELSE
                        WITH t: stb.seb[csei] SELECT FROM
                            enumerated => {
                                IF ~t.painted THEN {
                                    <<RRA: Unpainted enumeration types are identified by their name/value pairs>>
                                    AppendCode[$enumerated];
                                    AppendCode[$leftParen];
                                    FOR iSei: ISEIndex
                                    Ź SymbolOps.FirstCtxSe[stb, ctx], SymbolOps.NextSe[stb, iSei]
                                    UNTIL iSei = ISENull DO
                                        AppendName[SymbolOps.NameForSe[stb, iSei]];
                                        IF t.machineDep THEN
                                            AppendCard[SymbolOps.DecodeCard[stb.seb[iSei].idValue]];
                                        ENDLOOP;
                                    AppendCode[$rightParen];
                                    }
                                ELSE {
                                    <<Painted enumeration types are identified by their paint alone>>
                                    AppendCode[$paint];
                                    AppendPaint[csei];
                                    };
                                };
                            ENDCASE => ERROR;
                };
            $record => {
                <<There are a few special records.  Other records are painted.>>
                SELECT (TypeContext[csei]-CTXNull) FROM
                    CTXRecord.nil.SIZE + 2*CTXRecord.simple.SIZE => AppendCode[$text];
                    CTXRecord.nil.SIZE + 3*CTXRecord.simple.SIZE => AppendCode[$stringBody];
                    <<CTXRecord.nil.SIZE + 4*CTXRecord.simple.SIZE => AppendCode[$condition];>>
                    <<CTXRecord.nil.SIZE + 5*CTXRecord.simple.SIZE => AppendCode[$lock];>>
                    ENDCASE => {AppendCode[$paint]; AppendPaint[csei]};
                };
            $structure => {
                <<a structure is an unpainted record>>
                ctx: CTXIndex = TypeContext[csei];
                WITH c~~stb.ctxb[ctx] SELECT FROM
                    included => IF ~c.complete THEN ERROR;
                    ENDCASE;
                AppendCode[$leftParen];
                FOR iSei: ISEIndex Ź SymbolOps.FirstCtxSe[stb, ctx], SymbolOps.NextSe[stb, iSei]
                WHILE iSei # ISENull DO
                    AppendField[iSei];
                    ENDLOOP;
                AppendCode[$rightParen];
                };
            $union => {
                AppendCode[$union];
                AppendPaint[csei];
                };
            $array => {
                IF Packed[csei] THEN AppendCode[$packed];
                AppendCode[$array];  
                AppendTypeString[Domain[csei]]; 
                AppendTypeString[Range[csei]];
                };
            $sequence => {
                IF Packed[csei] THEN AppendCode[$packed];
                AppendCode[$sequence];  
                AppendField[Tag[csei]]; 
                AppendTypeString[Range[csei]];
                };
            $subrange => {
                AppendCode[$subrange];
                AppendTypeString[Ground[csei]];
                AppendCard[First[csei]];
                AppendCard[Last[csei]];
                };
            $opaque =>  {
                WITH t~~stb.seb[csei] SELECT FROM
                    opaque =>
                        IF stb.seb[t.id].idCtx IN [FirstStandardCtx..LastStandardCtx]
                            THEN AppendCode[$atomRec]
                            ELSE {AppendCode[$opaque]; AppendPaint[csei]};
                    ENDCASE => ERROR;
                };
            $countedZone, $uncountedZone => {
                IF Mds[csei] THEN AppendCode[$mds];
                AppendCode[class];
                };
            $list => {
                IF Ordered[csei] THEN AppendCode[$ordered];
                IF ReadOnly[csei] THEN AppendCode[$readOnly];
                AppendCode[$list];
                AppendTypeString[ListArg[csei]];
                };
            $relativeRef => {
                AppendCode[$relativeRef];
                AppendTypeString[Base[csei]];
                AppendTypeString[Range[csei]];
                };
            $ref => {
                IF ReadOnly[csei] THEN AppendCode[$readOnly];
                IF TypeClass[Range[csei]] = $any
                    THEN AppendCode[$refAny]
                    ELSE {AppendCode[$ref]; AppendTypeString[Range[csei]]};
                };
            $var => {
                IF ReadOnly[csei] THEN AppendCode[$readOnly];
                AppendCode[$var];
                AppendTypeString[Range[csei]];
                };
            $pointer, $longPointer => { 
                IF Ordered[csei] THEN AppendCode[$ordered];
                IF ReadOnly[csei] THEN AppendCode[$readOnly];
                AppendCode[class];
                AppendTypeString[Range[csei]];
                }; 
            $descriptor, $longDescriptor => {
                IF ReadOnly[csei] THEN AppendCode[$readOnly];
                AppendCode[class];
                AppendTypeString[Range[csei]];
                };
            $procedure, $safeProc => {
                AppendCode[class];
                AppendTypeString[Domain[csei]];
                AppendTypeString[Range[csei]];
                };
            $port, $program, $signal, $error => {
                IF Safe[csei] THEN AppendCode[$safe];
                AppendCode[class];
                AppendTypeString[Domain[csei]];
                AppendTypeString[Range[csei]];
                };
            $process => {
                IF Safe[csei] THEN AppendCode[$safe];
                AppendCode[process];
                AppendTypeString[Range[csei]];
                };
            $nil => {
                AppendCode[$leftParen];
                AppendCode[$rightParen];
                };
            $cardinal, $integer, $character, $longInteger, $longCardinal, $real, $type, $any, $unspecified, $longUnspecified, $dcard, $dint, 
            $dreal =>
                AppendCode[class];
            $globalFrame, $localFrame => ERROR;
            ENDCASE => ERROR;
        Pop[];
        };

    OpaqueValue: PROC [type: CSEIndex, base: STB] RETURNS [val: CSEIndex] = {
        val Ź type;
        WITH t1~~stb.seb[type] SELECT FROM
            opaque => {
                mdi1: MDIndex = (WITH c1~~stb.ctxb[stb.seb[t1.id].idCtx] SELECT FROM
                    included => c1.module,
                    imported => stb.ctxb[c1.includeLink].module,
                    ENDCASE => OwnMdi);
                mdi2: MDIndex = SymbolOps.FindMdi[base, stb.mdb[mdi1].stamp];
                IF mdi2 # MDNull AND base.mdb[mdi2].exported THEN {
                    sei2: ISEIndex;
                    ss: ConvertUnsafe.SubString = SymbolOps.SubStringForName[stb, stb.seb[t1.id].hash];
                    sei2 Ź SymbolOps.SearchContext[base, SymbolOps.FindString[base, ss], base.mainCtx];
                    IF sei2#ISENull AND base.seb[sei2].idType=typeTYPE 
                        AND base.seb[sei2].public THEN val Ź SymbolOps.UnderType[base, sei2]}};
            ENDCASE;
        };

    lastName: CHAR;

    NewName: PROC RETURNS [CHAR] = INLINE {RETURN [lastName Ź lastName.SUCC]};
<<Canonicalization    >>
    Canonicalize: PROC [type: Type] = {
        <<build an equivalence table for the type>>
        AddState[type]; -- gets them all recursively
        <<minimize the table>>
        UNTIL ~Split[] DO NULL ENDLOOP;
        <<generate a new string>>
        ts.length Ź 0;
        AppendTypeString[type];  -- will make use of the equivalences
        [] Ź InsertDefinitions[];
        };

    Split: PROC RETURNS [split: BOOLŹFALSE]= {
        <<iterate over all k-equivalent classes, >>
        <<splitting them into k+1-equivalent classes>>
        FOR i: CARDINAL IN [0..state.index) DO
            <<check to see if we have done this class already>>
            found: BOOL Ź FALSE;
            FOR j: CARDINAL IN [0..i) DO 
                IF state[i].current=state[j].current THEN found Ź TRUE;
                ENDLOOP;
            IF ~found THEN {
                <<if not, process the class >>
                list[0] Ź state[i].type;
                list.index Ź 1;
                state[i].next Ź state[i].type;
                FOR j: CARDINAL IN (i..state.index) DO
                    IF state[j].current=state[i].current THEN {  -- in the class
                        found Ź FALSE;
                        FOR k: CARDINAL IN [0..list.index) DO
                            IF kEQ[state[j].type,list[k]] THEN {
                                state[j].next Ź list[k]; found Ź TRUE; EXIT};
                            ENDLOOP;
                        IF ~found THEN {  
                            <<a new class is born>>
                            state[j].next Ź state[j].type;
                            IF list.index = list.max THEN {
                                nLen: NAT = list.index + (list.index + 4) / 2;
                                new: LONG POINTER TO ListVector = zone.NEW[ListVector[nLen]];
                                OSMiscOps.Copy[
                                    from: @list[0],
                                    nwords: ListVector[list.index].WORDS - ListVector[0].WORDS,
                                    to: @new[0]];
                                new.index Ź list.index;
                                zone.FREE[@list];
                                list Ź new};
                            IF list.index >= list.max THEN ERROR;
                            list[list.index]Źstate[j].type;
                            list.index Ź list.index + 1;
                            split Ź TRUE};
                        };
                    ENDLOOP;
                };
            ENDLOOP;
        FOR i: CARDINAL IN [0..state.index) DO
            state[i].current Ź state[i].next;
            ENDLOOP;
        };

    AddState: PROC [type: Type] = {
        class: Code;
        csei: CSEIndex = SymbolOps.UnderType[stb, type];
        FOR i: CARDINAL IN [0..state.index) DO
            IF state[i].type = csei THEN RETURN;
            ENDLOOP;
        IF state.index = state.max THEN {
            nLen: NAT = state.index + (state.index + 4) / 2;
            new: LONG POINTER TO StateTable = zone.NEW[StateTable[nLen]];
            OSMiscOps.Copy[
                from: @state[0],
                nwords: StateTable[state.index].WORDS - StateTable[0].WORDS,
                to: @new[0]];
            new.index Ź state.index;
            zone.FREE[@state];
            state Ź new};
        IF state.index >= state.max THEN ERROR;
        state[state.index] Ź [csei, CSENull, CSENull];
        state.index Ź state.index + 1;
        class Ź TypeClass[csei];
        SELECT class FROM
            $definition => ERROR;
            $record => {
                <<Records and other painted types don't add state because they are unique enough>>
                };
            $enumerated => {
                <<For painted enumerated values there is no new state because they are unique.>>
                <<For unpainted enumerated types there is no new state because there are no subsidiary types (just names).>>
                };
            $structure =>
                <<For unpainted records we have to add in the states for the component types.>>
                FOR iSei: ISEIndex Ź SymbolOps.FirstCtxSe[stb, TypeContext[csei]], SymbolOps.NextSe[stb, iSei]
                    WHILE iSei#ISENull DO
                        AddState[stb.seb[iSei].idType];
                        ENDLOOP;
            $union => NULL;
                <<Another place where unions are assumed to be painted.>>
            $array => {
                AddState[Domain[csei]];
                AddState[Range[csei]]};
            $sequence => {
                AddState[stb.seb[Tag[csei]].idType];
                AddState[Range[csei]]};
            $subrange => AddState[Ground[csei]];
            $opaque => NULL;
            $countedZone, $uncountedZone => NULL;
            $list => AddState[ListArg[csei]];
            $relativeRef => {
                AddState[Base[csei]];
                AddState[Range[csei]]};
            $ref => AddState[Range[csei]];
            $var => AddState[Range[csei]];
            $pointer, $longPointer, $descriptor, $longDescriptor => AddState[Range[csei]];
            $procedure, $safeProc, $port, $program, $signal, $error => {
                AddState[Domain[csei]];
                AddState[Range[csei]]};
            $process => AddState[Range[csei]];
            $nil => NULL;
            $globalFrame, $localFrame => ERROR;
            $cardinal, $integer, $character, $longInteger, $longCardinal, $real, $type, $any, $unspecified, $longUnspecified, $dcard, $dint, 
            $dreal => NULL;
            ENDCASE => ERROR;
        };

    kEQ: PROC [t1, t2: CSEIndex] RETURNS [BOOL] = {
        <<This routine is concerned with type equality.>>
        class1: Code = TypeClass[t1];
        class2: Code = TypeClass[t2];
        IF class1 # class2 THEN RETURN [FALSE];
        IF t1 = t2 THEN RETURN [TRUE];
        SELECT class1 FROM
            $definition => ERROR;
            $enumerated => {
                WITH x1: stb.seb[t1] SELECT FROM
                    enumerated => {
                        iSei1: ISEIndex Ź SymbolOps.FirstCtxSe[stb, TypeContext[t1]];
                        WITH x2: stb.seb[t2] SELECT FROM
                            enumerated => {
                                iSei2: ISEIndex Ź SymbolOps.FirstCtxSe[stb, TypeContext[t1]];
                                IF x1.painted OR x2.painted THEN RETURN [t1 = t2];
                                    <<If either is painted, then type index equality suffices>>
                                <<Both are unpainted, so use name&value equality>>
                                IF x1.range # x2.range THEN RETURN [FALSE];
                                UNTIL iSei1=ISENull OR iSei2=ISENull DO
                                    IF SymbolOps.NameForSe[stb, iSei1] # SymbolOps.NameForSe[stb, iSei2] THEN RETURN [FALSE];
                                    IF stb.seb[iSei1].idValue # stb.seb[iSei2].idValue THEN RETURN [FALSE];
                                    iSei1 Ź SymbolOps.NextSe[stb, iSei1];
                                    iSei2 Ź SymbolOps.NextSe[stb, iSei2];
                                    ENDLOOP;
                                RETURN [iSei1=iSei2];
                                };
                            ENDCASE;
                        };
                    ENDCASE;
                RETURN [FALSE];
                };
            $structure => {
                <<For structures, equality is determined by name and type equivalence.>>
                iSei1: ISEIndex Ź SymbolOps.FirstCtxSe[stb, TypeContext[t1]];
                iSei2: ISEIndex Ź SymbolOps.FirstCtxSe[stb, TypeContext[t2]];
                UNTIL iSei1=ISENull OR iSei2=ISENull DO
                    IF SymbolOps.NameForSe[stb, iSei1] # SymbolOps.NameForSe[stb, iSei2] THEN RETURN [FALSE];
                    IF Current[stb.seb[iSei1].idType] # Current[stb.seb[iSei2].idType] THEN
                        RETURN [FALSE]; 
                    iSei1 Ź SymbolOps.NextSe[stb, iSei1];
                    iSei2 Ź SymbolOps.NextSe[stb, iSei2];
                    ENDLOOP;
                RETURN [iSei1=iSei2];
                };
            $array =>
                RETURN [Current[Domain[t1]]=Current[Domain[t2]]
                    AND Current[Range[t1]]=Current[Range[t2]]];
            $sequence => {
                iSei1: ISEIndex = Tag[t1];
                iSei2: ISEIndex = Tag[t2];
                RETURN [SymbolOps.NameForSe[stb, iSei1] = SymbolOps.NameForSe[stb, iSei2]
                    AND Current[stb.seb[iSei1].idType]=Current[stb.seb[iSei2].idType]
                    AND Current[Range[t1]]=Current[Range[t2]]];
                };
            $subrange => RETURN [Current[Ground[t1]]=Current[Ground[t2]]
            AND First[t1] = First[t2] AND Last[t1] = Last[t2]];
            $list => RETURN [Current[ListArg[t1]]=Current[ListArg[t2]]];
            $relativeRef =>
                RETURN [Current[Base[t1]]=Current[Base[t2]]
                    AND Current[Range[t1]]=Current[Range[t2]]];
            $ref => RETURN [Current[Range[t1]]=Current[Range[t2]]];
            $var => RETURN [Current[Range[t1]]=Current[Range[t2]]];
            $pointer, $longPointer, $descriptor, $longDescriptor => 
                RETURN [Current[Range[t1]]=Current[Range[t2]]];
            $procedure, $safeProc, $port, $program, $signal, $error => {
                RETURN [Current[Domain[t1]]=Current[Domain[t2]] 
                    AND Current[Range[t1]]=Current[Range[t2]]]};
            $process => RETURN [Current[Range[t1]]=Current[Range[t2]]];
            $globalFrame, $localFrame => ERROR;
            ENDCASE => RETURN [FALSE];
        };

    Current: PROC [type: Type] RETURNS [CSEIndex] = {
        csei: CSEIndex = SymbolOps.UnderType[stb, type];
        FOR i: CARDINAL IN [0..state.index) DO
            IF state[i].type=csei THEN RETURN [state[i].current];
            ENDLOOP;
        ERROR;
        };

    StateTable: TYPE = RECORD [
        index: CARDINAL,
        elems: SEQUENCE max: CARDINAL OF RECORD[type, current, next: CSEIndex]];
    state: LONG POINTER TO StateTable Ź NIL;

    ListVector: TYPE = RECORD [
        index: CARDINAL,
        elems: SEQUENCE max: CARDINAL OF CSEIndex];
    list: LONG POINTER TO ListVector Ź NIL;
<<Stack management>>
    StackElementRecord: TYPE = RECORD[name: CHAR, type: CSEIndex, index: CARDINAL];
    StackElement: TYPE = LONG POINTER TO StackElementRecord;

    StackVector: TYPE = RECORD [
        index: CARDINAL,
        elems: SEQUENCE len: CARDINAL OF StackElementRecord];
    stack: LONG POINTER TO StackVector Ź NIL;

    DefsVector: TYPE = RECORD [
        index: CARDINAL,
        elems: SEQUENCE len: CARDINAL OF StackElementRecord];
    defs: LONG POINTER TO DefsVector Ź NIL;

    Push: PROC [type: CSEIndex] = INLINE {
        IF stack.index = stack.len THEN {
            <<Grow the stack a little>>
            nLen: NAT = stack.index + (stack.index + 4)/2;
            new: LONG POINTER TO StackVector = zone.NEW[StackVector[nLen]];
            OSMiscOps.Copy[
                from: @stack[0],
                nwords: StackVector[stack.index].WORDS - StackVector[0].WORDS,
                to: @new[0]];
            new.index Ź stack.index;
            zone.FREE[@stack];
            stack Ź new};
        stack[stack.index] Ź ['\000, type, ts.length];
        stack.index Ź stack.index + 1;
        };

    Pop: PROC = INLINE {
        IF stack.index = 0 THEN ERROR;
        stack.index Ź stack.index - 1;
        IF stack[stack.index].name='\000 THEN RETURN;
        IF defs.index = defs.len THEN {
            <<Grow the defs a little to accomodate the new definition>>
            nLen: NAT = defs.index + (defs.index+4)/2;
            new: LONG POINTER TO DefsVector = zone.NEW[DefsVector[nLen]];
            OSMiscOps.Copy[
                from: @defs[0],
                nwords: DefsVector[defs.index].WORDS - DefsVector[0].WORDS,
                to: @new[0]];
            new.index Ź defs.index;
            zone.FREE[@defs];
            defs Ź new};
        defs[defs.index] Ź stack[stack.index];
        defs.index Ź defs.index+1;
        };

    Find: PROC [type: CSEIndex] RETURNS [StackElementŹNIL] = {
        FOR i: CARDINAL IN [0..stack.index) DO
            IF stack[i].type = type THEN RETURN [@stack[i]];
            ENDLOOP;
        };

    InsertDefinitions: PROC RETURNS [recursive: BOOL Ź FALSE] = {
        WHILE TRUE DO
            index, j: CARDINAL Ź 0;
            found: BOOL Ź FALSE;
            FOR i: CARDINAL IN [0..defs.index) DO
                IF defs[i].name#'\000 AND defs[i].index>=index THEN {
                    index Ź defs[i].index; j Ź i;
                    found Ź recursive Ź TRUE};
                ENDLOOP;
            IF ~found THEN EXIT;
            IF ts.length+2 > ts.maxlength THEN ts Ź Expand[ts];
            ts.length Ź ts.length + 2;
            FOR i: CARDINAL DECREASING IN [index+2..ts.length) DO ts[i] Ź ts[i-2] ENDLOOP;
            ts[index] Ź VAL[Code.definition.ORD];
            ts[index+1] Ź defs[j].name;
            defs[j].name Ź '\000;
            ENDLOOP;
        lastName Ź '\000;
        defs.index Ź 0;
        };
<<Procedures that work with the symbol table>>
    TypeContext: PROC [csei: CSEIndex] RETURNS [CTXIndex] = {
        WITH t: stb.seb[csei] SELECT FROM
            enumerated => RETURN [t.valueCtx];
            record => RETURN [t.fieldCtx];
            definition => RETURN [t.defCtx];
            union => RETURN [t.caseCtx];
            opaque => RETURN [stb.seb[t.id].idCtx];
            ENDCASE => ERROR;
        };

    ListArg: PROC [csei: CSEIndex] RETURNS [Type] = {
        <<For LIST OF T returns T>>
        ctx: CTXIndex = TypeContext[SymbolOps.UnderType[stb, Range[csei]]];
        iSei: ISEIndex = SymbolOps.FirstCtxSe[stb, ctx];
        WITH c~~stb.ctxb[ctx] SELECT FROM
            included => IF ~c.complete THEN ERROR;
            ENDCASE;
        RETURN [stb.seb[iSei].idType];
        };

    Base: PROC [csei: CSEIndex] RETURNS [Type] = INLINE {
        RETURN [WITH t~~stb.seb[csei] SELECT FROM
            relative => t.baseType,
            ENDCASE => ERROR]
        };

    Range: PROC [csei: CSEIndex] RETURNS [Type] = {
        RETURN [WITH t~~stb.seb[csei] SELECT FROM
            array => t.componentType,
            sequence => t.componentType,
            transfer => t.typeOut,
            ref => t.refType,
            relative => t.offsetType,
            arraydesc => t.describedType,
            ENDCASE => ERROR]
        };

    Domain: PROC [csei: CSEIndex] RETURNS [Type] = {
        RETURN [WITH t~~stb.seb[csei] SELECT FROM
            array => t.indexType,
            sequence => stb.seb[t.tagSei].idType,
            union => stb.seb[t.tagSei].idType,
            transfer => t.typeIn,
            ENDCASE => ERROR]
        };

    Tag: PROC [csei: CSEIndex] RETURNS [ISEIndex] = {
        RETURN [WITH t~~stb.seb[csei] SELECT FROM
            sequence => t.tagSei,
            union => t.tagSei,
            ENDCASE => ERROR]
        };

    First: PROC [csei: CSEIndex] RETURNS [CARD] = {
        RETURN [SELECT TypeClass[csei] FROM
            $enumerated => 0,
            $subrange =>
                (WITH t~~stb.seb[csei] SELECT FROM
                    subrange => t.origin,
                    ENDCASE => ERROR),
            $cardinal => Target.maxWord,
            $integer => Target.maxWord - Target.maxWord/2,
            $character => CHAR.FIRST.ORD.LONG,
            $longInteger => Target.maxLongWord - Target.maxLongWord/2,
            $longCardinal => Target.maxLongWord,
            ENDCASE => ERROR]
        };

    Last: PROC [csei: CSEIndex] RETURNS [CARD] = {
        RETURN [SELECT TypeClass[csei] FROM
            $enumerated =>
                (WITH t~~stb.seb[csei] SELECT FROM
                    enumerated => t.range,
                    ENDCASE => ERROR),
            $subrange =>
                (WITH t~~stb.seb[csei] SELECT FROM
                    subrange => LOOPHOLE[t.origin + t.range],
                    ENDCASE => ERROR),
            $cardinal => Target.maxWord,
            $integer => Target.maxWord/2,
            $character => CHAR.LAST.ORD.LONG,
            $longInteger => Target.maxLongWord/2,
            $longCardinal => Target.maxLongWord,
            ENDCASE => ERROR]
        };

    Safe: PROC [csei: CSEIndex] RETURNS [BOOL] = INLINE {
        RETURN [WITH t~~stb.seb[csei] SELECT FROM
            transfer => t.safe,
            ENDCASE => ERROR]
        };

    ReadOnly: PROC [csei: CSEIndex] RETURNS [BOOL] = {
        RETURN [WITH t~~stb.seb[csei] SELECT FROM
            ref => t.readOnly,
            arraydesc => t.readOnly,
            ENDCASE => ERROR]
        };

    Ordered: PROC [csei: CSEIndex] RETURNS [BOOL] = {
        RETURN [WITH t~~stb.seb[csei] SELECT FROM
            ref => t.ordered,
            ENDCASE => ERROR]
        };

    Packed: PROC [csei: CSEIndex] RETURNS [BOOL] = {
        RETURN [WITH t~~stb.seb[csei] SELECT FROM
            array => t.packed,
            sequence => t.packed,
            ENDCASE => ERROR]
        };

    Mds: PROC [csei: CSEIndex] RETURNS [BOOL] = INLINE {
        RETURN [WITH t~~stb.seb[csei] SELECT FROM
            zone => t.mds,
            ENDCASE => ERROR]
        };

    Ground: PROC [csei: CSEIndex] RETURNS [Type] = INLINE {
        RETURN [WITH t~~stb.seb[csei] SELECT FROM
            subrange => t.rangeType,
            ENDCASE => ERROR]  -- NOTE relativeRef not yet
        };

    TypeClass: PROC [sei: Type] RETURNS [code: Code] = {
        csei: CSEIndex;
        <<IF type = fhType THEN RETURN[localFrame];>>
        <<IF type = nullType THEN RETURN[nil];>>
        <<IF type = gfhType THEN RETURN[globalFrame];>>
        <<IF type = unspecType THEN RETURN[unspecified];>>
        IF sei=nullType THEN RETURN [$nil];
        IF stb.seb[sei].seTag = id THEN RETURN [$definition];
        csei Ź SymbolOps.UnderType[stb, sei];
        WITH t~~stb.seb[csei] SELECT FROM
            basic => code Ź SelectBasicClass[t.code];
            record => code Ź (IF t.painted THEN $record ELSE $structure);
            definition => code Ź $record;
            real => code Ź SELECT t.length FROM
                Target.bitsPerReal => $real,
                Target.bitsPerReal*2 => $dreal,
                ENDCASE => ERROR;
            signed => code Ź SELECT t.length FROM
                Target.bitsPerWord => $integer,
                Target.bitsPerLongWord => $longInteger,
                Target.bitsPerWord*2 => $dint,
                ENDCASE => ERROR;
            unsigned => code Ź SELECT t.length FROM
                Target.bitsPerWord => $cardinal,
                Target.bitsPerLongWord => $longCardinal,
                Target.bitsPerWord*2 => $dcard,
                ENDCASE => ERROR;
            union => code Ź $union;
            array => code Ź $array;
            opaque => code Ź $opaque;
            sequence => code Ź $sequence;
            ref => code Ź (SELECT TRUE FROM
                t.var => $var,
                t.counted => IF t.list THEN $list ELSE $ref,
                ENDCASE => $pointer);
            arraydesc => code Ź $descriptor;
            relative => code Ź $relativeRef;
            enumerated => code Ź $enumerated;
            subrange => code Ź $subrange;
            transfer => code Ź (SELECT t.mode FROM
                $proc => IF t.safe THEN $safeProc ELSE $procedure,
                $port => $port,
                $signal => $signal,
                $error => $error,
                $process => $process,
                $program => $program,
                ENDCASE => ERROR);
            zone => code Ź (IF t.counted THEN $countedZone ELSE $uncountedZone);
            mode => code Ź $type;
            any => code Ź $any;
            ENDCASE => ERROR;
        };

    SelectBasicClass: PROC [code: [0..16)] RETURNS [Code] = INLINE {
        RETURN [SELECT code FROM
            codeANY => $unspecified,
            codeCHAR => $character,
            ENDCASE => ERROR]
        };

    }.