/*
 * Copyright (c) 2000-2018, 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.
 *
 */

/** \file
    \brief Optimize redundant subscript computations.
 */

#include "gbldefs.h"
#include "global.h"
#include "error.h"
#include "symtab.h"
#include "ast.h"
#include "optimize.h"
#include "rtlRtns.h"

#if DEBUG
#define Trace(a) TraceOutput a
/* print a message, continue */
#include <stdarg.h>
static void
TraceOutput(const char *fmt, ...)
{
  va_list argptr;
  va_start(argptr, fmt);
  if (DBGBIT(39, 1)) {
    if (gbl.dbgfil) {
      vfprintf(gbl.dbgfil, fmt, argptr);
      fprintf(gbl.dbgfil, "\n");
    } else {
      fprintf(stderr, "Trace: ");
      vfprintf(stderr, fmt, argptr);
      fprintf(stderr, "\n");
    }
    va_end(argptr);
  }
} /* TraceOutput */
#else
/* eliminate the trace output */
#define Trace(a)
#endif

/* used more than once */
#define A_MOREG(s) astb.stg_base[s].f6
#define A_MOREP(s, v) (astb.stg_base[s].f6 = (v))
/*
 * clear A_OPT1, A_OPT2 fields
 * clear A_REPL, and the f6 flag
 */

static void
InitAST(void)
{
  int ast;
  for (ast = 0; ast < astb.stg_avail; ++ast) {
    A_OPT1P(ast, 0);
    A_OPT2P(ast, 0);
    A_REPLP(ast, 0);
    A_MOREP(ast, 0);
  }
} /* InitAST */

static int OnlyFG = 0;

/*
 * return '1' if ast 'ast' is marked as modified in loop 'l', or
 * in any loop contained inside of 'l'
 * use the DFS tree numbering saved in LP_LEVEL and LP_TAIL
 */
static int
modified(int ast, int l)
{
  int m;
  m = A_OPT2G(ast); /* zero, or loop in which ast is modified */
  if (OnlyFG == 0) {
    int mdfs;
    mdfs = LP_LEVEL(m);
    if (mdfs <= LP_LEVEL(l) && mdfs >= LP_TAIL(l)) {
      return 1;
    }
  } else {
    /* just compare numbers */
    if (m == l) {
      return 1;
    }
  }
  return 0;
} /* modified */

static int SSlisthead, SSlisttail;
static int *DtypeAssigned = NULL;
static int DtypeAssignedSize = 0;

static void
InitSSlist(void)
{
  SSlisthead = SSlisttail = 1;
} /* InitSSlist */

static void
clearSSlist(void)
{
  int ss, nextss;
  for (ss = SSlisthead; ss > 1; ss = nextss) {
    nextss = A_OPT1G(ss);
    A_OPT1P(ss, 0);
  }
  InitSSlist();
} /* clearSSlist */

#define SS_ALL 1
#define SS_MULTIPLE 2
#define SS_ROOT 4
#define SS_INV 8
#define SS_ALL_MULTIPLE 3
#define SS_INV_ROOT 12
#define SS_INV_ROOT_MULTIPLE 14

/*
 * findssexprs is called several times with a 'type' parameter
 * type == SS_ALL means put all subscript expressions and subexpressions
 *  on the SSlist.
 * type == SS_ROOT means put all 'root' subscript expressions on the SSlist,
 *  that is, all expressions which are directly used, or for which its
 *  parent is not an optimizable subscript subexpression.
 * type == SS_INV_ROOT means put all invariant 'root' subexpressions on the
 * SSlist
 * type == SS_ALL_MULTIPLE means the same as type == SS_ALL, but set A_MOREG if
 * it
 *  it put on the list more than once
 * type == SS_INV_ROOT_MULTIPLE means put all invariant 'root' subexpressions on
 * the
 *  SSlist that have at least 2 uses, found by A_MOREG != 0.
 */

static void
addSS(int ss, int type, int l)
{
  switch (A_TYPEG(ss)) {
  case A_ID:
    if (!(type & SS_ALL))
      return;
    break;
  case A_CNST:
    return;
  }
  if (A_OPT1G(ss) != 0) {
    /* already on the list */
    if (type == SS_ALL_MULTIPLE) {
      A_MOREP(ss, 1);
    }
    return;
  }
#if DEBUG
  if (DBGBIT(39, 1)) {
    fprintf(gbl.dbgfil, "Adding subscript expression %d to list type %d for "
                        "loop/node %d, opt2=%d",
            ss, type, l, A_OPT2G(ss));
    if (DBGBIT(39, 4)) {
      fprintf(gbl.dbgfil, "  ");
      printast(ss);
    }
    fprintf(gbl.dbgfil, "\n");
  }
#endif
  if (SSlisttail == 1) {
    SSlisthead = ss;
  } else {
    A_OPT1P(SSlisttail, ss);
  }
  SSlisttail = ss;
  A_OPT1P(ss, 1);
  if (type == SS_ALL_MULTIPLE) {
    A_MOREP(ss, 0); /* first time on list */
  }
} /* addSS */

/*
 * puts subexpressions on SSlist
 * return '0' if there is a subexpression that should not be added to the SSlist
 * return '1 'otherwise
 */
