flang1/flang1exe/optimize.c

/*
 * Copyright (c) 1994-2019, NVIDIA CORPORATION.  All rights reserved.
 *
 * Licensed under the Apache License, Version 2.0 (the "License");
 * you may not use this file except in compliance with the License.
 * You may obtain a copy of the License at
 *
 *     http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 *
 */

/*  optimize.c - main module of the optimize phase.
    portions of this module are used by the vectorizer.

    void optimize()  -  main controller for the optimizer
    void optshrd_init()  -  init for structures and submodules shared by
        the by optimizer and vectorizer
    void optshrd_finit() -  init for a function before its processed
        by the optimizer or vectorizer.
    void optshrd_fend()  -  cleanup after a function has been processed
        by the optimizer or vectorizer.
    void optshrd_end()  -  cleanup of shared structures and submodules
        shared by the optimizer and vectorizer.

    static void optimize_init()
    static void optimize_end()
    static void function_init()
    static void function_end()
    static void merge_blocks()
    static void loop_init(int)
    extern void add_loop_preheader(int)
    static void add_loop_exit(int)
    static void process_exit(int, int)
    static void replace_label(int, int, int)

*/
#include "gbldefs.h"
#include "global.h"
#include "error.h"
#include "symtab.h"
#include "ast.h"
#include "nme.h"
#include "optimize.h"
#include "machar.h"

#if DEBUG
extern void dmpnme(void);
#endif

extern void open_pragma(int);
extern void close_pragma(void);

static void br_to_br(void);
static void merge_blocks(void);
static void loop_init(int lp);
static void process_exit(int lp, int s);
static void replace_label(int bihx, int label, int newlab);

/*   SHARED init and end routines for the vectorizer and optimizer */

/*
 * Initialize and free the data structures that are shared by the
 * vectorizer and optimizer.  These data structures represent the
 * information created by those modules that are shared by the vectorizer
 * and optimizer.  For C, this space is reused across functions in the
 * source file during a given pass (vectorizer and optimizer); for Fortran,
 * the space is allocated for each function.  At the end of each pass, the
 * space is freed.
 *
 * The shared modules are:
 *    flowgraph
 *    findloop
 *    flow
 *    invariant analysis (not code motion).
 *
 * Since it's possible for the vectorizer/optimizer to see more than one
 * function, it's necessary to initialize and free certain data structures
 * that are valid only for the lifetime of a function (for example,
 * various getitem areas).
 *
 * A skeleton of the vectorizer/optimizer for using these routines is:
 *
 *     optshrd_init();
 *     foreach function {
 *         optshrd_finit();
 *         ...
 *         optshrd_fend();
 *     }
 *     optshrd_end();
 *
 */

void
optshrd_init(void)
{

  STG_ALLOC(opt.fgb, 100);   /* flowgraph space */
  opt.fgb.stg_avail = 0;	/* expected starting value */
  gbl.entbih = 1;                /* the first bih */
  STG_ALLOC(opt.rteb, 32); /* retreating edges */

  STG_ALLOC(opt.lpb, 50);   /* loop table */
  LP_PARENT(0) = 0; /* set the parent of region 0 to 0 -- this is
                     * for tests which look at the parent of a
                     * loop without looking at the loop index
                     */

  STG_ALLOC(opt.storeb, 100); /* store area */
  STG_ALLOC(opt.defb, 64); /* definition table */
  STG_ALLOC(opt.useb, 64); /* use lists */

  STG_ALLOC(opt.invb, 100); /* invariant expr area */
  STG_ALLOC_SIDECAR(astb, opt.astb);

  opt.sc = SC_AUTO; /* default storage class for opt-created temps */

  nme_init();

}

void
optshrd_finit(void)
{

}

void
optshrd_fend(void)
{
  flow_end();

  freearea(PSI_AREA);
  freearea(DU_AREA);
  freearea(STL_AREA);

}

void
optshrd_end(void)
{
  STG_DELETE(opt.fgb);
  STG_DELETE(opt.rteb);
  STG_DELETE(opt.lpb);
  STG_DELETE(opt.storeb);
  STG_DELETE(opt.defb);
  STG_DELETE(opt.useb);
  STG_DELETE(opt.invb);
  STG_DELETE_SIDECAR(astb, opt.astb);
  nme_end();

}

