-- File [Ivy]<Nelson>Lupine>LupineSymbolTableImpl.mesa.
-- Last edited by BZM on 11-May-82 14:12:53.
-- Last edited by Andrew Birrell October 4, 1982 1:09 pm (changes for 3.4)
-- Last edited by Paul Rovner January 28, 1983 1:37 pm (changes for 4.0)


DIRECTORY
  -- Cedar-only symbol table interface (can be easily converted to Mesa):
  AMTypes USING [Error],
  Rope USING[ ToRefText ],
  RTSymbolDefs USING[ SymbolTableBase, SymbolIdIndex ],
  RTSymbolOps USING[ EnumerateCtxIseis, NullISEI, NullCtx, ISECtx ],
  RTSymbols USING [AcquireSTBFromSGI, ReleaseSTB ],
  -- Mesa-compatible interfaces:
  BcdDefs USING [FTSelf, SGIndex, SGNull, VersionID],
  BcdOps USING [BcdBase, ProcessSegs, SGHandle],
  CWF USING [FWF1],
  Directory USING [Error, GetProps],
  File USING [Capability, nullCapability, PageNumber],
  Inline USING [LowHalf],
  LongString USING [
          AppendChar, AppendLongNumber, AppendNumber,
        AppendSubString, EqualSubStrings ],
  LupineSymbolTable USING [
        ComponentProcedure,
        DirectoryProcedure, FullTypeName, GMT,
        Index, InterfaceInfo, OpenErrorCode,
        ParamPassingMethod, STBase,
        String, StringNIL, SymbolHandle, SymbolID,
        TransferProcedure, TransferTypes, TypeHandle,
        TypeInfo, VariantProcedure, VersionStamp, Words ],
  Space USING [
          Create, Delete, Handle, LongPointer,
        Map, nullHandle, virtualMemory ],
  Strings: TYPE Strings USING [SubString, SubStringDescriptor],
  Symbols USING [
        BodyRecord, BTIndex,
        codeANY, codeCHAR, codeINT,
        CSEIndex, CTXIndex, CTXRecord,
        HTIndex, HTNull, ISEIndex, ISENull, lZ,
        MDIndex, OwnMdi,
        RecordSEIndex, RecordSENull, SEIndex, SENull, SERecord,
        TransferMode, TypeClass, typeTYPE, WordLength ],
  SymbolTable USING [Base],
  Table USING [Base, Limit];