static int
markss(int ast, int type, int l)
{
  int lop, rop, sptr, ssflags;

  switch (A_TYPEG(ast)) {
  default: /* only (), binop, unop, ID, const, MEM,
            * section descriptor references are optimizable */
    return 0;
  case A_PAREN:
  case A_UNOP:
  case A_CONV:
    lop = markss(A_LOPG(ast), type, l);
    if (!lop)
      return 0;
    if (lop) {
      if (type & SS_ALL)
        addSS(A_LOPG(ast), type, l);
      if (type != SS_INV_ROOT_MULTIPLE || A_MOREG(ast))
        return 1;
    }
    break;
  case A_BINOP:
    lop = markss(A_LOPG(ast), type, l);
    rop = markss(A_ROPG(ast), type, l);
    if (lop && rop && (type != SS_INV_ROOT_MULTIPLE || A_MOREG(ast))) {
      if (type & SS_ALL) {
        addSS(A_LOPG(ast), type, l);
        addSS(A_ROPG(ast), type, l);
      }
      return 1;
    }
    if (lop)
      addSS(A_LOPG(ast), type, l);
    if (rop)
      addSS(A_ROPG(ast), type, l);
    break;
  case A_ID:
    if (((type & SS_INV_ROOT) == SS_INV_ROOT) && modified(ast, l))
      return 0;
    if (type != SS_INV_ROOT_MULTIPLE || A_MOREG(ast))
      return 1;
    break;
  case A_SUBSCR:
    if (((type & SS_INV_ROOT) == SS_INV_ROOT) && modified(ast, l))
      return 0;
    if (type == SS_INV_ROOT_MULTIPLE && A_MOREG(ast) == 0)
      return 0;
    sptr = 0;
    if (!XBIT(70, 0x8000000)) {
      sptr = sptr_of_subscript(ast);
      if (!POINTERG(sptr))
        sptr = 0;
    }
    lop = markss(A_LOPG(ast), type, l);
    if (lop) {
      int asd, s, all, ss;
      asd = A_ASDG(ast);
      all = 1;
      ssflags = 0;
      for (s = 0; s < ASD_NDIM(asd); ++s) {
        ss = ASD_SUBS(asd, s);
        if (markss(ss, type, l)) {
          ssflags |= (1 << s);
          if (type == SS_ALL && !sptr) {
            addSS(ss, type, l);
          }
        } else {
          all = 0;
        }
      }
      if (!sptr) {
        if (all) {
          if (type & SS_ALL) {
            addSS(A_LOPG(ast), type, l);
          }
          return 1;
        } else if (ssflags) {
          for (s = 0; s < ASD_NDIM(asd); ++s) {
            ss = ASD_SUBS(asd, s);
            if (ssflags & (1 << s)) {
              addSS(ss, type, l);
            }
          }
        }
      }
    }
    /* ### probably needs some work for section descriptor members */
    break;
  case A_CNST:
    return 1; /* ok as subexpression */
  case A_MEM:
    /* allow these */
    if (((type & SS_INV_ROOT) == SS_INV_ROOT) && modified(ast, l))
      return 0;
    if (type == SS_INV_ROOT_MULTIPLE && A_MOREG(ast) == 0)
      return 0;
    lop = markss(A_PARENTG(ast), type, l);
    if (lop)
      return 1;
    break;
  }
  return 0;
} /* markss */

/*
 * at a root subexpression, recurse to the subexpressions
 * put eligible subexpressions on the SSlist
 */
static int
markrootss(int root, int type, int l)
{
  if (markss(root, type, l)) {
    int lop, rop;
    /* for a root subexpression, don't put on the list if
     * it is a simple unary op on a constant, or a binary
     * op where one (or both) operands are constants */
    switch (A_TYPEG(root)) {
    case A_UNOP:
      lop = A_LOPG(root);
      if (A_TYPEG(lop) == A_CNST)
        return 0;
      break;
    case A_BINOP:
      lop = A_LOPG(root);
      rop = A_ROPG(root);
      if (A_TYPEG(lop) == A_CNST) {
        if (A_TYPEG(rop) != A_CNST && type == SS_INV_ROOT_MULTIPLE) {
          addSS(rop, type, l);
        }
        return 0;
      } else if (A_TYPEG(rop) == A_CNST) {
        if (type == SS_INV_ROOT_MULTIPLE) {
          addSS(lop, type, l);
        }
        return 0;
      }
      break;
    }
    addSS(root, type, l);
    return 1;
  }
  return 0;
} /* markrootss */

static int findsstype, findssl;

static int subscrnest = 0;
static LOGICAL
count_nest(int ast, int *dummy)
{
  if (A_TYPEG(ast) == A_SUBSCR) {
    if (!XBIT(70, 0x8000000)) {
      int sptr;
      sptr = sptr_of_subscript(ast);
      if (!POINTERG(sptr))
        return FALSE;
    }
    ++subscrnest;
  }
  return FALSE;
} /* count_nest */

/*
 * at an AST, look for a subscript expression.
 * if we are in a subscript, add subexpressions to SSlist
 */
static void
findss(int ast, int *dummy)
{
  if (A_TYPEG(ast) == A_SUBSCR) {
    if (subscrnest == 1) {
      int asd, s;
      asd = A_ASDG(ast);
      for (s = 0; s < ASD_NDIM(asd); ++s) {
        int ss;
        ss = ASD_SUBS(asd, s);
        /* don't mark simple subscripts */
        switch (A_TYPEG(ss)) {
        case A_PAREN:
        case A_UNOP:
        case A_CONV:
        case A_BINOP:
        case A_SUBSCR:
        case A_MEM:
          markrootss(ss, findsstype, findssl);
        }
      }
    }
    --subscrnest;
  }
} /* findss */

/*
 * number any expressions in subscripts in a single fg node
 */
static void
findssexprsfg(int l, int fg, int newstmts, int type)
{
  int std;
  for (std = FG_STDFIRST(fg); std; std = STD_NEXT(std)) {
    int ast;
    ast = STD_AST(std);
    Trace(("statement %d in node %d in loop %d type %d", std, fg, l, type));
    if (std >= newstmts && A_TYPEG(ast) == A_ASN) {
      if (!markrootss(A_SRCG(ast), type, l)) {
        ast_traverse(ast, count_nest, findss, NULL);
      }
    } else {
      ast_traverse(ast, count_nest, findss, NULL);
    }
    if (std == FG_STDLAST(fg))
      break; /* leave loop */
  }
} /* findssexprsfg */

#if DEBUG
static void
dumpSSlist(void)
{
  int ast;
  for (ast = SSlisthead; ast > 1; ast = A_OPT1G(ast)) {
    fprintf(gbl.dbgfil, "ast %d on list, OPT2=%d  ", ast, A_OPT2G(ast));

    printast(ast);
    fprintf(gbl.dbgfil, "\n");
  }
} /* dumpSSlist */
#endif

/*
 * find and number any expressions in subscripts in a single loop
 */
static void
findssexprs(int l, int newstmts, int type, int onlyfg)
{
  /* build a list starting at SSlisthead, linked by A_OPT1 fields,
   * terminated by '1', of optimizable expressions that appear in
   * subscripts in loops.  We terminate by '1' so we can easily tell
   * whether an ast is already on the list (A_OPT1(ast) != 0 means on
   * the list somewhere, A_OPT1(ast) == 0 means not on the list) */
  clearSSlist();
  Trace(("findssexprs, loop %d, type %d", l, type));
  ast_visit(1, 1);
  findsstype = type;
  findssl = l;
  if (onlyfg) {
    findssexprsfg(l, onlyfg, newstmts, type);
  } else {
    int fg;
    for (fg = LP_FG(l); fg; fg = FG_NEXT(fg)) {
      findssexprsfg(l, fg, newstmts, type);
    }
  }
  ast_unvisit();

#if DEBUG
  if (DBGBIT(39, 1))
    dumpSSlist();
#endif
} /* findssexprs */

/* has a CALL appeared in this loop? */
static int CallAppears = 0;

/*
 * mark ast 'ast' as modified in loop 'l'
 */