/*
 * hlopt_init() & hlopt_end():
 * Initialization & cleanup for 'high level' optimizations (transformations)
 * such as unrolling & invariant if removal.  The optimizations require
 * a flow graph, loop discovery, and flow analysis.  Optional analysis
 * is induction analysis (see HLOPT_... in optimize.h).
 */
void
hlopt_init(int hlopt_bv)
{
  optshrd_init();

  if (hlopt_bv & HLOPT_INDUC)
    induction_init();

  optshrd_finit();

  flowgraph(); /* build the flowgraph for the function */
#if DEBUG
  if (DBGBIT(9, 1))
    dump_flowgraph();
#endif

  findloop(hlopt_bv); /* find the loops */
#if DEBUG
  if (DBGBIT(9, 4)) {
    dump_flowgraph();
    dump_loops();
  }
#endif

  flow(); /* do flow analysis on the loops  */

}

void
hlopt_end(int hlopt_bv, int gbc)
{
  optshrd_fend();

  optshrd_end();

  if (hlopt_bv & HLOPT_INDUC)
    induction_end();

}

static void
optimize_init(void)
{

  /*  initialize for the optimize module  */

  optshrd_init();

  induction_init(); /* induction data areas */

}

static void
optimize_end(void)
{

  /*  free up the space used by the optimize module */

  optshrd_end();

  induction_end();

}

/*  initialize for a function to be optimized  */
static void
function_init(void)
{
  optshrd_finit();
  /* clear temporary used for innermost loop count */

  opt.cntlp.cnt_sym = 0;

  if (DBGBIT(0, 1))
    fprintf(gbl.dbgfil, "***** begin optimizing %s\n",
            getprint((int)gbl.currsub));

}

/*  end for an optimized function  */
static void
function_end(void)
{
  int bihx;

  optshrd_fend();

}

/*
 * given a linked list of flow edges;
 * return the linked list with the flow edge to 'r' removed
 */
static PSI_P
remove_flow_list(PSI_P link, int r)
{
  PSI_P head, tail, next;
  head = NULL;
  tail = NULL;
  for (; link; link = next) {
    next = PSI_NEXT(link);
    PSI_NEXT(link) = NULL;
    if (PSI_NODE(link) != r) {
      if (head == NULL) {
        head = link;
      } else {
        PSI_NEXT(tail) = link;
      }
      tail = link;
    }
  }
  return head;
} /* remove_flow_list */

/*
 * remove a loop;
 * remove lpx from the LP_CHILD list of its parent.
 * make the fnodes be simple fall-through fnodes
 * add the fnodes to the fnode list of the parent
 */
static void
remove_loop(int lpx)
{
  int parent, prev, head, tail;
  parent = LP_PARENT(lpx);
  if (LP_CHILD(parent) == lpx) {
    LP_CHILD(parent) = LP_SIBLING(lpx);
    /* does this make 'parent' an innermost loop? */
    if (parent && LP_CHILD(parent) == 0) {
      LP_INNERMOST(parent) = 1;
    }
  } else {
    int lc;
    for (lc = LP_CHILD(parent); lc && LP_SIBLING(lc) != lpx;
         lc = LP_SIBLING(lc))
      ;
    if (lc && LP_SIBLING(lc) == lpx) {
      LP_SIBLING(lc) = LP_SIBLING(lpx);
    }
  }
  head = LP_HEAD(lpx);
  tail = LP_TAIL(lpx);
  FG_PRED(head) = remove_flow_list(FG_PRED(head), tail);
  FG_SUCC(tail) = remove_flow_list(FG_SUCC(tail), head);

  for (prev = FG_LPREV(head); prev; prev = FG_LPREV(prev)) {
    if (FG_LOOP(prev) == parent)
      break;
  }
  if (prev && LP_FG(lpx)) {
    int next, fg;
    next = FG_NEXT(prev);
    FG_NEXT(prev) = LP_FG(lpx);
    for (fg = LP_FG(lpx); fg && FG_NEXT(fg); fg = FG_NEXT(fg))
      ;
    FG_NEXT(fg) = next;
  }
  LP_FG(lpx) = 0;
} /* remove_loop */

