
    <<Flow.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Sweet, May 31, 1986 9:49:07 pm PDT>>
        <<Satterthwaite, April 17, 1986 11:29:24 am PST>>
        <<Maxwell, August 11, 1983 9:12 am>>
        <<Russ Atkinson (RRA) March 6, 1985 11:19:01 pm PST>>

    DIRECTORY
        Alloc,
        Basics,
        Code,
        CodeDefs,
        FOpCodes,
        IntCodeDefs,
        P5,
        P5S,
        P5U,
        PrincOps,
        Symbols,
        Tree,
        TreeOps;

    Flow: PROGRAM
        IMPORTS CPtr: Code, CodeDefs, P5U, P5, TreeOps 
        EXPORTS CodeDefs, P5, P5S = BEGIN OPEN IntCodeDefs, CodeDefs;

        <<imported definitions>>

        BitCount: TYPE = Symbols.BitCount;
        HTIndex: TYPE = Symbols.HTIndex;

        labelStack: LabelInfoIndex _ LabelInfoNull;

        UndeclaredLabel: SIGNAL [HTIndex] = CODE;

        tb: Tree.Base;        -- tree base (local copy)
        cb: CodeDefs.Base;        -- code base (local copy)

        CompForNodeName: PACKED ARRAY Tree.NodeName[relE..notin] OF Comparator _ [
            relE:eq, relN:ne, relL:lt, relGE:ge, relG:gt, relLE:le, in: in, notin: out];

        FlowNotify: PUBLIC Alloc.Notifier =
            BEGIN  -- called by allocator whenever table area is repacked
            tb _ base[Tree.treeType];
            cb _ base[codeType];
            END;

        FlowExp: PUBLIC PROC [node: Tree.Index] RETURNS [l: Node] =
            BEGIN -- generates code for a flow expression
            SELECT tb[node].name FROM
                ifx => l _ IfExp[node];
                or => l _ Or[node];
                and => l _ And[node];
                not => l _ Not[node];
                relE, relN, relL, relGE, relG, relLE, in, notin => l _ Rel[node];
                abs => l _ Abs[node];
                lengthen => l _ Lengthen[node];
                <<shorten => l _ Shorten[node];>>
                min => l _ Min[node];
                max => l _ Max[node];
                istype => l _ Rel[node];
                ENDCASE => {SIGNAL CPtr.CodeNotImplemented};
            RETURN
            END;


        Abs: PROC [node: Tree.Index] RETURNS [Node] =
            BEGIN -- generate code for ABS
            op: Node _ P5U.ArithOpForTree[node, abs];
            bits: BitCount _ P5U.BitsForType[tb[node].info];
            val: Node _ P5.Exp[tb[node].son[1]];
            RETURN [P5U.ApplyOp[op, P5U.MakeNodeList[val], bits]];
            END;


        Lengthen: PROC [node: Tree.Index] RETURNS [Node] =
            BEGIN -- convert 16 bit to 32
            signed: BOOL _ tb[node].attr3;
            short: Node _ P5.Exp[tb[node].son[1]];
            IF signed THEN RETURN [P5U.SignExtend[short]]
            ELSE RETURN[P5U.ZeroExtend[short]];
            END;


        <<Shorten: PROC [node: Tree.Index] RETURNS [Lexeme] =>>
            <<BEGIN>>
            <<P5.PushRhs[tb[node].son[1]];>>
            <<IF ~tb[node].attr1 THEN P5U.Out0[qPOP]    -- no checking>>
            <<ELSE IF tb[node].attr3 THEN>>
                <<BEGIN>>
                <<P5U.Out1[qLI, 100000b]; P5U.Out1[qLI, 0]; P5U.Out0[qDADD];>>
                <<P5U.Out1[qLI, 1]; P5U.Out0[qBNDCK]; P5U.Out0[qPOP];>>
                <<P5U.Out1[qLI, 100000b]; P5U.Out0[qXOR];>>
                <<END>>
            <<ELSE>>
                <<BEGIN>>
                <<P5U.Out1[qLI, 1]; P5U.Out0[qBNDCK]; P5U.Out0[qPOP];>>
                <<END;    >>
            <<RETURN [P5L.TOSLex[1]]>>
            <<END;>>
            <<>>
            <<>>
        And: PROC [node: Tree.Index] RETURNS [l: Node] = 
            BEGIN -- generate code for "AND"
            e1: Node = P5.Exp[tb[node].son[1]];
            e2: Node = P5.Exp[tb[node].son[2]];
            else: CaseList = P5U.MakeCaseList[NIL, CPtr.falseNode];
            then: CaseList = P5U.MakeCaseList[P5U.MakeNodeList[e1], e2, else];
            l _ z.NEW[NodeRep.cond _ [bits: e1.bits, details: cond[then]]];
            END;

        Or: PROC [node: Tree.Index] RETURNS [l: Node] = 
            BEGIN -- generate code for "OR"
            e1: Node = P5.Exp[tb[node].son[1]];
            e2: Node = P5.Exp[tb[node].son[2]];
            else: CaseList = P5U.MakeCaseList[NIL, e2];
            then: CaseList = P5U.MakeCaseList[P5U.MakeNodeList[e1], CPtr.trueNode, else];
            l _ z.NEW[NodeRep.cond _ [bits: e1.bits, details: cond[then]]];
            END;

        Not: PROC [node: Tree.Index] RETURNS [l: Node] =
            BEGIN -- generate code for "NOT"
            e1: Node = P5.Exp[tb[node].son[1]];
            else: CaseList = P5U.MakeCaseList[NIL, CPtr.trueNode];
            then: CaseList = P5U.MakeCaseList[P5U.MakeNodeList[e1], CPtr.falseNode, else];
            l _ z.NEW[NodeRep.cond _ [bits: e1.bits, details: cond[then]]];
            END;

        Rel: PROC [node: Tree.Index] RETURNS [l: Node] =
            BEGIN -- produces code for relationals
            e1: Node = P5.Exp[tb[node].son[1]];
            e2: Node = P5.Exp[tb[node].son[2]];
            ops: NodeList _ P5U.MakeNodeList[e1, P5U.MakeNodeList[e2]];
            name: Tree.NodeName _ tb[node].name;
            SELECT name FROM 
                relE, relN, relL, relGE, relG, relLE, in, notin => 
                    l _ P5U.ApplyOp[oper: P5U.CompareOpForTree[node, CompForNodeName[name]],  args: ops, bits: 1];
                istype => NULL; -- obviously needs work
                ENDCASE;
            END;

        IfExp: PROC [node: Tree.Index] RETURNS [l: Node] =
            BEGIN -- generates code for an IF expression
            test: Node = P5.Exp[tb[node].son[1]];
            e1: Node = P5.Exp[tb[node].son[2]];
            e2: Node = P5.Exp[tb[node].son[3]];
            else: CaseList = P5U.MakeCaseList[NIL, e2];
            then: CaseList = P5U.MakeCaseList[P5U.MakeNodeList[test], e1, else];
            l _ z.NEW[NodeRep.cond _ [bits: e1.bits, details: cond[then]]];
            END;

        Min: PROC [node: Tree.Index] RETURNS [l: Node] =
            BEGIN -- generates code for "MAX[...]"
            op: Node _ P5U.ArithOpForTree[node, min];
            bits: BitCount _ P5U.BitsForType[tb[node].info];
            l _ CMinMax[op, tb[node].son[1], bits];
            END;


        Max: PROC [node: Tree.Index] RETURNS [l: Node] =
            BEGIN -- generates code for "MAX[...]"
            op: Node _ P5U.ArithOpForTree[node, max];
            bits: BitCount _ P5U.BitsForType[tb[node].info];
            l _ CMinMax[op, tb[node].son[1], bits];
            END;


        CMinMax: PROC [mOp: Node, t: Tree.Link, bits: BitCount] RETURNS [l: Node] =
            BEGIN -- common subroutine for Cmin and Cmax
            args: NodeList _ P5.ExpList[t].head;
            RETURN [P5U.ApplyOp[mOp, args, bits]];
            END;
        CatchMark: PUBLIC PROC [node: Tree.Index] RETURNS [Node] =
            BEGIN -- process a CONTINUEd or RETRYed statement
            cl: CodeList _ P5U.NewCodeList[];
            l: LabelInfoIndex _ P5U.GetChunk[LabelInfoRecord.SIZE];
            retry: Label = P5U.AllocLabel[];
            continue: Label = P5U.AllocLabel[];
            cb[l] _ [thread: labelStack, catchLevel: CPtr.catchcount, body:
                stmt[retry: retry, continue: continue]];
            labelStack _ l;
            P5U.InsertLabel[cl, retry];
            P5U.MoreCode[cl, P5.StatementTree[tb[node].son[1]]];
            P5U.InsertLabel[cl, continue];
            IF labelStack # l THEN ERROR;
            labelStack _ cb[l].thread;
            P5U.FreeChunk[l, LabelInfoRecord.SIZE];
            RETURN[P5U.MakeBlock[cl]];
            END;

        LabelStmt: PUBLIC PROC [node: Tree.Index] RETURNS [Node] =
            BEGIN -- process an exitable block
            cl: CodeList _ P5U.NewCodeList[];
            elabel: Label = P5U.AllocLabel[];
            labelmark: LabelInfoIndex = labelStack;
            TreeOps.ScanList[tb[node].son[2], LabelCreate];
            P5U.MoreCode[cl, P5.StatementTree[tb[node].son[1]]];
            P5U.Jump[cl, elabel];
            LabelList[cl, tb[node].son[2], elabel, labelmark];
            P5U.InsertLabel[cl, elabel];
            RETURN[P5U.MakeBlock[cl]];
            END;


        GetLabelMark: PUBLIC PROC RETURNS [LabelInfoIndex] =
            {RETURN [labelStack]};


        PopLabels: PROC [first: LabelInfoIndex] =
            BEGIN
            oldl: LabelInfoIndex;
            UNTIL first = LabelInfoNull DO
                oldl _ first;
                first _ cb[first].thread;
                P5U.FreeChunk[oldl, LabelInfoRecord.SIZE];
                ENDLOOP;
            END;

        ObscureLabels: PROC [mark: LabelInfoIndex] RETURNS [first: LabelInfoIndex] =
            BEGIN
            first _ labelStack;
            UNTIL labelStack = LabelInfoNull OR  cb[labelStack].thread = mark DO 
                labelStack _ cb[labelStack].thread;
                ENDLOOP;
            cb[labelStack].thread _ LabelInfoNull;
            labelStack _ mark;
            RETURN
            END;

        FindLabel: PROC [start: LabelInfoIndex, hti: HTIndex] RETURNS [NamedLabelInfoIndex] =
            BEGIN
            FOR l: LabelInfoIndex _ start, cb[l].thread UNTIL l = LabelInfoNull DO
                WITH li: cb[l] SELECT FROM
                    named => IF li.hti = hti THEN RETURN [LOOPHOLE[l]];
                    ENDCASE;
                ENDLOOP;
            ERROR UndeclaredLabel[hti]
            END;

        LabelList: PUBLIC PROC [cl: CodeList, t: Tree.Link, elabel: Label, mark: LabelInfoIndex] =
            BEGIN -- generates code for labels
            toBind: LabelInfoIndex = ObscureLabels[mark];

            PutLabel: PROC [t: Tree.Link] =
                BEGIN
                P5U.InsertLabel[cl, cb[FindLabel[toBind, TreeOps.GetHash[t]]].cci];
                END;

            CLabelItem: PROC [t: Tree.Link] =
                BEGIN -- generates code for a labelitem
                node: Tree.Index = TreeOps.GetNode[t];
                TreeOps.ScanList[tb[node].son[1], PutLabel];
                P5U.MoreCode[cl, P5.StatementTree[tb[node].son[2]]];
                P5U.Jump[cl, elabel];
                END;

            TreeOps.ScanList[t, CLabelItem];
            PopLabels[toBind];
            END;


        LabelCreate: PUBLIC PROC [t: Tree.Link] =
            BEGIN -- sets up label cells for labels
            node: Tree.Index = TreeOps.GetNode[t];
            TreeOps.ScanList[tb[node].son[1], PushLabel];
            END;


        PushLabel: PROC [t: Tree.Link] =
            BEGIN -- stacks a label for an EXIT clause
            hti: Symbols.HTIndex = TreeOps.GetHash[t];
            l: LabelInfoIndex = P5U.GetChunk[LabelInfoRecord.SIZE];
            cb[l] _ [thread: labelStack, catchLevel: CPtr.catchcount, body:
                named[hti: hti, cci: P5U.AllocLabel[LONG[LOOPHOLE[hti, CARDINAL]]]]];
            labelStack _ l;
            END;


        MakeExitLabel: PUBLIC PROC RETURNS [exit, loop: Label] =
            BEGIN -- sets up anonymous label for EXITs
            l: LabelInfoIndex = P5U.GetChunk[LabelInfoRecord.SIZE];
            exit _ P5U.AllocLabel[];
            loop _ P5U.AllocLabel[];
            cb[l] _ [thread: labelStack, catchLevel: CPtr.catchcount, body:
                loop[exit: exit, loop: loop]];
            labelStack _ l;
            RETURN
            END;


        Retry: PUBLIC PROC RETURNS [Node] =
            BEGIN -- process RETRY statement
            FOR l: LabelInfoIndex _ labelStack, cb[l].thread UNTIL l = LabelInfoNull DO
                WITH li: cb[l] SELECT FROM
                    stmt => RETURN[ExplicitJump[li.catchLevel, li.retry]];
                    ENDCASE;
                ENDLOOP;
            ERROR
            END;


        Continue: PUBLIC PROC RETURNS [Node] =
            BEGIN -- process CONTINUE statement
            FOR l: LabelInfoIndex _ labelStack, cb[l].thread UNTIL l = LabelInfoNull DO
                WITH li: cb[l] SELECT FROM
                    stmt => RETURN[ExplicitJump[li.catchLevel, li.continue]];
                    ENDCASE;
                ENDLOOP;
            ERROR
            END;


        Exit: PUBLIC PROC RETURNS [Node] =
            BEGIN  -- generate code for EXIT
            FOR l: LabelInfoIndex _ labelStack, cb[l].thread UNTIL l = LabelInfoNull DO
                WITH li: cb[l] SELECT FROM
                    loop => RETURN[ExplicitJump[li.catchLevel, li.exit]];
                    ENDCASE;
                ENDLOOP;
            ERROR
            END;

        Loop: PUBLIC PROC RETURNS [Node] =
            BEGIN  -- generate code for LOOP
            FOR l: LabelInfoIndex _ labelStack, cb[l].thread UNTIL l = LabelInfoNull DO
                WITH li: cb[l] SELECT FROM
                    loop => RETURN[ExplicitJump[li.catchLevel, li.loop]];
                    ENDCASE;
                ENDLOOP;
            ERROR
            END;


        GoTo: PUBLIC PROC [node: Tree.Index] RETURNS [Node] =
            BEGIN  -- generate code for GOTO
            l: NamedLabelInfoIndex = FindLabel[labelStack, TreeOps.GetHash[tb[node].son[1]]];
            RETURN[ExplicitJump[cb[l].catchLevel, cb[l].cci]];
            END;


        ExplicitJump: PROC [cc: CARDINAL, lc: Label] RETURNS [Node] =
            BEGIN -- process EXIT/REPEAT/GOTO/etc. statement
            IF CPtr.catchcount = cc THEN RETURN[z.NEW[NodeRep.goto _ [details: goto[lc]]]]
            ELSE
                BEGIN
                <<var: VarComponent = [wSize: 1, space: frame[>>
                    <<wd: PrincOps.localbase,>>
                    <<level: CPtr.curctxlvl-(CPtr.catchcount-cc-1)]];>>
                <<P5L.LoadComponent[var];>>
                <<P5U.PushLitVal[-1];>>
                <<P5U.Out1[FOpCodes.qLL, PrincOps.returnOffset];>>
                <<P5U.Out0[FOpCodes.qSFC];>>
                <<Stack.Decr[2];>>
                <<P5U.OutJump[Jump, lc];>>
                RETURN[NIL];
                END;
            END;

        END.