static void
mark(int ast, int l)
{
  int a, aa, sptr, dtype;
  a = ast;
  while (a > 0) {
    aa = a;
    switch (A_TYPEG(a)) {
    case A_ID:
      A_OPT2P(a, l);
      sptr = A_SPTRG(a);
      if (TARGETG(sptr) || F90POINTERG(sptr)) {
        dtype = DTYPEG(sptr);
        dtype = DDTG(dtype);
        if (dtype < DtypeAssignedSize)
          DtypeAssigned[dtype] = l;
      }
      a = 0;
      break;
    case A_SUBSCR:
      A_OPT2P(a, l);
      a = A_LOPG(a);
      break;
    case A_SUBSTR:
      A_OPT2P(a, l);
      a = A_LOPG(a);
      break;
    case A_MEM:
      A_OPT2P(a, l);
      A_OPT2P(A_MEMG(a), l);
      sptr = A_SPTRG(A_MEMG(a));
      if (TARGETG(sptr) || F90POINTERG(sptr)) {
        dtype = DTYPEG(sptr);
        dtype = DDTG(dtype);
        if (dtype < DtypeAssignedSize)
          DtypeAssigned[dtype] = l;
      }
      a = A_PARENTG(a);
      break;
    case A_CNST:
      aa = 0;
      a = 0;
      break;
    case A_BINOP:
      mark(A_LOPG(a), l);
      mark(A_ROPG(a), l);
      a = 0;
      aa = 0;
      break;
    default:
      interr("redundss:mark unexpected AST type", A_TYPEG(a), 3);
      a = 0;
      aa = 0;
      break;
    }
#if DEBUG
    if (DBGBIT(39, 2) && aa) {
      fprintf(gbl.dbgfil, "Modified ast %d = ", aa);
      printast(aa);
      fprintf(gbl.dbgfil, "\n");
    }
#endif
  }
} /* mark */

static void
markmodified(int ast, int *pl)
{
  int argt, argcnt, arg, a, astli, l, sptr, dtype;
  int subr, subrast, paramct, dpdsc, templatecall;
  l = *pl;
  switch (A_TYPEG(ast)) {
  /* for statement ASTs and function calls, mark modified variables */
  case A_DO:     /* modifies DO variable */
  case A_MP_PDO: /* modifies DO variable */
    mark(A_DOVARG(ast), l);
    break;
  case A_ASN: /* modifies LHS variable */
    mark(A_DESTG(ast), l);
    break;
  case A_FUNC: /* potentially modifies arguments */
  case A_CALL: /* potentially modifies arguments */
    argt = A_ARGSG(ast);
    argcnt = A_ARGCNTG(ast);
    subrast = A_LOPG(ast);
    if (A_TYPEG(subrast) == A_ID) {
      subr = A_SPTRG(subrast);
      paramct = PARAMCTG(subr);
      dpdsc = DPDSCG(subr);
    } else {
      subr = -1;
      paramct = -1;
      dpdsc = -1;
    }
    templatecall = 0;
    if (A_TYPEG(ast) == A_CALL && subr > 0 &&
        getF90TmplSectRtn(SYMNAME(subr))) {
      templatecall = 1;
    }
    for (a = 0; a < argcnt; ++a) {
      int asym;
      arg = ARGT_ARG(argt, a);
      /* don't count descriptor arguments as modified
       * if they need to be so marked, they will be at the array
       * argument to which they correspond */
      asym = -1;
      if (a < paramct) {
        asym = aux.dpdsc_base[dpdsc + a];
      }
      switch (A_TYPEG(arg)) {
      case A_ID:
      case A_MEM:
        sptr = memsym_of_ast(arg);
        if (!DESCARRAYG(sptr) || (templatecall && a == 0) ||
            (!templatecall && dpdsc == 0)) {
          /* regular symbol, or 1st argument to template call,
           * or call to a function without an interface */
          mark(arg, l);
        }
        if (asym > NOSYM && POINTERG(asym) && SDSCG(sptr)) {
          /* there is an explicit interface
           * the corresponding dummy is a pointer dummy
           * there is a section descriptor */
          mark(mk_id(SDSCG(sptr)), l);
        }
        break;
      case A_SUBSTR:
        mark(arg, l);
        break;
      case A_SUBSCR:
        sptr = memsym_of_ast(arg);
        if (!DESCARRAYG(sptr)) {
          mark(arg, l);
        }
        break;
      }
    }
    a = A_LOPG(ast);
    if (A_TYPEG(a) != A_ID || !PUREG(A_SPTRG(a))) {
      CallAppears = l;
    }
    break;
  case A_ICALL: /* potentially modifies first argument */
    argcnt = A_ARGCNTG(ast);
    argt = A_ARGSG(ast);
    arg = ARGT_ARG(argt, 0);
    switch (A_TYPEG(arg)) {
    case A_ID:
    case A_MEM:
      mark(arg, l);
    }
    switch (A_OPTYPEG(ast)) {
    case I_PTR2_ASSIGN:
      /* get datatype of first argument */
      dtype = A_DTYPEG(arg);
      if (dtype < DtypeAssignedSize)
        DtypeAssigned[dtype] = l;
      /* modifies the section descriptor also */
      mark(ARGT_ARG(argt, 1), l);
      break;

    case I_NULLIFY:
    case I_PTR_COPYOUT:
      if (argcnt > 1) {
        /* modifies the section descriptor also */
        mark(ARGT_ARG(argt, 1), l);
      }
      break;

    case I_COPYOUT:
      /* modifies the section descriptor also */
      mark(ARGT_ARG(argt, 2), l);
      break;

    case I_COPYIN:
      /* modifies the section descriptor also */
      mark(ARGT_ARG(argt, 3), l);
      break;

    case I_PTR_COPYIN:
      /* modifies the section descriptor also */
      mark(ARGT_ARG(argt, 4), l);
      break;
    }
    break;
  case A_ALLOC: /* modifies allocated object */
  case A_REDIM: /* modifies redimensioned object */
    mark(A_SRCG(ast), l);
    sptr = sym_of_ast(A_SRCG(ast));
    if (MIDNUMG(sptr)) {
      mark(mk_id(MIDNUMG(sptr)), l);
    }
    if (PTROFFG(sptr)) {
      mark(mk_id(PTROFFG(sptr)), l);
    }
    if (SDSCG(sptr)) {
      mark(mk_id(SDSCG(sptr)), l);
    }
    break;
  case A_FORALL: /* modified FORALL indices */
    for (astli = A_LISTG(ast); astli; astli = ASTLI_NEXT(astli)) {
      mark(mk_id(ASTLI_SPTR(astli)), l);
    }
    break;
  case A_REALIGN:      /* modifies realigned object */
  case A_REDISTRIBUTE: /* modifies redistributed object */
    mark(A_LOPG(ast), l);
    sptr = sym_of_ast(A_SRCG(ast));
    if (MIDNUMG(sptr)) {
      mark(mk_id(MIDNUMG(sptr)), l);
    }
    if (PTROFFG(sptr)) {
      mark(mk_id(PTROFFG(sptr)), l);
    }
    if (SDSCG(sptr)) {
      mark(mk_id(SDSCG(sptr)), l);
    }
    break;
  }
} /* markmodified */