/*
 * return '1' if the ast tree has no function calls
 */
static int
no_functions(int ast)
{
  /* ### not written */
  return 1;
} /* no_functions */

void
optimize(int whichpass)
{
  int lpx;
  int i;

  optimize_init();

#if DEBUG
  if (DBGBIT(38, 128)) {
    optimize_end();
    return;
  }
#endif
  if (opt.fgb.stg_avail == 1) {
    optimize_end();
    return;
  }
/* optimize is called for each function */

#if DEBUG
  if (DBGBIT(10, 2)) {
    fprintf(gbl.dbgfil, "STDs before optimizer\n");
    dump_std();
  }
#endif

  function_init();

  flowgraph(); /* build the flowgraph for the function */
#if DEBUG
  if (DBGBIT(9, 1))
    dump_flowgraph();
#endif

  findloop(HLOPT_ALL); /* find the loops */

#if DEBUG
  if (DBGBIT(9, 4)) {
    dump_flowgraph();
    dump_loops();
  }
#endif

  if (XBIT(70, 0x2000)) /* enhanced analysis with HCCSYM variables */
    flg.x[70] |= 0x1000;
  flow(); /* do flow analysis on the loops  */
  flg.x[70] &= ~0x1000;
  if (whichpass == 1) {
    flow_end();
    optimize_end();
    return;
  }

#if DEBUG
  if (DBGBIT(29, 128))
    dump_loops();
#endif

  if (XBIT(0, 0x1000))
    use_before_def(); /* after flow; check for uses before defs */

  delete_stores(); /* find deleteable stores */

  /*
   * do optimizations for each loop.  also, for each loop, mark
   * the blocks which are the head and tail of the loop and mark
   * the head block as innermost if it's the head of an innermost
   * loop (this information is used by the scheduler).
   */
  for (i = 1; i <= opt.nloops; i++) {
    int headfg;

    lpx = LP_LOOP(i);
    headfg = LP_HEAD(lpx);
    gbl.lineno = FG_LINENO(headfg);

    if (LP_PARLOOP(lpx))
      opt.sc = SC_PRIVATE;

    /* apply loop-scoped pragmas/directives available for this loop */
    open_pragma(gbl.lineno);

    if (LP_INNERMOST(lpx)) {
      if (XBIT(70, 0x4000)) {
        int fg, empty, dostd;
        /* remove empty loops */
        empty = 1;
        dostd = 0;
        for (fg = LP_FG(lpx); empty && fg; fg = FG_NEXT(fg)) {
          int std;
          for (std = FG_STDFIRST(fg); empty && std; std = STD_NEXT(std)) {
            switch (A_TYPEG(STD_AST(std))) {
            case A_DO:
              if (dostd == 0) {
                dostd = std;
              } else {
                empty = 0;
              }
              break;
            case A_ENDDO:
            case A_CONTINUE:
              break;
            default:
              empty = 0;
              break;
            }
            if (std == FG_STDLAST(fg))
              break;
          }
        }
        if (empty && dostd) {
          /* if the DO variable is dead, remove all the statements */
          int doast, dovar, donme;
          doast = STD_AST(dostd);
          dovar = A_SPTRG(A_DOVARG(doast));
          donme = add_arrnme(NT_VAR, dovar, 0, (INT)0, 0, FALSE);
          if (!is_live_out(donme, lpx) && no_functions(doast)) {
            /* remove all statements, change all to continue */
            for (fg = LP_FG(lpx); fg; fg = FG_NEXT(fg)) {
              int std;
              for (std = FG_STDFIRST(fg); std; std = STD_NEXT(std)) {
                int ast;
                ast = STD_AST(std);
                A_TYPEP(ast, A_CONTINUE);
                if (std == FG_STDLAST(fg))
                  break;
              }
            }
            /* this loop no longer exists.
             * remove the loop from the LP_CHILD list of its parent.
             * if the parent has no other children, mark the parent as INNERMOST
             */
            remove_loop(lpx);
            continue;
          } else {
            /* insert assignment from lower bound, upper bound, stride */
            /* insert proper assignment to DO variable */
            /* ### not done */
          }
        }
      }
      FG_INNERMOST(headfg) = 1;
    }

    if (LP_FG(lpx) == 0) {
      continue;
    }
    FG_HEAD(headfg) = 1;
    FG_MEXITS(headfg) = LP_MEXITS(lpx);
    FG_TAIL(LP_TAIL(lpx)) = 1;
    loop_init(lpx);

    invariant(lpx);

    induction(lpx);

    add_loop_preheader(lpx);
    add_loop_exit(lpx);

    /*  set done bit for all nodes in the loop  */

    close_pragma();

    opt.sc = SC_AUTO;
  }
  if (opt.nloops == 0) {
    ;
  } else {

    /*  do region 0  */

    opt.pre_fg = NEW_NODE(gbl.entbih);
    opt.exit_fg = NEW_NODE(FG_LPREV(opt.exitfg));

    if (OPTDBG(9, 1)) {
      fprintf(gbl.dbgfil, "\n  Loop init for region 0\n");
      fprintf(gbl.dbgfil, "    preheader: %d\n", opt.pre_fg);
      fprintf(gbl.dbgfil, "    exit: %d\n", opt.exit_fg);
    }
  }

  br_to_br();

  merge_blocks(); /* merge the blocks */

  function_end();

#if DEBUG
  if (DBGBIT(10, 4)) {
    fprintf(gbl.dbgfil, "STDs after optimizer\n");
    dump_std();
  }
  if (DBGBIT(10, 64))
    dmpnme();
#endif

  flow_end();
  optimize_end();

}

