Merge pull request #520 from ThePortlandGroup/nv_stage

 Pull 2018-07-03T21-37 Recent NVIDIA Changes

Author: sscalpone

include/flang/Error/errmsg-in.n

@@ -1346,6 +1346,10 @@ This OpenMP feature is not yet implemented.
 An unlimited repetition count (*) is allowed by the Fortran 2008 standard
 only on a parenthesized list of edit descriptors that appears as the the last
 (or only) item at the top level of a FORMAT.
+.MS E 550 "Allocatable device array is not in c_f_pointer with -Mallocatable=03 - $."
+The second argument in c_f_pointer may not be an allocatable device array
+with -Mallocatable=03 semantics.  A device pointer may be used,
+or the program may be compiled with the -Mallocatable=95 compiler flag.
 .MS S 901 "#elif after #else"
 A preprocessor #elif directive was found after a #else directive; only
 #endif is allowed in this context.

runtime/flang/type.c

@@ -547,7 +547,8 @@ void ENTF90(DEALLOC_POLY03A, dealloc_poly03a)(F90_Desc *sd, __STAT_T *stat,
         continue;
       }
       if (fd) {
-        if (ld->tag == 'T' && src_td->obj.tag == __POLY) {
+        if (ld->tag == 'T' && src_td->obj.tag == __POLY
+            && (fd->tag == __DESC || fd->tag == __POLY)) {
             ENTF90(DEALLOC_POLY_MBR03A, dealloc_poly_mbr03a)
             (fd, stat, cb, firsttime, CADR(errmsg), CLEN(errmsg));
         }

tools/flang1/flang1exe/scopestack.c

@@ -251,11 +251,13 @@ push_scope_level(int sptr, SCOPEKIND kind)
   scope->Private = FALSE;
   scope->sym = 0;
   scope->uplevel_sptr = 0;
+#if DEBUG
   if (DBGBIT(5, 0x200)) {
     fprintf(gbl.dbgfil, "\n++++++++  push_scope_level(%s)  pass=%d  line=%d\n",
             kind_to_string(kind), sem.which_pass, gbl.lineno);
     dumpscope(gbl.dbgfil);
   }
+#endif
 }
 
 /** \brief Push an interface entry on the scope stack and mark it closed.
@@ -330,11 +332,13 @@ pop_scope_level(SCOPEKIND kind)
       stb.curr_scope = sem.scope_stack[1].sptr;
     }
   }
+#if DEBUG
   if (DBGBIT(5, 0x200)) {
     fprintf(gbl.dbgfil, "\n--------  pop_scope_level(%s)  pass=%d  line=%d\n",
             kind_to_string(kind), sem.which_pass, gbl.lineno);
     dumpscope(gbl.dbgfil);
   }
+#endif
 }
 
 static SCOPESTACK saved_scope_stack[1];
@@ -352,11 +356,13 @@ save_scope_level(void)
   saved_scope_stack[count_scope_saved++] = *curr_scope();
   pop_scope();
   stb.curr_scope = curr_scope()->sptr;
+#if DEBUG
   if (DBGBIT(5, 0x200)) {
     fprintf(gbl.dbgfil, "\n--------  save_scope_level  pass=%d  line=%d\n",
             sem.which_pass, gbl.lineno);
     dumpscope(gbl.dbgfil);
   }
+#endif
 }
 
 /** \brief Restore the scope that was saved by save_scope_level() */
@@ -369,11 +375,13 @@ restore_scope_level(void)
   }
   *push_scope() = saved_scope_stack[--count_scope_saved];
   stb.curr_scope = curr_scope()->sptr;
+#if DEBUG
   if (DBGBIT(5, 0x200)) {
     fprintf(gbl.dbgfil, "\n++++++++  restore_scope_level  pass=%d  line=%d\n",
             sem.which_pass, gbl.lineno);
     dumpscope(gbl.dbgfil);
   }
+#endif
 }
 
 void