/* return '1' if loop 'm' appears in loop 'l' */
static int
inloop(int m, int l)
{
  if (OnlyFG == 0) {
    int mdfs;
    mdfs = LP_LEVEL(m);
    if (mdfs <= LP_LEVEL(l) && mdfs >= LP_TAIL(l)) {
      return 1;
    }
  } else {
    if (m == l) {
      return 1;
    }
  }
  return 0;
} /* inloop */

/* mark modified subexpressions for fg node */
static void
markmodifiedexprsfg(int l, int fg)
{
  int std;
  for (std = FG_STDFIRST(fg); std; std = STD_NEXT(std)) {
    ast_traverse(STD_AST(std), NULL, markmodified, &l);
    if (std == FG_STDLAST(fg))
      break;
  }
} /* markmodifiedexprsfg */

/*
 * at loop l, find which subexpressions are modified at this loop
 * level, and mark them modified by setting A_OPT2 to the loop number
 */
static void
markmodifiedexprs(int l, int onlyfg)
{
  /* go through the nodes in the loop and statements in the node */
  /* use ast_traverse to get all function references */
  ast_visit(1, 1);
  if (onlyfg) {
    markmodifiedexprsfg(l, onlyfg);
  } else {
    int fg;
    for (fg = LP_FG(l); fg; fg = FG_NEXT(fg)) {
      markmodifiedexprsfg(l, fg);
    }
  }
  ast_unvisit_norepl();
} /* markmodifiedexprs */

/*
 * now propagate 'modified' from subexpressions
 * because of the way the list of subexpressions is ordered,
 * all subsubexpressions are visited first;
 * we have to go through ALL subsubexpressions, even if they are not
 * used in loop l, because they might have been used in a contained loop
 * of loop l, and we have to mark A_OPT2 with 'l' even in that case.
 */
static void
propagatemodified(int l)
{
  int ast, dtype;
  for (ast = SSlisthead; ast > 1; ast = A_OPT1G(ast)) {
    if (!modified(ast, l)) {
      int sptr, asd, s, mem;
      switch (A_TYPEG(ast)) {
      case A_PAREN:
      case A_UNOP:
      case A_CONV:
        if (modified(A_LOPG(ast), l)) {
          A_OPT2P(ast, l);
        }
        break;
      case A_BINOP:
        if (modified(A_LOPG(ast), l) || modified(A_ROPG(ast), l)) {
          A_OPT2P(ast, l);
        }
        break;
      case A_ID:
        /* may be set by markmodified */
        sptr = A_SPTRG(ast);
        switch (SCG(sptr)) {
        case SC_CMBLK:
        case SC_STATIC:
          /* call in this loop? */
          if (inloop(CallAppears, l)) {
            A_OPT2P(ast, l);
          }
          break;
        default:;
        }
        /* if 'target' or 'pointer', and any assignment to pointer of that
         * datatype in the loop, or any call in the loop,
         * we must assume it might be modified secretly */
        if (TARGETG(sptr) || POINTERG(sptr)) {
          /* call in this loop? */
          if (inloop(CallAppears, l)) {
            A_OPT2P(ast, l);
          }
          /* assignment to pointer of that datatype? */
          dtype = DTYPEG(sptr);
          dtype = DDTG(dtype);
          if (dtype >= DtypeAssignedSize || inloop(DtypeAssigned[dtype], l)) {
            A_OPT2P(ast, l);
          }
        }
        if (DESCARRAYG(sptr)) {
          int ast2;
          ast2 = mk_id(sptr);
          if (ast2 != ast && modified(ast2, l)) {
            A_OPT2P(ast, l);
          }
        }
        break;
      case A_CNST:
        break;
      case A_SUBSCR:
        if (modified(A_LOPG(ast), l)) {
          A_OPT2P(ast, l);
        }
        asd = A_ASDG(ast);
        for (s = 0; s < ASD_NDIM(asd); ++s) {
          if (modified(ASD_SUBS(asd, s), l)) {
            A_OPT2P(ast, l);
          }
        }
        break;
      case A_MEM:
        if (modified(A_PARENTG(ast), l)) {
          A_OPT2P(ast, l);
        }
        mem = A_MEMG(ast);
        if (modified(mem, l)) {
          A_OPT2P(ast, l);
        }
        sptr = A_SPTRG(mem);
        if (DESCARRAYG(sptr)) {
          int ast2;
          ast2 = mk_id(sptr);
          if (ast2 != ast && modified(ast2, l)) {
            A_OPT2P(ast, l);
          }
        }
        /* if 'target' or 'pointer', and any assignment to pointer of that
         * datatype in the loop, or any call in the loop,
         * we must assume it might be modified secretly */
        if (TARGETG(sptr) || POINTERG(sptr)) {
          /* call in this loop? */
          if (inloop(CallAppears, l)) {
            A_OPT2P(ast, l);
          }
          /* assignment to pointer of that datatype? */
          if (inloop(DtypeAssigned[DTYPEG(sptr)], l)) {
            A_OPT2P(ast, l);
          }
        }
        break;
      default:
        A_OPT2P(ast, l);
        break;
      }
    }
  }
#if DEBUG
  if (DBGBIT(39, 1))
    dumpSSlist();
#endif
} /* propagatemodified */