/*******************************************************************/

/*
 * attempt to move the label which labels a bih.  The condition for
 * moving the label is if the block contains an unconditional branch.
 * This routine is recursive so that if we have br to br to br, ...,
 * the label labelling last branch in the branch chain is moved first.
 */
static void
move_label(int lab, int bih)
{

}

static void
br_to_br(void)
{
  if (XBIT(6, 0x8))
    return;
  if (opt.num_nodes < 3)
    return;

}

/*******************************************************************/

static void
merge_blocks(void)
{
  int std;
  int next_std;
  int ast;

  if (XBIT(8, 0x4))
    return;
  for (std = STD_NEXT(0); std; std = next_std) {
    next_std = STD_NEXT(std);
    if (STD_LABEL(std) == 0) {
      ast = STD_AST(std);
      if (A_TYPEG(ast) == A_CONTINUE)
        unlnkilt(std, 0, TRUE);
    }
  }
  if (opt.num_nodes < 3)
    return;

}

/*******************************************************************/

static void
loop_init(int lp)
{
  opt.pre_fg = NEW_NODE(FG_LPREV(LP_HEAD(lp)));
  FG_FT(opt.pre_fg) = 1;

  /* create a block for the loop exit -- code will be added to this
   * block as optimizations are performed.  Note that block is inserted
   * the tail of the loop
   */
  opt.exit_fg = NEW_NODE(LP_TAIL(lp));
  FG_FT(opt.exit_fg) = 1;

  FG_PAR(opt.pre_fg) = LP_PARLOOP(lp);
  FG_PAR(opt.exit_fg) = LP_PARLOOP(lp);
  if (OPTDBG(9, 1)) {
    fprintf(gbl.dbgfil, "\n  Loop init for loop (%d)\n", lp);
    fprintf(gbl.dbgfil, "    preheader: %d, exit: %d\n", opt.pre_fg,
            opt.exit_fg);
  }
}

/*******************************************************************/

/*
 * After a loop has been processed, the flow graph is updated to include
 * the preheader.  This node is physically placed immediatedly before the
 * loop head.
 * The predecessors of head not in the loop are replaced by the preheader
 * flow graph node. The predecessors of this node are the predecessors
 * of head not in the loop.
 * Also, this node replaces head as the successor of all the nodes not
 * in the loop.
 * If there is a path to the head node by branching (the node does not
 * fall thru to the head), the label of head is replaced with a new label
 * and all the branches to the head are modified.  The original label
 * is used to label the preheader.
 * Also, the preheader is added to the region containing the loop.
 */