LupineSymbolTableImpl: PROGRAM
  IMPORTS AMTypes, BcdOps, CWF, Directory, Inline, LongString, Rope, RTSymbolOps,
              RTSymbols, Space
  EXPORTS LupineSymbolTable
  SHARES LupineSymbolTable
  = BEGIN OPEN Symbols, ST: LupineSymbolTable;

 
  STBase: TYPE = ST.STBase;
  
  String: TYPE = ST.String;
  AllocString: TYPE = STRING _ NIL;
    -- Circumvent String = MaxFilenameLength problem.
  AllocSubString: TYPE = Strings.SubStringDescriptor _
                        [base: NIL, offset: NULL, length: NULL] | NULL;
  
  MaxFilenameLength: INTEGER = 100;
  MaxIdentifierLength: INTEGER = 150;
 
 -- Interface file operations.


  -- This is root interface symbol table info (from OpenInterface).
  rootSTB: STBase _ NIL;
  rootFile: File.Capability _ File.nullCapability;
  rootSpace: Space.Handle _ Space.nullHandle;
  rootBcd: BcdOps.BcdBase _ NIL;


  OpenInterface: PUBLIC PROCEDURE [
      interfaceFilename: String,
      interfaceCapability: File.Capability ] =
    BEGIN
    ENABLE UNWIND => CloseInterface[];
    symbols: BcdDefs.SGIndex;
    rootFile _ interfaceCapability;
    [rootSpace, rootBcd] _ LoadUpBcd[
      interfaceCapability
     ! LoadVersionError => ERROR OpenError[interfaceFilename, badFileVersion] ];
    IF (symbols _ GetOwnSymbolsSGI[rootBcd]) = BcdDefs.SGNull
    THEN ERROR OpenError[interfaceFilename, badFileFormat];
    rootSTB _ NARROW
                   [RTSymbols.AcquireSTBFromSGI[
                      bcd: rootBcd,
                      sgi: symbols, 
                      mesaSymbolsOK: TRUE 
                         ! AMTypes.Error =>
                            BEGIN
                            temp: REF TEXT = Rope.ToRefText[msg];
                            IF reason = noSymbols
                             THEN ERROR OpenError[LOOPHOLE[temp,String], badFileName] ;
                            END ],
                    RTSymbolDefs.SymbolTableBase.x].e;
    IF ~rootBcd.definitions
    THEN ERROR OpenError[interfaceFilename, notInterfaceModule];
    InitializeBuiltinTypes[standardStb: rootSTB];
    END;

  OpenError: PUBLIC ERROR [fileOrModuleName: String, why: ST.OpenErrorCode]
        = CODE;

  CloseInterface: PUBLIC PROCEDURE = 
    BEGIN
    IF rootSTB # NIL THEN RTSymbols.ReleaseSTB[[x[rootSTB]]];
    IF rootSpace # Space.nullHandle THEN Space.Delete[rootSpace];
    rootSTB _ NIL;
    rootFile _ File.nullCapability;
    rootSpace _ Space.nullHandle;
    rootBcd _ NIL;
    END;

  GetInterfaceInfo: PUBLIC PROCEDURE [
        moduleNameString, fileNameString: String_NIL ]
    RETURNS [
        contents: ST.InterfaceInfo,
        moduleName, fileName: String,
        moduleVersion: ST.VersionStamp,
        moduleCreateTime, sourceCreateTime: ST.GMT ] =
    BEGIN
    CheckContents: ContextProcedure =
      BEGIN
      SELECT itemStb.TypeForm[SymType[itemStb,itemIsei]] FROM
        transfer =>
            contents.transfers[XferModeToTransferType[
                        itemStb.XferMode[SymType[itemStb,itemIsei]]] ] _ TRUE;
        opaque => contents.types _ TRUE;
        ENDCASE => IF ~itemStb.seb[itemIsei].constant THEN contents.variables _ TRUE;
      END;
    dummy: AllocString = [MaxFilenameLength];
    contents _ [];  -- Initialize contents.
    [] _ EnumerateContext[
      ctxStb: rootSTB, ctx: rootSTB.stHandle.outerCtx, ctxProc: CheckContents];
    GetModuleInfo[ rootSTB, OwnMdi,
        (moduleName _ moduleNameString), (fileName _ fileNameString)];
    moduleVersion _ rootSTB.stHandle.version;
    moduleCreateTime _
      Directory.GetProps[rootFile, dummy ! Directory.Error => CONTINUE].createDate;
    sourceCreateTime _ LOOPHOLE[rootSTB.stHandle.sourceVersion.time];
    END;

  VersionStampString: PUBLIC PROCEDURE [stamp: ST.VersionStamp, string: String]
        RETURNS [stampString: String] =
    -- Be sure to set LupineSymbolTable.MaxVersionStampStringLength correctly.
    BEGIN OPEN LongString;
    stampString _ string;
    stampString.length _ 0;
    AppendNumber[stampString, stamp.net, 8];  AppendChar[stampString, '#];
    AppendNumber[stampString, stamp.host, 8];  AppendChar[stampString, '#];
    AppendLongNumber[stampString, stamp.time, 8];
    END;

  XferModeToTransferType: PACKED ARRAY TransferMode OF ST.TransferTypes = [
    proc: Procedure, error: Error, signal: Signal,
    port: Port, program: Program, process: Process, none: Other  ];

  GetModuleInfo: PROCEDURE [
        stBase: STBase, module: MDIndex,
        --RETURNS-- moduleName, fileName: String_ST.StringNIL] =
    --INLINE-- BEGIN
    IF moduleName # ST.StringNIL
            THEN HtiString[stBase, stBase.mdb[module].moduleId, moduleName];
    IF fileName # ST.StringNIL
            THEN HtiString[stBase, stBase.mdb[module].fileId, fileName];
    END;

  LoadVersionError: ERROR = CODE;

  LoadUpBcd: PROC [bcdFile: File.Capability]
      RETURNS [bcdSpace: Space.Handle_Space.nullHandle, bcd: BcdOps.BcdBase] =
    BEGIN
    bcdSpaceBase: File.PageNumber _ 1;
    pages: CARDINAL;
    BEGIN ENABLE UNWIND => IF bcdSpace#Space.nullHandle THEN Space.Delete[bcdSpace];
      bcdSpace _ Space.Create[size: 1, parent: Space.virtualMemory];
      Space.Map[space: bcdSpace, window: [file: bcdFile, base: bcdSpaceBase]];
      bcd _ Space.LongPointer[bcdSpace];
      IF bcd.versionIdent # BcdDefs.VersionID THEN ERROR LoadVersionError;
      pages _ bcd.nPages;
      IF pages > 1 THEN
        BEGIN
        Space.Delete[bcdSpace];
        bcdSpace _ Space.Create[size: pages, parent: Space.virtualMemory];
        Space.Map[space: bcdSpace, window: [file: bcdFile, base: bcdSpaceBase]];
        bcd _ Space.LongPointer[bcdSpace];
        END;
    END;
    END;

  GetOwnSymbolsSGI: PROC [ownBcd: BcdOps.BcdBase]
      RETURNS [ownSGI: BcdDefs.SGIndex] =
    BEGIN OPEN BcdOps, BcdDefs;
    CheckSeg: PROC [sgh: SGHandle, sgi: SGIndex]
      RETURNS [--stop:-- BOOLEAN] =
      {RETURN[sgh.class=symbols AND sgh.file=FTSelf]};
    ownSGI _ ProcessSegs[bcd: ownBcd, proc: CheckSeg].sgi;
    END;

 -- Enumeration routines that generate an interface's contents.

 EnumerateDirectory: PUBLIC PROCEDURE [proc: ST.DirectoryProcedure]
                RETURNS [stopped: BOOLEAN_FALSE] =
    BEGIN
    DoDirItem: ContextProcedure =
      BEGIN OPEN itemStb;
      moduleName: AllocString = [MaxIdentifierLength];
      fileName: AllocString = [MaxFilenameLength];
      imported: BOOLEAN;
      defContext: CTXIndex;
      module: MDIndex;
      WITH seb[UnderType[seb[itemIsei].idType]] SELECT FROM
          definition => defContext _ defCtx;
          transfer => defContext _
                          bb[LOOPHOLE[seb[itemIsei].idInfo, BTIndex]].localCtx;
          ENDCASE => ERROR;
      WITH ctx: ctxb[defContext] SELECT FROM
          simple => {module _ OwnMdi; imported _ FALSE};
          included => {module _ ctx.module; imported _ FALSE};
          imported => {module _ ctxb[ctx.includeLink].module; imported_TRUE};
          ENDCASE => ERROR;
      GetModuleInfo[itemStb, module, moduleName, fileName];
      FOR chr: CARDINAL IN [0..fileName.length) DO
        IF fileName[chr] = '. THEN {fileName.length _ chr; EXIT};
        ENDLOOP;
      RETURN[stop: proc[moduleName: moduleName, fileName: fileName,
                        imported: imported, directoryIndex: itemIndex].stop];
      END;
    stopped _ EnumerateContext[
        ctxStb: rootSTB, ctx: rootSTB.stHandle.directoryCtx, ctxProc: DoDirItem];
    END;

  EnumerateTransfers: PUBLIC PROCEDURE [
        proc: ST.TransferProcedure,
        all, procs, signals, errors: BOOLEAN _ FALSE ]
      RETURNS [stopped: BOOLEAN_FALSE] =
    BEGIN
    index: ST.Index _ 0;
      -- The ContextProcedure's itemIndex is invalid here
      -- because this enumeration is of the ST's outer context.
    DoTransfer: ContextProcedure =
      BEGIN
      InlineOrMachineCode: PROCEDURE [transfer: ISEIndex] RETURNS [BOOLEAN] =
        INLINE {RETURN[itemStb.seb[transfer].constant]};
      topType: SEIndex = SymType[itemStb, itemIsei];
      type: CSEIndex = itemStb.UnderType[topType];
      WITH xfer: itemStb.seb[type] SELECT FROM
       transfer =>
        SELECT xfer.mode FROM
          proc =>
            IF (all OR procs) AND ~InlineOrMachineCode[itemIsei] THEN
              stop _ proc[
                        transfer: [itemStb, itemIsei],
                        transferType: [itemStb, topType], kind: Procedure,
                        argumentRecordType: [itemStb, xfer.typeIn],
                        resultRecordType: [itemStb, xfer.typeOut],
                        transferIndex: (index _ index+1) ];
          error =>
            IF all OR errors THEN
              stop _ proc[
                        transfer: [itemStb, itemIsei],
                        transferType: [itemStb, topType], kind: Error,
                        argumentRecordType: [itemStb, xfer.typeIn],
                        resultRecordType: [itemStb, xfer.typeOut],
                        transferIndex: (index _ index+1) ];
          signal =>
            IF all OR signals THEN
              stop _ proc[
                        transfer: [itemStb, itemIsei],
                        transferType: [itemStb, topType], kind: Signal,
                        argumentRecordType: [itemStb, xfer.typeIn],
                        resultRecordType: [itemStb, xfer.typeOut],
                        transferIndex: (index _ index+1) ];
          ENDCASE => 
            IF all THEN
              stop _ proc[
                        transfer: [itemStb, itemIsei],
                        transferType: [itemStb, topType],
                        kind: XferModeToTransferType[xfer.mode],
                        argumentRecordType: [itemStb, xfer.typeIn],
                        resultRecordType: [itemStb, xfer.typeOut],
                        transferIndex: (index _ index+1) ];
        ENDCASE => NULL;
      END;
    stopped _ EnumerateContext[
        ctxStb: rootSTB, ctx: rootSTB.stHandle.outerCtx, ctxProc: DoTransfer];
    END;

  EnumerateRecord: PUBLIC PROCEDURE [
        recordType: ST.TypeHandle, proc: ST.ComponentProcedure]
    RETURNS [stopped: BOOLEAN_FALSE] =
    BEGIN
    recStb: STBase = recordType.base;
    IF recordType.type = SENull THEN RETURN;
    WITH rec: recStb.seb[recStb.UnderType[recordType.type]] SELECT FROM
      record =>
        BEGIN
        DoComponent: ContextProcedure =
          BEGIN
          RETURN[
            stop: proc[
                    component: [itemStb, itemIsei],
                    componentType: [itemStb, SymType[itemStb, itemIsei]],
                    componentIndex: itemIndex ].stop  ];
          END;
        stopped _ EnumerateContext[
          ctxStb: recStb, ctx: rec.fieldCtx, ctxProc: DoComponent]
        END;
      ENDCASE => ERROR;
    END;

  EnumerateVariants: PUBLIC PROCEDURE [
        variantPartType: ST.TypeHandle, proc: ST.VariantProcedure]
    RETURNS [stopped: BOOLEAN_FALSE] =
    BEGIN
    varStb: STBase = variantPartType.base;
    IF variantPartType.type = SENull THEN ERROR;
    WITH var: varStb.seb[varStb.UnderType[variantPartType.type]] SELECT FROM
      union =>
        BEGIN
        DoVariant: ContextProcedure =
          BEGIN
          RETURN[
            stop: proc[
                    variantTag: [itemStb, itemIsei],
                    variantNumber: itemStb.seb[itemIsei].idValue,
                    variantRecordType: [itemStb, itemStb.seb[itemIsei].idInfo],
                    variantIndex: itemIndex ].stop  ];
          END;
        stopped _ EnumerateContext[
          ctxStb: varStb, ctx: var.caseCtx, ctxProc: DoVariant];
        END;
      ENDCASE => ERROR;
    END;

  ContextProcedure: TYPE = PROCEDURE [
        itemStb: SymbolTable.Base, itemIsei: ISEIndex, itemIndex: ST.Index]
      RETURNS [stop: BOOLEAN_FALSE];

  EnumerateContext: PROCEDURE [
        ctxStb: STBase,
        ctx: CTXIndex,
        ctxProc: ContextProcedure ]
      RETURNS [stopped: BOOLEAN_FALSE] =
    BEGIN
    item: ST.Index _ 0;
    SkipRecordPackingInfo: PROCEDURE [stb: RTSymbolDefs.SymbolTableBase,
                                                 isei: RTSymbolDefs.SymbolIdIndex]
        RETURNS [--stop:-- BOOLEAN] =
      BEGIN
      RETURN[IF item=0 AND NOT RTSymbolOps.NullISEI[isei]
                             AND RTSymbolOps.NullCtx[RTSymbolOps.ISECtx[stb, isei]]
                THEN FALSE
                ELSE ctxProc[itemStb: NARROW[stb, RTSymbolDefs.SymbolTableBase.x].e,
                          itemIsei: NARROW[isei, RTSymbolDefs.SymbolIdIndex.x].e,
                          itemIndex: (item_item+1) ].stop  ];
      END;
    stopped _ RTSymbolOps.EnumerateCtxIseis[
        stb: [x[ctxStb]], ctx: [x[ctx]], proc: SkipRecordPackingInfo,
        mesaSymbolsOK: TRUE
      !
      AMTypes.Error =>
        BEGIN
        temp: REF TEXT = Rope.ToRefText[msg];
        IF reason = noSymbols THEN ERROR OpenError[LOOPHOLE[temp,String], badFileName];
        END  ];
    END;

-- General operations for types and symbols.

  SymbolName: PUBLIC PROCEDURE [symbol: ST.SymbolHandle, nameString: String]
                RETURNS [name: String_NULL] =
    BEGIN
    stb: STBase = symbol.base;
    name _ nameString;
    IF IsAnonymous[symbol]
        THEN name.length _ 0
        ELSE IseiString[stb, symbol.symbol, name];
    END;

  IsAnonymous: PUBLIC PROCEDURE [symbol: ST.SymbolHandle]
        RETURNS [yes: BOOLEAN] =
    {RETURN[symbol.base.seb[symbol.symbol].hash = HTNull]};

  SymbolType: PUBLIC PROCEDURE [symbol: ST.SymbolHandle]
      RETURNS [type: ST.TypeHandle] = {
    RETURN[ST.TypeHandle[symbol.base, SymType[symbol.base, symbol.symbol]]]};

  SymType: PROCEDURE [stb: STBase, isei: ISEIndex] RETURNS [SEIndex] =
    INLINE BEGIN
    RETURN[ IF stb.seb[isei].idType = SENull
                THEN ERROR ELSE stb.seb[isei].idType];
    END;

  SymbolUniqueID: PUBLIC PROCEDURE [symbol: ST.SymbolHandle]
      RETURNS [uniqueID: ST.SymbolID] = {
    RETURN[LOOPHOLE[@symbol.base.seb[symbol.symbol]]]};

  SearchTypeDefinition: PUBLIC PROCEDURE [
        rootDef: ST.TypeHandle,
        candidateDefs: LONG DESCRIPTOR FOR READONLY ARRAY OF ST.FullTypeName ]
      RETURNS [indexOfMatch: INTEGER _ -1 --No match--] =
    BEGIN
    thisBase: STBase = rootDef.base;
    thisType: SEIndex _ rootDef.type;
    thisName, thisModule: AllocSubString;
    DO
      WITH sei: thisBase.seb[thisType] SELECT FROM
        id =>
          BEGIN
          IseiSubString[
            stb: thisBase,
            isei: ISEI[thisType],
            iseiSubString: @thisName ];
          HtiSubString[
            stb: thisBase,
            hti: ModuleHtiOfTypeName[thisBase, ISEI[thisType]],
            htiSubString: @thisModule ];
          FOR type: INTEGER IN [0..LENGTH[candidateDefs]) DO
              IF StringEqualSubString[candidateDefs[type].name, @thisName] AND
                 StringEqualSubString[candidateDefs[type].module, @thisModule]
                THEN RETURN[type];
            REPEAT
              FINISHED => thisType _ sei.idInfo;
            ENDLOOP;
          END;
        cons =>
          WITH csei: sei SELECT FROM
            long => thisType _ csei.rangeType;
            ENDCASE => RETURN;
        ENDCASE => ERROR; 
      ENDLOOP;
    END;

  Size: PUBLIC PROCEDURE [type: ST.TypeHandle] RETURNS [size: ST.Words] =
    BEGIN RETURN[type.base.WordsForType[type.type]]; END;

  ComputeArraySize: PUBLIC PROCEDURE [
        index, elements: ST.TypeHandle, packed: BOOLEAN ]
      RETURNS [--size:-- ST.Words] =
    BEGIN
    -- This array size code is from from SymbolPack.WordsForType.
    -- It's been changed to work properly for CARDINAL, INTEGER, etc.,
    -- index types, for which the compiler's Cardinality is zero!
    bits: LONG CARDINAL;
    cardinality: ST.Words = WITH indexInfo: GetTypeInfo[type: index] SELECT FROM
      Basic => indexInfo.cardinality,
      ENDCASE => ERROR;
    RETURN[
      IF (bits_elements.base.BitsPerElement[elements.type, packed]) < WordLength
        THEN (cardinality+(WordLength/bits-1)) / (WordLength/bits)
        ELSE cardinality * ((bits+WordLength-1)/WordLength) ];
    END;


  ModuleHtiOfTypeName: PROCEDURE [stBase: STBase, typeName: ISEIndex]
        RETURNS [--moduleHti:-- HTIndex] =
    --INLINE-- BEGIN
    RETURN[stBase.mdb[ModuleOfTypeName[stBase, typeName]].moduleId]
    END;

  ModuleOfTypeName: PROCEDURE [stBase: STBase, typeName: ISEIndex]
        RETURNS [module: MDIndex] =
    BEGIN
    typeNameCtx: CTXRecord = stBase.ctxb[stBase.seb[typeName].idCtx];
    WITH ctx: typeNameCtx SELECT FROM
      simple => module _ OwnMdi;
      included => module _ ctx.module;
      imported => module _ stBase.ctxb[ctx.includeLink].module;
      ENDCASE => ERROR;
    END;

  HtiSubString: PROCEDURE [stb: STBase, hti: HTIndex,
                --RETURNS-- htiSubString: Strings.SubString] =
    INLINE BEGIN  -- hti=HTNull is OK; returns null substring.
    stb.SubStringForHash[htiSubString, hti];
    END;

  HtiString: PROCEDURE [stb: STBase, hti: HTIndex,
                --RETURNS-- htiString: String] =
    BEGIN
    desc: Strings.SubStringDescriptor;
    sub: Strings.SubString = @desc;
    HtiSubString[stb, hti, sub];
    htiString.length _ 0;
    LongString.AppendSubString[htiString, sub];
    END;

  ISEI: PROCEDURE [sei: SEIndex] RETURNS [--isei:-- ISEIndex] =
    -- In many discriminating SELECT statements, an SEIndex
    -- is properly known to be an ISEIndex, but Mesa cannot infer this
    -- because both are relative pointers.  This procedure captures
    -- the coercion.
    INLINE BEGIN RETURN[LOOPHOLE[sei]] END;

  IseiSubString: PROCEDURE [stb: STBase, isei: ISEIndex,
                --RETURNS-- iseiSubString: Strings.SubString] =
    --INLINE-- BEGIN
    HtiSubString[  stb,
                   (IF isei=ISENull THEN HTNull ELSE stb.seb[isei].hash),
                   iseiSubString   ];
    END;

  IseiString: PROCEDURE [stb: STBase, isei: ISEIndex,
                --RETURNS-- iseiString: String] =
    INLINE BEGIN
    HtiString[        stb,
                (IF isei=ISENull THEN HTNull ELSE stb.seb[isei].hash),
                iseiString   ];
    END;

  StringEqualSubString: PROCEDURE [a: String, b: Strings.SubString]
        RETURNS [--exactMatch:-- BOOLEAN] =
    INLINE BEGIN
    RETURN [a.length=b.length AND SlowStringEqualSubString[a,b]];
    END;

  SlowStringEqualSubString: PROCEDURE [a: String, b: Strings.SubString]
        RETURNS [exactMatch: BOOLEAN] =
    BEGIN
    aSub: AllocSubString _ [base: a, offset: 0, length: a.length];
    RETURN[LongString.EqualSubStrings[@aSub,b]];
    END;

-- Detailed operations for types.

  GetTypeInfo: PUBLIC PROC [type: ST.TypeHandle] RETURNS [info: ST.TypeInfo_[]] =
    BEGIN OPEN ST;
    typeStb: STBase = type.base;
    typeSei: SEIndex = type.type;
      IF typeSei = SENull THEN RETURN[[self: type, info: Null[]]];
      WITH typeSer: typeStb.seb[typeSei] SELECT FROM
        id =>
            SELECT TRUE FROM
              typeSer.idType # typeTYPE => ERROR;
              typeSer.idCtx = StandardTypeContext =>
                SELECT typeSei FROM
                  UNSPECIFIEDIndex => RETURN[
                        [self: type,
                         info: Basic[
                            kind: Unspecified,
                            origin: FIRST[WORD],
                            cardinality: (LONG[LAST[WORD]]-FIRST[WORD]+1) ]] ];
                  INTEGERIndex => RETURN[
                          [self: type,
                         info: Basic[
                            kind: Integer,
                            origin: FIRST[INTEGER],
                            cardinality: (LONG[LAST[INTEGER]]-FIRST[INTEGER]+1) ]] ];
                  CARDINALIndex => RETURN[
                          [self: type,
                         info: Basic[
                            kind: Cardinal,
                            origin: FIRST[CARDINAL],
                            cardinality: (LONG[LAST[CARDINAL]]-FIRST[CARDINAL]+1) ]] ];
                  NATIndex => RETURN[
                          [self: type,
                         info: Basic[
                            kind: Nat,
                            origin: FIRST[NAT],
                            cardinality: (LONG[LAST[NAT]]-FIRST[NAT]+1) ]] ];
                  REALIndex => RETURN[
                          [self: type,
                         info: Basic[
                            kind: Real,
                            origin: 0, cardinality: 0 ]] ];
                  WORDIndex => RETURN[
                          [self: type,
                         info: Basic[
                            kind: Word,
                            origin: FIRST[WORD],
                            cardinality: (LONG[LAST[WORD]]-FIRST[WORD]+1) ]] ];
                  CHARACTERIndex => RETURN[
                        [self: type,
                         info: Basic[
                            kind: Character,
                            origin: LOOPHOLE[FIRST[CHARACTER], INTEGER],
                            cardinality: LONG[ LOOPHOLE[LAST[CHARACTER], INTEGER]
                                          - LOOPHOLE[FIRST[CHARACTER], INTEGER]
                                          + 1 ] ]] ];
                  BOOLEANIndex => RETURN[
                          [self: type,
                         info: Basic[
                            kind: Boolean,
                            origin: LOOPHOLE[FIRST[BOOLEAN], INTEGER],
                            cardinality: 2 ]] ];
                  TEXTIndex => RETURN[[self: type, info: Text[]]];
                  STRINGIndex => RETURN[[self: type, info: String[]]];
                  StringBodyIndex => RETURN[[self: type, info: StringBody[]]];
                  ATOMIndex => RETURN[[self: type, info: Atom[], readonly: FALSE]];
                  MONITORLOCKIndex, CONDITIONIndex =>
                    RETURN[[self: type, info: Other[]]];
                  MDSZoneIndex => RETURN[
                        [self: type,
                         info: Zone[allocation: Uncounted, mdsZone: TRUE]] ];
                  ENDCASE =>
                    -- This code automatically handles INT, CHAR, BOOL
                    -- and other synonyms.  It could cause unforeseeable
                    -- problems with future builtin types.  Beware.
                    BEGIN 
                    synonymInfo: TypeInfo _ GetTypeInfo[[typeStb, typeSer.idInfo]];
                    synonymInfo.self _ type;
                    RETURN[ SELECT synonymInfo.type FROM
                      Basic, String, StringBody, Text, Atom, Rope, Any => synonymInfo,
                      ENDCASE => [self: type, info: Other[]] ];
                    END;
              IsType[["Rope"L, "ROPE"L], typeStb, ISEI[typeSei]] =>
                        RETURN[[self: type, info: Rope[], readonly: FALSE]];
              ENDCASE =>
                BEGIN
                method: ParamPassingMethod=GetParamMethod[typeStb, ISEI[typeSei]];
                symInfo: TypeInfo _ GetTypeInfo[[typeStb, typeSer.idInfo]];
                symInfo.self _ type;
                IF method # standard THEN symInfo.passingMethod _ method;
                RETURN[symInfo];
                END;
        cons =>
            WITH typeCser: typeSer SELECT FROM
              basic, real => ERROR;  -- Should have been in StandardTypeContext.
              definition => RETURN[[self: type, info: Definition[]]];
              subrange => RETURN[
                    [self: type,
                     info: Basic[
                        kind: Subrange,
                        origin: typeCser.origin,
                        cardinality: IF typeCser.empty
                                        THEN 0 ELSE typeCser.range+1]] ];
              enumerated => RETURN[
                    [self: type,
                     info:  Basic[
                        kind: Enumeration,
                        origin: 0,
                        cardinality: typeCser.nValues]] ];
              transfer => RETURN[
                    [self: type,
                     info:  Transfer[
                        kind: XferModeToTransferType[typeCser.mode],
safe: FALSE, -- SAFE:                        safe: typeCser.safe,
                        argumentType: TypeHandle[typeStb, typeCser.typeIn],
                        resultType: TypeHandle[typeStb, typeCser.typeOut]]] ];
              record =>
                BEGIN
                variantType: TypeClass _ record;
                GetVariantType: ComponentProcedure =
                  BEGIN
                  variantType _ componentType.base.TypeForm[componentType.type];
                  RETURN[
                    stop: SELECT variantType FROM
                        union, sequence => TRUE, ENDCASE => FALSE];
                  END;  -- GetVariantType.
                IF typeCser.hints.variant THEN
                  [] _ EnumerateRecord[type, GetVariantType];
                RETURN[
                    [self: type,
                     info:  Record[
                        painted: typeCser.painted,
                        paramRecord: typeCser.argument,
                        monitored: typeCser.monitored,
                        uniField: typeCser.hints.unifield,
                        hasVariants: variantType=union,
                        hasSequences: variantType=sequence]] ];
                END;
              union =>
                IF typeCser.controlled THEN
                  SELECT typeStb.seb[SymType[typeStb, typeCser.tagSei]].seTag FROM
                    id => RETURN[
                            [self: type,
                         info: VariantPart[
                            tag: Named[
                                name: SymbolHandle[typeStb, typeCser.tagSei],
                                type: SymbolType[[typeStb, typeCser.tagSei]]]]] ];
                    cons => RETURN[
                            [self: type,
                         info: VariantPart[
                            tag: Star[
                                name: SymbolHandle[typeStb, typeCser.tagSei]]]] ];
                    ENDCASE => ERROR
                  ELSE RETURN[
                            [self: type,
                         info: VariantPart[tag: Computed[]]] ];
              ref =>
                 SELECT TRUE FROM
                   ~typeCser.counted => RETURN[
                        [self: type,
                         info: Pointer[
                            referentType: TypeHandle[typeStb,typeCser.refType]],
                         readonly: typeCser.readOnly] ];
                   typeCser.list => {
                        base: STBase;
                        first, rest: SEIndex;
                        [base, first, rest] _ ListTypes[typeStb, typeSei];
                        RETURN[
                            [self: type,
                             info: List[
                                firstType: TypeHandle[base, first],
                                restType: TypeHandle[base, rest]],
                             readonly: typeCser.readOnly] ] };
                   typeCser.counted => RETURN[
                        [self: type,
                         info: Ref[
                            referentType: TypeHandle[typeStb,typeCser.refType]],
                         readonly: typeCser.readOnly] ];
                   ENDCASE => ERROR;
              relative => RETURN[
                    [self: type,
                     info:  RelativePtr[
                        baseType: TypeHandle[typeStb, typeCser.baseType],
                        offsetType: TypeHandle[typeStb, typeCser.offsetType],
                        resultType: TypeHandle[typeStb, typeCser.resultType]]] ];
              array => RETURN[
                    [self: type,
                     info:  Array[
                        packed: typeCser.packed,
                        indexType: TypeHandle[typeStb, typeCser.indexType],
                        elementType:
                            TypeHandle[typeStb, typeCser.componentType]]] ];
              arraydesc =>
                BEGIN
                arrayInfo: TypeInfo _
                  GetTypeInfo[[typeStb, typeCser.describedType]];
                WITH array: arrayInfo SELECT FROM
                  Array => RETURN[
                    [self: type,
                     info: Descriptor[
                        packed: array.packed,
                        indexType: array.indexType,
                        elementType: array.elementType],
                     readonly: typeCser.readOnly]  ];
                  ENDCASE => ERROR;
                END;
              sequence => 
                IF typeCser.controlled
                 THEN RETURN [
                     [self: type,
                      info: Sequence[
                        packed: typeCser.packed,
                        indexType: SymbolType[[typeStb, typeCser.tagSei]],
                        elementType: TypeHandle[typeStb, typeCser.componentType],
                        tagName: Named[
                                name: SymbolHandle[typeStb, typeCser.tagSei]]]] ]
                 ELSE RETURN [
                     [self: type,
                      info: Sequence[
                        packed: typeCser.packed,
                        indexType: SymbolType[[typeStb, typeCser.tagSei]],
                        elementType: TypeHandle[typeStb, typeCser.componentType],
                        tagName: Computed[]]] ];
              long =>
                BEGIN
                shortInfo: TypeInfo _ GetTypeInfo[[typeStb, typeCser.rangeType]];
                shortInfo.self _ type;
                shortInfo.long _ SELECT shortInfo.type FROM
                  Ref, List, Zone => FALSE, ENDCASE => TRUE;
                RETURN[shortInfo];
                END;
              zone => RETURN[
                    [self: type,
                     info: Zone[
                      allocation: IF typeCser.counted THEN Counted ELSE Uncounted,
                      mdsZone: typeCser.mds  ]] ];
              opaque => RETURN[
                    [self: type,
                     info: Opaque[lengthKnown: typeCser.lengthKnown]] ];
              any => RETURN[[self: type, info: Any[]]];
              ENDCASE => RETURN[[self: type, info: Other[]]];
          ENDCASE => ERROR;
    END;


  IsType: PROCEDURE [
        type: ST.FullTypeName,
        candidateStb: STBase, candidateIsei: ISEIndex ]
      RETURNS [--yes:-- BOOLEAN] =
    BEGIN
    -- Checks to see if the candidate type ID = FullTypeName.
    candidate: AllocSubString;
    IseiSubString[candidateStb, candidateIsei, @candidate];
    IF ~StringEqualSubString[type.name, @candidate] THEN RETURN[FALSE];
    HtiSubString[
        stb: candidateStb,
        hti: ModuleHtiOfTypeName[candidateStb, candidateIsei],
        htiSubString: @candidate];
    RETURN[StringEqualSubString[type.module, @candidate]];
    END;

  GetParamMethod: PROC [paramStb: STBase, paramIsei: ISEIndex]
        RETURNS [method: ST.ParamPassingMethod] =
    BEGIN
    Check: PROC [prefix: STRING] RETURNS [--isMatch:-- BOOLEAN] =
        BEGIN
        IF prefix.length >= typeName.length THEN RETURN[FALSE];
        FOR i: CARDINAL IN [0..prefix.length) DO
            IF typeName.base[typeName.offset+i] # prefix[i] THEN RETURN[FALSE];
            ENDLOOP;
        RETURN[TRUE];
        END;
    typeName: AllocSubString;
    IseiSubString[paramStb, paramIsei, @typeName];
    RETURN[
        SELECT TRUE FROM
          Check["VAR"L], Check["VALUERESULT"L] => var,
          Check["VALUE"L] => value,
          Check["RESULT"L] => result,
          Check["HANDLE"L] => handle,
          ENDCASE => standard];
    END;

  ListTypes: PROC [listStb: STBase, listSei: --Ref--SEIndex]
        RETURNS [base: STBase, first, rest: SEIndex_SENull] =
    BEGIN
    componentName: AllocSubString;
    gotFirst, gotRest: BOOLEAN _ FALSE;
    CheckFirstRest: ST.ComponentProcedure =
        BEGIN
        IseiSubString[component.base, component.symbol, @componentName];
        SELECT TRUE FROM
            gotFirst => NULL;
            StringEqualSubString["first"L, @componentName] =>
                {gotFirst _ TRUE;
                 base _ componentType.base;
                 first _ componentType.type};
            ENDCASE => NULL;
        SELECT TRUE FROM
            gotRest => NULL;
            StringEqualSubString["rest"L, @componentName] =>
                {gotRest _ TRUE;
                 rest _ componentType.type};
            ENDCASE => NULL;
        RETURN[stop: gotFirst AND gotRest];
        END;  -- CheckFirstRest.
      listCsei: CSEIndex = listStb.UnderType[listSei];
      WITH listRef: listStb.seb[listCsei] SELECT FROM
        ref => {
          IF ~listRef.list OR ~listRef.counted THEN ERROR;
          IF ~EnumerateRecord[
                recordType: [listStb, listRef.refType],
                proc: CheckFirstRest ].stopped
            THEN ERROR };
        ENDCASE => ERROR;
    END;

  UNSPECIFIEDIndex, INTEGERIndex, CARDINALIndex,
  NATIndex, REALIndex, WORDIndex, CHARACTERIndex, BOOLEANIndex,
  TEXTIndex, STRINGIndex, StringBodyIndex, ATOMIndex,
  MONITORLOCKIndex, CONDITIONIndex, MDSZoneIndex:   ISEIndex _ ISENull;

  StandardTypeContext: CTXIndex = LOOPHOLE[2];

  InitializeBuiltinTypes: PROCEDURE [standardStb: STBase] =
    BEGIN
    GetTypeISEIndex: PROC [standardType: STRING, system: {Mesa, Cedar}_Mesa]
                                        RETURNS [typesISE: ISEIndex] =
        BEGIN OPEN Strings;
        subString: SubStringDescriptor _
          [standardType, 0, standardType.length];
        typesISE _ standardStb.SearchContext[
          hti: standardStb.FindString[@subString],
          ctx: StandardTypeContext ];
        IF typesISE=ISENull AND system=Mesa THEN ERROR;
        END;
    UNSPECIFIEDIndex _ GetTypeISEIndex["UNSPECIFIED"L];
    INTEGERIndex _ GetTypeISEIndex["INTEGER"L];
    CARDINALIndex _ GetTypeISEIndex["CARDINAL"L];
    NATIndex _ GetTypeISEIndex["NAT"L, Cedar];
    REALIndex _ GetTypeISEIndex["REAL"L];
    WORDIndex _ GetTypeISEIndex["WORD"L];
    CHARACTERIndex _ GetTypeISEIndex["CHARACTER"L];
    BOOLEANIndex _ GetTypeISEIndex["BOOLEAN"L];
    TEXTIndex _ GetTypeISEIndex["TEXT"L];
    STRINGIndex _ GetTypeISEIndex["STRING"L];
    StringBodyIndex _ GetTypeISEIndex["StringBody"L];
    ATOMIndex _ GetTypeISEIndex["ATOM"L, Cedar];
    MONITORLOCKIndex _ GetTypeISEIndex["MONITORLOCK"L];
    CONDITIONIndex _ GetTypeISEIndex["CONDITION"L];
    MDSZoneIndex _ GetTypeISEIndex["MDSZone"L];
    END;

-- Type printing routines.  The output must be compilable.
-- Most of these routines are derived from <Mesa>Lister>ListPub.mesa.

  PutTypeName: PUBLIC PROCEDURE [
        putProc: PROC[CHARACTER],
        type: ST.TypeHandle,
        includeReadonly: BOOLEAN_TRUE,
        rootInterfaceOpenName: String_ST.StringNIL ] =
    BEGIN ENABLE UNWIND => putChar _ NIL;
    putChar _ putProc;
    rootInterfaceQualifier _ rootInterfaceOpenName;
    [] _ PrintType[
        stBase: type.base,
        tsei: type.type,
        printReadonly: includeReadonly,
        dosub: NoSub ];
    --putChar _ NIL;
    --rootInterfaceQualifier _ NIL;
    END;

  -- These global routines are used by PrintType and friends (below).
  putChar: PROCEDURE [CHARACTER] _ NIL;  -- Set by PutTypeName.
  PutChar: PROC [chr: CHARACTER] = INLINE {putChar[chr]};
  PutString: PROC [str: String] =
    --INLINE-- BEGIN
    FOR i: CARDINAL IN [0..str.length) DO PutChar[str[i]] ENDLOOP;
    END;
  PutSubString: PROC [subStr: Strings.SubString] =
    --INLINE-- BEGIN
    FOR i: CARDINAL IN [subStr.offset..subStr.offset+subStr.length) DO
        PutChar[subStr.base[i]];
        ENDLOOP;
    END;
  PutDecimal: PROC [int: LONG INTEGER] = 
    --INLINE-- {CWF.FWF1[putChar, "%LD", @int]};
  PutOctal: PROC [num: LONG CARDINAL, trailingB: BOOLEAN_TRUE] =
    --INLINE-- {CWF.FWF1[putChar, "%LB", @num]; IF trailingB THEN PutChar['B]};


  PrintType: PROCEDURE [
        stBase: STBase,
        tsei: SEIndex,
        dosub: PROCEDURE [vf: ValFormat],
        printReadonly: BOOLEAN_TRUE ]
      RETURNS [vf: ValFormat _ [none[]] ] =
    BEGIN OPEN Symbols, stBase;  -- This damn OPEN was here when I arrived!
    PrintReadonly: PROC [wantReadonly: BOOLEAN] =
      BEGIN
       -- Exclude only the top-level appearance of READONLY in a type expression.
      IF wantReadonly AND printReadonly THEN PutString["READONLY "L];
      IF ~printReadonly THEN printReadonly _ TRUE;
      END;
    WITH t: seb[tsei] SELECT FROM
      id =>
        BEGIN
        printBase: BOOLEAN _ TRUE;
        ifInteger: BOOLEAN _ FALSE;
        bsei: SEIndex _ tsei;
        csei: CSEIndex;
        DO
          csei _ UnderType[bsei];
          WITH c: seb[csei] SELECT FROM
            basic =>
              SELECT c.code FROM
                codeINT => BEGIN printBase _ ifInteger; vf _ [num[]] END;
                codeCHAR => vf _ [char[]];
                ENDCASE;
            subrange =>
              {bsei _ c.rangeType; ifInteger _ TRUE; LOOP};
            enumerated =>
              {printBase _ TRUE; vf _ [enum[stBase, LOOPHOLE[csei]]]};
            ENDCASE;
          EXIT;
          ENDLOOP;
        SELECT TRUE FROM
         ~printReadonly AND GetTypeInfo[type: [stBase, csei]].readonly =>
           [] _ PrintType[stBase, csei, dosub, FALSE];
         printBase OR dosub = NoSub =>
          BEGIN
          PrintModuleQualifier[stBase, tsei];
          WITH seb[csei] SELECT FROM
            record =>
              BEGIN
              -- This prints variant records in the Cedar style.
              -- For example:  short red Dress => Dress[red][short].
              --    Old variant record code:
              --    UNTIL (tsei _ TypeLink[tsei]) = SENull DO
              --      WITH seb[tsei] SELECT FROM
              --         id => {PutChar[' ]; PrintSei[stBase, ISEI[tsei]]};
              --         ENDCASE;
              --      ENDLOOP;
              PrintBoundVariants: PROC [recordType: ISEIndex] =
                BEGIN
                parent: SEIndex;
                IF (parent _ TypeLink[recordType]) = SENull
                  THEN PrintSei[stBase, recordType]
                  ELSE BEGIN
                    WITH seb[parent] SELECT FROM
                      id => PrintBoundVariants[ISEI[parent]]; 
                      cons => [] _ PrintType[stBase, parent, dosub]; 
                      ENDCASE => ERROR; 
                    PutChar['[];  PrintSei[stBase, recordType];  PutChar[']];
                    END;
                END;  -- PrintBoundVariants.
              PrintBoundVariants[ISEI[tsei]];
              END;
            ENDCASE => PrintSei[stBase, ISEI[tsei]];
          END;
         ENDCASE => NULL;
        dosub[vf];
        END;
      cons =>
        WITH t SELECT FROM
          --basic =>  Should see the ID first.
          enumerated =>
            BEGIN
            PrintEnumItem: ContextProcedure =
              BEGIN
              IF itemIndex > 1 THEN PutString[", "L];
              PrintSei[itemStb, itemIsei];
              END;
            IF machineDep THEN PutString["MACHINE DEPENDENT "L];
            PutChar['{];
            [] _ EnumerateContext[
              ctxStb: stBase, ctx: valueCtx, ctxProc: PrintEnumItem];
            PutChar['}];
            END;
          record =>
            BEGIN
            IF ctxb[fieldCtx].level # lZ THEN
              BEGIN
              fctx: CTXIndex = fieldCtx;
              bti: BTIndex _ FIRST[BTIndex];
              btlimit: BTIndex = bti + stHandle.bodyBlock.size;
              PutString["FRAME ["];
              UNTIL bti = btlimit DO
                WITH entry: bb[bti] SELECT FROM
                  Callable =>
                    BEGIN
                    IF entry.localCtx = fctx THEN
                      BEGIN PrintSei[stBase, entry.id]; PutChar[']]; EXIT END;
                    bti _
                      bti +
                        (WITH entry SELECT FROM
                           Inner => SIZE[Inner Callable BodyRecord],
                           ENDCASE => SIZE[Outer Callable BodyRecord]);
                    END;
                  ENDCASE => bti _ bti + SIZE[Other BodyRecord];
                ENDLOOP;
              END
            ELSE
              BEGIN
            --IF monitored THEN PutString["MONITORED "L];
                -- The LOCK field is printed below, so MONITORED is redundant.
              IF machineDep THEN PutString["MACHINE DEPENDENT "L];
              PutString[IF painted THEN "RECORD "L ELSE "STRUCT "L];
              PrintFieldCtx[stBase, fieldCtx];
              END;
            END;
          ref =>
            IF ~list
             THEN {  -- Normal POINTER or REF.
                IF ordered THEN PutString["ORDERED "L];
                IF basing THEN PutString["BASE "L];
                PutString[IF counted THEN "REF "L ELSE "POINTER"L];
                IF dosub # NoSub THEN {PutChar[' ]; dosub[[num[]]]};
                IF ~readOnly THEN WITH seb[UnderType[refType]] SELECT FROM
                  basic => IF code = Symbols.codeANY THEN GO TO noprint;
                  ENDCASE;
                IF ~counted THEN PutString[" TO "L];
                PrintReadonly[readOnly];
                [] _ PrintType[stBase, refType, NoSub];
                EXITS noprint => NULL }
             ELSE {  -- LIST OF something.
                firstBase: STBase;  firstBody: SEIndex;
                [base: firstBase, first: firstBody] _ ListTypes[stBase, tsei];
                PutString["LIST OF "L];
                PrintReadonly[readOnly];
                [] _ PrintType[firstBase, firstBody, NoSub] };
          array =>
            BEGIN
            IF packed THEN PutString["PACKED "L];
            PutString["ARRAY "L];
            [] _ PrintType[stBase, indexType, NoSub];
            PutString[" OF "L];
            [] _ PrintType[stBase, componentType, NoSub];
            END;
          arraydesc =>
            BEGIN
            PutString["DESCRIPTOR FOR "L];
            PrintReadonly[readOnly];
            [] _ PrintType[stBase, describedType, NoSub];
            END;
          transfer =>
            BEGIN
            ArgRes: PROC[type: CSEIndex] =
              BEGIN
              WITH argRes: seb[type] SELECT FROM
                record => PrintFieldCtx[stBase, argRes.fieldCtx];
                any => PutString["ANY"L];
              ENDCASE => ERROR;--?--
              END;
-- SAFE:            IF safe THEN PutString["SAFE "L];
            PrintModeName[mode];
            IF typeIn # RecordSENull THEN
              BEGIN
              PutChar[' ];
              ArgRes[typeIn];
              END;
            IF typeOut # RecordSENull THEN
              BEGIN
              PutString[" RETURNS "L];
              ArgRes[typeOut];
              END;
            END;
          union =>
            BEGIN
            tagType: SEIndex;
            PutString["SELECT "L];
            IF ~controlled THEN
              IF overlaid THEN PutString["OVERLAID "L]
              ELSE PutString["COMPUTED "L]
            ELSE BEGIN PrintSei[stBase, tagSei]; PutString[": "L] END;
            tagType _ seb[tagSei].idType;
            IF seb[tagSei].public # defaultPublic THEN
              PutString[
                IF defaultPublic THEN "PRIVATE "L ELSE "PUBLIC "L];
            WITH seb[tagType] SELECT FROM
              id => [] _ PrintType[stBase, tagType, NoSub];
              cons => PutChar['*];
              ENDCASE;
            PutString[" FROM "L];
            BEGIN
            isei: ISEIndex;
            first: BOOLEAN _ TRUE;
            varRec: RecordSEIndex;
            FOR isei _ FirstCtxSe[caseCtx], NextSe[isei] UNTIL isei=ISENull DO
              IF first THEN first _ FALSE ELSE PutString[", "L];
              PrintSei[stBase, isei];
              PutString[" => "L];
              varRec _ seb[isei].idInfo;
              PrintFieldCtx[stBase, seb[varRec].fieldCtx];
              ENDLOOP;
            PutString[" ENDCASE"L];
            END;
            END;
          sequence =>
            BEGIN
            IF packed THEN PutString["PACKED "L];
            PutString["SEQUENCE "L];
            IF controlled
                THEN {PrintSei[stBase, tagSei]; PutString[": "L]}
                ELSE PutString["COMPUTED "L];
            [] _ PrintType[stBase, SymType[stBase,tagSei], NoSub];
            PutString[" OF "L];
            [] _ PrintType[stBase, componentType, NoSub];
            END;
          relative =>
            BEGIN
            IF baseType # SENull
              THEN [] _ PrintType[stBase, baseType, NoSub, printReadonly];
            PutString[" RELATIVE "L];
            [] _ PrintType[stBase, offsetType, dosub, printReadonly];
            END;
          subrange =>
            BEGIN
            -- This has changes to (TRY) do intervals with negative endpoints
            -- such as (3..-1]) correctly.
            -- It still has problems for values not contained in LONG INTEGERs.
            org: LONG INTEGER _ origin;
            size: LONG CARDINAL _ range;
            upperBound: LONG INTEGER = org + size;
            doit: PROCEDURE [pvf: ValFormat] =
              BEGIN
              PutChar['[];
              PrintTypedVal[org, pvf, TRUE];
              PutString[".."L];
              IF empty
                THEN {PrintTypedVal[org, pvf, TRUE]; PutChar[')]}
                ELSE {
                  PrintTypedVal[
                    upperBound, pvf, upperBound < INTEGER[0]];
                  PutChar[']] };
              END;
            vf _ PrintType[stBase, rangeType, doit];
            END;
          long =>
            BEGIN
            range: CSEIndex = stBase.UnderType[rangeType];
            refOrList: BOOLEAN =
                    WITH refType: stBase.seb[range] SELECT FROM
                      ref => refType.counted OR refType.list,
                      ENDCASE => FALSE;
            IF ~refOrList THEN PutString["LONG "L];
            [] _ PrintType[stBase, rangeType, NoSub, printReadonly];
            END;
          real => PutString["REAL"L];
          opaque =>
            BEGIN
            PutString["TYPE"L];
            IF lengthKnown THEN {
              PutString[" ["L]; PrintValue[length]; PutString["]"L]; };
            END;
          zone => --Not totally corrrect for MdsZone:--
            PutString[IF ~counted THEN "UNCOUNTED ZONE"L ELSE "ZONE"L];
          any => PutString["ANY"L];
          ENDCASE => PutString["--!!!Unknown Type!!!--"L];
      ENDCASE;
    END;  -- PrintType.


  rootInterfaceQualifier: String;  -- Set by PutTypeName.

  PrintModuleQualifier: PROCEDURE [stBase: STBase, typeSei: SEIndex] =
    --INLINE-- BEGIN
    WITH type: stBase.seb[typeSei] SELECT FROM
      id =>
        BEGIN
        module: MDIndex;
        IF type.idCtx = StandardTypeContext THEN RETURN;
        module _ ModuleOfTypeName[stBase, ISEI[typeSei]];
        IF module = OwnMdi
          THEN {IF rootInterfaceQualifier=NIL OR rootInterfaceQualifier.length=0
                  THEN RETURN
                  ELSE PutString[rootInterfaceQualifier] }
          ELSE PrintHti[stBase, stBase.mdb[module].moduleId];
        PutChar['.];
        END;
      ENDCASE => NULL;
    END;

  defaultPublic: BOOLEAN _ TRUE;

  PrintSymbolType: PRIVATE PROCEDURE [stb: STBase, sei: ISEIndex] =
    BEGIN OPEN stb;
    savePublic: BOOLEAN _ defaultPublic;
    typeSei: SEIndex;
    IF seb[sei].public # defaultPublic THEN
      BEGIN
      defaultPublic _ seb[sei].public;
      PutString[IF defaultPublic THEN "PUBLIC "L ELSE "PRIVATE "L];
      END;
    IF seb[sei].idType = typeTYPE
     THEN BEGIN
      typeSei _ seb[sei].idInfo;
      PutString["TYPE = "L];
      [] _ PrintType[tsei: typeSei, dosub: NoSub, stBase: stb];
      END
     ELSE BEGIN
      vf: ValFormat;
      typeSei _ seb[sei].idType;
      vf _ PrintType[tsei: typeSei, dosub: NoSub, stBase: stb];
      IF seb[sei].constant AND vf.tag # none THEN
        BEGIN
        PutString[" = "L];
        PrintTypedVal[LONG[seb[sei].idValue], vf];
        END;
      END;
    defaultPublic _ savePublic;
    END;

  PrintFieldCtx: PROCEDURE [stBase: STBase, ctx: CTXIndex] =
    BEGIN
    PrintFieldItem: ContextProcedure =
      BEGIN
      IF itemIndex > 1 THEN PutString[", "L];
      IF ~IsAnonymous[[itemStb, itemIsei]]
        THEN {PrintSei[itemStb, itemIsei]; PutString[": "L] };
      PrintSymbolType[itemStb, itemIsei];
      END;
    PutChar['[];
    [] _ EnumerateContext[ctxStb: stBase, ctx: ctx, ctxProc: PrintFieldItem];
    PutChar[']];
    END;

  PrintModeName: PROCEDURE [mode: TransferMode] =
    BEGIN
    ModePrintName: PACKED ARRAY TransferMode OF STRING =
    ["PROCEDURE"L, "PORT"L, "SIGNAL"L, "ERROR"L,
     "PROCESS"L, "PROGRAM"L, "NONE"L];
    PutString[ModePrintName[mode]]
    END;

  ValFormat: TYPE = RECORD [
    SELECT tag: * FROM
      none => NULL,
      num => NULL,
      char => NULL,
      enum => [stBase: STBase, esei: EnumeratedSEIndex],
      ENDCASE];

  PrintTypedVal: PROCEDURE [
    val: LONG UNSPECIFIED, vf: ValFormat, integer: BOOLEAN_FALSE] =
    BEGIN
    WITH vf SELECT FROM
      num =>  PrintValue[val, integer];
      enum => PrintEnum[val, stBase, esei];
      char => IF val IN [' ..'~]
                THEN {PutChar[''];  PutChar[Inline.LowHalf[val]]}
                ELSE {PutOctal[num: val, trailingB: FALSE]; PutChar['C]};
      ENDCASE;
    END;

  PrintValue: PROCEDURE [value: LONG UNSPECIFIED, integer: BOOLEAN _ FALSE] =
    BEGIN
    IF integer OR
      LOOPHOLE[value,LONG CARDINAL] < LOOPHOLE[LAST[LONG INTEGER],LONG CARDINAL]
        THEN PutDecimal[LOOPHOLE[value, LONG INTEGER]]
        ELSE PutOctal[LOOPHOLE[value, LONG CARDINAL]];
    END;

  NoSub: PROCEDURE [vf: ValFormat] = BEGIN NULL END;

  EnumeratedSEIndex: TYPE =
    Table.Base RELATIVE POINTER [0..Table.Limit) TO enumerated cons SERecord;

  PrintEnum: PROCEDURE [
        val: LONG UNSPECIFIED, stBase: STBase, esei: EnumeratedSEIndex] =
    BEGIN OPEN Symbols, stb: stBase;
    sei: ISEIndex;
    FOR sei _ stb.FirstCtxSe[stb.seb[esei].valueCtx], stb.NextSe[sei]
        WHILE sei # ISENull DO
      IF stb.seb[sei].idValue = val THEN {PrintSei[stBase, sei]; RETURN};
      ENDLOOP;
    PutString["LOOPHOLE ["L];  PrintValue[val];  PutChar[']];
    END;

  PrintHti: PROCEDURE [stb: STBase, hti: Symbols.HTIndex] =
    BEGIN
    subStr: AllocSubString;
    IF hti = HTNull THEN ERROR;
    HtiSubString[stb, hti, @subStr];
    PutSubString[@subStr];
    END;

  PrintSei: PROCEDURE [stb: STBase, sei: Symbols.ISEIndex] =
    BEGIN
    subStr: AllocSubString;
    IF sei = ISENull THEN ERROR;
    IseiSubString[stb, sei, @subStr];
    PutSubString[@subStr];
    END;



  -- Module Initialization


  END.  -- LupineSymbolTableImpl.