/* lop (+/-) rop, where lop or rop (or both) might be zero */
static int
addcomponents(int lop, int optype, int rop, int l)
{
  int ast;
  if (rop == 0) {
    ast = lop;
  } else if (lop == 0) {
    if (optype == OP_ADD) {
      ast = rop;
    } else if (optype == OP_SUB) {
      if (A_TYPEG(rop) == A_UNOP && A_OPTYPEG(rop) == OP_SUB) {
        /* -(-rop) == rop */
        ast = A_LOPG(rop);
      } else if (A_TYPEG(rop) == A_BINOP && A_OPTYPEG(rop) == OP_SUB) {
        /* -(rlop-rrop) = rrop-rlop */
        ast = mk_binop(optype, A_ROPG(rop), A_LOPG(rop), A_DTYPEG(rop));
        A_OPT2P(ast, A_OPT2G(rop));
      } else {
        ast = mk_unop(optype, rop, A_DTYPEG(rop));
        A_OPT2P(ast, A_OPT2G(rop));
      }
    } else {
      ast = mk_unop(optype, rop, A_DTYPEG(rop));
      A_OPT2P(ast, A_OPT2G(rop));
    }
  } else if (optype == OP_ADD) {
    /* look for (-a)+(-b), (-a)+b, a+(-b), (-a)+a, a+(-a) */
    if (A_TYPEG(lop) == A_UNOP && A_OPTYPEG(lop) == OP_SUB) {
      if (A_TYPEG(rop) == A_UNOP && A_OPTYPEG(rop) == OP_SUB) {
        int tmp;
        /* (-a)+(-b) turns into -(a+b) */
        lop = A_LOPG(lop);
        rop = A_LOPG(rop);
        tmp = mk_binop(OP_ADD, lop, rop, A_DTYPEG(rop));
        if (!modified(tmp, l)) {
          if (modified(lop, l) || modified(rop, l)) {
            A_OPT2P(tmp, l);
          }
        }
        ast = mk_unop(OP_SUB, tmp, A_DTYPEG(tmp));
        A_OPT2P(ast, A_OPT2G(tmp));
      } else {
        /* (-a) + b turns into b-a */
        lop = A_LOPG(lop);
        if (lop == rop) {
          /* -a + a */
          ast = 0;
        } else {
          ast = mk_binop(OP_SUB, rop, lop, A_DTYPEG(rop));
          if (!modified(ast, l)) {
            if (modified(lop, l) || modified(rop, l)) {
              A_OPT2P(ast, l);
            }
          }
        }
      }
    } else if (A_TYPEG(rop) == A_UNOP && A_OPTYPEG(rop) == OP_SUB) {
      /* a + (-b) turns into a-b */
      rop = A_LOPG(rop);
      if (lop == rop) {
        /* a - a */
        ast = 0;
      } else {
        ast = mk_binop(OP_SUB, lop, rop, A_DTYPEG(rop));
        if (!modified(ast, l)) {
          if (modified(lop, l) || modified(rop, l)) {
            A_OPT2P(ast, l);
          }
        }
      }
    } else {
      ast = mk_binop(OP_ADD, lop, rop, A_DTYPEG(rop));
      if (!modified(ast, l)) {
        if (modified(lop, l) || modified(rop, l)) {
          A_OPT2P(ast, l);
        }
      }
    }
  } else {
    /* look for (-a)-(-b), (-a)-b, a-(-b), a-a */
    if (A_TYPEG(lop) == A_UNOP && A_OPTYPEG(lop) == OP_SUB) {
      if (A_TYPEG(rop) == A_UNOP && A_OPTYPEG(rop) == OP_SUB) {
        /* (-a)-(-b) turns into b-a */
        lop = A_LOPG(lop);
        rop = A_LOPG(rop);
        if (lop == rop) {
          /* (-a) - (-a) */
          ast = 0;
        } else {
          ast = mk_binop(OP_SUB, rop, lop, A_DTYPEG(rop));
          if (!modified(ast, l)) {
            if (modified(lop, l) || modified(rop, l)) {
              A_OPT2P(ast, l);
            }
          }
        }
      } else {
        /* (-a) - b turns into -(a+b) */
        int tmp;
        lop = A_LOPG(lop);
        tmp = mk_binop(OP_ADD, rop, lop, A_DTYPEG(rop));
        if (!modified(tmp, l)) {
          if (modified(lop, l) || modified(rop, l)) {
            A_OPT2P(tmp, l);
          }
        }
        ast = mk_unop(OP_SUB, tmp, A_DTYPEG(tmp));
        A_OPT2P(ast, A_OPT2G(tmp));
      }
    } else if (A_TYPEG(rop) == A_UNOP && A_OPTYPEG(rop) == OP_SUB) {
      /* a - (-b) turns into a+b */
      rop = A_LOPG(rop);
      ast = mk_binop(OP_ADD, lop, rop, A_DTYPEG(rop));
      if (!modified(ast, l)) {
        if (modified(lop, l) || modified(rop, l)) {
          A_OPT2P(ast, l);
        }
      }
    } else {
      if (lop == rop) {
        /* a - a */
        ast = 0;
      } else {
        ast = mk_binop(OP_SUB, lop, rop, A_DTYPEG(rop));
        if (!modified(ast, l)) {
          if (modified(lop, l) || modified(rop, l)) {
            A_OPT2P(ast, l);
          }
        }
      }
    }
  }
  return ast;
} /* addcomponents */

/* -lop, look for -(-lop), -(l-r) */
static int
negatecomponent(int lop, int l)
{
  int ast;
  if (lop == 0) {
    ast = 0;
  } else if (A_TYPEG(lop) == A_UNOP && A_OPTYPEG(lop) == OP_SUB) {
    /* -(-lop) == lop */
    ast = A_LOPG(lop);
  } else if (A_TYPEG(lop) == A_BINOP && A_OPTYPEG(lop) == OP_SUB) {
    /* -(llop-lrop) = lrop-llop */
    ast = mk_binop(OP_SUB, A_ROPG(lop), A_LOPG(lop), A_DTYPEG(lop));
    A_OPT2P(ast, A_OPT2G(lop));
  } else {
    ast = mk_unop(OP_SUB, lop, A_DTYPEG(lop));
    A_OPT2P(ast, A_OPT2G(lop));
  }
  return ast;
} /* negatecomponent */

/*
 * lop*rop, where lop or rop (or both) might be zero
 * loop for (-lop)*(-rop), (-lop)*rop, eliminate negatives
 */
static int
mulcomponents(int lop, int rop, int l)
{
  int ast, negate;
  if (lop == 0 || rop == 0) {
    ast = 0;
  } else {
    negate = 1;
    if (A_TYPEG(lop) == A_UNOP && A_OPTYPEG(lop) == OP_SUB) {
      negate = -negate;
      lop = A_LOPG(lop);
    }
    if (A_TYPEG(rop) == A_UNOP && A_OPTYPEG(rop) == OP_SUB) {
      negate = -negate;
      rop = A_LOPG(rop);
    }
    if (lop == astb.i1) {
      ast = rop;
    } else if (rop == astb.i1) {
      ast = lop;
    } else {
      ast = mk_binop(OP_MUL, lop, rop, A_DTYPEG(rop));
      if (!modified(ast, l)) {
        if (modified(lop, l) || modified(rop, l)) {
          A_OPT2P(ast, l);
        }
      }
    }
    if (negate == -1) {
      int nast;
      nast = mk_unop(OP_SUB, ast, A_DTYPEG(ast));
      if (!modified(nast, l)) {
        if (modified(ast, l)) {
          A_OPT2P(nast, l);
        }
      }
      ast = nast;
    }
  }
  return ast;
} /* mulcomponents */

/*
 * given an ast, see if it is a product, and if so, build two trees,
 * one the product of components that are invariant in loop l, and one
 * the product of components that are variant in loop l
 */
