Merge pull request #124 from flang-compiler/master

Pull recent NVIDIA changes

include/flang/Error/errmsg-common.n

@@ -1,5 +1,5 @@
 .\"/*
-.\" * Copyright (c) 2017, NVIDIA CORPORATION.  All rights reserved.
+.\" * Copyright (c) 2010-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.
@@ -26,3 +26,5 @@ You may specify a directory to use for temporary files with the TMPDIR environme
 .MS F 703 "only the last -preinclude switch is processed"
 We have one spot for the preinclude file in the gbl. structure.  This is not 
 a user visible switch.
+.MS F 704 "Compilation aborted due to previous errors."
+Compilation will abort immediately in case of Severe or Fatal error.

runtime/flang/type.c

@@ -1406,21 +1406,23 @@ void ENTF90(INIT_UNL_POLY_DESC, init_unl_poly_desc)(F90_Desc *dd, F90_Desc *sd,
     }
 }
 
-void ENTF90(INIT_FROM_DESC, init_from_desc)(void *object, const F90_Desc *desc)
+void ENTF90(INIT_FROM_DESC, init_from_desc)(void *object,
+                                            const F90_Desc *desc,
+                                            int rank)
 {
   if (object && desc) {
 
     OBJECT_DESC *obj_desc = (OBJECT_DESC *) desc;
     size_t items = 1;
     size_t index[MAXDIMS];
     TYPE_DESC *type_desc = obj_desc->type;
-    int rank = 0;
     int j;
     size_t element_bytes = 0;
     void *prototype = NULL;
 
     if (desc->tag == __DESC) {
-      rank = desc->rank;
+      if (desc->rank < rank)
+        rank = desc->rank;
       if (rank > 0) {
         items = desc->lsize;
         for (j = 0; j < rank; ++j) {

tools/flang1/flang1exe/func.c

@@ -2658,24 +2658,9 @@ rewrite_func_ast(int func_ast, int func_args, int lhs)
     rtlRtn = DTY(A_DTYPEG(arg1)) == TY_CHAR ? RTE_date : RTE_datew;
     goto sub_common;
   case I_IDATE:
-    {
-      TY_KIND arg_ty = TY_NONE; /* args must all be short or int */
-      for (i = 0; i < nargs; ++i) {
-        int arg_ast = ARGT_ARG(func_args, i);
-        TY_KIND ty = DTY(A_DTYPEG(arg_ast));
-        if (i == 0) {
-          arg_ty = ty;
-        } else {
-          assert(arg_ty == ty,
-                 "rewrite_func_ast:idate called with bad arguments", 0,
-                 ERR_Fatal);
-        }
-      }
-      assert(arg_ty == TY_SINT || arg_ty == TY_INT,
-             "rewrite_func_ast:idate called with bad arguments", 0, ERR_Fatal);
-      rtlRtn = arg_ty == TY_SINT ? RTE_idate : RTE_jdate;
-    }
     is_icall = FALSE;
+    arg1 = ARGT_ARG(func_args, 0);
+    rtlRtn = DTY(A_DTYPEG(arg1)) == TY_SINT ? RTE_idate : RTE_jdate;
     goto sub_common;
   case I_LASTVAL:
     rtlRtn = RTE_lastval;

tools/flang1/flang1exe/rest.c

@@ -1,5 +1,5 @@
 /*
- * Copyright (c) 2017, NVIDIA CORPORATION.  All rights reserved.
+ * Copyright (c) 1994-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.
@@ -1753,6 +1753,17 @@ transform_call(int std, int ast)
             DESCUSEDP(sptr, 1);
             NODESCP(sptr, 0);
             ++newj;
+          } else if (needdescr) {
+            int sptrsdsc;
+            sptr = memsym_of_ast(ele);
+            get_static_descriptor(sptr);
+
+            sptrsdsc = get_member_descriptor(sptr);
+            if (sptrsdsc <= NOSYM) {
+              sptrsdsc = SDSCG(sptr);
+            }
+            ARGT_ARG(newargt, newj) = check_member(ele, mk_id(sptrsdsc));
+            ++newj;
           } else {
             ty = dtype_to_arg(A_DTYPEG(ele));
             ARGT_ARG(newargt, newj) = pghpf_type(ty);
@@ -2228,7 +2239,7 @@ handle_seq_section(int entry, int arr, int loc, int std, int *retval,
     topdtype = DTY(topdtype + 1);
 
   if (simplewholearray && CONTIGATTRG(arraysptr)) {
-    *retval = first_element(arr);
+    *retval = arr;
     *descr = DESCRG(arraysptr) > NOSYM ?
       check_member(arrayast, mk_id(DESCRG(arraysptr))) : 0;
     return;

tools/flang1/flang1exe/semant.c

@@ -7570,16 +7570,17 @@ semant1(int rednum, SST *top)
    *      <bind attr> ::= ( <id name> ) |
    */
   case BIND_ATTR1:
-    /* see also FUNC_SUFFIX2 for a copy of this  processing */
-    np = scn.id.name + SST_CVALG(RHS(2));
+    /* see also FUNC_SUFFIX2 for a copy of this processing */
 
     bind_attr.exist = -1;
     bind_attr.altname = 0;
 
-    if (sem_strcmp(np, "c") == 0) {
-      bind_attr.exist = DA_B(DA_C);
-    } else
+    np = scn.id.name + SST_CVALG(RHS(2));
+    if (sem_strcmp(np, "c") != 0) {
       error(4, 3, gbl.lineno, "Illegal BIND -", np);
+    } else {
+      bind_attr.exist = DA_B(DA_C);
+    }
 
     break;
   /*
@@ -7593,17 +7594,15 @@ semant1(int rednum, SST *top)
 
     bind_attr.exist = -1;
     bind_attr.altname = 0;
+
     np = scn.id.name + SST_CVALG(RHS(2));
     if (sem_strcmp(np, "c") != 0) {
       error(4, 3, gbl.lineno, "Illegal BIND -", np);
     } else {
-      bind_attr.exist = DA_B(DA_C);
-      np = stb.n_base + CONVAL1G(SST_SYMG(RHS(6)));
-      if (*np) {
-        bind_attr.exist |= DA_B(DA_ALIAS);
-        bind_attr.altname = SST_SYMG(RHS(6));
-      }
+      bind_attr.exist = DA_B(DA_C) | DA_B(DA_ALIAS);
+      bind_attr.altname = SST_SYMG(RHS(6)); // altname may be ""
     }
+
     break;
 
   /* ------------------------------------------------------------------ */
@@ -12969,6 +12968,7 @@ process_bind(int sptr)
   int b_type;
   int b_bitv;
   int need_altname = 0;
+  char *np;
   char *w32_name;
   int wsptr;
 
@@ -12991,6 +12991,11 @@ process_bind(int sptr)
 
     switch (b_type) {
     case DA_ALIAS:
+      /* An altname can't be empty.  Exit early to use a "normal" mangled
+       * variant of the primary symbol name. */
+      np = stb.n_base + CONVAL1G(bind_attr.altname);
+      if (!*np)
+        return;
 #if defined(TARGET_OSX)
       /* Win32 and OSX needs altname with underbar for bind only, to
          match C routines.  Do not depend on processing in
@@ -12999,7 +13004,7 @@ process_bind(int sptr)
        */
       w32_name = (char *)getitem(0, strlen(SYMNAME(bind_attr.altname)) + 1);
       w32_name[0] = '_';
-      strcpy(&(w32_name[1]), stb.n_base + CONVAL1G(bind_attr.altname));
+      strcpy(&(w32_name[1]), np);
 
       wsptr = getstring(w32_name, strlen(w32_name));
       ALTNAMEP(sptr, wsptr);

tools/flang1/flang1exe/semfin.c

@@ -1,5 +1,5 @@
 /*
- * Copyright (c) 1994-2017, NVIDIA CORPORATION.  All rights reserved.
+ * Copyright (c) 1994-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.
@@ -3549,10 +3549,12 @@ init_derived_type(SPTR sptr, int parent_ast, int wherestd)
       if (descr_ast > 0) {
         int func_ast = mk_id(sym_mkfunc_nodesc(mkRteRtnNm(RTE_init_from_desc),
                                                DT_NONE));
-        int argt = mk_argt(2);
-        new_ast = mk_func_node(A_CALL, func_ast, 2, argt);
+        int argt = mk_argt(3);
+        new_ast = mk_func_node(A_CALL, func_ast, 3, argt);
         ARGT_ARG(argt, 0) = mk_id(sptr);
         ARGT_ARG(argt, 1) = descr_ast;
+        ARGT_ARG(argt, 2) =
+          mk_unop(OP_VAL, mk_cval(rank_of_sym(sptr), DT_INT4), DT_INT4);
       }
     }
 

tools/flang1/flang1exe/semsmp.c

@@ -9486,18 +9486,23 @@ parref_bnd(int ast, int stblk)
 void
 set_parref_flag(int sptr, int psptr, int stblk)
 {
-
-  if (SCG(sptr) && SCG(sptr) == SC_CMBLK)
+  if (!SCG(sptr))
     return;
-  if (SCG(sptr) && SCG(sptr) == SC_STATIC)
+  if (STYPEG(sptr) == ST_MEMBER)
     return;
-  if (DINITG(sptr) || SAVEG(sptr)) /* save variable can be threadprivate */
+  if (SCG(sptr) == SC_CMBLK || SCG(sptr) == SC_STATIC)
     return;
   if (SCG(sptr) == SC_EXTERN && ST_ISVAR(sptr)) /* No global vars in uplevel */
     return;
-  if (STYPEG(sptr) == ST_MEMBER)
-    return;
-
+  if (DINITG(sptr) || SAVEG(sptr)) {
+    if (SCG(sptr) != SC_LOCAL) {
+      if (SCG(sptr) == SC_BASED) {
+        int sym = MIDNUMG(sptr);
+        if (SCG(sym) != SC_LOCAL)
+          return;
+      }
+    }
+  }
   if (!stblk)
     stblk = get_stblk_uplevel_sptr();
 
@@ -9549,16 +9554,23 @@ set_parref_flag2(int sptr, int psptr, int std)
 {
   int i, stblk, paramct, parsyms, ast, key;
   LLUplevel *up;
-  if (SCG(sptr) && SCG(sptr) == SC_CMBLK)
+  if (!SCG(sptr))
     return;
-  if (SCG(sptr) && SCG(sptr) == SC_STATIC)
+  if (STYPEG(sptr) == ST_MEMBER)
     return;
-  if (DINITG(sptr) || SAVEG(sptr)) /* save variable can be threadprivate */
+  if (SCG(sptr) == SC_CMBLK || SCG(sptr) == SC_STATIC)
     return;
   if (SCG(sptr) == SC_EXTERN && ST_ISVAR(sptr)) /* No global vars in uplevel */
     return;
-  if (STYPEG(sptr) == ST_MEMBER)
-    return;
+  if (DINITG(sptr) || SAVEG(sptr)) {
+    if (SCG(sptr) != SC_LOCAL) {
+      if (SCG(sptr) == SC_BASED) {
+        int sym = MIDNUMG(sptr);
+        if (SCG(sym) != SC_LOCAL)
+          return;
+      }
+    }
+  }
   if (std) { /* use std to trace back to previous A_MP_BMPSCOPE */
     int nested = 0;
     std = STD_PREV(std);

tools/flang2/docs/xflag.n

@@ -1284,7 +1284,7 @@ only removes 2% of the operations.
 .XB 0x40000000
 Allow conditional vectorization containing reductions (experimental)
 .XB 0x80000000
-Enable LLVM vectorization containing SELECT (experimental)
+Disable LLVM vectorization containing SELECT 
 
 .XF "35:"
 Low-level vectorizer - maximum loop iteration count; 0 means

tools/flang2/flang2exe/cgmain.c

@@ -2199,7 +2199,7 @@ locset_to_tbaa_info(LL_Module *module, LL_MDRef omniPtr, int ilix)
   int bsym, rv;
   const ILI_OP opc = ILI_OPC(ilix);
   const ILTY_KIND ty = IL_TYPE(opc);
-  const int nme = (ty == ILTY_LOAD) ? ILI_OPND(ilix, 2) : ILI_OPND(ilix, 3);
+  const int nme = ILI_OPND(ilix, (ty == ILTY_LOAD) ? 2 : 3);
   const int base = basenme_of(nme);
 
   if (!base)
@@ -2213,10 +2213,11 @@ locset_to_tbaa_info(LL_Module *module, LL_MDRef omniPtr, int ilix)
     /* do nothing */
     break;
   default:
-    return LL_MDREF_ctor(LL_MDREF_kind(module->unrefPtr),
-                         LL_MDREF_value(module->unrefPtr));
+    return module->unrefPtr;
   }
 
+  if (!strncmp(SYMNAME(bsym), "reshap$r", 8))
+    return LL_MDREF_ctor(0, 0);
   if ((NME_SYM(nme) != bsym) && assumeWillAlias(nme))
     return omniPtr;
 
@@ -2295,7 +2296,7 @@ get_tbaa_metadata(LL_Module *module, int ilix, OPERAND *opnd, int isVol)
 
 cons_indirect:
   if (!myPtr)
-    return LL_MDREF_ctor(0, 0);
+    return myPtr;
 
   a[0] = a[1] = myPtr;
   a[2] = ll_get_md_i64(module, 0);
@@ -3265,6 +3266,28 @@ ll_instr_flags_for_memory_order_and_scope(int ilix)
   return flags;
 }
 
+/**
+   \brief Invalidate cached sincos intrinsics on write to input expression
+ */
+static bool
+sincos_input_uses(int ilix, int nme)
+{
+  int i;
+  const ILI_OP opc = ILI_OPC(ilix);
+  const int noprs = ilis[opc].oprs;
+  const ILTY_KIND ilty = IL_TYPE(opc);
+  if (ilty == ILTY_LOAD)
+    return (ILI_OPND(ilix, 2) == nme);
+  for (i = 1; i <= noprs; ++i) {
+    if (IL_ISLINK(opc, i)) {
+      bool isUse = sincos_input_uses(ILI_OPND(ilix, i), nme);
+      if (isUse)
+        return true;
+    }
+  }
+  return false;
+}
+
 /**
    \brief Remove all loads that correspond to a given NME
    \param key      an ILI value
@@ -3278,7 +3301,8 @@ sincos_clear_arg_helper(hash_key_t key, hash_data_t data, void *context)
   const int seek_nme = ((int *)context)[1];
   const int ilix = HKEY2INT(key);
   const int ilix_nme = ILI_OPND(ilix, 2);
-  if ((ilix == lhs_ili) || ((data == NULL) && (seek_nme == ilix_nme)))
+  if ((ilix == lhs_ili) || ((data == NULL) && (seek_nme == ilix_nme)) ||
+      sincos_input_uses(ilix, seek_nme))
     hashmap_erase(sincos_imap, key, NULL);
 }
 

tools/flang2/flang2exe/exp_ftn.c

@@ -1,5 +1,5 @@
 /*
- * Copyright (c) 2017, NVIDIA CORPORATION.  All rights reserved.
+ * Copyright (c) 1993-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.
@@ -1976,6 +1976,39 @@ add_ptr_subscript(int i, int sub, int ili1, int base, int basesym, int basenm,
   return ili1;
 }
 
+static LOGICAL
+is_currsub_dummy(int sdsc)
+{
+
+#ifdef KEEP_ARG_IN_MEM
+  return TRUE;  
+#endif
+
+  if (SCG(sdsc) != SC_DUMMY)
+    return FALSE;
+  if (!flg.smp) {
+    if (CONTAINEDG(gbl.currsub)) {
+      if (INTERNREFG(sdsc)) {
+        return FALSE;
+      }
+    }
+    return TRUE;
+  } else if (TASKDUPG(gbl.currsub))  {
+    return FALSE;
+  } else if (!gbl.outlined) {
+    if (CONTAINEDG(gbl.currsub)) {
+      if (INTERNREFG(sdsc)) {
+        return FALSE;
+      }
+    } else 
+      return TRUE;
+  } else {
+    return FALSE;
+  }
+  return TRUE;
+
+}
+
 int
 get_sdsc_element(int sdsc, int indx, int membase, int membase_nme)
 {
@@ -2035,9 +2068,8 @@ get_sdsc_element(int sdsc, int indx, int membase, int membase_nme)
     } else {
       acon = mk_address(sdsc);
       if (SCG(sdsc) == SC_DUMMY
-          && (!flg.smp || (flg.smp && is_llvm_local_private(sdsc))) &&
-          !(gbl.internal > 1 && INTERNREFG(sdsc))
-              ) {
+          && is_currsub_dummy(sdsc)
+        ) {
         int asym, anme;
         asym = mk_argasym(sdsc);
         anme = addnme(NT_VAR, asym, 0, (INT)0);