
    <<CompilerSequencer.mesa>>
        <<Copyright  1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, December 1, 1985 3:12:39 pm PST>>
        <<Russ Atkinson, 10-Dec-80 10:53:50>>
        <<Maxwell, August 2, 1983 3:06 pm>>
        <<Paul Rovner, November 21, 1983 11:10 am>>
        <<Russ Atkinson (RRA) April 3, 1985 4:16:54 pm PST>>
    <<>>
    DIRECTORY
        BasicTime: TYPE USING [],
        Alloc: TYPE USING [Handle, Selector, TableInfo, Chunkify, Create, Destroy, Failure, Reset],
        CBinary: TYPE USING [DebugTab, ErrorTab, MesaTab],
        CompilerOps: TYPE USING [LetterSwitches, StreamId, Transaction],
        CompilerUtil: TYPE USING [TableId, InstallParseTables, PrefillSymbols, P1Unit, P2Unit, P3Unit, P3Postlude, P4Unit, P5module, 
        EndObjectFile, PrintBodies, PrintSymbols, PrintTree, StartObjectFile, TableOut],
        ComData: TYPE USING [bcdSeg, codeSeg, compilerVersion, globalFrameSize, interface, linkCount, matched, nErrors, nWarnings, 
        objectBytes, objectStamp, objectVersion, ownSymbols, pattern, source, sourceTokens, symSeg, switches, table, textIndex],
        Copier: TYPE USING [FileInit, FileReset],
        FS: TYPE USING [StreamFromOpenFile, nullOpenFile],
        FileParmOps: TYPE USING [AcquireOutput, ReleaseOutput],
        IO: TYPE USING [Close, Flush, PutChar, Put, PutRope, rope, STREAM, time, Error],
        LiteralOps: TYPE USING [Initialize, Finalize],
        Loader: TYPE USING [BCDBuildTime],
        Log: TYPE USING [Error],
        OSMiscOps: TYPE USING [GenerateUniqueId, MergeStamps, StampToTime, TimeToStamp],
        PrincOpsUtils: TYPE USING [Codebase],
        Rope: TYPE USING [ROPE],
        RuntimeError: TYPE USING [UNCAUGHT],
        SourceMap: TYPE USING [Cons, Init, Reset],
        SymLiteralOps: TYPE USING [Finalize, Initialize],
        SymbolPack: TYPE,
        SymbolOps: TYPE USING [Finalize, Initialize],
        SymbolSegment: TYPE USING [Tables, treeType],
        TimeStamp: TYPE USING [Stamp],
        Tree: TYPE USING [Link],
        TreeOps: TYPE USING [Finalize, Initialize, PopTree, Reset];

    CompilerSequencer: MONITOR
        IMPORTS Alloc, CBinary, CompilerUtil, Copier, FS, FileParmOps, IO, Log, LiteralOps, Loader, OSMiscOps, PrincOpsUtils, RuntimeError, 
        SourceMap, SymLiteralOps, SymbolOps, TreeOps,  ownSymbols: SymbolPack, dataPtr: ComData
        EXPORTS CompilerOps, CompilerUtil = { 

        table: Alloc.Handle _ NIL;

    <<stream management>>

        StreamId: TYPE = CompilerOps.StreamId;
        TransactionPtr: TYPE = REF CompilerOps.Transaction;

        getStream: PROC[StreamId] RETURNS[IO.STREAM];

        streamInfo: ARRAY StreamId[$source .. $log] OF RECORD[
            access: {read, write},
            stream: IO.STREAM,
            status: RECORD [count: NAT, open: BOOL]];

        AcquireStream: PUBLIC PROC[id: StreamId] RETURNS[stream: IO.STREAM] = {
            IF streamInfo[id].stream = NIL THEN {
                streamInfo[id].stream _ getStream[id];
                streamInfo[id].status _ [count:0, open:TRUE]};
            stream _ streamInfo[id].stream;
            IF streamInfo[id].status = [count: 0, open: FALSE] THEN
                streamInfo[id].status.open _ TRUE;
            streamInfo[id].status.count _ streamInfo[id].status.count + 1};

        ReleaseStream: PUBLIC PROC[id: StreamId] = {
            streamInfo[id].status.count _ streamInfo[id].status.count - 1;
            IF streamInfo[id].status.count = 0 THEN {
                IF streamInfo[id].access = $write THEN streamInfo[id].stream.Flush[];
                streamInfo[id].status.open _ FALSE}
            };


    <<table segment management>>

        tableBase: ARRAY CompilerUtil.TableId [$error..$debug] OF LONG POINTER;

        AcquireTable: PUBLIC PROC[id: CompilerUtil.TableId] RETURNS[LONG POINTER] = {
            RETURN[tableBase[id]]};

        ReleaseTable: PUBLIC PROC[id: CompilerUtil.TableId] = {};


    <<compiler inquiries>>

        DefaultSwitches: PUBLIC PROC RETURNS[CompilerOps.LetterSwitches] = {
            RETURN[[
                TRUE , -- A  Address fault for NIL checks
                TRUE , -- B  Bounds checking
                TRUE , -- C  compile for Cedar (special FORK)
                FALSE, -- D  call Debugger on compiler error (FALSE => just log error)
                TRUE , -- E  fixed (big Eval stack)
                TRUE , -- F  Floating point microcode
                TRUE , -- G  TRUE => loG goes to compiler.log, FALSE => use foo.errlog
                FALSE, -- H  unused
                FALSE, -- I  unused
                FALSE, -- J  cross-Jumping optimization
                FALSE, -- K  unused
                TRUE , -- L  allocate space for code Links
                TRUE , -- M  reference counting Microcode
                TRUE , -- N  Nil pointer checking
                FALSE, -- O  unused
                FALSE, -- P  Pause after compilation with errors
                FALSE, -- Q  unused
                FALSE, -- R  unused
                TRUE , -- S  Sort (by static frequency) global vars & entry indexes
                FALSE, -- T  unused
                FALSE, -- U  uninitialized variable checking
                FALSE, -- V  unused
                TRUE , -- W  log Warning messages
                FALSE, -- X  unused
                FALSE, -- Y  complain about KFCB
                TRUE   -- Z  FALSE => use old-style method to access ROPE & ATOM literals
                ]]
            };

        CompilerVersion: PUBLIC PROC RETURNS[TimeStamp.Stamp] = {
            RETURN[dataPtr.compilerVersion]};

        AppendHerald: PUBLIC PROC[s: IO.STREAM] = {
            s.Put[IO.rope["Cedar 6.0 Cross Compiler of "], IO.time[Loader.BCDBuildTime[]]]};


    <<compiler sequencing>>

        pass: CHARACTER ['1..'5];

        ExtendedTables: TYPE = Alloc.Selector[SymbolSegment.Tables.FIRST .. SymbolSegment.Tables.LAST+1];

        Initialize: PROC = {
            weights: ARRAY ExtendedTables OF Alloc.TableInfo _ [
                [30, 16], [20], [4], [4], [4], [2], [4], [1], [2], [1], [2], [2], [20, 15]];    -- empirical
            IF table = NIL
                THEN {
                    table _ Alloc.Create[weights: DESCRIPTOR[weights]]; 
                    table.Chunkify[table: SymbolSegment.treeType, firstSmall: 4, nSmall: 7];
                    table.Chunkify[table: SymbolSegment.Tables.LAST+1, nSmall: 5]}    -- codeType
                ELSE table.Reset[];
            SymbolOps.Initialize[table, NIL];  LiteralOps.Initialize[table];
            TreeOps.Initialize[table];  SourceMap.Init[]};

        Finalize: PROC[parms: TransactionPtr, ownedObject: BOOL] = {
            parms.objectVersion _ dataPtr.objectVersion;
            parms.interface _ dataPtr.interface;
            parms.matched _ dataPtr.matched AND (dataPtr.nErrors = 0);
            parms.sourceTokens _ dataPtr.sourceTokens;
            parms.nErrors _ dataPtr.nErrors;  parms.nWarnings _ dataPtr.nWarnings;
            parms.objectBytes _ dataPtr.objectBytes;
            parms.objectFrameSize _ dataPtr.globalFrameSize;  
            parms.linkCount _ dataPtr.linkCount;
            parms.bcdPages _ [base: dataPtr.bcdSeg.base, pages: dataPtr.bcdSeg.pages];
            parms.codePages _ [base: dataPtr.codeSeg.base, pages: dataPtr.codeSeg.pages];
            parms.symbolPages _ [base: dataPtr.symSeg.base, pages: dataPtr.symSeg.pages];
            CompilerUtil.EndObjectFile[dataPtr.nErrors=0];
            IF streamInfo[$object].stream # NIL THEN {
                IO.Close[streamInfo[$object].stream ! IO.Error => CONTINUE];
                streamInfo[$object].stream _ NIL};
            IF ownedObject
                THEN {
                    IF parms.objectFile = FS.nullOpenFile THEN ERROR;
                    FileParmOps.ReleaseOutput[parms.objectFile];
                    };
            SourceMap.Reset[];
            TreeOps.Finalize[];  LiteralOps.Finalize[];  SymbolOps.Finalize[];
            table.Reset[]};

        Debug: PROC[tree, symbols: PROC[Alloc.Handle]] = {
            tree[table];  symbols[table]};

        Punt: PUBLIC ERROR = CODE;

        started: BOOL _ FALSE;

        Start: PUBLIC ENTRY PROC = {
            ENABLE UNWIND => NULL;
            IF started AND table # NIL THEN Alloc.Destroy[table];
            table _ NIL;
            started _ TRUE};

        Stop: PUBLIC ENTRY PROC = {
            ENABLE UNWIND => NULL;
            IF started THEN {
                IF table # NIL THEN {Alloc.Destroy[table]; table _ NIL};
                started _ FALSE};
            };

        DoTransaction: PUBLIC ENTRY PROC[parms: TransactionPtr] = {
            ENABLE UNWIND => NULL;
            root: Tree.Link;
            debug: BOOL;
            nParseErrors: CARDINAL;
            parsed, aborted: BOOL;
            ownedObject: BOOL _ FALSE;

            PrintTreeRoot: PROC[table: Alloc.Handle] = {CompilerUtil.PrintTree[table, root]};
            PrintSymbols: PROC[table: Alloc.Handle] = {
                CompilerUtil.PrintSymbols[table, dataPtr.interface]};

            IF ~started THEN RETURN WITH ERROR Punt[];
            getStream _ parms.getStream;
            dataPtr.source _ parms.source;
            dataPtr.switches _ parms.switches;
            dataPtr.matched _ parms.op = replace;
            dataPtr.pattern _ parms.pattern;
            debug _ dataPtr.switches['d];

            dataPtr.objectVersion _ OSMiscOps.GenerateUniqueId[];
            dataPtr.objectStamp _ OSMiscOps.TimeToStamp[dataPtr.source.version];
            <<encode switches, compiler version (see DIRECTORY processing also)>>
                dataPtr.objectStamp _ OSMiscOps.MergeStamps[
                    dataPtr.objectStamp, OSMiscOps.TimeToStamp[[0, 0, LOOPHOLE[dataPtr.switches]]]];
                dataPtr.objectStamp _ OSMiscOps.MergeStamps[
                    dataPtr.objectStamp, OSMiscOps.TimeToStamp[dataPtr.compilerVersion]];

            dataPtr.nErrors _ dataPtr.nWarnings _ 0; aborted _ FALSE;
            streamInfo[$source] _
                [access: $read, stream: parms.sourceStream, status: [count: 0, open: FALSE]];
            streamInfo[$object] _ streamInfo[$log] _
                [access: $write, stream: NIL, status: [count: 0, open: FALSE]];
            Initialize[];
        { ENABLE {
               ABORTED => NULL;
               UNWIND => Finalize[parms, ownedObject];
                Alloc.Failure => {IF ~debug THEN GOTO storageFull};
                RuntimeError.UNCAUGHT => IF ~debug THEN GOTO uncaughtSignal;
                };
            dataPtr.table _ table;

            CompilerUtil.PrefillSymbols[];
            dataPtr.textIndex _ SourceMap.Cons[0];

            <<first pass>>
            IF parms.startPass # NIL AND ~parms.startPass[1] THEN GOTO cancel;
            pass _ '1;
            parsed _ CompilerUtil.P1Unit[];
            nParseErrors _ dataPtr.nErrors;
            IF ~parsed THEN GOTO failed;
            root _ TreeOps.PopTree[];  TreeOps.Reset[];
            IF parms.debugPass <= 1 THEN Debug[PrintTreeRoot, PrintSymbols];

            <<second pass>>
            IF parms.startPass # NIL AND ~parms.startPass[2] THEN GOTO cancel;
            pass _ '2;
            root _ CompilerUtil.P2Unit[root];
            IF parms.debugPass <= 2 THEN Debug[PrintTreeRoot, PrintSymbols];

            <<third and fourth passes>>
            IF parms.startPass # NIL AND ~parms.startPass[3] THEN GOTO cancel;

            SymLiteralOps.Initialize[table];
        { ENABLE UNWIND => SymLiteralOps.Finalize[];

            Copier.FileInit[[dataPtr.objectVersion, parms.objectName], table, parms.fileParms];
        { ENABLE UNWIND => Copier.FileReset[];
            BEGIN
                ENABLE Alloc.Failure => {Copier.FileReset[]; SymLiteralOps.Finalize[]; GOTO storageFull};

                pass _ '3;
                root _ CompilerUtil.P3Unit[root];
                CompilerUtil.P3Postlude[dataPtr.nErrors <= nParseErrors];

                IF parms.debugPass <= 3 THEN Debug[PrintTreeRoot, PrintSymbols];
                IF dataPtr.nErrors > nParseErrors THEN GOTO deleteFiles;

                dataPtr.objectVersion _ OSMiscOps.StampToTime[dataPtr.objectStamp];
                parms.fileParms.Forget[[dataPtr.objectVersion, parms.objectName]];
                IF parms.objectFile # FS.nullOpenFile THEN ERROR;
                parms.objectFile _ FileParmOps.AcquireOutput[parms.objectName];
                ownedObject _ TRUE;
                IF parms.objectFile = FS.nullOpenFile THEN ERROR;
                streamInfo[$object].stream
                    _ FS.StreamFromOpenFile[openFile: parms.objectFile, accessRights: $write];

                IF parms.startPass # NIL AND ~parms.startPass[4]
                    THEN {Copier.FileReset[]; SymLiteralOps.Finalize[]; GOTO cancel};
                pass _ '4;
                CompilerUtil.StartObjectFile[AcquireStream[$object]];
                CompilerUtil.P4Unit[root];
                IF parms.debugPass <= 4 THEN Debug[CompilerUtil.PrintBodies, PrintSymbols];

                EXITS
                    deleteFiles => NULL;
            END;
        };  -- end ENABLE UNWIND => Copier.FileReset[];
            Copier.FileReset[];

            IF dataPtr.nErrors # 0 THEN {SymLiteralOps.Finalize[]; GOTO failed};

            <<fifth pass>>
            IF ~dataPtr.interface THEN {
                IF parms.startPass # NIL AND ~parms.startPass[5]
                    THEN {SymLiteralOps.Finalize[]; GOTO cancel};
                pass _ '5;
                CompilerUtil.P5module[];
                };
        };  -- end ENABLE UNWIND => SymLiteralOps.Finalize[];
            SymLiteralOps.Finalize[];

            IF parms.startPass # NIL AND ~parms.startPass[6] THEN GOTO cancel;
            CompilerUtil.TableOut[table];
        <<>>
            <<IF parms.startPass # NIL THEN [] _ parms.startPass[0];>>
            IF dataPtr.nErrors # 0 THEN aborted _ TRUE;

            EXITS
                failed => aborted _ TRUE;
                cancel => {Log.Error[aborted];  aborted _ TRUE};
                uncaughtSignal => {
                    errorStream: IO.STREAM = AcquireStream[$log];
                    aborted _ TRUE;
                    Log.Error[compilerError];
                    IO.PutRope[errorStream, "in Pass "];  IO.PutChar[errorStream, pass];
                    IO.PutChar[errorStream, '\n];
                    ReleaseStream[$log];
                    Finalize[parms, ownedObject];
                    RETURN WITH ERROR Punt[];
                    };
                storageFull => {
                    errorStream: IO.STREAM = AcquireStream[$log];
                    aborted _ TRUE;
                    dataPtr.nErrors _ dataPtr.nErrors+1;
                    IO.PutRope[errorStream, "\nStorage "];  IO.PutRope[errorStream, "overflow"];
                    IO.PutRope[errorStream, " in Pass "];  IO.PutChar[errorStream, pass];
                    IO.PutChar[errorStream, '\n];
                    ReleaseStream[$log];
                    };

        }; -- end ENABLE UNWIND => Finalize[parms, ownedObject]; etc.
        Finalize[parms, ownedObject];
        };  -- end DoTransaction

    <<* * * * * *  M A I N   B O D Y   C O D E  * * * * * *>>

        START dataPtr;     -- initialize STRING variables, etc.
        START ownSymbols;
        dataPtr.ownSymbols _ ownSymbols;
        dataPtr.compilerVersion _ [net: 0Dh, host: 0Ch, time: 0F0000006h]; -- Cedar release

        CompilerUtil.InstallParseTables[PrincOpsUtils.Codebase[LOOPHOLE[CBinary.MesaTab]]] ;
        tableBase[$error] _ PrincOpsUtils.Codebase[LOOPHOLE[CBinary.ErrorTab]];
        tableBase[$debug] _ PrincOpsUtils.Codebase[LOOPHOLE[CBinary.DebugTab]];

        }.