static void
findmulcomponents(int ast, int l, int *pinv, int *pvar)
{
  int linv, lvar, rinv, rvar, optype;
  if (ast == 0) {
    *pvar = 0;
    *pinv = 0;
    return;
  }
  /* default result, unless some other case applies */
  if (modified(ast, l) || A_TYPEG(ast) == A_CNST) {
    *pvar = ast;
    *pinv = astb.i1;
  } else {
    *pvar = astb.i1;
    *pinv = ast;
  }
  switch (A_TYPEG(ast)) {
  case A_UNOP:
    switch (A_OPTYPEG(ast)) {
    case OP_ADD:
      findmulcomponents(A_LOPG(ast), l, pinv, pvar);
      break;
    case OP_SUB:
      findmulcomponents(A_LOPG(ast), l, &linv, &lvar);
      /* negate one of them */
      *pinv = negatecomponent(linv, l);
      *pvar = lvar;
      break;
    }
    break;
  case A_BINOP:
    switch (A_OPTYPEG(ast)) {
    case OP_MUL:
      findmulcomponents(A_LOPG(ast), l, &linv, &lvar);
      findmulcomponents(A_ROPG(ast), l, &rinv, &rvar);
      *pinv = mulcomponents(linv, rinv, l);
      *pvar = mulcomponents(lvar, rvar, l);
      break;
    }
    break;
  case A_PAREN:
    findmulcomponents(A_LOPG(ast), l, pinv, pvar);
    break;
  }
} /* findmulcomponents */

/*
 * given an ast, see if it is a sum, and if so, build two trees,
 * one the sum of components that are invariant in loop l, and one
 * the sum of components that are variant in loop l
 */
static void
findcomponents(int ast, int l, int *pinv, int *pvar)
{
  int linv, lvar, rinv, rvar, optype;
  /* default result, unless some other case applies */
  if (modified(ast, l) || A_TYPEG(ast) == A_CNST) {
    *pvar = ast;
    *pinv = 0;
  } else {
    *pvar = 0;
    *pinv = ast;
  }
  switch (A_TYPEG(ast)) {
  case A_UNOP:
    switch (A_OPTYPEG(ast)) {
    case OP_ADD:
      findcomponents(A_LOPG(ast), l, pinv, pvar);
      break;
    case OP_SUB:
      findcomponents(A_LOPG(ast), l, &linv, &lvar);
      /* negate both of them */
      *pinv = negatecomponent(linv, l);
      *pvar = negatecomponent(lvar, l);
      break;
    }
    break;
  case A_BINOP:
    optype = A_OPTYPEG(ast);
    switch (optype) {
    case OP_ADD:
    case OP_SUB:
      findcomponents(A_LOPG(ast), l, &linv, &lvar);
      findcomponents(A_ROPG(ast), l, &rinv, &rvar);
      *pinv = addcomponents(linv, optype, rinv, l);
      *pvar = addcomponents(lvar, optype, rvar, l);
      break;
    case OP_MUL:
      findcomponents(A_LOPG(ast), l, &linv, &lvar);
      findcomponents(A_ROPG(ast), l, &rinv, &rvar);
      if (lvar == 0) {
        int rvarinv, rvarvar;
        /* linv*(rinv+(rvarinv*rvarvar))  becomes
         * linv*rinv + (linv*rvarinv)*rvarvar */
        *pinv = mulcomponents(linv, rinv, l);
        findmulcomponents(rvar, l, &rvarinv, &rvarvar);
        linv = mulcomponents(linv, rvarinv, l);
        *pvar = mulcomponents(linv, rvarvar, l);
      } else if (rvar == 0) {
        int lvarinv, lvarvar;
        /* (linv+(lvarinv*lvarvar))*rinv  becomes
         * linv*rinv + (lvarinv*rinv)*lvarvar */
        *pinv = mulcomponents(linv, rinv, l);
        findmulcomponents(lvar, l, &lvarinv, &lvarvar);
        rinv = mulcomponents(lvarinv, rinv, l);
        *pvar = mulcomponents(lvarvar, rinv, l);
      } else {
        /* (lvar+linv)*(rinv+rvar)  just reassociate */
        *pinv = 0;
        lvar = addcomponents(lvar, OP_ADD, linv, l);
        rvar = addcomponents(rvar, OP_ADD, rinv, l);
        *pvar = mulcomponents(lvar, rvar, l);
      }
      break;
    }
    break;
  case A_PAREN:
    findcomponents(A_LOPG(ast), l, pinv, pvar);
    break;
  }
} /* findcomponents */

/*
 * return TRUE if ast is a sum of variant and invariant parts */
static LOGICAL
mixedsum(int ast, int l)
{
  LOGICAL mixed;
  int lop, rop, lmod, rmod;
  mixed = FALSE;
  switch (A_TYPEG(ast)) {
  case A_UNOP:
    switch (A_OPTYPEG(ast)) {
    case OP_ADD:
    case OP_SUB:
      mixed = mixedsum(A_LOPG(ast), l);
    }
    break;
  case A_BINOP:
    switch (A_OPTYPEG(ast)) {
    case OP_ADD:
    case OP_SUB:
      lop = A_LOPG(ast);
      rop = A_ROPG(ast);
      lmod = modified(lop, l);
      rmod = modified(rop, l);
      if ((lmod && !rmod) || (!lmod && rmod)) {
        mixed = TRUE;
      } else if (mixedsum(lop, l) || mixedsum(rop, l)) {
        mixed = TRUE;
      }
      break;
    }
    break;
  case A_PAREN:
    mixed = mixedsum(A_LOPG(ast), l);
    break;
  }
  return mixed;
} /* mixedsum */

/*
 * given 'factor' that is invariant in loop 'l',
 * and 'sum' that is partially invariant in loop 'l',
 * distribute 'factor' over 'sum':
 *  (factor)*((sumvarinv*sumvarvar)+suminv) becomes
 *  ((factor)*(sumvarinv))*(sumvarvar) + (factor)*(suminv)
 */
static int
distribute(int factor, int sum, int l)
{
  int suminv, sumvar, sumvarinv, sumvarvar, ast;
  findcomponents(sum, l, &suminv, &sumvar);
  suminv = mulcomponents(factor, suminv, l);
  findmulcomponents(sumvar, l, &sumvarinv, &sumvarvar);
  factor = mulcomponents(factor, sumvarinv, l);
  sumvar = mulcomponents(factor, sumvarvar, l);
  ast = addcomponents(suminv, OP_ADD, sumvar, l);
  return ast;
} /* distribute */

/*
 * return a replacement ast that is reassociated and distributed
 * to give better code floating.
 * (i*k+1)*2+3 will become (i*(k*2))+((1*2)+3)
 * We compute a sum of a loop-invariant expression and a loop-variant one.
 * Leave the constant part in the 'loop-variant' part.
 */
