-- FlowExpression.mesa
-- last modified by Sweet, 7-Dec-81 13:30:41
-- last modified by Satterthwaite, December 16, 1982 9:32 am

DIRECTORY
  Alloc: TYPE USING [Notifier],
  Code: TYPE USING [CodeNotImplemented, ZEROlexeme, warnStackOverflow],
  CodeDefs: TYPE USING [
    Base, codeType, JumpType, LabelCCIndex, Lexeme, NullLex, VarComponent, VarIndex],
  FOpCodes: TYPE USING [
    qAND, qBNDCK, qDADD, qDCMP, qDIS, qDSUB, qDUP, qEXDIS, qFCOMP, qLI,
    qLINT, qLP, qNEG, qREC, qREC2, qUDCMP, qXOR],
  Log: TYPE USING [Warning],
  P5: TYPE USING [
    Exp, FlowTree, GenTempLex, LogHeapFree, PushLex, PushRhs, 
    ReleaseTempLex, SAssign],
  P5L: TYPE USING [
    AllLoaded, ComponentForLex, CopyToTemp, EasilyLoadable, FieldOfVar,
    LoadBoth, LoadComponent, LoadVar, MakeComponent, NormalizeExp, 
    NormalLex, OVarItem, ReusableCopies, TOSLex, VarAlignment, VarForLex],
  P5U: TYPE USING [
    InsertLabel, LabelAlloc, LongTreeAddress, Out0, Out1, OutJump, 
    PushLitVal, TreeLiteral],
  Stack: TYPE USING [
    Also, Decr, DeleteToMark, Dump, Mark, Off, On, ResetToMark, RoomFor,
    TempStore, UnMark],
  Symbols: TYPE USING [ISEIndex, ISENull],
  Tree: TYPE USING [Base, Index, Link, NodeName, treeType],
  TreeOps: TYPE USING [GetNode, ListLength, ScanList];


FlowExpression: PROGRAM
    IMPORTS CPtr: Code, Log, P5U, P5L, P5, Stack, TreeOps 
    EXPORTS CodeDefs, P5 =
  BEGIN
  OPEN FOpCodes, CodeDefs;

  -- imported definitions

  ISEIndex: TYPE = Symbols.ISEIndex;
  ISENull: ISEIndex = Symbols.ISENull;

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

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

  JumpNN: ARRAY Tree.NodeName[relE..relLE] OF JumpType = [
    relE:JumpE, relN:JumpN, relL:JumpL, relGE:JumpGE, relG:JumpG, relLE:JumpLE];

  UJumpNN: ARRAY Tree.NodeName[relE..relLE] OF JumpType = [
    relE:JumpE, relN:JumpN, relL:UJumpL, relGE:UJumpGE, relG:UJumpG, relLE:UJumpLE];

  CNN: ARRAY Tree.NodeName[relE..relLE] OF Tree.NodeName = [
    relE:relN, relN:relE, relL:relGE, relGE:relL, relG:relLE, relLE:relG];

  RNN: ARRAY Tree.NodeName[relE..relLE] OF Tree.NodeName = [
    relE:relE, relN:relN, relL:relG, relGE:relLE, relG:relL, relLE:relGE];

  PushOnly: PROC [t: Tree.Link] =
    BEGIN
    P5.PushRhs[t];
    END;

  FlowExp: PUBLIC PROC [node: Tree.Index] RETURNS [l: Lexeme] =
    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, TRUE];
      abs => l ← Abs[node];
      lengthen => l ← Lengthen[node];
      shorten => l ← Shorten[node];
      min => l ← Min[node];
      max => l ← Max[node];
      istype => l ← Rel[node, TRUE];
      ENDCASE => {SIGNAL CPtr.CodeNotImplemented; l ← CPtr.ZEROlexeme};
    RETURN
    END;


  Abs: PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN -- generate code for ABS
    nw: [1..2];
    real: BOOL;
    poslabel: LabelCCIndex = P5U.LabelAlloc[];
    donelabel: LabelCCIndex;
    SELECT TRUE FROM
      tb[node].attr1 => {nw ← 2; real ← TRUE};
      tb[node].attr2 => {nw ← 2; real ← FALSE};
      ENDCASE => {nw ← 1; real ← FALSE};
    IF real THEN	-- delete for strict IEEE floating point
      BEGIN
      IF ~Stack.RoomFor[3] THEN {
        Stack.Dump[];
	IF CPtr.warnStackOverflow THEN Log.Warning[other--awfulCode--]};
      P5.PushRhs[tb[node].son[1]];
      P5U.PushLitVal[77777b];
      P5U.Out0[qAND];
      END
    ELSE IF nw = 2 THEN
      BEGIN
      var: VarComponent;
      zero: VarComponent = [wSize: 2, space: const[d1: 0, d2: 0]];
