
    <<PGSBcd.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, October 18, 1985 10:09:14 am PDT>>
        <<Maxwell, August 8, 1983 2:34 pm>>
        <<Wyatt, March 16, 1984 2:20:33 pm PST>>
        <<Russ Atkinson (RRA) March 19, 1985 9:56:37 am PST>>

    DIRECTORY
        Basics: TYPE USING [bytesPerWord],
        BcdDefs: TYPE,
        FileSegment: TYPE USING [Pages],
        IO: TYPE USING [GetIndex, SetIndex, STREAM, PutChar, UnsafePutBlock],
        PGSConDefs: TYPE USING [objectVersion, outeol, outstring, pgsVersion, resetoutstream, seterrstream, sourceName, sourceVersion, 
        warningsLogged, WriteSymbols],
        PrincOps: TYPE USING [bytesPerPage, wordsPerPage],
        Rope: TYPE USING [Cat, Find, Flatten, FromChar, Length, ROPE, Substr],
        TableCommand: TYPE USING [FindInterface, FindItem, BadInterface],
        UnsafeStorage: TYPE USING [GetSystemUZone, NewUObject];

    PGSBcd: PROGRAM
        IMPORTS IO, PGSConDefs, Rope, TableCommand, UnsafeStorage
        EXPORTS PGSConDefs = {

        StreamIndex: TYPE = INT; -- FileStream.FileByteIndex
        bytesPerWord: CARDINAL = Basics.bytesPerWord;

        <<BCD construction>>

            bcdHeader: BcdDefs.BCD;
            module: BcdDefs.MTRecord.direct;
            export: BcdDefs.EXPHandle;
            defsFile: BcdDefs.FTRecord;
            codeSeg, symbolSeg: BcdDefs.SGRecord;
            ssb: Rope.ROPE;

            out: IO.STREAM;
            moduleIndex, segIndex: StreamIndex;    -- for fixup
            moduleId: Rope.ROPE;
            systemZone: UNCOUNTED ZONE _ UnsafeStorage.GetSystemUZone[];


            InitializePackedString: PROC = {ssb _ Rope.FromChar[LOOPHOLE[0]]};
                <<ssb.string.length _ 1; ssb.size[1] _ 0};>>

            AddName: PROC[n: Rope.ROPE] RETURNS[name: BcdDefs.NameRecord] = {
                IF n = NIL THEN name _ BcdDefs.NullName
                ELSE {
                    lengthChar: CHAR _ VAL[CARDINAL[n.Length[]]];
                    name _ BcdDefs.NameRecord[ssb.Length[]+1];
                    ssb _ Rope.Cat[ssb, Rope.FromChar[lengthChar], n]};
                RETURN};

            FillInModule: PROC[name: BcdDefs.NameRecord, altoCode: BOOL] = {
                OPEN BcdDefs;
                module _ MTRecord[
                    name: name, namedInstance: FALSE, initial: FALSE,
                    file: FTSelf, linkLoc: frame, config: CTNull,
                    code: [
                        sgi: SGIndex.FIRST, linkspace: FALSE, packed: FALSE,
                        offset: 0, length: 0],
                    sseg: SGIndex.FIRST+SGRecord.SIZE,
                    frameRefs: FALSE, frameType: 0, framesize: 4,
                    tableCompiled: TRUE, altoCode: altoCode, long: FALSE,
                    residentFrame: FALSE, crossJumped: FALSE, packageable: TRUE,
                    gfi: 1, variables: EVNull, ngfi: 1,
                    boundsChecks: FALSE, nilChecks: FALSE,
                    extension: direct[length: 0, frag: ]];
                codeSeg _ [class: code, file: FTSelf, base: 2, pages: 0, extraPages: 0];
                symbolSeg _ [class: symbols, file: FTNull, base: 0, pages: 0, extraPages: 0]};

            FillInExport: PROC[name: BcdDefs.NameRecord, size, entry: CARDINAL] = {
                export _ UnsafeStorage.NewUObject[BcdDefs.EXPRecord.SIZE+size, systemZone];
                export^ _ BcdDefs.EXPRecord[
                    name: name, size: size, port: interface,
                    namedInstance: FALSE, typeExported: FALSE,
                    file: BcdDefs.FTIndex.FIRST, links:];
                FOR i: CARDINAL IN [0..size) DO export.links[i] _ BcdDefs.NullLink ENDLOOP;
                export.links[entry] _ BcdDefs.Link[variable[vgfi:1, var:0, vtag:var]]};

            FillInHeader: PROC = {
                OPEN h: bcdHeader;
                <<clear all fields>>
                LOOPHOLE[bcdHeader, ARRAY [0..BcdDefs.BCD.SIZE) OF CARDINAL] _ ALL[0];
                h.versionIdent _ BcdDefs.VersionID;
                h.version _ PGSConDefs.objectVersion;
                h.creator _ PGSConDefs.pgsVersion;
                h.sourceVersion _ PGSConDefs.sourceVersion;
                h.source _ IF PGSConDefs.sourceName = NIL
                    THEN BcdDefs.NullName ELSE AddName[PGSConDefs.sourceName];
                h.nPages _ 1;
                h.nConfigs _ 0;  h.nModules _ 1;
                h.nImports _ 0;  h.nExports _ IF export = NIL THEN 0 ELSE 1;
                h.definitions _ h.repackaged _ h.typeExported _ FALSE;
                h.tableCompiled _ TRUE;
                h.versions _ FALSE;
                h.extended _ TRUE;
                h.spare1 _ TRUE;    -- large eval stack
                h.spare2 _ FALSE;
                h.firstdummy _ 2;  h.nDummies _ 0;
                h.ctOffset _ h.impOffset _ h.ntOffset _ BcdDefs.BCD.SIZE;
                h.ssOffset _ BcdDefs.BCD.SIZE;
                h.ssLimit _ StringBody[ssb.Length[]].SIZE;    -- all strings must be entered by now
                h.mtOffset _ h.ssOffset + LOOPHOLE[h.ssLimit, CARDINAL];
                h.mtLimit _ BcdDefs.MTIndex.FIRST + BcdDefs.MTRecord.direct.SIZE;
                h.sgOffset _ h.mtOffset + LOOPHOLE[h.mtLimit, CARDINAL];
                h.sgLimit _ BcdDefs.SGIndex.FIRST + 2*BcdDefs.SGRecord.SIZE;
                IF export # NIL THEN {
                    h.ftOffset _ h.sgOffset + LOOPHOLE[h.sgLimit, CARDINAL];
                    h.ftLimit _ BcdDefs.FTIndex.FIRST + BcdDefs.FTRecord.SIZE;
                    h.expOffset _ h.ftOffset + LOOPHOLE[h.ftLimit, CARDINAL];
                    h.expLimit _ BcdDefs.EXPIndex.FIRST + BcdDefs.EXPRecord.SIZE+export.size};
                h.rtPages _ [0, 0]};

            PutWords: PROC[out: IO.STREAM, base: LONG POINTER, words: NAT] = {
                out.UnsafePutBlock[[base: base, count: words*bytesPerWord]]};

            PadToIndex: PROC[out: IO.STREAM, index: INT] = {
                here: INT ~ out.GetIndex[];
                IF here>index THEN ERROR;
                THROUGH [here..index) DO out.PutChar[VAL[0]] ENDLOOP};

            WriteBcd: PROC[out: IO.STREAM] = {
                ssb _ Rope.Flatten[ssb]; -- so we can blt it out
                PutWords[out, @bcdHeader, BcdDefs.BCD.SIZE];
                PutWords[out, LOOPHOLE[ssb], StringBody[ssb.Length[]].SIZE];
                moduleIndex _ IO.GetIndex[out];
                PutWords[out, @module, BcdDefs.MTRecord.direct.SIZE];
                segIndex _ IO.GetIndex[out];
                PutWords[out, @codeSeg, BcdDefs.SGRecord.SIZE];
                PutWords[out, @symbolSeg, BcdDefs.SGRecord.SIZE];
                IF export # NIL THEN {
                    PutWords[out, @defsFile, BcdDefs.FTRecord.SIZE];
                    PutWords[out, export, (BcdDefs.EXPRecord.SIZE+export.size)];
                    systemZone.FREE[@export]}
                };

            PagesForWords: PROC[nWords: CARDINAL] RETURNS[CARDINAL] = INLINE {
                RETURN[(nWords + (PrincOps.wordsPerPage-1))/PrincOps.wordsPerPage]};


        <<overall control>>

            WriteBcdHeader: PUBLIC PROC[
                  outStream: IO.STREAM,
                  tableId, binaryId: Rope.ROPE,    -- file being written
                  interfaceId, fileId: Rope.ROPE,    -- interface being exported
                  altoCode: BOOL_TRUE] = {
                symbols: FileSegment.Pages;
                out _ outStream;  
                IF tableId # NIL THEN moduleId _ tableId
                ELSE {
                    dot: INT ~ binaryId.Find["."];
                    IF dot < 0 THEN moduleId _ binaryId 
                    ELSE moduleId _ binaryId.Substr[len: dot];
                    };
                InitializePackedString[];
                FillInModule[AddName[moduleId], altoCode];
                <<fill in interface info>>
                IF interfaceId = NIL THEN export _ NIL
                ELSE {
                    dName: BcdDefs.NameRecord = AddName[interfaceId];
                    size, entry: CARDINAL;
                    [defsFile.version, symbols] _
                        TableCommand.FindInterface[interfaceId, fileId
                            ! TableCommand.BadInterface => {
                                OPEN PGSConDefs;
                                seterrstream[];  outeol[1]; 
                                outstring[id]; outstring[" cannot be opened"];
                                GO TO fail}];
                    defsFile.name _ IF fileId = NIL THEN dName ELSE AddName[fileId];
                    [size, entry] _ TableCommand.FindItem[symbols, moduleId
                        ! TableCommand.BadInterface => {
                            OPEN PGSConDefs;
                            seterrstream[];  outeol[1]; 
                            outstring[moduleId]; outstring[" not found"];
                            GO TO fail}];
                    FillInExport[dName, size, entry];
                    EXITS
                        fail => {
                            OPEN PGSConDefs;
                            outstring[" -- SELF used"];
                            outeol[2]; resetoutstream[]; warningsLogged _ TRUE;
                            export _ NIL}};
                FillInHeader[]; -- Do this after all strings entered
                WriteBcd[out];
                PadToIndex[out, PrincOps.bytesPerPage]};

            FixupBcdHeader: PUBLIC PROC = {
                bytesPerPage: CARDINAL = PrincOps.bytesPerPage;
                endIndex: StreamIndex _ IO.GetIndex[out];
                nBytes: CARDINAL = endIndex - bytesPerPage;
                <<IF export # NIL THEN RETURN;    ** from ModuleMaker ??>>
                module.code.length _ nBytes;
                codeSeg.pages _ PagesForWords[(nBytes + (bytesPerWord-1))/bytesPerWord];
                IF bcdHeader.nExports = 0 THEN {
                    startIndex: StreamIndex;
                    symbolBytes: CARDINAL;
                    UNTIL (startIndex _ IO.GetIndex[out]) MOD bytesPerPage = 0 DO
                        out.PutChar[000C]; ENDLOOP;
                    symbolSeg _ [
                        class: symbols, file: BcdDefs.FTSelf,
                        base: codeSeg.base+codeSeg.pages, pages: , extraPages: 0];
                    PGSConDefs.WriteSymbols[out, moduleId];
                    endIndex _ IO.GetIndex[out];
                    symbolBytes _ endIndex-startIndex;
                    symbolSeg.pages _ PagesForWords[(symbolBytes + (bytesPerWord-1))/bytesPerWord]};
                IO.SetIndex[out, moduleIndex];
                PutWords[out, @module, BcdDefs.MTRecord.direct.SIZE];
                IO.SetIndex[out, segIndex];
                PutWords[out, @codeSeg, BcdDefs.SGRecord.SIZE];
                PutWords[out, @symbolSeg, BcdDefs.SGRecord.SIZE];
                IO.SetIndex[out, endIndex]
                };

            }.