static int
MakeReplacement(int ast, int l)
{
  int optype, rast;
  int lop, linv, lvar, rop, rinv, rvar, subscr[MAXSUBS], numdim, asd, s, any;
  switch (A_TYPEG(ast)) {
  case A_PAREN:
    return MakeReplacement(A_LOPG(ast), l);
  case A_CONV:
    rast = MakeReplacement(A_LOPG(ast), l);
    if (rast == A_LOPG(ast)) {
      rast = ast;
    } else {
      rast = mk_convert(rast, A_DTYPEG(ast));
    }
    break;
  case A_UNOP:
    switch (A_OPTYPEG(ast)) {
    case OP_SUB:
      rast = MakeReplacement(A_LOPG(ast), l);
      rast = negatecomponent(rast, l);
      break;
    case OP_ADD:
      rast = MakeReplacement(A_LOPG(ast), l);
      break;
    default:
      rast = ast;
      break;
    }
    break;
  case A_BINOP:
    optype = A_OPTYPEG(ast);
    switch (optype) {
    case OP_ADD:
    case OP_SUB:
      /* find 'components' of lop and rop, linv, lvar, rinv, rvar.
       * add (linv+rinv)+(lvar+rvar) */
      findcomponents(A_LOPG(ast), l, &linv, &lvar);
      findcomponents(A_ROPG(ast), l, &rinv, &rvar);
      linv = addcomponents(linv, optype, rinv, l);
      lvar = addcomponents(lvar, optype, rvar, l);
      rast = addcomponents(linv, OP_ADD, lvar, l);
      break;
    case OP_MUL:
      /* multiply is the most difficult case
       * ((a+b)*(c+d)) * ((e+f)*(g+h))
       * If one side is invariant and the other is variant ADD or SUB,
       * but not completely variant, distribute the one side over the
       * other.
       * If either or both sides are multiplies, find multiplicative
       * components and reassociate as for sums */
      lop = MakeReplacement(A_LOPG(ast), l);
      rop = MakeReplacement(A_ROPG(ast), l);
      rast = ast;
      if (!modified(lop, l) && mixedsum(rop, l)) {
        rast = distribute(lop, rop, l);
      } else if (!modified(rop, l) && mixedsum(lop, l)) {
        rast = distribute(rop, lop, l);
      } else {
        findmulcomponents(ast, l, &linv, &lvar);
        rast = mulcomponents(linv, lvar, l);
      }
      break;
    default:
      rast = ast;
      break;
    }
    break;
  case A_SUBSCR:
    /* see if any subscripts can be modified */
    if (!XBIT(70, 0x8000000)) {
      int sptr;
      sptr = sptr_of_subscript(ast);
      if (!POINTERG(sptr))
        break;
    }
    rast = ast;
    asd = A_ASDG(ast);
    numdim = ASD_NDIM(asd);
    any = 0;
    for (s = 0; s < numdim; ++s) {
      subscr[s] = MakeReplacement(ASD_SUBS(asd, s), l);
      if (subscr[s] != ASD_SUBS(asd, s))
        ++any;
    }
    if (any) {
      rast = mk_subscr(A_LOPG(ast), subscr, numdim, A_DTYPEG(ast));
    }
    break;
  default:
    rast = ast;
  }
  return rast;
} /* MakeReplacement */

/* count how many ast_replace calls are made */
static int gany = 0;

/*
 * make an assignment for each expression on SSlisthead
 */
static int
addssassignments(int before, int beforefg, int rewrite, int par, int task)
{
  int ast, any;
  any = 0;
  for (ast = SSlisthead; ast > 1; ast = A_OPT1G(ast)) {
    /* ast is used in this loop */
    int lhs, asn, std, rhs;
    int dt;
    ++gany;
    ++any;
#if DEBUG
    if (DBGBIT(39, 4)) {
      Trace(("Remove ast %d, OPT2=%d, gany=%d", ast, A_OPT2G(ast), gany));
      printast(ast);
      Trace((""));
    }
#endif
    dt = A_DTYPEG(ast);
    if (!par && !task) {
      lhs = mk_id(getcctmp_sc('r', ast, ST_VAR, dt, SC_LOCAL));
    } else {
      lhs = mk_id(getcctmp_sc('r', ast, ST_VAR, dt, SC_PRIVATE));
    }

    asn = mk_stmt(A_ASN, A_DTYPEG(lhs));
    rhs = ast_rewrite(ast);
    A_SRCP(asn, rhs);
    A_DESTP(asn, lhs);
    std = add_stmt_before(asn, before);
    STD_FG(std) = beforefg;
    STD_PAR(std) = par;
    STD_TASK(std) = task;
    Trace(("add statement %d in node %d", std, beforefg));
    ast_replace(ast, lhs);
  }
  return any;
} /* addssassignments */

static void
rewritefg(int fg)
{
  int std;
  for (std = FG_STDFIRST(fg); std; std = STD_NEXT(std)) {
    int ast;
    ast = STD_AST(std);
    ast = ast_rewrite(ast);
    STD_AST(std) = ast;
    if (A_TYPEG(ast) == A_ASN && A_DESTG(ast) == A_SRCG(ast)) {
      Trace(("delete useless assignment %d", std));
      if (STD_LABEL(std) == 0) {
        /* flow around it */
        STD_DELETE(std) = 1;
        STD_NEXT(STD_PREV(std)) = STD_NEXT(std);
        STD_PREV(STD_NEXT(std)) = STD_PREV(std);
        /* remove from flow graph */
        if (std == FG_STDLAST(fg)) {
          FG_STDLAST(fg) = STD_PREV(std);
          break;
        }
      } else {
        /* turn into labelled continue statement */
        STD_AST(std) = mk_stmt(A_CONTINUE, 0);
      }
    }
    if (std == FG_STDLAST(fg))
      break; /* leave loop */
  }
} /* rewritefg */

/*
 * go through loops, innermost first,
 * call findssexprs to build SSlist of all subscript subexpressions
 * used in the loop.
 * call markmodifiedexprs for each loop to mark expressions that
 * are directly modified in this loop
 * call propagatemodified to mark which of these are modified in the loop.
 * call findssexprs to build SSlist of the root subscript subexpressions
 * used in the loop.
 * for each of these, call MakeReplacement to reassociate and distribute,
 * and to find the invariant part of the expression.  Insert an assignment
 * for the invariant part outside of the loop, or move the assignment if the
 * whole expression is invariant.
 */
