<<>>
    <<MimosaSequencer.mesa>>
        <<Copyright Ó 1985, 1986, 1987, 1988, 1989, 1990, 1991 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, June 10, 1986 3:04:13 pm PDT>>
        <<Russ Atkinson (RRA) February 7, 1992 6:11 pm PST>>
        <<Bob Hagmann March 24, 1986 8:50:18 am PST>>
        <<JKF August 15, 1988 1:47:31 pm PDT>>
        <<Foote, May 18, 1993 4:38 pm PDT>>
        <<>>
        DIRECTORY
            Alloc USING [AddNotify, Chunkify, Create, Destroy, Failure, Handle, Notifier, Reset, TableInfo],
            CompilerOps USING [LetterSwitches, StreamId, Transaction],
            CompilerUtil USING [EndObjectFile, InstallParseTables, P1Unit, P2Unit, P3Postlude, P3Unit, P4Unit, P5module, PrefillSymbols, 
            PrintBodies, PrintSymbols, PrintTree, StartObjectFile, TableOut],
            IO USING [Flush, Put, PutChar, PutRope, STREAM],
            LiteralOps USING [Finalize, Initialize],
            Literals USING [ltTag, stTag],
            Loader USING [BCDBuildTime],
            MimData USING [base, checks, compilerVersion, interface, nErrors, nWarnings, objectStamp, objectVersion, ownSymbols, pattern, 
            source, sourceTokens, switches, textIndex],
            MimosaCopier USING [FileInit, FileReset],
            MimosaEvents,
            MimosaLog USING [Error],
            MimSysOps USING [Close],
            MimZones USING [permZone, RegisterForReset],
            MobDefs USING [VersionStamp],
            OSMiscOps USING [bytesPerFilePage, GenerateUniqueId, MergeStamps, StampToTime, TimeToStamp, WordAnd, WordOr],
            Rope USING [ROPE],
            RuntimeError USING [UNCAUGHT],
            SourceMap USING [Cons, Init, Reset],
            SymbolOps USING [Finalize, Initialize, own],
            Symbols USING [htTag, seTag],
            SymbolSegment USING [Tables, treeType],
            SymLiteralOps USING [Finalize, Initialize],
            Tree USING [Link, treeTag],
            TreeOps USING [Finalize, Initialize, PopTree, Reset];