@@ -405,7 +413,7 @@ par_push_scope(LOGICAL bind_to_outer)
   scope->di_par = sem.doif_depth;
   scope->shared_list = NULL;
   scope->prev_sc = prev_sc;
-  (void)enter_lexical_block(flg.debug && !XBIT(123, 0x400));
+  enter_lexical_block(flg.debug && !XBIT(123, 0x400));
 }
 
 void
@@ -452,7 +460,6 @@ pop_scope(void)
 }
 
 #if DEBUG
-
 void
 dumpscope(FILE *f)
 {

tools/flang1/flang1exe/semantio.c

@@ -1244,8 +1244,9 @@ semantio(int rednum, SST *top)
     array_io_item:
       if (DTY(dtype) == TY_ARRAY)
         dtype = DTY(dtype + 1);
-      if (!((SST_IDG(stkptr) == S_EXPR && DTYG(dtype) == TY_DERIVED))
-          && !no_data_components(dtype))
+      if (no_data_components(dtype))
+        continue;
+      if (!((SST_IDG(stkptr) == S_EXPR && DTYG(dtype) == TY_DERIVED)))
         (void)mkarg(stkptr, &dum);
       if (is_read) {
         if (SST_IDG(stkptr) == S_IDENT)

tools/flang1/flang1exe/semutil2.c

@@ -1016,7 +1016,6 @@ static LOGICAL _can_fold(int);
 static void constructf90(int, ACL *);
 static void _dinit_acl(ACL *, LOGICAL);
 
-#if DEBUG
 static int acl_array_num = 0;
 
 static char *_iexpr_op[] = {
@@ -1034,6 +1033,7 @@ iexpr_op(int op)
   return "?N?";
 }
 
+#if DEBUG
 static void
 _printacl(int in_array, ACL *aclp, FILE *f)
 {

tools/flang1/utils/symtab/symtab.in.h

@@ -431,7 +431,7 @@ int add_symitem(int, int);
 void change_predefineds(int, LOGICAL);
 
 char *getsname(int);	/* defined in assem.c */
-void sym_is_refd(int);	/* defined in assem.c */
+void sym_is_refd(SPTR);	/* defined in assem.c */
 
 void iso_c_lib_stat(int *, int *, int);
 int get_ieee_arith_intrin(char *);

tools/flang2/flang2exe/assem.h

@@ -27,9 +27,9 @@
 
 extern char *comment_char;
 
-char *getsname(int);
+char *getsname(SPTR);
 char *getsname2(int);
-void sym_is_refd(int);
+void sym_is_refd(SPTR);
 
 extern void assem_init(void);
 /*  called when processing of user function is begun by the CG */

tools/flang2/flang2exe/cgllvm.h

@@ -110,7 +110,6 @@ typedef enum {
 extern char **sptr_array;
 extern LL_Type **sptr_type_array;
 
-char *get_llvm_name(int sptr);		/* see llassem*.c */
 char *get_llvm_sname(int sptr);
 char *get_llvm_mips_sname(int sptr);
 

tools/flang2/flang2exe/dinit.c

@@ -372,7 +372,7 @@ dinit_data(VAR *ivl, CONST *ict, DTYPE dtype, ISZ_T base_off)
 /* Too many initializer is allowed.
 if (ict)   errsev(67);
  */
-error_exit:
+ error_exit:;
 #if DEBUG
   if (ivl && DBGBIT(6, 2) && ilmb.ilmavl != BOS_SIZE) {
     /* dump ilms afterwards because dmpilms overwrites opcodes */

tools/flang2/flang2exe/expand.c

@@ -1501,6 +1501,8 @@ exp_store(ILM_OP opc, ILM *ilmp, int curilm)
     case IL_AKMV:
       expr = ILI_OPND(expr, 1);
       break;
+    default:
+      break;
     }
     if (IL_RES(ILI_OPC(expr)) != ILIA_AR) {
       expr = ad1ili(IL_KAMV, expr);