void
add_loop_preheader(int lp)
{
  int i, v;
  PSI_P p, q, prev;
  int newlabel;

  int head;

  if (FG_STDFIRST(opt.pre_fg) == 0)
    return;
  if (OPTDBG(9, 1))
    fprintf(gbl.dbgfil, "\n  Preheader end for loop (%d)\n", lp);

  /* Every node dominated by lp's dominator will be dominated by the
   * new preheader. */
  head = LP_HEAD(lp); /* loop's head */
  i = FG_DOM(head);   /* dominator of loop's head */
  for (p = FG_SUCC(i); p != PSI_P_NULL; p = PSI_NEXT(p)) {
    v = PSI_NODE(p);
    if (FG_DOM(v) == i)
      FG_DOM(v) = opt.pre_fg;
  }
  FG_DOM(opt.pre_fg) = i;
  FG_DOM(head) = opt.pre_fg;

  i = 0;             /* number of predecessors not in the loop */
  newlabel = 0;      /* non-zero if a pred does fall thru to the head */
  prev = PSI_P_NULL; /* the last predecessor to head that's kept */
  for (p = FG_PRED(head); p != PSI_P_NULL; p = PSI_NEXT(p)) {
    v = PSI_NODE(p);
    if (FG_LOOP(v) != lp) { /* v in pred(head) and not in the loop */
      i++;
      if (FG_LNEXT(v) != opt.pre_fg) {
        /* if pred. doesn't fall thru */
        newlabel = 1;
      }
      /* search v's successor list for the item indicating head */

      for (q = FG_SUCC(v); q != PSI_P_NULL; q = PSI_NEXT(q))
        if (head == PSI_NODE(q))
          break;
      assert(q != PSI_P_NULL, "add_loop_pre:suc(q)nhd", head, 3);

      /* Replace head in succ(v) with the preheader node  */

      PSI_NODE(q) = opt.pre_fg;
      /*
       * Replace v in pred(head) with the preheader node only if this
       * is the first predecessor found which is not in the loop.
       * Otherwise, this predecessor item (p) is deleted.
       */
      if (i == 1) {
        PSI_NODE(p) = opt.pre_fg;
        prev = p;
      } else {
        assert(prev != PSI_P_NULL, "add_loop_pre:prev", head, 3);
        PSI_NEXT(prev) = PSI_NEXT(p);
      }
      /*
       * make v a predecessor of the preheader and make head a
       * successor of the preheader
       */
      (void)add_pred(opt.pre_fg, v);
      q = add_succ(opt.pre_fg, head);
      PSI_FT(q) = 1;
#if DEBUG
      if (OPTDBG(9, 1)) {
        fprintf(gbl.dbgfil, "    old pred of head :\n");
        dump_node(v);
      }
#endif
    } else /* v not in pred(head), remember this predecessor item */
      prev = p;
  }

  if (newlabel) { /* have to create a new label for the loop head */
    int label, newlab;

    label = STD_LABEL(FG_STDFIRST(head)); /* original label */
    newlab = getlab();
    ILIBLKP(newlab, head); /* label the head with the new label */
    STD_LABEL(FG_STDFIRST(head)) = newlab;

    ILIBLKP(label, opt.pre_fg); /* label the preheader with the */
    STD_LABEL(FG_STDFIRST(opt.pre_fg)) = label; /* original label */

    /* find all nodes in the loop which are predecessors of head.
     * the branches in these nodes are changed to access the new
     * label
     */
    for (p = FG_PRED(head); p != PSI_P_NULL; p = PSI_NEXT(p)) {
      v = PSI_NODE(p);
      if (FG_LOOP(v) == lp)
        replace_label((int)FG_TO_BIH(v), label, newlab);
    }
  }
  /*
   * set the loop field of the preheader to an ancestor of lp which
   * contains blocks -- a loop could have been deleted (indicated by a null
   * region)
   */
  for (i = lp; LP_FG(i = LP_PARENT(i)) == 0;)
    ;

  FG_LOOP(opt.pre_fg) = i;

  /* add the preheader to the region for parent of lp  */

  FG_NEXT(opt.pre_fg) = LP_FG(i);
  LP_FG(i) = opt.pre_fg;

  /* link the preheader's stds into the std list */

  {
    int new;
    int old;
    int p;

    /* search for the last std preceding the preheader */
    for (p = FG_LPREV(opt.pre_fg); p; p = FG_LPREV(p))
      if (FG_STDLAST(p))
        break;
    new = FG_STDFIRST(opt.pre_fg);
    old = FG_STDLAST(p);
    STD_NEXT(old) = new;
    STD_PREV(new) = old;

    /* search for the first std following the preheader */
    for (p = FG_LNEXT(opt.pre_fg); p; p = FG_LNEXT(p))
      if (FG_STDFIRST(p))
        break;
    new = FG_STDLAST(opt.pre_fg);
    old = FG_STDFIRST(p);
    STD_NEXT(new) = old;
    STD_PREV(old) = new;
  }

#if DEBUG
  if (OPTDBG(9, 1)) {
    fprintf(gbl.dbgfil, "    preheader:\n");
    dump_node(opt.pre_fg);
    fprintf(gbl.dbgfil, "    head:\n");
    dump_node(head);
  }
  if (OPTDBG(9, 4)) {
    fprintf(gbl.dbgfil, "\n  Region of preheader node %d\n", opt.pre_fg);
    dump_region(i);
  }
#endif
}

