
    <<ObjectOut.Mesa>>
        <<Copyright  1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, June 23, 1986 3:41:36 pm PDT>>
        <<Sweet, September 2, 1980  3:05 PM>>
        <<Rovner, November 21, 1983 11:11 am>>
        <<Russ Atkinson (RRA) March 6, 1985 9:58:17 pm PST>>

    DIRECTORY
        Alloc: TYPE USING [Base, Handle, Notifier, AddNotify, DropNotify, Bias, Bounds, Top],
        BcdDefs: TYPE USING [SGRecord, VersionStamp, FTNull, PageSize],
        ComData: TYPE USING [compilerVersion, codeSeg, defBodyLimit, fgTable, fixupLoc, globalFrameSize, importCtx, interface, mainCtx, 
        moduleCtx, mtRoot, mtRootSize, nBodies, nInnerBodies, objectBytes, objectVersion, ownSymbols, source, symSeg, 
        typeAtomRecord],
        CompilerUtil: TYPE USING [Address],
        ConvertUnsafe: TYPE USING [SubString, AppendSubStringToRefText],
        FileParms: TYPE USING [Name],
        Host: TYPE MachineParms USING [bitsPerByte, bitsPerWord],
        IO: TYPE USING [GetIndex, SetIndex, STREAM, UnsafePutBlock],
        Literals: TYPE USING [Base, STNull],
        LiteralOps: TYPE USING [CopyLiteral, ForgetEntries, StringValue, TextType],
        OSMiscOps: TYPE USING [FreePages, FreeWords, Words],
        PackageSymbols: TYPE USING [OuterPackRecord, InnerPackRecord, IPIndex, IPNull],
        PrincOpsUtils: TYPE USING [LongCopy],
        RCMap: TYPE USING [Base],
        RCMapOps: TYPE USING [RCMT, Acquire, Create, Destroy, GetSpan],
        Rope: TYPE USING [Flatten, Length, Text],
        RTBcd: TYPE USING [RefLitItem, RefLitList, RTHeader, StampIndex, StampList,TypeItem, TypeList, UTInfo, AnyStamp],
        Symbols: TYPE USING [Base, HashVector, Name, Type, MDIndex, BodyInfo, BTIndex, MDNull, OwnMdi, BTNull, RootBti, lL],
        SymbolSegment: TYPE USING [Base, FGHeader, FGTEntry, ExtFirst, ExtRecord, ExtIndex, STHeader, WordOffset, VersionID, ltType, 
        htType, ssType, seType, ctxType, mdType, bodyType, extType, constType],
        SymbolOps: TYPE USING [EnumerateBodies, HashBlock, NameForSe, SiblingBti, SonBti, SubStringForName],
        SymLiteralOps: TYPE USING [RefLitItem, DescribeRefLits, DescribeTypes, EnumerateRefLits, EnumerateTypes, TypeIndex, UTypeId],
        Table: TYPE USING [IndexRep, IPointer, Selector, Tag],
        Tree: TYPE USING [Base, Index, Link, Map, Node, firstIndex, Null, treeTag, treeType],
        TreeOps: TYPE USING [FreeTree, GetTag, UpdateLeaves],
        TypeStrings: TYPE USING [Create],
        UnsafeStorage: TYPE USING [GetSystemUZone];

    ObjectOut: PROGRAM
        IMPORTS Alloc, ConvertUnsafe, IO, PrincOpsUtils, OSMiscOps, LiteralOps, RCMapOps, Rope, SymbolOps, SymLiteralOps, TreeOps, 
        TypeStrings, dataPtr: ComData, UnsafeStorage
        EXPORTS CompilerUtil = {

        StreamIndex: TYPE = INT; -- FileStream.FileByteIndex
        Address: TYPE = CompilerUtil.Address;

        stream: IO.STREAM _ NIL;
        zone: UNCOUNTED ZONE = UnsafeStorage.GetSystemUZone[];

        pageSize: CARDINAL = BcdDefs.PageSize;
        bytesPerWord: CARDINAL = Host.bitsPerWord/Host.bitsPerByte;
        bytesPerPage: CARDINAL = pageSize*bytesPerWord;

        treeTag: Table.Tag = Tree.treeTag;

        NextFilePage: PUBLIC PROC RETURNS[CARDINAL] = {
            fill: ARRAY [0..8) OF WORD _ ALL[0];
            r: INTEGER = (stream.GetIndex[] MOD bytesPerPage)/bytesPerWord;
            m: INTEGER;
            IF r # 0 THEN
                FOR n: INTEGER _ pageSize-r, n-m WHILE n > 0 DO
                    m _ MIN[n, fill.LENGTH];
                    WriteObjectWords[LOOPHOLE[fill.BASE.LONG], m];
                    ENDLOOP;
            RETURN[stream.GetIndex[]/bytesPerPage + 1]};

        WriteObjectWords: PROC[addr: Address, n: CARD] = {
            stream.UnsafePutBlock[[base: addr, startIndex: 0, count: n*bytesPerWord]]};

        RewriteObjectWords: PROC[index: StreamIndex, addr: Address, n: CARD] = {
            saveIndex: StreamIndex = stream.GetIndex[];
            stream.SetIndex[index];
            stream.UnsafePutBlock[[addr, 0, n*bytesPerWord]];
            stream.SetIndex[saveIndex]};

        WriteTableBlock: PROC[p: Table.IPointer, size: CARD] = {
            WriteObjectWords[LOOPHOLE[p], size]};

    <<bcd i/o>>

        bcdOffset: CARD;
        bcdIndex: StreamIndex;

        BCDIndex: PROC[offset: CARD] RETURNS[StreamIndex] = INLINE {
            RETURN[bcdIndex + offset*bytesPerWord]};

        StartBCD: PUBLIC PROC = {
            [] _ NextFilePage[];
            bcdIndex _ stream.GetIndex[];
            bcdOffset _ 0};

        ReadBCDOffset: PUBLIC PROC RETURNS[CARD] = {RETURN[bcdOffset]};

        ReadBCDIndex: PUBLIC PROC RETURNS[StreamIndex] = {
            RETURN[BCDIndex[bcdOffset]]};

        AppendBCDWord: PUBLIC PROC[word: UNSPECIFIED] = {
            <<-- stream.PutWord[word];>>
            stream.UnsafePutBlock[[@word, 0, 2]]; bcdOffset _ bcdOffset + 1};

        AppendBCDWords: PUBLIC PROC[addr: Address, n: CARD] = {
            WriteObjectWords[addr, n]; bcdOffset _ bcdOffset + n};

        AppendBCDString: PUBLIC PROC[s: LONG STRING] = {
            header: StringBody _ [length: s.length, maxlength: s.length, text:];
            AppendBCDWords[@header, StringBody[0].SIZE];
            AppendBCDWords[@s.text, StringBody[s.length].SIZE - StringBody[0].SIZE]};

        FillBCDPage: PUBLIC PROC = {
            IF bcdOffset MOD pageSize # 0 THEN {
                [] _ NextFilePage[]; bcdOffset _ bcdOffset + (pageSize - bcdOffset MOD pageSize)}
            };

        UpdateBCDWords: PUBLIC PROC[offset: CARD, addr: Address, n: CARD] = {
            RewriteObjectWords[BCDIndex[offset], addr, n]};

        EndBCD: PUBLIC PROC = {[] _ NextFilePage[]};


    <<symbol table i/o >>

        PageCount: PROC[words: CARD] RETURNS[CARDINAL] = {
            RETURN[(words+(pageSize-1))/pageSize]};

        SetFgt: PROC[d: SymbolSegment.WordOffset, sourceFile: FileParms.Name]
            RETURNS[fgBase, fgPages: CARDINAL] = {
            np: CARDINAL = PageCount[d];
            dataPtr.symSeg.pages _ np;
            IF dataPtr.interface THEN {
                fgBase _ 0;
                dataPtr.symSeg.extraPages _ fgPages _ 0;
                dataPtr.codeSeg.file _ BcdDefs.FTNull;
                dataPtr.codeSeg.base _ dataPtr.codeSeg.pages _ 0;
                dataPtr.objectBytes _ 0;
                dataPtr.mtRoot.framesize _ dataPtr.globalFrameSize _ 0}
            ELSE { 
                fgBase _ np;
                dataPtr.symSeg.extraPages _ fgPages _ PageCount[
                    (StringBody[sourceFile.Length[]].SIZE-StringBody[0].SIZE) +
                        dataPtr.fgTable.LENGTH*SymbolSegment.FGTEntry.SIZE +
                        SymbolSegment.FGHeader.SIZE]};
            dataPtr.codeSeg.class _ code;  dataPtr.codeSeg.extraPages _ 0;
            RETURN};


    <<tree i/o>>

        litBias: CARD;

        WriteExtensions: PROC[table: Alloc.Handle] RETURNS[size: CARD] = {
            OPEN SymbolSegment;
            tb: Tree.Base;
            ltb: Literals.Base;
            treeLoc: Tree.Index _ Tree.firstIndex;
            initialized: BOOL _ FALSE;    -- set after rep of Tree.Null is written

            OutputNotify: Alloc.Notifier = {
                tb _ base[Tree.treeType];  ltb _ base[ltType];
                seb _ base[seType];   ctxb _ base[ctxType];
                extb _ base[extType]};

            OutputLiteral: PROC[t: Tree.Link.literal] RETURNS[Tree.Link] = {
                t.index _ LiteralOps.CopyLiteral[[baseP:@ltb, index:t.index]]-litBias;
                RETURN[t]};

            OutputString: PROC[t: Tree.Link.string] RETURNS[Tree.Link] = {
                t.index _ Literals.STNull;    -- temporary
                RETURN[t]};

            SetEmpty: Tree.Map = {RETURN[Tree.Null]};

            OutputTree: Tree.Map = {
                WITH link: t SELECT TreeOps.GetTag[t] FROM
                    literal => v _ OutputLiteral[link];
                    string => v _ OutputString[link];
                    subtree => {
                        s: Tree.Link = TreeOps.UpdateLeaves[link, OutputTree];
                        IF s = Tree.Null AND initialized THEN v _ Tree.Null
                        ELSE
                            WITH s SELECT TreeOps.GetTag[s] FROM
                                subtree => {
                                    node: Tree.Index = index;
                                    nw: CARD = Tree.Node[tb[node].nSons].SIZE;
                                    WriteTableBlock[@tb[node], nw];    -- common header
                                    [] _ TreeOps.FreeTree[TreeOps.UpdateLeaves[s, SetEmpty]];
                                    v _ [subtree[index: treeLoc]];  treeLoc _ treeLoc + nw};
                                ENDCASE => v _ s};
                    ENDCASE => v _ link;
                RETURN};

            extb: SymbolSegment.Base;
            extLimit: ExtIndex;
            seb, ctxb: Symbols.Base;
            table.AddNotify[OutputNotify];
            [] _ OutputTree[Tree.Null];  initialized _ TRUE;
            extb _ table.Bounds[extType].base;
            extLimit _ table.Top[extType];
            FOR exti: ExtIndex _ ExtFirst, exti + ExtRecord.SIZE UNTIL exti = extLimit DO
                extb[exti].tree _
                    IF dataPtr.interface OR extb[exti].type = value OR extb[exti].type = default
                        THEN OutputTree[extb[exti].tree]
                        ELSE Tree.Null;
                ENDLOOP;
            table.DropNotify[OutputNotify];
            RETURN[treeLoc-Tree.firstIndex]};


        WriteExtensionTable: PROC[table: Alloc.Handle] RETURNS[size: CARD] = {
            OPEN SymbolSegment;
            extb: SymbolSegment.Base;
            extLimit: ExtIndex;

            OutputNotify: Alloc.Notifier = {extb _ base[extType]};

            table.AddNotify[OutputNotify];
            extLimit _ table.Top[extType];  size _ 0;
            FOR exti: ExtIndex _ ExtFirst, exti + ExtRecord.SIZE UNTIL exti = extLimit DO
                IF extb[exti].tree # Tree.Null THEN {
                    size _ size + SymbolSegment.ExtRecord.SIZE;
                    WriteTableBlock[@extb[exti], SymbolSegment.ExtRecord.SIZE]};
                ENDLOOP;
            table.DropNotify[OutputNotify];
            RETURN};


    <<package table i/o>>

        WritePackTables: PROC[table: Alloc.Handle] = {
            OPEN Symbols, PackageSymbols;
            bb: Symbols.Base;

            OutputNotify: Alloc.Notifier = {bb _ base[SymbolSegment.bodyType]};

            BodyLength: PROC[info: Symbols.BodyInfo] RETURNS[CARDINAL] = INLINE {
                RETURN[WITH info SELECT FROM External => bytes, ENDCASE => 0]};

            nOuter: CARDINAL = dataPtr.nBodies - dataPtr.nInnerBodies;
            outer: LONG DESCRIPTOR FOR ARRAY OF OuterPackRecord _
                DESCRIPTOR[OSMiscOps.Words[nOuter*OuterPackRecord.SIZE], nOuter];
            next: CARDINAL _ 0;
            nextIP: IPIndex _ IPIndex.FIRST;

            OuterBody: PROC[bti: BTIndex] = {
                WITH body: bb[bti] SELECT FROM
                    Callable =>
                        IF ~body.inline THEN {
                            outer[next] _ OuterPackRecord[
                                hti: SymbolOps.NameForSe[body.id],
                                entryIndex: body.entryIndex,
                                length: BodyLength[body.info],
                                firstSon: InnerBodies[bti],
                                resident: body.resident];
                            next _ next + 1};
                    ENDCASE
                };

            InnerBodies: PROC[root: BTIndex] RETURNS[origin: IPIndex] = {
                buffer: InnerPackRecord;

                ProcessBody: PROC[bti: BTIndex] RETURNS[BOOL] = {
                    WITH body: bb[bti] SELECT FROM
                        Callable =>
                            IF ~body.inline AND body.level > Symbols.lL THEN {
                                IF origin # IPNull THEN WriteObjectWords[@buffer, InnerPackRecord.SIZE];
                                buffer _ InnerPackRecord[
                                    entryIndex: body.entryIndex,
                                    length:  BodyLength[body.info],
                                    lastSon: FALSE];
                                IF origin = IPNull THEN origin _ nextIP;
                                nextIP _ nextIP + 1};
                        ENDCASE => NULL;
                    RETURN[FALSE]};

                origin _ IPNull;
                IF root # Symbols.RootBti THEN [] _ SymbolOps.EnumerateBodies[root, ProcessBody]
                ELSE
                    FOR sonBti: BTIndex _ SymbolOps.SonBti[root], SymbolOps.SiblingBti[sonBti]
                        UNTIL sonBti = BTNull DO
                            WITH body: bb[sonBti] SELECT FROM
                                Callable => NULL;    -- processed as an outer body
                                ENDCASE => [] _ SymbolOps.EnumerateBodies[sonBti, ProcessBody];
                            ENDLOOP;
                IF origin # IPNull THEN {
                    buffer.lastSon _ TRUE; WriteObjectWords[@buffer, InnerPackRecord.SIZE]};
                RETURN};

            table.AddNotify[OutputNotify];
            OuterBody[Symbols.RootBti];
            FOR bti: BTIndex _ SymbolOps.SonBti[Symbols.RootBti], SymbolOps.SiblingBti[bti]
                UNTIL bti = BTNull DO
                    OuterBody[bti] ENDLOOP;
            table.DropNotify[OutputNotify];
            IF next # outer.LENGTH OR nextIP # dataPtr.nInnerBodies THEN ERROR;
            SortPackInfo[outer, 1, outer.LENGTH];
            WriteObjectWords[outer.BASE, nOuter*OuterPackRecord.SIZE];
            OSMiscOps.FreeWords[outer.BASE]};

        SortPackInfo: PROC[
            a: LONG DESCRIPTOR FOR ARRAY OF PackageSymbols.OuterPackRecord,
            l, u: CARDINAL] = {
            <<Shell sort of a[l..u)>>
            h, i, j, k: CARDINAL;
            key: Symbols.Name;
            t: PackageSymbols.OuterPackRecord;
            h _ u - l;
            DO
                h _ h/2;
                FOR k IN [l+h .. u) DO
                    i _ k;  j _ k-h;  key _ a[k].hti;  t _ a[k];
                    WHILE LOOPHOLE[key, CARD] < LOOPHOLE[a[j].hti, CARD] DO
                        a[i] _ a[j];  i _ j;
                        IF j < l+h THEN EXIT;  j _ j-h;
                        ENDLOOP;
                    a[i] _ t;
                    ENDLOOP;
                IF h <= 1 THEN EXIT;
                ENDLOOP
            };


    <<main drivers>>

        StartObjectFile: PUBLIC PROC[objectStream: IO.STREAM] = {
            stream _ objectStream};


        TableOut: PUBLIC PROC[table: Alloc.Handle] = {
            OPEN SymbolSegment;
            h: STHeader;
            fixupLoc: StreamIndex;
            d: WordOffset;
            nw: CARD;

            WriteSubTable: PROC[selector: Table.Selector] = {
                base: Alloc.Base;
                size: CARD;
                [base, size] _ table.Bounds[selector];
                WriteTableBlock[base + table.Bias[selector], size]};

            dataPtr.symSeg.class _ symbols;
            dataPtr.symSeg.base _ NextFilePage[];
            h.versionIdent _ SymbolSegment.VersionID;
            h.version _ dataPtr.objectVersion;
            h.sourceVersion _ dataPtr.source.version;
            h.creator _ dataPtr.compilerVersion;
            h.definitionsFile _ dataPtr.interface;
            h.extended _ TRUE;
            h.directoryCtx _ dataPtr.moduleCtx;
            h.importCtx _ dataPtr.importCtx;
            h.outerCtx _ dataPtr.mainCtx;
            d _ STHeader.SIZE;
            h.hvBlock.offset _ d;
                d _ d + (h.hvBlock.size _ Symbols.HashVector.SIZE);
            h.htBlock.offset _ d;  d _ d + (h.htBlock.size _ table.Bounds[htType].size);
            h.ssBlock.offset _ d;  d _ d + (h.ssBlock.size _ table.Bounds[ssType].size);
            IF dataPtr.interface THEN h.innerPackBlock _ h.outerPackBlock _ [d, 0]
            ELSE {
                h.innerPackBlock.offset _ d;
                d _ d + (h.innerPackBlock.size _ dataPtr.nInnerBodies*PackageSymbols.InnerPackRecord.SIZE);
                h.outerPackBlock.offset _ d;
                d _ d + (h.outerPackBlock.size _
                    (dataPtr.nBodies-dataPtr.nInnerBodies)*PackageSymbols.OuterPackRecord.SIZE)};
            h.constBlock.offset _ d;  d _ d + (h.constBlock.size _ table.Bounds[constType].size);
            h.seBlock.offset _ d;  d _ d + (h.seBlock.size _ table.Bounds[seType].size);
            h.ctxBlock.offset _ d;  d _ d + (h.ctxBlock.size _ table.Bounds[ctxType].size);  
            h.mdBlock.offset _ d;  d _ d + (h.mdBlock.size _ table.Bounds[mdType].size);
            h.bodyBlock.offset _ d;  d _ d + table.Bounds[bodyType].size;
            h.bodyBlock.size _ dataPtr.defBodyLimit;
            h.epMapBlock _ h.spareBlock _ [d, 0];
            IF table.Bounds[extType].size # 0 THEN fixupLoc _ stream.GetIndex[]
            ELSE {
                h.treeBlock _ h.litBlock _ h.sLitBlock _ h.extBlock _ [d, 0];
                [h.fgRelPgBase, h.fgPgCount] _ SetFgt[d, dataPtr.source.locator]};
            WriteObjectWords[@h, STHeader.SIZE];
            WriteObjectWords[SymbolOps.HashBlock[], h.hvBlock.size];
            WriteSubTable[htType];
            WriteSubTable[ssType];
            IF ~dataPtr.interface THEN WritePackTables[table];
            WriteSubTable[constType];
            WriteSubTable[seType];
            WriteSubTable[ctxType];
            WriteSubTable[mdType];
            WriteSubTable[bodyType];
            IF table.Bounds[extType].size # 0 THEN {
                litBias _ LiteralOps.ForgetEntries[];
                h.treeBlock.offset _ d;
                h.treeBlock.size _ WriteExtensions[table];
                d _ d + h.treeBlock.size;
                h.litBlock.offset _ d;
                nw _ table.Bounds[ltType].size - litBias;
                WriteTableBlock[table.Bounds[ltType].base+table.Bias[ltType]+litBias, nw];
                d _ d + (h.litBlock.size _ nw);
                h.sLitBlock _ [d, 0];
                h.extBlock.offset _ d;
                h.extBlock.size _ WriteExtensionTable[table];
                d _ d + h.extBlock.size;
                [h.fgRelPgBase, h.fgPgCount] _ SetFgt[d, dataPtr.source.locator];
                RewriteObjectWords[fixupLoc, @h, STHeader.SIZE]};
            IF ~dataPtr.interface THEN {
                fg: FGHeader;
                s: Rope.Text _ Rope.Flatten[dataPtr.source.locator];
                [] _ NextFilePage[];
                nw _ StringBody[s.Length].SIZE-StringBody[0].SIZE;
                fg.offset _ FGHeader.SIZE + nw;
                fg.length _ dataPtr.fgTable.LENGTH;
                fg.sourceFile _ StringBody[
                    length: s.Length,
                    maxlength: s.Length,
                    text: -- written separately -- ];
                WriteObjectWords[@fg, FGHeader.SIZE];
                WriteObjectWords[LOOPHOLE[s, LONG POINTER]+Rope.Text.SIZE, nw];
                WriteObjectWords[dataPtr.fgTable.BASE, dataPtr.fgTable.LENGTH*FGTEntry.SIZE];
                OSMiscOps.FreePages[dataPtr.fgTable.BASE]}
            };



        RTTableOut: PUBLIC PROC[table: Alloc.Handle] = {
            nLits: CARDINAL = SymLiteralOps.DescribeRefLits[].length;
            nTypes: CARDINAL = SymLiteralOps.DescribeTypes[].length;
            IF nLits + nTypes # 0 THEN {
                OPEN RTBcd;
                rtOffset: CARDINAL _ RTHeader.SIZE;
                header: RTHeader _ [
                    refLitTable: LOOPHOLE[rtOffset],
                    litBase: TRASH,
                    litLength: TRASH,
                    rcMapBase: TRASH,
                    rcMapLength: TRASH,
                    stampTable: TRASH,
                    typeTable: LOOPHOLE[rtOffset + RefLitList[nLits].SIZE]];
                fixupOffset: CARD = ReadBCDOffset[];


                textBase: LONG POINTER _ NIL;  -- to a sequence of StringBody's
                textLimit: CARDINAL _ 0;
                textLoc: CARDINAL _ 0;

                EqText: PROC[rt: REF TEXT, pt: LONG POINTER TO TEXT] RETURNS[BOOL] = INLINE {
                    IF rt.length # pt.length THEN RETURN[FALSE];
                    FOR i: CARDINAL IN [0..rt.length) DO
                        IF rt[i] # pt[i] THEN RETURN[FALSE] ENDLOOP;
                    RETURN[TRUE]};

                EnterText: PROC[s: REF TEXT] RETURNS[loc: CARDINAL] = {
                    t: LONG POINTER TO TEXT;
                    nw: CARDINAL;
                    FOR loc _ 0, loc + TEXT[t.length].SIZE UNTIL loc >= textLoc DO
                        t _ textBase + loc;
                        IF EqText[s, t] THEN RETURN;
                        ENDLOOP;
                    nw _ TEXT[s.length].SIZE;
                    WHILE textLoc + nw > textLimit DO
                        newLimit: CARDINAL = PageCount[textLimit+MAX[MIN[textLimit/2, 512], 64]];
                        newBase: LONG POINTER _ OSMiscOps.Words[newLimit*pageSize];
                        IF textBase # NIL THEN {
                            PrincOpsUtils.LongCopy[from: textBase, to: newBase, nwords: textLoc];
                            OSMiscOps.FreeWords[textBase]};
                        textBase _ newBase;  textLimit _ newLimit*pageSize;
                        ENDLOOP;
                    loc _ textLoc;
                    PrincOpsUtils.LongCopy
                        [from: LOOPHOLE[s, LONG POINTER], to: textBase+loc, nwords: nw];
                    textLoc _ textLoc + nw;
                    RETURN};


                stampList: REF RTBcd.StampList _ NIL;
                nextStamp: NAT _ 1;

                EnterStamp: PROC[mdi: Symbols.MDIndex] RETURNS[index: RTBcd.StampIndex] = {
                    IF mdi = Symbols.MDNull THEN index _ RTBcd.AnyStamp
                    ELSE {
                        stamp: BcdDefs.VersionStamp = table.Bounds[SymbolSegment.mdType].base[mdi].stamp;
                        FOR i: NAT IN [1 .. nextStamp) DO
                            IF stamp = stampList[i] THEN RETURN[[i]];
                            ENDLOOP;  
                        IF stampList = NIL OR nextStamp >= stampList.limit THEN ExpandStampList[];
                        index _ [nextStamp];  stampList[nextStamp] _ stamp;  nextStamp _ nextStamp + 1};
                    RETURN};

                ExpandStampList: PROC = INLINE {
                    oldSize: NAT = nextStamp - 1;
                    AdjustStampList[oldSize + MAX[MIN[oldSize/2, 128], 32]]};

                AdjustStampList: PROC[newSize: NAT] = {
                    oldSize: NAT = nextStamp - 1;
                    newList: REF RTBcd.StampList = NEW[RTBcd.StampList[newSize]];
                    FOR i: NAT IN [1 .. MIN[oldSize, newSize]] DO newList[i] _ stampList[i] ENDLOOP;
                    stampList _ newList};


                AppendBCDWords[@header, RTHeader.SIZE];
                AppendBCDWord[nLits];
                IF nLits # 0 THEN {

                    WriteLitItem: PROC[item: SymLiteralOps.RefLitItem] = {
                        info: RefLitItem;
                        loc, chars: CARDINAL;
                        type: Symbols.Type;
                        WITH v: item SELECT FROM
                            atom => {
                                desc: ConvertUnsafe.SubString;
                                s: REF TEXT;
                                n: CARDINAL;
                                desc _ SymbolOps.SubStringForName[v.pName];
                                n _ desc.length + (desc.length MOD 2);
                                s _ NEW[TEXT[n]];
                                ConvertUnsafe.AppendSubStringToRefText[s, desc];  
                                IF s.length < n THEN s[n-1] _ 0c;
                                loc _ EnterText[s];  chars _ s.length;
                                type _ dataPtr.typeAtomRecord;
                                s _ NIL};
                            text => {
                                s: LONG STRING = LiteralOps.StringValue[v.value];
                                loc _ EnterText[LOOPHOLE[s, REF TEXT]];  chars _ s.length;  -- ARRGGH
                                type _ LiteralOps.TextType[v.value]};
                            ENDCASE;
                        info _ [
                            referentType: SymLiteralOps.TypeIndex[type, FALSE],
                            offset: loc, length: TEXT[chars].SIZE];
                        AppendBCDWords[@info, RefLitItem.SIZE]};

                    SymLiteralOps.EnumerateRefLits[WriteLitItem]};

                AppendBCDWord[nTypes];
                rtOffset _ rtOffset + RefLitList[nLits].SIZE + TypeList[nTypes].SIZE;
                header.rcMapBase _ LOOPHOLE[rtOffset.LONG];
                IF nTypes = 0 THEN header.rcMapLength _ 0
                ELSE {
                    rcmt: RCMapOps.RCMT = RCMapOps.Create[
                        zone: zone, ptr: NIL, nPages: 0, expansionOK: TRUE];

                    EnterUT: PROC[type: Symbols.Type] RETURNS[RTBcd.UTInfo] = {
                        mdi: Symbols.MDIndex;
                        sei: Symbols.Type;
                        [mdi, sei] _ SymLiteralOps.UTypeId[type];
                        RETURN[[version: EnterStamp[mdi], sei: sei]]};

                    WriteTypeItem: PROC[canonical: BOOL, type: Symbols.Type] = {
                        s: LONG STRING _ TypeStrings.Create[dataPtr.ownSymbols, type, zone];
                        info: TypeItem _ [
                            table: dataPtr.mtRoot.sseg,
                            sei: type,
                            canonical: canonical,
                            rcMap: rcmt.Acquire[dataPtr.ownSymbols, type],
                            ct: [EnterText[LOOPHOLE[s, REF TEXT]]],  -- ARRGGH
                            ut: EnterUT[type]];
                        zone.FREE[@s];
                        AppendBCDWords[@info, TypeItem.SIZE]};

                    [] _ EnterStamp[Symbols.OwnMdi];

                    SymLiteralOps.EnumerateTypes[WriteTypeItem];

                    header.rcMapLength _ rcmt.GetSpan[].size;
                    AppendBCDWords[rcmt.GetSpan[].base, header.rcMapLength];
                    rtOffset _ rtOffset + header.rcMapLength;
                    [] _ RCMapOps.Destroy[rcmt]};

                header.stampTable _ LOOPHOLE[rtOffset];
                AdjustStampList[nextStamp-1];
                AppendBCDWords[LOOPHOLE[stampList, LONG POINTER], StampList[nextStamp-1].SIZE];
                rtOffset _ rtOffset + StampList[nextStamp-1].SIZE;
                stampList _ NIL;

                header.litBase _ LOOPHOLE[rtOffset];
                header.litLength _ textLoc;
                IF textBase # NIL THEN {
                    AppendBCDWords[textBase, textLoc]; OSMiscOps.FreeWords[textBase]};
                UpdateBCDWords[fixupOffset, @header, RTHeader.SIZE]}
            };


        EndObjectFile: PUBLIC PROC[update: BOOL] = {
            IF stream # NIL AND update THEN {
                saveIndex: StreamIndex = stream.GetIndex[];
                stream.SetIndex[dataPtr.fixupLoc];
                WriteObjectWords[@dataPtr.codeSeg, BcdDefs.SGRecord.SIZE];
                WriteObjectWords[@dataPtr.symSeg, BcdDefs.SGRecord.SIZE];
                WriteObjectWords[dataPtr.mtRoot, dataPtr.mtRootSize];
                stream.SetIndex[saveIndex]};
            stream _ NIL};

        }.
    <<>>
