
    <<ObjectOut.Mesa>>
        <<Copyright  1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, April 23, 1986 3:34:13 pm PST>>
        <<Sweet, September 2, 1980  3:05 PM>>
        <<Maxwell, August 11, 1983 8:38 am>>
        <<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, Bounds, Failure, Top],
        Basics: TYPE USING [BytePair, bytesPerWord, RawBytes],
        BcdDefs: TYPE USING [SGRecord, VersionStamp, FTNull, PageSize],
        ComData: TYPE USING [catchBytes, codeByteOffsetList, codeOffsetList, compilerVersion, codeSeg, defBodyLimit, fgTable, fixupLoc, 
        globalFrameSize, importCtx, interface, jumpIndirectList, 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],
        Fixup: TYPE USING [JIHandle, PCHandle],
        IO: TYPE USING [GetIndex, PutChar, SetIndex, STREAM, UnsafePutBlock],
        Literals: TYPE USING [Base, STNull],
        LiteralOps: TYPE USING [CopyLiteral, ForgetEntries, StringValue, TextType],
        OSMiscOps: TYPE USING [FreePages, FreeWords, Words],
        PackageSymbols: TYPE USING [ConstRecord, OuterPackRecord, InnerPackRecord, IPIndex, IPNull, JIData],
    PrincOps: TYPE USING [BytePC],
        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, CBTIndex, nullName, MDNull, OwnMdi, BTNull, RootBti, 
        lL],
        SymbolSegment: TYPE USING [Base, FGHeader, FGTEntry, 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 [IPointer, Selector],
        Tree: TYPE USING [Base, Index, Link, Map, Scan, Null, treeType],
        TreeOps: TYPE USING [FreeTree, UpdateLeaves],
        TypeStrings: TYPE USING [Create],
        UnsafeStorage: TYPE USING [GetSystemUZone],
        XSymbolSegment: TYPE SymbolSegment USING [ExtRecord],
        XTree: TYPE Tree USING [Index, Link, Node],
        XTreeOps: TYPE USING [ForEachSon, LinkToX];

    ObjectOut: PROGRAM
        IMPORTS Alloc, ConvertUnsafe, IO, PrincOpsUtils, OSMiscOps, LiteralOps, RCMapOps, Rope, SymbolOps, SymLiteralOps, TreeOps, 
        TypeStrings, dataPtr: ComData, UnsafeStorage, XTreeOps
        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 = Basics.bytesPerWord;
        BytesPerPage: CARDINAL = PageSize*BytesPerWord;

        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]};

        WriteObjectWord: PROC[w: WORD] = {
            pair: Basics.BytePair = LOOPHOLE[w];
            stream.PutChar[VAL[pair.high]]; stream.PutChar[VAL[pair.low]]};

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

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

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

    <<bcd i/o>>

        bcdOffset: CARDINAL;
        bcdIndex: StreamIndex;

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

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

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

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

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

        AppendBCDWords: PUBLIC PROC[addr: Address, n: CARDINAL] = {
            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: CARDINAL, addr: Address, n: CARDINAL] = {
            RewriteObjectWords[BCDIndex[offset], addr, n]};

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


    <<symbol table i/o >>

        PageCount: PROC[words: CARDINAL] 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: CARDINAL;

        WriteExtensions: PROC[table: Alloc.Handle] RETURNS[size: CARDINAL] = {
            OPEN SymbolSegment;
            tb: Tree.Base;
            ltb: Literals.Base;
            treeLoc: Tree.Index _ Tree.Index.FIRST;
            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] = {
                OPEN LiteralOps;
                WITH lit: t.index SELECT FROM
                    word => lit.lti _ CopyLiteral[[baseP:@ltb, index:lit]].lti-litBias;
                    string => lit.sti _ Literals.STNull;    -- temporary
                    ENDCASE => ERROR;
                RETURN[t]};

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

            OutputTree: Tree.Map = {
                WITH link: t SELECT FROM
                    literal => v _ OutputLiteral[link];
                    subtree => {
                        s: Tree.Link = TreeOps.UpdateLeaves[link, OutputTree];
                        IF s = Tree.Null AND initialized THEN v _ Tree.Null
                        ELSE
                            WITH s SELECT FROM
                                subtree => {
                                    node: Tree.Index = index;
                                    header: XTree.Node--[0]--;
                                    nw: CARDINAL;

                                    WriteSon: Tree.Scan = {
                                        link: XTree.Link _ XTreeOps.LinkToX[t];
                                        nw _ nw +  XTree.Link.SIZE;
                                        WriteTableBlock[@link, XTree.Link.SIZE]};

                                    header _ [
                                        free: FALSE,
                                        name: tb[node].name,
                                        attr1: tb[node].attr1, attr2: tb[node].attr2, attr3: tb[node].attr3,
                                        shared: FALSE,
                                        nSons: tb[node].nSons,
                                        info: tb[node].info,
                                        son: ];
                                    nw _ XTree.Node.SIZE;
                                    WriteTableBlock[@header, XTree.Node.SIZE];    -- common header
                                    XTreeOps.ForEachSon[[@tb, s], WriteSon];
                                    [] _ TreeOps.FreeTree[TreeOps.UpdateLeaves[s, SetEmpty]];
                                    v _ [subtree[index: treeLoc]];  treeLoc _ treeLoc + nw;
                                    IF treeLoc-Tree.Index.FIRST > XTree.Index.LAST-XTree.Index.FIRST THEN
                                        ERROR Alloc.Failure[table, Tree.treeType]
                                    };
                                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, LOOPHOLE[extLimit, CARDINAL]] _ table.Bounds[extType];
            FOR exti: ExtIndex _ ExtIndex.FIRST, 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.Index.FIRST]};


        WriteExtensionTable: PROC[table: Alloc.Handle] RETURNS[size: CARDINAL] = {
            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 _ ExtIndex.FIRST, exti + ExtRecord.SIZE UNTIL exti = extLimit DO
                IF extb[exti].tree # Tree.Null THEN {
                    extRecord: XSymbolSegment.ExtRecord _ [
                        type: extb[exti].type,
                        sei: extb[exti].sei,
                        tree: XTreeOps.LinkToX[extb[exti].tree]];
                    size _ size + XSymbolSegment.ExtRecord.SIZE;
                    WriteTableBlock[@extRecord, XSymbolSegment.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 + 1;
            outer: LONG DESCRIPTOR FOR ARRAY OF OuterPackRecord _
                DESCRIPTOR[OSMiscOps.Words[nOuter*OuterPackRecord.SIZE], nOuter];
            next: CARDINAL _ 0;
            nextIP: IPIndex _ IPIndex.FIRST;


        OuterBody: PROC[bti: CBTIndex, firstSon: IPIndex] = {
        IF ~bb[bti].inline AND bb[bti].nesting # Catch THEN {
        outer[next] _ OuterPackRecord[
        hti: SymbolOps.NameForSe[bb[bti].id],
        entryIndex: bb[bti].entryIndex,
        length: BodyLength[bb[bti].info],
        firstSon: firstSon,
        resident: bb[bti].resident,
        needsFixup: TRUE];        -- *** temporary ***
        next _ next + 1}};

    OuterCatch: PROC[firstSon: IPIndex] = INLINE {
    outer[next] _ OuterPackRecord[
    hti: nullName,
    entryIndex: dataPtr.nBodies,
    length: dataPtr.catchBytes,
    firstSon: firstSon,
    resident: bb[RootBti].resident,
    needsFixup: TRUE];        -- *** temporary ***
    next _ next + 1};

    origin: IPIndex;
    buffer: InnerPackRecord;
    catchDepth: CARDINAL _ 0;

    StartInner: PROC = INLINE {origin _ IPNull};

    EndInner: PROC = {
    IF origin # IPNull THEN {
    buffer.lastSon _ TRUE; WriteObjectWords[@buffer, InnerPackRecord.SIZE]}};

    ProcessBody: PROC[bti: CBTIndex] = INLINE {
    IF ~bb[bti].inline AND bb[bti].nesting # Catch AND bb[bti].level > lL THEN {
    IF origin # IPNull THEN WriteObjectWords[@buffer, InnerPackRecord.SIZE];
    buffer _ InnerPackRecord[
    entryIndex: bb[bti].entryIndex,
    length:  BodyLength[bb[bti].info],
    needsFixup: TRUE,    -- *** temporary ***
    lastSon: FALSE];
    IF origin = IPNull THEN origin _ nextIP;
    nextIP _ nextIP + 1}};

    EnumerateInner: PROC[parent: BTIndex, catch: BOOL] = {
    FOR  sonBti: BTIndex _ SymbolOps.SonBti[parent], SymbolOps.SiblingBti[sonBti]
    UNTIL sonBti = BTNull DO
    saveCatchDepth: CARDINAL = catchDepth;
    WITH body: bb[sonBti] SELECT FROM
    Callable => {
    IF body.nesting = Catch THEN catchDepth _ catchDepth + 1
    ELSE IF (catchDepth # 0) = catch THEN ProcessBody[LOOPHOLE[sonBti]]};
    ENDCASE;
    EnumerateInner[sonBti, catch];
    catchDepth _ saveCatchDepth;
    ENDLOOP};

    InnerBodies: PROC[root: BTIndex, catch: BOOL] RETURNS[IPIndex] = {
    StartInner[];
    EnumerateInner[root, catch];
    EndInner[];
    RETURN[origin]};

    table.AddNotify[OutputNotify];

    StartInner[];
    FOR bti: BTIndex _ SymbolOps.SonBti[Symbols.RootBti], SymbolOps.SiblingBti[bti]
    UNTIL bti = BTNull DO
    WITH body: bb[bti] SELECT FROM
    Callable => NULL;    -- outer bodies, see below
    ENDCASE => EnumerateInner[bti, FALSE];
    ENDLOOP;
    EndInner[];
    OuterBody[Symbols.RootBti, origin];

    FOR bti: BTIndex _ SymbolOps.SonBti[Symbols.RootBti], SymbolOps.SiblingBti[bti]
    UNTIL bti = BTNull DO
    WITH body: bb[bti] SELECT FROM
    Callable =>
    IF body.nesting # Catch THEN OuterBody[LOOPHOLE[bti], InnerBodies[bti, FALSE]];
    ENDCASE;
    ENDLOOP;

    OuterCatch[InnerBodies[Symbols.RootBti, TRUE]];

    table.DropNotify[OutputNotify];
    IF next # outer.LENGTH OR nextIP # dataPtr.nInnerBodies THEN ERROR;
    SortPackInfo[outer, 1, outer.LENGTH-1];
    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 key < a[j].hti 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
            };


DoConstantTables: PROC [table: Alloc.Handle, write: BOOL] RETURNS[total: CARDINAL] = {
<<writes out sequences sorted by pc>>

DoPCList: PROC[handle: Fixup.PCHandle] = {
p, nextP: Fixup.PCHandle;
nw : CARDINAL _ 0;
FOR p _ handle, p.next UNTIL p = NIL DO
nw _ nw + PrincOps.BytePC.SIZE;
ENDLOOP;
total _ total + CARDINAL.SIZE + nw;
IF write THEN {
WriteObjectWord[nw/PrincOps.BytePC.SIZE];
FOR p _ handle, nextP UNTIL p = NIL DO
nextP _ p.next;
WriteObjectWord[LOOPHOLE[p.pc, CARDINAL]];
--zone.--FREE[@p];
ENDLOOP
}
};

DoJIList: PROC[handle: Fixup.JIHandle] = INLINE {
j, nextJ: Fixup.JIHandle;
nw: CARDINAL _ 0;
FOR j _ handle, j.next UNTIL j = NIL DO
nw _ nw + PackageSymbols.JIData.SIZE;
ENDLOOP;
total _ total + CARDINAL.SIZE + nw;
IF write THEN {
WriteObjectWord[nw/PackageSymbols.JIData.SIZE];
FOR j _ handle, nextJ UNTIL j = NIL DO
d: PackageSymbols.JIData _ [pc: j.pc, tableSize: j.tableSize];
nextJ _ j.next;
WriteObjectWords[@d, PackageSymbols.JIData.SIZE];
--zone.--FREE[@j];
ENDLOOP
}
};

base: Alloc.Base;
nw: CARDINAL;
[base, nw] _ table.Bounds[SymbolSegment.constType];
IF write THEN {
WriteObjectWord[nw/PackageSymbols.ConstRecord.SIZE];
WriteTableBlock[base, nw]};
total _ CARDINAL.SIZE + nw;
DoPCList[dataPtr.codeOffsetList];
DoPCList[dataPtr.codeByteOffsetList];
DoJIList[dataPtr.jumpIndirectList]};


    <<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: CARDINAL;

            WriteSubTable: PROC[selector: Table.Selector] = {
                base: Alloc.Base;
                size: CARDINAL;
                [base, size] _ table.Bounds[selector];
                WriteTableBlock[base, 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 _ h.constBlock _ [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+1)*PackageSymbols.OuterPackRecord.SIZE);
                h.constBlock.offset _ d;  d _ d + (h.constBlock.size _ DoConstantTables[table, FALSE])};
            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];  [] _ DoConstantTables[table, TRUE]};
            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+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];
                sLength: CARDINAL = s.Length;
                [] _ NextFilePage[];
                nw _ StringBody[sLength].SIZE-StringBody[0].SIZE;
                fg.offset _ FGHeader.SIZE + nw;
                fg.length _ dataPtr.fgTable.LENGTH;
                fg.sourceFile _ StringBody[
                    length: sLength,
                    maxlength: sLength,
                    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: CARDINAL = 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];
                stream.UnsafePutBlock[[LOOPHOLE[(@dataPtr.codeSeg).LONG, LONG POINTER TO Basics.RawBytes], 0, BcdDefs.SGRecord.SIZE*BytesPerWord]];
                stream.UnsafePutBlock[[LOOPHOLE[(@dataPtr.symSeg).LONG, LONG POINTER TO Basics.RawBytes], 0, BcdDefs.SGRecord.SIZE*BytesPerWord]];
                stream.UnsafePutBlock[[LOOPHOLE[dataPtr.mtRoot, LONG POINTER TO Basics.RawBytes], 0, dataPtr.mtRootSize*BytesPerWord]];
                stream.SetIndex[saveIndex]};
            stream _ NIL};

        }.
    <<>>