static void
reassociate(void)
{
  int loop, oldstdavl, par;
  oldstdavl = astb.std.stg_avail;
  for (loop = 1; loop <= opt.nloops; ++loop) {
    int l, ast, any;
    l = LP_LOOP(loop);
    Trace(("REASSOCIATE loop %d: Find all subscript expressions", l));
    findssexprs(l, oldstdavl, SS_ALL, 0);
    Trace(("REASSOCIATE loop %d: Mark modified expressions", l));
    markmodifiedexprs(l, 0);
    Trace(("REASSOCIATE loop %d: propagate modified expressions", l));
    propagatemodified(l);
    Trace(("REASSOCIATE loop %d: find root subscript expressions", l));
    findssexprs(l, oldstdavl, SS_ROOT, 0);
    /* go through each root expression used in this loop.
     * reassociate and distribute for maximum code floating */
    any = 0;
    ast_visit(1, 1);
    for (ast = SSlisthead; ast > 1; ast = A_OPT1G(ast)) {
      /* ast is used in this loop */
      int rast;
      rast = MakeReplacement(ast, l);
      if (rast != ast) {
        ++gany;
        ++any;
        Trace(("REASSOCIATE loop %d, gany=%d: replace ast %d by ast %d", l,
               gany, ast, rast));
#if DEBUG
        if (DBGBIT(39, 4)) {
          printast(ast);
          fprintf(gbl.dbgfil ? gbl.dbgfil : stderr, " ==> ");
          printast(rast);
          fprintf(gbl.dbgfil ? gbl.dbgfil : stderr, "\n");
        }
#endif
        ast_replace(ast, rast);
      }
    }
    if (!any) {
      ast_unvisit();
    } else {
      int fg;
      for (fg = LP_FG(l); fg; fg = FG_NEXT(fg)) {
        int std;
        for (std = FG_STDFIRST(fg); std; std = STD_NEXT(std)) {
          int ast, rast;
          ast = STD_AST(std);
          rast = ast_rewrite(ast);
          if (rast != ast) {
            Trace(("REASSOCIATE loop %d: std %d replace ast %d by ast %d", l,
                   std, ast, rast));
#if DEBUG
            if (DBGBIT(39, 4)) {
              printast(ast);
              fprintf(gbl.dbgfil ? gbl.dbgfil : stderr, " ==> ");
              printast(rast);
              fprintf(gbl.dbgfil ? gbl.dbgfil : stderr, "\n");
            }
#endif
            STD_AST(std) = rast;
          }
          if (std == FG_STDLAST(fg))
            break; /* leave loop */
        }
      }
      ast_unvisit();
      /* now find subscript expressions after changes */
      Trace((
          "REASSOCIATE loop %d: find subscript expressions after reassociation",
          l));
      findssexprs(l, oldstdavl, SS_ALL, 0);
      Trace(("REASSOCIATE loop %d: mark modified subexpressions after "
             "reassociation",
             l));
      markmodifiedexprs(l, 0);
      Trace(("REASSOCIATE loop %d: propagate modified subexpressions after "
             "reassociation",
             l));
      propagatemodified(l);
    }
    Trace(
        ("REASSOCIATE loop %d: find invariant root subscript expressions", l));
    findssexprs(l, oldstdavl, SS_INV_ROOT, 0);
    /* make preheader flow graph node for loop l, where to insert code */
    opt.pre_fg = add_fg(FG_LPREV(LP_HEAD(l)));
    rdilts(opt.pre_fg);
    ast_visit(1, 1);
    any = addssassignments(0, opt.pre_fg, 0, STD_PAR(FG_STDFIRST(LP_HEAD(l))),
                           STD_TASK(FG_STDFIRST(LP_HEAD(l))));
    wrilts(opt.pre_fg);
    if (any) {
      int fg;
      for (fg = LP_FG(l); fg; fg = FG_NEXT(fg)) {
        rewritefg(fg);
      }
    }
    ast_unvisit();
    add_loop_preheader(l);
  }
} /* reassociate */

static void
basic_block_redundant(void)
{
  int fg;
  Trace(("basic_block_redundant()"));
  for (fg = FG_LNEXT(0); fg > 0; fg = FG_LNEXT(fg)) {
    int any, ast, stdfirst, atype;
    Trace(("basic block node %d", fg));
    OnlyFG = fg;
    stdfirst = FG_STDFIRST(fg);
    if (stdfirst == 0)
      continue;
    Trace(("%d=stdfirst", stdfirst));
    Trace(("%d=ast", STD_AST(stdfirst)));
    atype = A_TYPEG(STD_AST(stdfirst));
    Trace(("%d=atype=%s", atype, astb.atypes[atype]));
    /* for purposes of this optimization, pull 'do' out of the basic block */
    if (atype == A_DO || atype == A_MP_PDO) {
      FG_STDFIRST(fg) = STD_NEXT(stdfirst);
    }
    findssexprs(fg, astb.std.stg_avail, SS_ALL_MULTIPLE, fg);
    markmodifiedexprs(fg, fg);
    propagatemodified(fg);
    findssexprs(fg, astb.std.stg_avail, SS_INV_ROOT_MULTIPLE, fg);
    ast_visit(1, 1);
    any = addssassignments(FG_STDFIRST(fg), fg, 1, STD_PAR(FG_STDFIRST(fg)),
                           STD_TASK(FG_STDFIRST(fg)));
    if (any) {
      rewritefg(fg);
    }
    ast_unvisit();
    FG_STDFIRST(fg) = stdfirst;
  }
  OnlyFG = 0;
} /* basic_block_redundant */

static void
Init(void)
{
  InitAST();
  InitSSlist();
  CallAppears = 0;
  if (DtypeAssigned == NULL) {
    NEW(DtypeAssigned, int, stb.dt.stg_avail);
    DtypeAssignedSize = stb.dt.stg_avail;
  }
  BZERO(DtypeAssigned, int, DtypeAssignedSize);
  OnlyFG = 0;
} /* Init */

/*
 * free up any dynamically allocated space
 */
static void
Done(void)
{
  freearea(PSI_AREA);
  optshrd_end();
  FREE(DtypeAssigned);
  DtypeAssignedSize = 0;
} /* Done */

void
redundss(void)
{
  Trace(("in redundss, func_count=%d", gbl.func_count));
  DtypeAssigned = NULL;
  DtypeAssignedSize = 0;
  optshrd_init();
  flowgraph();
  findloop(HLOPT_ALL);
  gany = 0;
  /* 'fix' the loop order, changing the definition of LP_TAIL to
   * be the loop order index of the last contained loop */
  reorder_dfn_loops();
#if DEBUG
  if (DBGBIT(39, 2)) {
    dumpfgraph();
    dumploops();
  }
#endif
  Init();
  reassociate();
  if (XBIT(70, 0x200)) {
    Init();
    basic_block_redundant();
  }
  Done();
  Trace(("leaving redundss, func_count=%d, gany=%d", gbl.func_count, gany));
} /* redundss */