/*******************************************************************/

static int newtarget_bih;
static int newtarget_fg;

/*
 * After a loop has been processed, the flow graph is updated to include
 * the exit node. A copy of the exit block is added for each exit of the
 * loop. This routine figures out where to add the exit blocks in the
 * bih list.  A block can be added immediately before its exit target
 * if the loop falls through to the target.  If it is not a fall through
 * exit target, the exit block is simply added to the end of the loop
 * and code is added to the end of the block so that it transfers control
 * to the exit target.
 */
void
add_loop_exit(int lp)
{
}

/* Add a loop exit following the tail of loop lp. */
void
add_single_loop_exit(int lp)
{
  int fg, fgSucc, fgNew;
  PSI_P psiSucc;
  int lpSucc;
  int sptrLbl, sptrNewLbl;
  int std;
  int ast;

  assert(lp, "add_loop_exit: no loop", lp, 4);
  assert(!LP_MEXITS(lp), "add_loop_exit: multiple exits", lp, 4);

  fgNew = add_fg(LP_TAIL(lp));
  add_to_parent(fgNew, LP_PARENT(lp));

  for (fg = LP_FG(lp); fg; fg = FG_NEXT(fg)) {
    /* Search for a node with a branch to the exit. */
    for (psiSucc = FG_SUCC(fg); psiSucc; psiSucc = PSI_NEXT(psiSucc)) {
      fgSucc = PSI_NODE(psiSucc);
      lpSucc = FG_LOOP(fgSucc);
      if (!lpSucc)
        break;
      if (lpSucc != lp && LP_PARENT(lpSucc) != lp)
        break;
    }
    if (psiSucc)
      /* ...node with exit branch found. */
      break;
  }
  assert(fg, "add_loop_exit: branch not found", lp, 4);
  FG_FT(fgNew) = PSI_FT(psiSucc);

  /* Add a CONTINUE statement to the new loop trailer. */
  ast = mk_stmt(A_CONTINUE, 0);
  rdilts(fgNew);
  std = add_stmt_after(ast, 0);
  wrilts(fgNew);
  FG_LINENO(fgNew) = STD_LINENO(std) = FG_LINENO(LP_TAIL(lp));

  sptrLbl = FG_LABEL(fgSucc);
  if (!PSI_FT(psiSucc) && sptrLbl) {
    int astlab;
    /* Add a GOTO statement to the new loop trailer. */
    ast = mk_stmt(A_GOTO, 0);
    astlab = mk_label(sptrLbl);
    A_L1P(ast, astlab);
    std = add_stmt_after(ast, std);

    /* Create a new label for fgNew. */
    sptrNewLbl = getlab();
    ILIBLKP(sptrNewLbl, fgNew);
    RFCNTI(sptrNewLbl);
    FG_LABEL(fgNew) = sptrNewLbl;

    /* Revise the branch to go to the new loop trailer. */
    replace_label(FG_TO_BIH(fg), sptrLbl, sptrNewLbl);
  }

  /* Fix up the pred./succ. chains. */
  add_succ(fg, fgNew);     /* succ(fg) = fgNew. */
  add_pred(fgNew, fg);     /* pred(fgNew) = fg. */
  add_succ(fgNew, fgSucc); /* succ(fgNew) = fgSucc. */
  add_pred(fgSucc, fgNew); /* pred(fgSucc) = fgNew. */
  rm_edge(fg, fgSucc);
}