MimosaSequencer: PROGRAM
    IMPORTS Alloc, MimData, CompilerUtil, IO, LiteralOps, Loader, MimosaCopier, MimosaLog, MimSysOps, MimZones, OSMiscOps, 
    RuntimeError, SourceMap, SymbolOps, SymLiteralOps, TreeOps
    EXPORTS CompilerOps, CompilerUtil, MimData, MimosaEvents = {
    OPEN MimosaEvents;

    ROPE: TYPE = Rope.ROPE;
    STREAM: TYPE = IO.STREAM;

    table: PUBLIC Alloc.Handle Ź NIL;
        <<Exported to MimData.table>>

    <<stream management>>

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

        getStream: PROC [StreamId] RETURNS [STREAM] Ź NIL;

        StreamInfo: TYPE = RECORD [
            access: {read, write},
            stream: STREAM,
            status: RECORD [count: NAT, open: BOOL]];

        streamInfo: ARRAY StreamId[$source .. $log] OF StreamInfo Ź [
            [access: $read, stream: NIL, status: [count: 0, open: FALSE]],
            [access: $write, stream: NIL, status: [count: 0, open: FALSE]],
            [access: $write, stream: NIL, status: [count: 0, open: FALSE]]
            ];

        AcquireStream: PUBLIC PROC [id: StreamId] RETURNS [stream: 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] = {
            count: CARDINAL Ź streamInfo[id].status.count;
            SELECT count FROM
                0 => ERROR;
                1 => {
                    st: STREAM = streamInfo[id].stream;
                    IF st # NIL AND streamInfo[id].access = $write THEN IO.Flush[st];
                    streamInfo[id].status.open Ź FALSE;
                    };
                ENDCASE => streamInfo[id].status.count Ź count-1;
            };

    <<compiler inquiries>>

        DefaultSwitches: PUBLIC PROC RETURNS [CompilerOps.LetterSwitches] = {
            RETURN [[
                FALSE,    -- A    [c2c] true => use dbx-style source macros
                TRUE,    -- B    true => emit bounds checking
                    <<Pass4B, Pass4S, Pass4Xa>>
                FALSE,    -- C    [c2c] true => c2c.c extension, false => c extension
                FALSE,    -- D    true => call Debugger on error, false => just log error
                FALSE,    -- E    [c2c] reserved
                TRUE,    -- F    [c2c] true => generate inline floating point
                FALSE,    -- G    [c2c] true => leave garbage (don't break cycles)
                TRUE,    -- H    true => for new-style exception Handling (obsolete)
                FALSE,    -- I    true => output intermediate code to icd file
                FALSE,    -- J    reserved
                TRUE,    -- K    true => emit smaller initialization code
                TRUE,    -- L    [c2c] true => use LF (012C) for newlines
                FALSE,    -- M    true => Mimosa only (no c2c generation)
                TRUE,    -- N    true => emit NIL checking
                    <<Pass4B, Pass4S, Pass4Xa, Pass4Xb>>
                TRUE,    -- O    [c2c] reserved
                FALSE,    -- P    true => punt on warning or error (stops compilation)
                    <<MimosaInterface>>
                FALSE,    -- Q    [c2c] true => generate calls for counted assignments
                FALSE,    -- R    [c2c] make certain procedures extern callable (obsolete)
                FALSE,    -- S    reserved (historical usage => sort variables)
                    <<Pass3B, Pass4B, Pass4L>>
                FALSE,    -- T    [c2c] reserved
                TRUE,    -- U    true => check for uninitialized variables
                    <<Pass3I>>
                FALSE,    -- V    [c2c] true => generate line # file (no source macros)
                TRUE ,    -- W    true => log Warning messages
                    <<MimosaLogImpl>>
                FALSE,    -- X    reserved (for experimental purposes)
                FALSE,    -- Y    reserved (for experimental purposes)
                FALSE    -- Z    reserved (for experimental purposes)
                ]]
            };
            importantSwitches: CompilerOps.LetterSwitches = [
                FALSE, TRUE, FALSE, FALSE, FALSE, FALSE,    -- B in ABCDEF
                FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,    -- none in GHIJKL
                FALSE, TRUE, TRUE, FALSE, FALSE, TRUE,    -- N,O,R in MNOPQR
                FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,    -- none in STUVWX
                FALSE, FALSE];            -- none in YZ
                <<Note: change this array when changing any default switches that should affect the functional version stamp of the output file.>>

        AppendHerald: PUBLIC PROC [s: STREAM] = {
            s.Put[[rope["Mimosa of "]], [time[Loader.BCDBuildTime[]]]];
            };

    <<compiler sequencing>>

        pass: CHAR Ź 0C;

        ExtendedTables: TYPE = SymbolSegment.Tables;

        Initialize: PROC = {
            max: INT = 16000;
            weights: ARRAY ExtendedTables OF Alloc.TableInfo Ź [    -- empirical
                [Tree.treeTag, 256, max],        -- 0    treeType
                [Symbols.seTag, 256, max],    -- 1    seType
                [Symbols.htTag, 64, max],    -- 2    htType
                [0, 64, max],        -- 3    ssType
                [0, 64, max],        -- 4    ctxType
                [0, 64, max],        -- 5    mdType
                [0, 64, max],        -- 6    bodyType
                [Literals.ltTag, 64, max],        -- 7    ltType
                [Literals.stTag, 64, max],        -- 8    stType
                [0, 64, max],        -- 9    extType
                [0, 64, max],        -- 10    atType
                [0, 64, max]            -- 11    constType
                ];
            IF table = NIL
                THEN {
                    table Ź Alloc.Create[weights: DESCRIPTOR[weights]]; 
                    table.Chunkify[table: SymbolSegment.treeType, firstSmall: 4, nSmall: 7];
                    Alloc.AddNotify[table, AllocRelocate];
                    }
                ELSE table.Reset[];
            CauseEvent[startFile];
            SymbolOps.Initialize[table, NIL];
            MimData.ownSymbols Ź SymbolOps.own;
            LiteralOps.Initialize[table];
            TreeOps.Initialize[table];
            SourceMap.Init[];
            };

        Finalize: PROC [parms: TransactionPtr, oops: BOOL] = {
            unitsPerPage: CARDINAL = OSMiscOps.bytesPerFilePage / BYTES[UNIT];
            parms.objectVersion Ź MimData.objectVersion;
            parms.interface Ź MimData.interface;
            parms.sourceTokens Ź MimData.sourceTokens;
            parms.nErrors Ź MimData.nErrors;
            parms.nWarnings Ź MimData.nWarnings;
            CompilerUtil.EndObjectFile[MimData.nErrors = 0 AND NOT oops];
            IF streamInfo[$object].stream # NIL THEN {
                parms.closeStream[object];
                [] Ź MimSysOps.Close[streamInfo[$object].stream];
                streamInfo[$object].stream Ź NIL;
                };
            CauseEvent[endFile];
            SourceMap.Reset[];
            TreeOps.Finalize[];
            LiteralOps.Finalize[];
            SymbolOps.Finalize[];
            IF table # NIL THEN table.Reset[];
            };

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

        Punt: PUBLIC ERROR = CODE;

        started: BOOL Ź FALSE;
        resetTable: BOOL Ź FALSE;

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

        Stop: PUBLIC PROC = {
            IF started THEN {
                started Ź FALSE;
                IF table # NIL AND resetTable THEN {Alloc.Destroy[table]; table Ź NIL};
                };
            CauseEvent[cleanup];
            };

        DoTransaction: PUBLIC PROC [parms: TransactionPtr] = {
            root: Tree.Link;
            debug: BOOL;
            nParseErrors: CARDINAL;
            parsed, aborted: BOOL;

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

            TestPass: PROC [passN: NAT] RETURNS [BOOL] = {
                parms.nErrors Ź MimData.nErrors;
                parms.nWarnings Ź MimData.nWarnings;
                IF parms.startPass # NIL AND ~parms.startPass[passN] THEN RETURN [TRUE];
                pass Ź '0 + passN;
                RETURN [FALSE];
                };

            IF ~started THEN RETURN WITH ERROR Punt[];
            getStream Ź parms.getStream;
            MimData.source Ź parms.source;
            MimData.switches Ź parms.switches;
            MimData.checks Ź parms.checks;
            MimData.pattern Ź parms.pattern;
            debug Ź MimData.switches['d];

            MimData.objectVersion Ź OSMiscOps.GenerateUniqueId[];
            MimData.objectStamp Ź OSMiscOps.TimeToStamp[MimData.source.version];
            {
                <<encode important switches, compiler version (see DIRECTORY processing also)>>
                sw: CARD Ź 0;
                FOR c: CHAR['a..'z] IN CHAR['a..'z] DO
                    <<Accumulate the switches numerically for portability>>
                    sw Ź sw + sw;
                    IF importantSwitches[c] AND MimData.switches[c] THEN sw Ź sw + 1;
                    ENDLOOP;
                MimData.objectStamp Ź OSMiscOps.MergeStamps[
                    MimData.objectStamp, OSMiscOps.TimeToStamp[[0, sw]]];
                MimData.objectStamp Ź OSMiscOps.MergeStamps[
                    MimData.objectStamp, OSMiscOps.TimeToStamp[MimData.compilerVersion]];
                };

            MimData.nErrors Ź MimData.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 {
                   UNWIND => Finalize[parms, TRUE];
                    Alloc.Failure => {IF ~debug THEN GO TO storageFull};
                    RuntimeError.UNCAUGHT => {IF ~debug THEN GOTO uncaughtSignal};
                    };

                CompilerUtil.PrefillSymbols[];
                MimData.textIndex Ź SourceMap.Cons[0];

                <<first pass>>
                IF TestPass[1] THEN GO TO cancel;
                parsed Ź CompilerUtil.P1Unit[];
                nParseErrors Ź MimData.nErrors;
                CauseEvent[pass1];
                IF ~parsed THEN GO TO failed;
                root Ź TreeOps.PopTree[];
                TreeOps.Reset[];
                IF parms.debugPass <= 1 THEN Debug[PrintTreeRoot, PrintSymbols];

                <<second pass>>
                IF TestPass[2] THEN GO TO cancel;
                root Ź CompilerUtil.P2Unit[root];
                IF parms.debugPass <= 2 THEN Debug[PrintTreeRoot, PrintSymbols];
                CauseEvent[pass2];

                IF MimData.nErrors # 0 THEN GO TO failed;
                    <<There is no need to go further if we can't even parse it!>>
                    <<>>
                <<third and fourth passes>>
                IF TestPass[3] THEN GO TO cancel;
                SymLiteralOps.Initialize[table];
                { ENABLE UNWIND => SymLiteralOps.Finalize[];

                    MimosaCopier.FileInit[
                    [MimData.objectVersion, parms.objectName], table, parms.fileParms];
                    { ENABLE UNWIND => MimosaCopier.FileReset[];
                        {
                            ENABLE Alloc.Failure => {
                                MimosaCopier.FileReset[];
                                SymLiteralOps.Finalize[];
                                GO TO storageFull;
                                };
                            root Ź CompilerUtil.P3Unit[root];
                            CompilerUtil.P3Postlude[MimData.nErrors <= nParseErrors];

                            IF parms.debugPass <= 3 THEN Debug[PrintTreeRoot, PrintSymbols];
                            CauseEvent[pass3];
                            IF MimData.nErrors > nParseErrors THEN GO TO deleteFiles;

                            MimData.objectVersion Ź OSMiscOps.StampToTime[MimData.objectStamp];
                            parms.fileParms.Forget[[MimData.objectVersion, parms.objectName]];

                            IF TestPass[4] THEN {
                                MimosaCopier.FileReset[];
                                SymLiteralOps.Finalize[];
                                GO TO cancel;
                                };
                            CompilerUtil.StartObjectFile[AcquireStream[$object]];
                            CompilerUtil.P4Unit[root];
                            IF parms.debugPass <= 4 THEN Debug[CompilerUtil.PrintBodies, PrintSymbols];
                            CauseEvent[pass4];

                            EXITS
                                deleteFiles => NULL;
                            };
                        };
                    MimosaCopier.FileReset[];

                    IF MimData.nErrors # 0 THEN {SymLiteralOps.Finalize[]; GO TO failed};

                    <<fifth pass>>
                    IF ~MimData.interface THEN {
                        IF TestPass[5] THEN {
                            SymLiteralOps.Finalize[];
                            GO TO cancel;
                            };
                        CompilerUtil.P5module[];
                        CauseEvent[pass5];
                        };
                    };
                SymLiteralOps.Finalize[];

                IF TestPass[6] THEN GO TO cancel;
                CompilerUtil.TableOut[table];
                CauseEvent[pass6];
                <<>>
                IF MimData.nErrors # 0 THEN GO TO failed;

                EXITS
                    failed => aborted Ź TRUE;
                    cancel => {MimosaLog.Error[aborted]; aborted Ź TRUE};
                    uncaughtSignal => {
                        errorStream: IO.STREAM = AcquireStream[$log];
                        aborted Ź TRUE;
                        MimosaLog.Error[compilerError];
                        IO.PutRope[errorStream, "Uncaught signal/error in Pass "];
                        IO.PutChar[errorStream, pass];
                        IO.PutChar[errorStream, '\n];
                        ReleaseStream[$log];
                        };
                    storageFull => {
                        errorStream: STREAM = AcquireStream[$log];
                        aborted Ź TRUE;
                        MimData.nErrors Ź MimData.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];
                        };
                };
        Finalize[parms, FALSE];
        };

    <<Stuff exported to MimosaEvents>>
        <<>>
        lastAdded: REF RegisteredProc Ź NIL;
        registeredList: REF RegisteredProc Ź NIL;
        freeList: REF RegisteredProc Ź NIL;
        RegisteredProc: TYPE = RECORD [
            next: REF RegisteredProc,
            proc: Callback,
            trigger: Trigger];

        EventAnd: PROC [t1, t2: Trigger] RETURNS [Trigger] = {
            RETURN [LOOPHOLE [OSMiscOps.WordAnd[LOOPHOLE[t1, WORD], LOOPHOLE[t2, WORD]]]];
            };

        EventOr: PROC [t1, t2: Trigger] RETURNS [Trigger] = {
            RETURN [LOOPHOLE [OSMiscOps.WordOr[LOOPHOLE[t1, WORD], LOOPHOLE[t2, WORD]]]];
            };

        Register: PUBLIC PROC [proc: Callback, class: EventsClass] = {
            IF lastAdded # NIL AND lastAdded.proc = proc
                THEN
                    <<Tricky quick kill for repeated events>>
                    lastAdded.trigger[class] Ź TRUE
                ELSE {
                    trigger: Trigger Ź nullTrigger;
                    trigger[class] Ź TRUE;
                    RegisterSet[proc, trigger];
                    };
            };

        RegisterSet: PUBLIC PROC [proc: Callback, trigger: Trigger] = {
            elem: REF RegisteredProc Ź registeredList;
            SELECT TRUE FROM
                proc = NIL => ERROR;
                trigger = nullTrigger => {
                    <<Delete the registration>>
                    reg: REF RegisteredProc Ź registeredList;
                    lag: REF RegisteredProc Ź NIL;
                    WHILE reg # NIL DO
                        next: REF RegisteredProc Ź reg.next;
                        IF reg.proc = proc THEN {
                            <<Move the registration to the free list>>
                            reg.next Ź freeList;
                            freeList Ź reg;
                            IF reg = lastAdded THEN lastAdded Ź NIL;
                            IF lag = NIL THEN registeredList Ź next ELSE lag.next Ź next;
                            EXIT;
                            };
                        lag Ź reg;
                        reg Ź next;
                        ENDLOOP;
                    RETURN;
                    };
                ENDCASE => {
                    new: REF RegisteredProc Ź NIL;
                    IF lastAdded # NIL AND lastAdded.proc = proc THEN {
                        <<Tricky quick kill for repeated events>>
                        elem Ź lastAdded;
                        GO TO merge;
                        };
                    DO
                        IF elem = NIL THEN EXIT;
                        IF elem.proc = proc THEN {lastAdded Ź elem; GO TO merge};
                        IF elem.next = NIL THEN EXIT;
                        elem Ź elem.next;
                        ENDLOOP;
                    <<Add the registration to the end of the list>>
                    IF freeList # NIL
                        THEN {
                            <<Can get the new element from the free list>>
                            new Ź freeList;
                            freeList Ź freeList.next;
                            new­ Ź [NIL, proc, trigger];
                            }
                        ELSE
                            <<Need to have a new free element>>
                            new Ź MimZones.permZone.NEW[RegisteredProc Ź [NIL, proc, trigger]];
                    IF elem = NIL THEN registeredList Ź new ELSE elem.next Ź new;
                    lastAdded Ź new;
                    EXITS merge => elem.trigger Ź EventOr[elem.trigger, trigger];
                    };
            IF trigger[relocate] AND MimData.base # NIL THEN proc[relocate];
            };

        CauseEvent: PUBLIC PROC [class: EventsClass] = {
            mask: Trigger Ź nullTrigger;
            mask[class] Ź TRUE;
            IF class = relocate AND MimData.base = NIL THEN RETURN;
            FOR each: REF RegisteredProc Ź registeredList, each.next WHILE each # NIL DO
                IF EventAnd[mask, each.trigger] = mask THEN each.proc[class];
                ENDLOOP;
            };

        ZoneReset: PROC = {CauseEvent[zoneReset]};
        AllocRelocate: Alloc.Notifier = {
            MimData.base Ź base;
            CauseEvent[relocate];
            };

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

        -- initialize STRING variables, etc.

        MimData.compilerVersion Ź [0, 0F0000107h];
            <<low byte => Compiler Release>>

        MimZones.RegisterForReset[ZoneReset];
        CompilerUtil.InstallParseTables[NIL];


    }.
    <<>>