
    <<Driver.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Sweet, Oct 25, 1980 4:09 PM>>
        <<Satterthwaite, April 16, 1986 3:48:13 pm PST>>
        <<Russ Atkinson (RRA) March 6, 1985 11:16:23 pm PST>>

    DIRECTORY
        Alloc USING [Notifier, AddNotify, DropNotify],
        Code USING [actenable, bodyComRetLabel, bodyStartLoc, bodyInRecord, bodyOutRecord, bodyRetLabel, caseCVState, catchcount, 
        catchoutrecord, cfSize, codeptr, curctxlvl, fileLoc, firstTemp, framesz, inlineFileLoc, mainBody, reentryLabel, 
        StackNotEmptyAtStatement, substenable, tailJumpOK, tempcontext, tempstart, xtracting],
        CodeDefs USING [AddressNotify, Base, CallsNotify, CCIndex, CCNull, codeType,  ConstructorNotify, CountingNotify, CrossJumpNotify, 
        DJumpsNotify, ExpressionNotify, FinalNotify, FlowExpressionNotify, FlowNotify, JumpCCNull,  LabelCCIndex, LabelCCNull, 
        Lexeme, MaxParmsInStack, NullLex,  OutCodeNotify, PeepholeNotify, SelectionNotify, StatementNotify,  StatementStateRecord, 
        StoreNotify, TempNotify, VarBasicsNotify, VarIndex,  VarMoveNotify, VarUtilsNotify],
        ComData USING [bodyIndex, globalFrameSize, nErrors, objectBytes, stopping, table, textIndex],
        FOpCodes USING [qLADRB, qLI, qLINKB, qLL, qME, qMEL, qMXD, qMXDL, qPSD, qRET, qSG],
        P5 USING [BuildArgRecord, EndCodeFile, Exp, ExtractFrom, Fixup, FreeTempSei, GenStringBodyLex, LogHeapFree, OutBinary, 
        PopStatementState, PRetLex, ProcessGlobalStrings, ProcessLocalStrings, PurgePendTempList, PushArgRecord, 
        PushStatementState, StartCodeFile, StatementTree, TempInit],
        P5L USING [LoadAddress, TOSAddrLex, TOSLex, VarFinal, VarForLex],
        P5S USING [],
        P5U USING [CgenUtilInit, CgenUtilNotify, CreateLabel, DeleteCell, InsertLabel, LabelAlloc, NextVar, OperandType, Out0, Out1, 
        OutJump, OutSource, PushLitVal, TreeLiteralValue, WordsForSei],
        PrincOps USING [globalbase, localbase],
        SourceMap USING [nullLoc, Up],
        Stack USING [Decr, Depth, Dump, Incr, Init, Load, Off, On, Reset, StackImplNotify, Top],
        SymbolOps USING [EnumerateBodies, NextSe, SetCtxLevel, TransferTypes],
        Symbols USING [Base, bodyType, BTIndex, CBTIndex, CSEIndex, CSENull, ctxType,  ISEIndex, ISENull, RecordSEIndex, RecordSENull, 
        RootBti, seType],
        Tree USING [Base, Index, Link, Null, treeType],
        TreeOps USING [FreeNode, FreeTree, MakeList, MakeNode, PushList, PushNode, PushSe, PushTree, SearchList];

    Driver: PROGRAM
        IMPORTS Alloc, MPtr: ComData, CPtr: Code, CodeDefs, P5, P5L, P5U, SourceMap, Stack, SymbolOps, TreeOps 
        EXPORTS P5, P5S = BEGIN OPEN CodeDefs;

        <<imported definitions>>

        localbase: CARDINAL = PrincOps.localbase;
        globalbase: CARDINAL = PrincOps.globalbase;

        CSEIndex: TYPE = Symbols.CSEIndex;
        CSENull: CSEIndex = Symbols.CSENull;
        ISEIndex: TYPE = Symbols.ISEIndex;
        ISENull: ISEIndex = Symbols.ISENull;
        RecordSEIndex: TYPE = Symbols.RecordSEIndex;
        RecordSENull: RecordSEIndex = Symbols.RecordSENull;


        tb: Tree.Base;        -- tree base (local copy)
        seb: Symbols.Base;        -- semantic entry base (local copy)
        ctxb: Symbols.Base;        -- context entry base (local copy)
        bb: Symbols.Base;        -- body entry base (local copy)
        cb: CodeDefs.Base;        -- code base (local copy)

        DriverNotify: Alloc.Notifier =
            BEGIN  -- called by allocator whenever table area is repacked
            seb _ base[Symbols.seType];
            ctxb _ base[Symbols.ctxType];
            bb _ base[Symbols.bodyType];
            tb _ base[Tree.treeType];
            cb _ base[codeType];
            P5U.CgenUtilNotify[base]; 
            AddressNotify[base];
            ExpressionNotify[base];  FlowExpressionNotify[base];  FlowNotify[base];
            Stack.StackImplNotify[base];
            TempNotify[base];
            StatementNotify[base];  SelectionNotify[base];
            ConstructorNotify[base];  StoreNotify[base];  CountingNotify[base];
            CallsNotify[base];
            OutCodeNotify[base];  FinalNotify[base];
            CrossJumpNotify[base];  DJumpsNotify[base];
            PeepholeNotify[base]; 
            VarUtilsNotify[base];  VarBasicsNotify[base];  VarMoveNotify[base];
            END;


        CodePassError: PUBLIC ERROR [n: CARDINAL] = CODE;

        P5Error: PUBLIC PROC [n: CARDINAL] = {ERROR CodePassError[n]};


        codeStart: LabelCCIndex;
        mLock: Tree.Link;
        longLock: BOOL;

        Module: PUBLIC PROC =
            BEGIN -- main driver for code generation
            (MPtr.table).AddNotify[DriverNotify];
            CPtr.bodyInRecord _ CPtr.bodyOutRecord _ RecordSENull;
            P5U.CgenUtilInit[MPtr.table];
            P5.TempInit[];
            Stack.Init[];  Stack.Off[];
            CPtr.inlineFileLoc _ SourceMap.nullLoc;
            CPtr.xtracting _ FALSE;
            CPtr.caseCVState _ none;
            CPtr.catchoutrecord _ RecordSENull;
            CPtr.catchcount _ 0;
            CPtr.actenable _ CPtr.substenable _ LabelCCNull;
            CPtr.codeptr _ codeStart _ LabelCCNull;
            P5.StartCodeFile[];
            [] _ SymbolOps.EnumerateBodies[Symbols.RootBti, Body];
            MPtr.objectBytes _ P5.EndCodeFile[];
            Stack.Reset[];
            P5L.VarFinal[];
            (MPtr.table).DropNotify[DriverNotify]
            END;


        Body: PROC [bti: Symbols.BTIndex] RETURNS [stop: BOOL _ FALSE] =
            BEGIN
            WITH body: bb[bti] SELECT FROM
                Callable => IF ~body.inline THEN ProcBody[LOOPHOLE[bti]];
                ENDCASE;
            END;


        ProcBody: PROC [bti: Symbols.CBTIndex] =
            BEGIN -- produces code for body
            bodyNode: Tree.Index;

            CPtr.mainBody _ (bti = Symbols.RootBti);
            MPtr.bodyIndex _ bti;
            MPtr.textIndex _ SourceMap.Up[bb[bti].sourceIndex];

            WITH bi: bb[bti].info SELECT FROM
                Internal =>
                    BEGIN
                    bodyNode _ bi.bodyTree;
                    CPtr.curctxlvl _ bb[bti].level;

                    <<set up input and output contexts>>
                    [CPtr.bodyInRecord, CPtr.bodyOutRecord] _ SymbolOps.TransferTypes[bb[bti].ioType];

                    CPtr.firstTemp _ CPtr.tempstart _ CPtr.framesz _ bi.frameSize;
                    CPtr.cfSize _ 0;
                    CPtr.bodyStartLoc _ CPtr.fileLoc _ SourceMap.Up[bb[bti].sourceIndex];
                    CPtr.tailJumpOK _ TRUE;

                    <<init the code stream and put down bracketing labels>>

                    CPtr.bodyRetLabel _ P5U.LabelAlloc[];
                    CPtr.bodyComRetLabel _ P5U.LabelAlloc[];
                    CPtr.codeptr _ CCNull;
                    codeStart _ P5U.CreateLabel[];
                    P5U.OutSource[SourceMap.Up[bb[bti].sourceIndex]];

                    <<init data for creating temporaries>>

                    SymbolOps.SetCtxLevel[CPtr.tempcontext, CPtr.curctxlvl];

                    <<tuck parameters away into the frame>>

                    IF Stack.Depth[] # 0 THEN SIGNAL CPtr.StackNotEmptyAtStatement;
                    WITH bb[bti] SELECT FROM
                        Inner => P5U.Out1[FOpCodes.qLINKB, frameOffset-localbase];
                        ENDCASE;
                    Stack.On[];
                    CPtr.reentryLabel _ P5U.CreateLabel[];    -- for reentry on tail recursion
                    PopInVals[CPtr.bodyInRecord, FALSE];
                    P5.PurgePendTempList[];

                    <<do type table and string literals>>

                    IF CPtr.mainBody THEN
                        MPtr.globalFrameSize _ P5.ProcessGlobalStrings[MPtr.globalFrameSize];
                    CPtr.firstTemp _ CPtr.tempstart _ P5.ProcessLocalStrings[CPtr.tempstart, bi.thread];
                    bi.frameSize _ CPtr.framesz _ MAX [CPtr.framesz, CPtr.tempstart];

                    <<do initialization code and main body>>

                    IF CPtr.mainBody AND MPtr.stopping THEN
                        {P5U.Out1[FOpCodes.qLADRB, 0]; P5U.Out1[FOpCodes.qSG, globalbase]};

                    IF bb[bti].entry THEN SetLock[tb[bodyNode].son[4]]
                    ELSE mLock _ Tree.Null;

                    <<generate code for declaration initializations and statements>>

                    tb[bodyNode].son[2] _ P5.StatementTree[tb[bodyNode].son[2]];
                    tb[bodyNode].son[3] _ P5.StatementTree[tb[bodyNode].son[3]];
                    tb[bodyNode].son[1] _ Tree.Null;
                    IF Stack.Depth[] # 0 THEN SIGNAL CPtr.StackNotEmptyAtStatement;

                    <<push the return values onto the stack>>

                    InsertRetLabels[mLock # Tree.Null];
                    Stack.Reset[];
                    IF CPtr.mainBody AND MPtr.stopping THEN
                        {P5U.Out1[FOpCodes.qLI, 0]; P5U.Out1[FOpCodes.qSG, globalbase]};
                    Stack.Off[];
                    P5U.Out0[FOpCodes.qRET];
                    P5.PurgePendTempList[];

                    <<write frame size into bodyitem>>

                    bi.frameSize _ CPtr.framesz;

            <<fixup jumps>>

                IF MPtr.nErrors = 0 THEN P5.Fixup[codeStart, bb[bti].entryIndex];
                END;
                ENDCASE;

                    <<output the object code>>

            TreeOps.FreeNode[bodyNode];
            IF MPtr.nErrors = 0 THEN P5.OutBinary[bti, codeStart]
            ELSE
                BEGIN
                c, next: CCIndex;
                FOR c _ codeStart, next WHILE c # CCNull DO
                    next _ cb[c].flink;
                    P5U.DeleteCell[c];
                    ENDLOOP;
                END;
            END;


        SSubst: PROC [node: Tree.Index] RETURNS [nRets: CARDINAL] =
            BEGIN
            saveEnable: LabelCCIndex = CPtr.substenable;
            ss: StatementStateRecord;
            tSei: CSEIndex = P5U.OperandType[tb[node].son[1]];
            P5.PushStatementState[@ss];  CPtr.substenable _ CPtr.actenable;
            CPtr.bodyOutRecord _ SymbolOps.TransferTypes[tSei].typeOut;
            tb[node].son[2] _ P5.StatementTree[tb[node].son[2]];
            IF Stack.Depth[] # 0 THEN SIGNAL CPtr.StackNotEmptyAtStatement;
            InsertRetLabels[FALSE]; -- if entry procedure, lock already dealt with
            Stack.Reset[];
            nRets _ P5U.WordsForSei[CPtr.bodyOutRecord];
            P5.PopStatementState[@ss];  CPtr.substenable _ saveEnable;
            RETURN
            END;

        InsertRetLabels: PROC [monitored: BOOL] =
            BEGIN
            IF CPtr.bodyComRetLabel # LabelCCNull THEN
                BEGIN
                P5U.InsertLabel[CPtr.bodyComRetLabel];
                IF monitored THEN ReleaseLock[];
                IF cb[CPtr.bodyComRetLabel].jumplist # JumpCCNull THEN PushRetVals[];
                P5U.InsertLabel[CPtr.bodyRetLabel];
                CPtr.bodyComRetLabel _ LabelCCNull;
                CPtr.bodyRetLabel _ LabelCCNull;
                END;
            END;


        Subst: PUBLIC PROC [node: Tree.Index] =
            BEGIN
            [] _ SSubst[node];
            END;

        SubstExp: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
            BEGIN
            nRets: CARDINAL = SSubst[node];
            RETURN [P5.PRetLex[nRets, node, FALSE]]
            END;

        PopInVals: PUBLIC PROC [irecord: RecordSEIndex, isenable: BOOL] =
            BEGIN
            nParms: CARDINAL;
            r: VarIndex;
            t: Tree.Link;
            sei: ISEIndex;
            np: CARDINAL _ 0;

            IF irecord = CSENull THEN RETURN;
            nParms _ P5U.WordsForSei[irecord];
            IF nParms = 0 THEN RETURN;
            IF isenable THEN
                IF nParms <= 1 THEN RETURN
                ELSE P5U.Out1[FOpCodes.qLL,localbase+1];
            sei _ P5U.NextVar[ctxb[seb[irecord].fieldCtx].seList];
            UNTIL sei = ISENull DO
                TreeOps.PushSe[sei]; TreeOps.PushTree[Tree.Null]; TreeOps.PushNode[assign, 2];
                np _ np+1;
                sei _ P5U.NextVar[SymbolOps.NextSe[sei]];
                ENDLOOP;
            TreeOps.PushList[np];
            t _ TreeOps.MakeNode[exlist, 1];

            IF nParms > MaxParmsInStack OR (isenable AND nParms > 1) THEN
                BEGIN
                IF ~isenable THEN Stack.Incr[1];
                r _ P5L.TOSAddrLex[nParms].lexbdoi;
                END
            ELSE
                BEGIN
                Stack.Incr[nParms];
                r _ P5L.VarForLex[P5L.TOSLex[nParms]];
                END;
            P5.ExtractFrom[t, irecord, r, (nParms > MaxParmsInStack AND ~isenable)];
            t _ TreeOps.FreeTree[t];
            END;


        PushRetVals: PROC =
            BEGIN -- pushes the return vals from a body onto the stack
            sei: ISEIndex;
            nRetVals: CARDINAL;
            np: CARDINAL _ 0;
            t: Tree.Link;

            IF CPtr.bodyOutRecord = CSENull THEN RETURN;
            nRetVals _ P5U.WordsForSei[CPtr.bodyOutRecord];
            sei _ ctxb[seb[CPtr.bodyOutRecord].fieldCtx].seList;
            UNTIL sei = ISENull DO
                TreeOps.PushSe[sei];
                np _ np+1;
                sei _ P5U.NextVar[SymbolOps.NextSe[sei]];
                ENDLOOP;
            t _ TreeOps.MakeList[np];
            [] _ P5.BuildArgRecord[t, CPtr.bodyOutRecord, FALSE, FALSE];
            t _ TreeOps.FreeTree[t];
            END;

        SetLock: PROC [lock: Tree.Link] =
            BEGIN
            retryEntry: LabelCCIndex = P5U.CreateLabel[];
            longLock _ P5L.LoadAddress[P5L.VarForLex[P5.Exp[(mLock _ lock)]]];
            P5U.Out0[IF longLock THEN FOpCodes.qMEL ELSE FOpCodes.qME];
            P5U.Out1[FOpCodes.qLI, 0];
            P5U.OutJump[JumpE, retryEntry];
            END;


        ReleaseLock: PUBLIC PROC =
            BEGIN
            Stack.Dump[];
            [] _ P5L.LoadAddress[P5L.VarForLex[P5.Exp[mLock]]];
            P5U.Out0[IF longLock THEN FOpCodes.qMXDL ELSE FOpCodes.qMXD];
            END;


        SReturn: PROC [node: Tree.Index, isResume: BOOL] =
            BEGIN -- generate code for RETURN and RESUME
            nRetVals: CARDINAL;
            nStack: CARDINAL;
            rSei: RecordSEIndex;
            monitored: BOOL;

            IF ~isResume AND CommonRet[tb[node].son[1]] THEN
                BEGIN
                P5U.OutJump[Jump, CPtr.bodyComRetLabel];
                RETURN
                END;

            monitored _ ~isResume AND tb[node].attr1;
            IF monitored AND tb[node].attr2 THEN
                {ReleaseLock[]; monitored _ FALSE};
            rSei _ IF isResume THEN CPtr.catchoutrecord ELSE CPtr.bodyOutRecord;
            nRetVals _ IF tb[node].attr3
                THEN P5.PushArgRecord[tb[node].son[1], rSei, isResume, isResume]
                ELSE P5.BuildArgRecord[tb[node].son[1], rSei, isResume, isResume];
            nStack _ 
                IF nRetVals > MaxParmsInStack OR isResume AND nRetVals # 0 THEN 1
                ELSE nRetVals;

            IF monitored THEN
                {Stack.Dump[]; ReleaseLock[]};
            IF nStack # 0 THEN
                BEGIN
                Stack.Load[Stack.Top[nStack], nStack];
                Stack.Decr[nStack]; -- remove from model
                END;
            IF isResume THEN 
                BEGIN
                P5U.PushLitVal[1]; Stack.Decr[1];
                P5U.Out0[FOpCodes.qRET]; 
                P5U.OutJump[JumpRet, LabelCCNull]; 
                END
            ELSE P5U.OutJump[Jump, CPtr.bodyRetLabel];
            END;


        Result: PUBLIC PROC [node: Tree.Index] = Return;

        Return: PUBLIC PROC [node: Tree.Index] =
            BEGIN -- produce code for RETURN
            SReturn[node, FALSE ! P5.LogHeapFree => RESUME[FALSE, NullLex]];
            END;


        Resume: PUBLIC PROC [node: Tree.Index] =
            BEGIN -- produce code for RESUME
            SReturn[node, TRUE ! P5.LogHeapFree => RESUME[FALSE, NullLex]];
            END;


        CommonRet: PROC [t: Tree.Link] RETURNS [common: BOOL _ TRUE] =
            BEGIN -- test if the returns list duplicats the returns declaration
            sei: ISEIndex;

            Item: PROC [t: Tree.Link] RETURNS [BOOL] =
                BEGIN
                WITH t SELECT FROM
                    symbol => common _ (sei = index);
                    literal, subtree => common _ FALSE;
                    ENDCASE;
                IF sei # ISENull THEN sei _ P5U.NextVar[SymbolOps.NextSe[sei]];
                RETURN [~common]
                END;

            IF t = Tree.Null THEN RETURN;
            IF CPtr.bodyOutRecord # CSENull THEN
                sei _ P5U.NextVar[ctxb[seb[CPtr.bodyOutRecord].fieldCtx].seList]
            ELSE RETURN [FALSE];
            TreeOps.SearchList[t, Item];
            RETURN
            END;

        Lock: PUBLIC PROC [node: Tree.Index] =
            BEGIN
            saveLock: Tree.Link = mLock;
            SetLock[tb[node].son[2]];
            tb[node].son[1] _ P5.StatementTree[tb[node].son[1]];
            InsertRetLabels[TRUE]; -- we are in an INLINE procedure
            mLock _ saveLock;
            END;

        StringInit: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
            BEGIN -- inits string storage and pushes pointer on stack
            nchars: CARDINAL = P5U.TreeLiteralValue[tb[node].son[2]];
            l: Lexeme.se _ P5.GenStringBodyLex[nchars];
            [] _ P5L.LoadAddress[P5L.VarForLex[l]];
            P5.FreeTempSei[l.lexsei];
            P5U.PushLitVal[0];
            P5U.PushLitVal[nchars];
            P5U.Out1[FOpCodes.qPSD, 0];
            RETURN [P5L.TOSLex[1]]
            END;

        END.