/*******************************************************************/

/*
 * node s is an exit target of the loop. newtarget_fg represents the
 * new exit target which must be executed before executing s.
 * newtarget_bih is the block header for the new target and has already
 * been inserted into the bih list.
 * s is made a successor of the new target flow graph node.
 * The predecessors of s in the loop are replaced by the new target.
 * These predecessors of s become the predecessors of the new
 * target. Also, the successor lists of these nodes are updated by replacing
 * s with the new target.
 * If the exit in the loop does not fall thru to the new target, then
 * a label is created for the new target and the branch in the exit is
 * modified to access this label.  NOTE that any transfer of control changes
 * from the new target to s have been taken care of by add_loop_exit.
 * Also, the new target is added to the region containing the loop.
 */
static void
process_exit(int lp, int s)
{
}

/*******************************************************************/

/*
 * Replace all occurrences of the label with a new label.
 */
static void
replace_label(int bihx, int label, int newlab)
{
  int std;
  int ast;

  std = BIH_ILTLAST(bihx);
  ast = STD_AST(std);
  ast_visit(1, 1);
  ast_replace(mk_label(label), mk_label(newlab));
  ast = ast_rewrite(ast);
  ast_unvisit();
  STD_AST(std) = ast;
  A_STDP(ast, std);
}

/*******************************************************************/
/*
 * remove a block of statements;
 * optionally convert the last ELSEIF to IF
 * optionally keep the last ENDIF
 */
static void
remove_block(int std1, int std2, LOGICAL convert_elseif, LOGICAL save_endif)
{
  int stdx, nextstdx, astx;
  for (stdx = std1; stdx; stdx = nextstdx) {
    nextstdx = STD_NEXT(stdx);
    astx = STD_AST(stdx);
    if (stdx == std2 && A_TYPEG(astx) == A_ELSEIF && convert_elseif) {
      A_TYPEP(astx, A_IFTHEN);
      break;
    }
    if (stdx == std2 && A_TYPEG(astx) == A_ENDIF && save_endif) {
      break;
    }
    if (STD_LABEL(stdx)
        || STD_PTA(stdx) || STD_PTASGN(stdx)
            ) {
      /* just convert to continue */
      A_TYPEP(astx, A_CONTINUE);
    } else {
      /* remove altogether */
      delete_stmt(stdx);
    }
    if (stdx == std2)
      break;
  }
} /* remove_block */

/*
 * look for conditional branches with constant conditions.
 * remove the branch, remove unreachable code as well.
 */