--    IF real THEN Stack.Dump[];
      Stack.Mark[];
      var ← P5L.MakeComponent[P5L.VarForLex[P5.Exp[tb[node].son[1]]]];
      var ← P5L.EasilyLoadable[var, load];
      P5L.LoadComponent[var];  P5L.LoadComponent[zero];
      P5U.Out0[--IF real THEN qFCOMP ELSE-- qDCMP];
      P5U.PushLitVal[0];
      P5U.OutJump[JumpGE, poslabel];
      P5L.LoadComponent[zero];  P5L.LoadComponent[var];
      P5U.Out0[--IF real THEN qFSUB ELSE-- qDSUB];
      Stack.ResetToMark[];
      P5U.OutJump[Jump, donelabel ← P5U.LabelAlloc[]];
      P5U.InsertLabel[poslabel];
      P5L.LoadComponent[var];
      Stack.Also[n: 2, place: [none[]]];
      Stack.UnMark[];
      P5U.InsertLabel[donelabel];
      END
    ELSE 	-- nw = 1
      BEGIN
      IF ~Stack.RoomFor[3] THEN {
        Stack.Dump[];
	IF CPtr.warnStackOverflow THEN Log.Warning[other--awfulCode--]};
      P5.PushRhs[tb[node].son[1]];
      P5U.Out0[qDUP]; -- don't use Stack.Dup since Neg will clear info
      P5U.PushLitVal[0];
      P5U.OutJump[JumpGE, poslabel];
      P5U.Out0[qNEG];
      P5U.InsertLabel[poslabel];
      END;
    RETURN [P5L.TOSLex[nw]]
    END;


  Lengthen: PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN
    r: VarIndex = P5L.VarForLex[P5.Exp[tb[node].son[1]]];
    nw: CARDINAL;
    IF P5L.VarAlignment[r, load].wSize = 2 THEN -- array descriptor
      BEGIN
      IF P5L.AllLoaded[r] THEN
	BEGIN
	len: VarComponent = Stack.TempStore[1];
	P5U.Out0[qLP];
	P5L.LoadComponent[len];
	END
      ELSE
	BEGIN
	tr1, tr2: VarIndex;
	[first: tr1, next: tr2] ← P5L.ReusableCopies[r, load, TRUE];
	P5L.FieldOfVar[r: tr1, wSize: 1];
	P5L.FieldOfVar[r: tr2, wd: 1, wSize: 1];
	IF P5L.AllLoaded[tr2] THEN -- clearly on top of stack
	  tr2 ← P5L.OVarItem[P5L.CopyToTemp[tr2].var];
	P5L.LoadVar[tr1];
	P5U.Out0[qLP];
	P5L.LoadVar[tr2];
	END;
      nw ← 3;
      END
    ELSE
      BEGIN
      P5L.LoadVar[r];
      IF tb[node].attr1 THEN P5U.Out0[qLP]
      ELSE IF tb[node].attr3 THEN P5U.Out0[qLINT]
      ELSE P5U.Out1[qLI, 0];
      nw ← 2;
      END;
    RETURN [P5L.TOSLex[nw]]
    END;

  Shorten: PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN
    P5.PushRhs[tb[node].son[1]];
    IF ~tb[node].attr1 THEN P5U.Out0[qDIS]	-- 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[qDIS];
      P5U.Out1[qLI, 100000b]; P5U.Out0[qXOR];
      END
    ELSE
      BEGIN
      P5U.Out1[qLI, 1]; P5U.Out0[qBNDCK]; P5U.Out0[qDIS];
      END;	
    RETURN [P5L.TOSLex[1]]
    END;


  And: PROC [node: Tree.Index] RETURNS [Lexeme] = INLINE
    BEGIN -- generate code for "AND"
    RETURN [CAnd[TRUE, tb[node].son[1], tb[node].son[2]]]
    END;

  CAnd: PROC [tf: BOOL, t1, t2: Tree.Link] RETURNS [Lexeme] =
    BEGIN -- main subroutine for Cand
    label: LabelCCIndex = P5U.LabelAlloc[];
    elabel: LabelCCIndex = P5U.LabelAlloc[];
    Stack.Mark[];
      BEGIN ENABLE P5.LogHeapFree => RESUME[FALSE, NullLex];
      P5.FlowTree[t1, FALSE, label];
      P5.FlowTree[t2, FALSE, label];
      END;
    P5U.PushLitVal[IF tf THEN 1 ELSE 0];
    Stack.DeleteToMark[];
    P5U.OutJump[Jump,elabel];
    P5U.InsertLabel[label];
    P5U.PushLitVal[IF tf THEN 0 ELSE 1];
    P5U.InsertLabel[elabel];
    Stack.Also[n: 1, place: [none[]]];
    RETURN [P5L.TOSLex[1]]
    END;


  Or: PROC [node: Tree.Index] RETURNS [Lexeme] = INLINE
    BEGIN -- generate code for "OR"
    RETURN [COr[TRUE, tb[node].son[1], tb[node].son[2]]]
    END;

  COr: PROC [tf: BOOL, t1, t2: Tree.Link] RETURNS [Lexeme] =
    BEGIN -- main subroutine for Cor
    labelt: LabelCCIndex = P5U.LabelAlloc[];
    labelf: LabelCCIndex = P5U.LabelAlloc[];
    elabel: LabelCCIndex = P5U.LabelAlloc[];
    Stack.Mark[];
      BEGIN ENABLE P5.LogHeapFree => RESUME[FALSE, NullLex];
      P5.FlowTree[t1, TRUE, labelt];
      P5.FlowTree[t2, FALSE, labelf];
      END;
    P5U.InsertLabel[labelt];
    P5U.PushLitVal[IF tf THEN 1 ELSE 0];
    Stack.DeleteToMark[];
    P5U.OutJump[Jump,elabel];
    P5U.InsertLabel[labelf];
    P5U.PushLitVal[IF tf THEN 0 ELSE 1];
    P5U.InsertLabel[elabel];
    Stack.Also[n: 1, place: [none[]]];
    RETURN [P5L.TOSLex[1]]
    END;


  Not: PROC [node: Tree.Index] RETURNS [l: Lexeme] =
    BEGIN -- generate code for "NOT"
    WITH tb[node].son[1] SELECT FROM
      subtree =>
        BEGIN
        subNode: Tree.Index = index;
        SELECT tb[subNode].name FROM
          or => l ← COr[FALSE, tb[subNode].son[1], tb[subNode].son[2]];
          and => l ← CAnd[FALSE, tb[subNode].son[1], tb[subNode].son[2]];
          relE, relN, relL, relGE, relG, relLE, in, notin => l ← Rel[subNode, FALSE];
          istype => l ← Rel[subNode, FALSE];
          not => {P5.PushRhs[tb[subNode].son[1]]; l ← P5L.TOSLex[1]};
          ENDCASE => GOTO VanillaNot;
        END;
      ENDCASE => GO TO VanillaNot;
    EXITS
      VanillaNot =>
	BEGIN
	P5.PushRhs[tb[node].son[1]]; P5U.PushLitVal[1]; P5U.Out0[qXOR];
	l ← P5L.TOSLex[1];
	END;
    END;


  Rel: PROC [node: Tree.Index, tf: BOOL] RETURNS [Lexeme] =
    BEGIN -- produces code for relationals outside flow
    tlabel: LabelCCIndex = P5U.LabelAlloc[];
    elabel: LabelCCIndex = P5U.LabelAlloc[];
    P5.FlowTree[[subtree[node]], tf, tlabel];
    P5U.PushLitVal[0];
    P5U.OutJump[Jump, elabel];
    P5U.InsertLabel[tlabel];
    Stack.Off[];
    P5U.PushLitVal[1];
    Stack.On[];
    P5U.InsertLabel[elabel];
    Stack.Also[n: 1, place: [none[]]];	-- forget backup
    RETURN [P5L.TOSLex[1]]
    END;


  IfExp: PROC [node: Tree.Index] RETURNS [l: Lexeme] =
    BEGIN -- generates code for an IF expression
    ilabel, elabel: LabelCCIndex;
    t3: Tree.Link = tb[node].son[3];
    t2: Tree.Link = tb[node].son[2];
    nwords: CARDINAL;
    tsei: ISEIndex ← ISENull;
    bothConst: BOOL = P5U.TreeLiteral[t2] AND P5U.TreeLiteral[t3];
    thenLong, elseLong: BOOL;
    elabel ← P5U.LabelAlloc[];
    Stack.Mark[];
    P5.FlowTree[tb[node].son[1], FALSE, elabel];
      BEGIN
      ENABLE P5.LogHeapFree => RESUME[FALSE, NullLex];
      [nwords: nwords, long: thenLong, tsei: tsei] ← P5L.NormalizeExp[
	P5L.VarForLex[P5.Exp[t2]], tsei, bothConst];
      elseLong ← nwords > 2 AND P5U.LongTreeAddress[t3];
      IF elseLong AND ~thenLong THEN P5U.Out0[FOpCodes.qLP];
      Stack.ResetToMark[];
      P5U.OutJump[Jump, ilabel ← P5U.LabelAlloc[]];
      P5U.InsertLabel[elabel];
      [] ← P5L.NormalizeExp[P5L.VarForLex[P5.Exp[t3]], tsei, bothConst];
      Stack.UnMark[];
      IF thenLong AND ~elseLong THEN {P5U.Out0[qLP]; elseLong ← TRUE};
      P5U.InsertLabel[ilabel];
      END;
    IF tsei # ISENull THEN P5.ReleaseTempLex[[se[tsei]]];
    l ← P5L.NormalLex[nwords, elseLong, bothConst]; -- either stack or bo with stack base
    SELECT TRUE FROM
      (nwords <= 2) => Stack.Also[n: nwords, place: [none[]]];
      bothConst => Stack.Also[n: 1, place: [none[]]];
      ENDCASE => Stack.Also[n: IF elseLong THEN 2 ELSE 1, place: [none[]]];
    END;


  Min: PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN -- generate code for "MIN[...]"
    real: BOOL = tb[node].attr1;
    nw: [1..2] = IF real OR tb[node].attr2 THEN 2 ELSE 1;
    signed: BOOL = tb[node].attr3;
    CMinMax[relL, tb[node].son[1], nw, real, signed];
    RETURN [P5L.TOSLex[nw]]
    END;


  Max: PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN -- generates code for "MAX[...]"
    real: BOOL = tb[node].attr1;
    nw: [1..2] = IF real OR tb[node].attr2 THEN 2 ELSE 1;
    signed: BOOL = tb[node].attr3;
    CMinMax[relG, tb[node].son[1], nw, real, signed];
    RETURN [P5L.TOSLex[nw]]
    END;


  CMinMax: PROC [n: Tree.NodeName, t: Tree.Link, nw: [1..2], real, signed: BOOL] =
    BEGIN -- common subroutine for Cmin and Cmax
    node: Tree.Index = TreeOps.GetNode[t];
    nArgs: CARDINAL = TreeOps.ListLength[t];	-- ASSERT nArgs >= 2
    IF nw = 1 AND nArgs = 2 THEN
      BEGIN
      label1: LabelCCIndex = P5U.LabelAlloc[];
      label2: LabelCCIndex = P5U.LabelAlloc[];
      op1: VarComponent ← P5L.ComponentForLex[P5.Exp[tb[node].son[1]]];
      op2: VarComponent ← P5L.ComponentForLex[P5.Exp[tb[node].son[2]]];
      P5L.LoadBoth[@op1, @op2, TRUE];
      P5U.OutJump[IF signed THEN JumpNN[n] ELSE UJumpNN[n], label1];
      P5U.Out0[qREC2]; P5U.Out0[qEXDIS];
      P5U.OutJump[Jump,label2];
      Stack.Decr[1];
      P5U.InsertLabel[label1];
      P5U.Out0[qREC];
      P5U.InsertLabel[label2];
      END
    ELSE
      BEGIN
      elabel: LabelCCIndex = P5U.LabelAlloc[];
      tlex: Lexeme.se;
      arg: CARDINAL ← 0;

      MinMaxItem: PROC [t: Tree.Link] =
	BEGIN
	IF (arg ← arg+1) > 1 THEN
	  BEGIN
	  label: LabelCCIndex = P5U.LabelAlloc[];
	  var: VarComponent ← P5L.MakeComponent[P5L.VarForLex[P5.Exp[t]]];
	  IF nw = 2 THEN var ← P5L.EasilyLoadable[var, load];
	  P5L.LoadComponent[var];
	  P5.PushLex[tlex];
	  IF nw = 2 THEN
	    BEGIN
	    P5U.Out0[IF real THEN qFCOMP ELSE IF signed THEN qDCMP ELSE qUDCMP];
	    P5U.PushLitVal[0];
	    P5U.OutJump[JumpNN[RNN[n]], label];
	    P5L.LoadComponent[var];
	    END
	  ELSE
	    BEGIN
	    P5U.OutJump[IF signed THEN JumpNN[RNN[n]] ELSE UJumpNN[RNN[n]], label];
	    P5U.Out0[qREC];
	    END;
	  IF arg = nArgs THEN P5U.OutJump[Jump, elabel]
	  ELSE P5.SAssign[tlex.lexsei];
	  P5U.InsertLabel[label];
	  END;
      END;

      P5.PushRhs[tb[node].son[1]];
      tlex ← P5.GenTempLex[nw];
      P5.SAssign[tlex.lexsei];
      TreeOps.ScanList[t, MinMaxItem];
      Stack.Decr[nw];  P5.PushLex[tlex];
      Stack.Also[n: nw, place: [none[]]];	-- forget backup
      P5U.InsertLabel[elabel];
      END;
    END;

  END.