
    <<InternalTypeStringsImpl.mesa>>
        <<Copyright © 1984, 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, April 30, 1986 10:09:34 am PDT>>
        <<Russ Atkinson (RRA) August 28, 1985 1:46:25 am PDT>>

    DIRECTORY
        Basics: TYPE USING [HighHalf, LowHalf],
        ConvertUnsafe: TYPE USING [SubString],
        PrincOpsUtils: TYPE USING [LongCopy],
        Symbols: TYPE,
        SymbolTable: TYPE USING [Base],
        TypeStrings: TYPE USING [Code, TypeString];

    TypeStringsImpl: PROGRAM 
        IMPORTS Basics, PrincOpsUtils
        EXPORTS TypeStrings = {
        OPEN Symbols, TypeStrings;

    <<*******************************************************************>>
    <<basic algorithm>>
    <<*******************************************************************>>

        stb: SymbolTable.Base _ 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: SymbolTable.Base, sei--type--: 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 + 4 > ts.maxlength THEN ts _ Retract[ts];
            RETURN[ts]};

        Expand: PROC[s: TypeString] RETURNS[new: TypeString] = {
            n: NAT = s.length + (s.length + 4)/2;
            new _ zone.NEW[StringBody[n]];
            PrincOpsUtils.LongCopy[
                from: @s.text,
                nwords: StringBody[s.length].SIZE - StringBody[0].SIZE,
                to: @new.text];
            new.length _ s.length;
            zone.FREE[@s];
            RETURN};

        Retract: PROC[s: TypeString] RETURNS[new: TypeString] = {
            new _ zone.NEW[StringBody[s.length]];
            PrincOpsUtils.LongCopy[
                from: @s.text,
                nwords: StringBody[s.length].SIZE - StringBody[0].SIZE,
                to: @new.text];
            new.length _ s.length;
            zone.FREE[@s];
            RETURN};

        Append: PROC[c: CHAR] = {  
            IF ts.length = ts.maxlength THEN ts _ Expand[ts];
            AppendChar[ts, c]};

        AppendChar: PROC[s: LONG STRING, c: CHAR] = {
            IF s = NIL OR s.length >= s.maxlength THEN ERROR;
            s[s.length] _ c;
            s.length _ s.length + 1};

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

        AppendCardinal: PROC[c: CARDINAL] = INLINE {
            Append[VAL[c/256]];  Append[VAL[c MOD 256]]};

        AppendLongCardinal: PROC[lc: LONG CARDINAL] = {
            AppendCardinal[Basics.HighHalf[lc]];
            AppendCardinal[Basics.LowHalf[lc]]};

        AppendPaint: PROC[type: CSEIndex] = {
            form: Symbols.TypeClass = stb.TypeForm[type];
            SELECT form FROM
                $enumerated, $definition, $record, $union, $opaque => {
                    version: ARRAY [0..3) OF CARDINAL;
                    ctx: CTXIndex _ TypeContext[type];
                    index: CARDINAL;
                    mdi: MDIndex;
                    WITH c~~stb.ctxb[ctx] SELECT FROM
                        simple => mdi _ OwnMdi;
                        included => {mdi _ c.module; ctx _ c.map};
                        ENDCASE => ERROR;
                    IF form = $opaque THEN {
                        <<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 
                        make the index a hash code instead of a context, where the hash code is dependent on the context and the 
                        name used (all opaque types have names, don't they?). We could do better than this, but only by changing 
                        the format of type strings, which we would rather not do.>>
                        WITH t: stb.seb[type] SELECT FROM
                            opaque => index _ HashInName[ctx-CTXIndex.FIRST, stb.NameForSe[t.id]];
                            ENDCASE => ERROR;
                        }
                    ELSE index _ ctx-CTXIndex.FIRST;
                    version _
                        (IF ctx IN StandardContext THEN ALL[0] ELSE LOOPHOLE[stb.mdb[mdi].stamp]);
                    AppendCardinal[version[0]];
                    AppendCardinal[version[1]];
                    AppendCardinal[version[2]];
                    AppendCardinal[index]};
                ENDCASE => ERROR;
            };

        HashInName: PROC[hash: CARDINAL, name: Name] RETURNS[CARDINAL] = {
            <<Given an initial hash, scramble the hash to make it dependent on the given name.  This only scrambles 16 bits, so it should only 
            be used to scramble things that are already nearly disambiguated.>>
            length, offset: CARDINAL;
            IF name = nullName THEN length _ offset _ 0
            ELSE length _ stb.ht[name].ssIndex - (offset _ stb.ht[name-1].ssIndex);
            IF length>200b THEN ERROR; -- avoid code for leftParen and rightParen
            hash _ hash + length;
            FOR i: CARDINAL IN [offset..offset+length) DO
                <<Hash in a new character.  First, rotate the hash left one bit.  Then add in the character code.  This should make the hash 
                dependent on the character code and the position of character within the string.>>
                hash _ hash + hash + (hash/100000b);
                hash _ hash + stb.ssb[i].ORD; 
                ENDLOOP;
            RETURN[hash]};

        AppendName: PROC[name: Name] = {
            length, offset: CARDINAL;
            IF name = nullName THEN length _ offset _ 0
            ELSE length _ stb.ht[name].ssIndex - (offset _ stb.ht[name-1].ssIndex);
            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[stb.NameForSe[iSei]];
            AppendTypeString[stb.seb[iSei].idType]};

        AppendTypeString: PROC[type: Type] = {
            csei: CSEIndex _ stb.UnderType[type];
            class: Code;
            e: StackElement;
            <<substitute concrete type for opaque type>>
            IF stb.TypeForm[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 LOOPHOLE[ctx, CARDINAL] = 4 THEN
                        AppendCode[$boolean]    -- This is the special common case for BOOLEAN
                    ELSE
                        WITH t: stb.seb[csei] SELECT FROM
                            enumerated => {
                                IF t.unpainted THEN {
                                    <<RRA: Unpainted enumeration types are identified by their name/value pairs>>
                                    AppendCode[$enumerated];
                                    AppendCode[$leftParen];
                                    FOR iSei: ISEIndex _ stb.FirstCtxSe[ctx], stb.NextSe[iSei] UNTIL iSei = ISENull DO
                                        AppendName[stb.NameForSe[iSei]];
                                        IF t.machineDep THEN AppendCardinal[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 LOOPHOLE[TypeContext[csei],CARDINAL] FROM
                        6 => AppendCode[$text];
                        8 => AppendCode[$stringBody];
                        <<10 => AppendCode[$condition];>>
                        <<12 => 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 _ stb.FirstCtxSe[ctx], stb.NextSe[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 => { -- 10 bytes
                    AppendCode[$subrange];
                    AppendTypeString[Ground[csei]];
                    AppendLongCardinal[First[csei]];
                    AppendLongCardinal[Last[csei]]};
                $opaque =>  {
                    WITH t~~stb.seb[csei] SELECT FROM
                        opaque =>
                            IF stb.seb[t.id].idCtx IN StandardContext 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 =>
                    AppendCode[class];
                $globalFrame, $localFrame => ERROR;
                ENDCASE => ERROR;
            Pop[]};

        OpaqueValue: PROC[type: CSEIndex, base: SymbolTable.Base] RETURNS[val: CSEIndex] = {
            OPEN b1~~stb;
            val _ type;
            WITH t1~~b1.seb[type] SELECT FROM
                opaque => {
                    mdi1: MDIndex = (WITH c1~~b1.ctxb[b1.seb[t1.id].idCtx] SELECT FROM
                        included => c1.module,
                        imported => b1.ctxb[c1.includeLink].module,
                        ENDCASE => OwnMdi);
                    mdi2: MDIndex = base.FindMdi[b1.mdb[mdi1].stamp];
                    IF mdi2 # MDNull AND base.mdb[mdi2].exported THEN {
                        sei2: ISEIndex;
                        ss: ConvertUnsafe.SubString = b1.SubStringForName[b1.seb[t1.id].hash];
                        sei2 _ base.SearchContext[base.FindString[ss], base.mainCtx];
                        IF sei2#ISENull AND base.seb[sei2].idType=typeTYPE 
                            AND base.seb[sei2].public THEN val _ base.UnderType[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]];
                                    PrincOpsUtils.LongCopy[
                                        from: @list[0],
                                        nwords: ListVector[list.index].SIZE - ListVector[0].SIZE,
                                        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 = stb.UnderType[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]];
                PrincOpsUtils.LongCopy[
                    from: @state[0],
                    nwords: StateTable[state.index].SIZE - StateTable[0].SIZE,
                    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 _ stb.FirstCtxSe[TypeContext[csei]], stb.NextSe[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 => 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;
                $record, union => RETURN[t1=t2];
                $enumerated => {
                    WITH x1: stb.seb[t1] SELECT FROM
                        enumerated => {
                            iSei1: ISEIndex _ stb.FirstCtxSe[TypeContext[t1]];
                            WITH x2: stb.seb[t2] SELECT FROM
                                enumerated => {
                                    iSei2: ISEIndex _ stb.FirstCtxSe[TypeContext[t1]];
                                    IF NOT (x1.unpainted OR x2.unpainted) THEN RETURN[t1 = t2];
                                        <<If either is painted, then type index equality suffices>>
                                    <<Both are unpainted, so use name&value equality>>
                                    IF x1.nValues # x2.nValues THEN RETURN[FALSE];
                                    UNTIL iSei1=ISENull OR iSei2=ISENull DO
                                        IF stb.NameForSe[iSei1] # stb.NameForSe[iSei2] THEN RETURN[FALSE];
                                        IF stb.seb[iSei1].idValue # stb.seb[iSei2].idValue THEN RETURN[FALSE];
                                        iSei1 _ stb.NextSe[iSei1];
                                        iSei2 _ stb.NextSe[iSei2];
                                        ENDLOOP;
                                    RETURN[iSei1=iSei2]};
                                ENDCASE;
                            };
                        ENDCASE;
                    RETURN[FALSE]};
                $structure => {
                    <<For structures, equality is determined by name and type equivalence.>>
                    iSei1: ISEIndex _ stb.FirstCtxSe[TypeContext[t1]];
                    iSei2: ISEIndex _ stb.FirstCtxSe[TypeContext[t2]];
                    UNTIL iSei1=ISENull OR iSei2=ISENull DO
                        IF stb.NameForSe[iSei1] # stb.NameForSe[iSei2] THEN RETURN[FALSE];
                        IF Current[stb.seb[iSei1].idType] # Current[stb.seb[iSei2].idType] THEN
                            RETURN[FALSE]; 
                        iSei1 _ stb.NextSe[iSei1];
                        iSei2 _ stb.NextSe[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[stb.NameForSe[iSei1] = stb.NameForSe[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]];
                $opaque => RETURN[t1=t2];
                $countedZone, uncountedZone => RETURN[t1=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]]];
                $nil => RETURN[t1=t2];
                $globalFrame, $localFrame => ERROR;
                $cardinal, $integer, $character, $longInteger, $longCardinal, $real, $type, $any, $unspecified, $longUnspecified =>
                    RETURN[t1=t2];
                ENDCASE => ERROR;
            };

        Current: PROC[type: Type] RETURNS[CSEIndex] = {
            csei: CSEIndex = stb.UnderType[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] = {
            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]];
                PrincOpsUtils.LongCopy[
                    from: @stack[0],
                    nwords: StackVector[stack.index].SIZE - StackVector[0].SIZE,
                    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 = {
            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]];
                PrincOpsUtils.LongCopy[
                    from: @defs[0],
                    nwords: DefsVector[defs.index].SIZE - DefsVector[0].SIZE,
                    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[stb.UnderType[Range[csei]]];
            iSei: ISEIndex = stb.FirstCtxSe[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] = {
            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,
                long => Range[stb.UnderType[t.rangeType]],
                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]
            };

        LC: TYPE = LONG CARDINAL;

        First: PROC[csei: CSEIndex] RETURNS[LC] = {
            RETURN[SELECT TypeClass[csei] FROM
                $enumerated => 0,
                $subrange =>
                    (WITH t~~stb.seb[csei] SELECT FROM
                        subrange => t.origin.LONG,
                        ENDCASE => ERROR),
                $cardinal => CARDINAL.FIRST,
                $integer => LOOPHOLE[INTEGER.FIRST, CARDINAL].LONG,
                $character => CHAR.FIRST.ORD.LONG,
                $longInteger => LOOPHOLE[INT.FIRST],
                $longCardinal => LC.FIRST,
                ENDCASE => ERROR]
            };

        Last: PROC[csei: CSEIndex] RETURNS[LC] = {
            RETURN[SELECT TypeClass[csei] FROM
                $enumerated =>
                    (WITH t~~stb.seb[csei] SELECT FROM
                        enumerated => LOOPHOLE[(t.nValues - 1).LONG],
                        ENDCASE => ERROR),
                $subrange =>
                    (WITH t~~stb.seb[csei] SELECT FROM
                        subrange => LOOPHOLE[(t.origin + t.range).LONG],
                        ENDCASE => ERROR),
                $cardinal => CARDINAL.LAST,
                $integer => INTEGER.LAST.LONG,
                $character => CHAR.LAST.ORD.LONG,
                $longInteger => INT.LAST,
                $longCardinal => LC.LAST,
                ENDCASE => ERROR]
            };

        Safe: PROC[csei: CSEIndex] RETURNS[BOOL] = {
            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
                long => ReadOnly[stb.UnderType[t.rangeType]],
                ref => t.readOnly,
                arraydesc => t.readOnly,
                ENDCASE => ERROR]
            };

        Ordered: PROC[csei: CSEIndex] RETURNS[BOOL] = {
            RETURN[WITH t~~stb.seb[csei] SELECT FROM
                long => Ordered[stb.UnderType[t.rangeType]],
                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] = {
            RETURN[WITH t~~stb.seb[csei] SELECT FROM
                zone => t.mds,
                ENDCASE => ERROR]
            };

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

        TypeClass: PROC[sei: Type] RETURNS[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 _ stb.UnderType[sei];
            RETURN[WITH t~~stb.seb[csei] SELECT FROM
                basic => SelectBasicClass[t.code],
                record => (IF t.painted THEN $record ELSE $structure),
                definition => $record,
                real => $real,
                union => $union,
                array => $array,
                opaque => $opaque,
                sequence => $sequence,
                ref => (IF t.counted THEN ERROR ELSE $pointer),
                arraydesc => $descriptor,
                long => (WITH rt~~stb.seb[stb.UnderType[t.rangeType]] SELECT FROM
                    ref => (SELECT TRUE FROM
                        rt.var => $var,
                        rt.counted => IF rt.list THEN $list ELSE $ref,
                        ENDCASE => $longPointer),
                    basic => (SELECT rt.code FROM
                        codeINT => $longInteger,
                        codeANY => $longUnspecified
                        ENDCASE => ERROR),
                    arraydesc => $longDescriptor,
                    ENDCASE => IF IsCardinal[t.rangeType] THEN $longCardinal ELSE ERROR),
                relative => $relativeRef,
                enumerated => $enumerated,
                subrange => IF IsCardinal[csei] THEN $cardinal ELSE $subrange,
                transfer => (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 => (IF t.counted THEN $countedZone ELSE $uncountedZone),
                mode => $type,
                any => $any,
                ENDCASE => ERROR]
            };

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

        IsCardinal: PROC[type: Type] RETURNS[BOOL] = {
            csei: CSEIndex = stb.UnderType[type];
            RETURN[WITH t~~stb.seb[csei] SELECT FROM
                subrange => (WITH rt~~stb.seb[stb.UnderType[t.rangeType]] SELECT FROM
                    basic => (rt.code = codeINT AND t.origin = 0 AND t.range = CARDINAL.LAST),
                    ENDCASE => FALSE),
                ENDCASE => FALSE]
            };

        }.