void
unconditional_branches(void)
{
  int stdx, nextstdx;
  int astx, nest, stdifx, stdstmtx, sptr, stdelsex, stdendx, astelsex, astendx;
  int condx;
  int *ifnest;
  int ifnestsize;
  ifnestsize = 50;
  NEW(ifnest, int, ifnestsize);
  /* initially, set STD_FG for A_IFTHEN, A_ELSEIF, A_ELSE to the
   * matching following A_ELSEIF, A_ELSE, A_ENDIF, as appropriate */
  for (stdx = STD_NEXT(0); stdx; stdx = STD_NEXT(stdx)) {
    astx = STD_AST(stdx);
    switch (A_TYPEG(astx)) {
    case A_IFTHEN:
      ++nest;
      NEED(nest, ifnest, int, ifnestsize, ifnestsize + 50);
      ifnest[nest] = stdx;
      break;
    case A_ELSEIF:
    case A_ELSE:
      if (nest <= 0) {
        /* bad nesting */
        return;
      }
      stdifx = ifnest[nest];
      STD_FG(stdifx) = stdx;
      ifnest[nest] = stdx;
      break;
    case A_ENDIF:
      if (nest <= 0) {
        /* bad nesting */
        FREE(ifnest);
        return;
      }
      stdifx = ifnest[nest];
      STD_FG(stdifx) = stdx;
      --nest;
      break;
    }
  }
  FREE(ifnest);
  for (stdx = STD_NEXT(0); stdx; stdx = nextstdx) {
    nextstdx = STD_NEXT(stdx);
    astx = STD_AST(stdx);
    switch (A_TYPEG(astx)) {
    case A_IF:
      /* if condition is .FALSE., remove if and its statement */
      /* if condition is .TRUE., replace condition by the statement */
      condx = A_IFEXPRG(astx);
      if (A_ALIASG(condx))
        condx = A_ALIASG(condx);
      if (A_TYPEG(condx) == A_CNST && (sptr = A_SPTRG(condx)) > 0 &&
          DT_ISLOG(DTYPEG(sptr))) {
        if (CONVAL2G(sptr) == 0) {
          /* .false. */
          remove_block(stdx, stdx, FALSE, FALSE);
        } else {
          /* .true. */
          stdstmtx = A_IFSTMTG(astx);
          STD_AST(stdx) = stdstmtx;
        }
      }
      break;
    case A_IFTHEN:
    case A_ELSEIF:
      /* if condition is .FALSE., remove if and all statements up
       * to the ENDIF, ELSEIF, ELSE (change ELSEIF to IF, ELSE/ENDIF to
       * CONTINUE)
       * if the condition is .TRUE., remove this statement, and remove
       * all statements from the ELSEIF/ELSE up to and including the ENDIF */
      condx = A_IFEXPRG(astx);
      if (A_ALIASG(condx))
        condx = A_ALIASG(condx);
      if (A_TYPEG(condx) == A_CNST && (sptr = A_SPTRG(condx)) > 0 &&
          DT_ISLOG(DTYPEG(sptr))) {
        stdelsex = STD_FG(stdx);
        if (CONVAL2G(sptr) == 0) {
          /* .false. */
          /* remove_block changes the ELSEIF to IF, if necessary */
          astelsex = STD_AST(stdelsex);
          if (A_TYPEG(astelsex) == A_ELSEIF) {
            remove_block(stdx, stdelsex, TRUE, FALSE);
          } else {
            stdendx = STD_FG(stdelsex);
            astendx = STD_AST(stdendx);
            if (A_TYPEG(astendx) == A_ENDIF) {
              remove_block(stdx, stdelsex, TRUE, FALSE);
              remove_block(stdendx, stdendx, FALSE, FALSE);
            }
          }
        } else {
          /* .true. */
          astelsex = STD_AST(stdelsex);
          if (A_TYPEG(astelsex) == A_ENDIF) {
            /* simply change if/endif to continue/continue
             * or else/endif */
            if (A_TYPEG(astx) == A_IF) {
              remove_block(stdx, stdx, FALSE, FALSE);
              remove_block(stdelsex, stdelsex, FALSE, FALSE);
            } else {
              A_TYPEG(astx) = A_ELSE;
            }
          } else if (A_TYPEG(astelsex) == A_ELSE ||
                     A_TYPEG(astelsex) == A_ELSEIF) {
            /* simply change if to continue or elseif to else,
             * remove elseif through endif */
            astendx = 0;
            for (stdendx = STD_FG(stdelsex); STD_FG(stdendx);
                 stdendx = STD_FG(stdendx)) {
              astendx = STD_AST(stdendx);
              if (A_TYPEG(astendx) == A_ENDIF)
                break;
            }
            if (stdendx)
              astendx = STD_AST(stdendx);
            if (stdendx && astendx && A_TYPEG(astendx) == A_ENDIF) {
              if (A_TYPEG(astx) == A_IFTHEN) {
                remove_block(stdx, stdx, FALSE, FALSE);
                remove_block(stdelsex, stdendx, FALSE, FALSE);
              } else {
                A_TYPEG(astx) = A_ELSE;
                remove_block(stdelsex, stdendx, FALSE, TRUE);
              }
            }
          }
        }
      }
      break;
    }
  }
  /* clear STD_FG field */
  for (stdx = STD_NEXT(0); stdx; stdx = STD_NEXT(stdx)) {
    STD_FG(stdx) = 0;
  }
} /* unconditional_branches */