Merge pull request #820 from ThePortlandGroup/nv_stage

Pull 2019-10-25T18-58 Recent NVIDIA Changes

Author: sscalpone

test/f90_correct/inc/fs11.mk

@@ -18,13 +18,9 @@
 
 # Determine call instruction used
 INSN=call
-LLFLAG=
 OPT=
 ifeq ($(findstring aarch64, $(UNAME)), aarch64)
     INSN=bl
-ifeq ($(findstring O0, $(OPT)), O0)
-    LLFLAG=-Mkeepll
-endif
 endif
 ifeq ($(findstring ppc64le, $(UNAME)), ppc64le)
     INSN=bl
@@ -36,34 +32,23 @@ build:  $(SRC)/fs11.f90
 	-$(RM) fs11.$(EXESUFFIX) core *.d *.mod FOR*.DAT FTN* ftn* fort.*
 	@echo ------------------------------------ building test $@
 	-$(CC) -c $(CFLAGS) $(SRC)/check.c -o check.$(OBJX)
-	-$(FC) $(FFLAGS) $(LLFLAG) $(LDFLAGS) $(SRC)/fs11.f90 -S
-	-$(FC) -c $(FFLAGS) $(LDFLAGS) $(SRC)/fs11.f90 -o fs11.$(OBJX)
+	-$(FC) -c $(FFLAGS) $(LDFLAGS) $(SRC)/fs11.f90 -o fs11.$(OBJX) -Minfo > fs11.txt 2>&1
 	-$(FC) $(FFLAGS) $(LDFLAGS) fs11.$(OBJX) check.$(OBJX) $(LIBS) -o fs11.$(EXESUFFIX)
 
 # rank2 should not be inlined (except with -Minline=reshape).
 # Verify that by checking for exactly 3 calls to mmul.
-# This check isn't valid for flang because it allows LLVM to inline.
+# Due to the complexity of counting specific function calls in assembly
+# or .ll files, we are now checking -Minfo messages about whether rank2 is
+# being inlined.
 run:
 	@echo ------------------------------------ executing test fs11
-ifeq ($(LLFLAG), -Mkeepll)
-	@mmul_calls=`grep -c 'void (.*)\*.*mmul' fs11.ll`; \
-	if [ $$mmul_calls -ne 3 ]; then \
-	  echo "RESULT: FAIL - expected exactly 3 calls to mmul, got $$mmul_calls in fs11.ll" ; \
+	@mmul_calls=`grep -c 'rank2.*inlined' fs11.txt`; \
+	if [ $$mmul_calls -ne 0 ]; then \
+	  echo "RESULT: FAIL" ; \
 	  exit 1; \
 	else \
-	  echo "RESULT: PASS - got exactly 3 calls to mmul in fs11.ll" ; \
-	fi
-else
-ifneq ($(FC), flang)
-	@mmul_calls=`grep -c '$(INSN).*mmul' fs11.s`; \
-	if [ $$mmul_calls -ne 3 ]; then \
-	    echo "RESULT: FAIL - expected exactly 3 calls to mmul, got $$mmul_calls in fs11.s" ; \
-	    exit 1; \
-	else \
-	  echo "RESULT: PASS - got exactly 3 calls to mmul in fs11.s" ; \
+	  echo "RESULT: PASS" ; \
 	fi
-endif
-endif
 	fs11.$(EXESUFFIX)
 
 verify: ;

test/f90_correct/inc/fs12.mk

@@ -1,5 +1,5 @@
 #
-# Copyright (c) 2015-2018, NVIDIA CORPORATION.  All rights reserved.
+# Copyright (c) 2015-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.
@@ -31,22 +31,23 @@ build:  $(SRC)/fs12.f90
 	-$(RM) fs12.$(EXESUFFIX) core *.d *.mod FOR*.DAT FTN* ftn* fort.*
 	@echo ------------------------------------ building test $@
 	-$(CC) -c $(CFLAGS) $(SRC)/check.c -o check.$(OBJX)
-	-$(FC) $(FFLAGS) $(LDFLAGS) $(SRC)/fs12.f90 -S 
-	-$(FC) -c $(FFLAGS) $(LDFLAGS) $(SRC)/fs12.f90 -o fs12.$(OBJX)
+	-$(FC) -c $(FFLAGS) $(LDFLAGS) $(SRC)/fs12.f90 -o fs12.$(OBJX) -Minfo > fs12.txt 2>&1
 	-$(FC) $(FFLAGS) $(LDFLAGS) fs12.$(OBJX) check.$(OBJX) $(LIBS) -o fs12.$(EXESUFFIX)
 
 # contig_cpy should not be inlined (except with -Minline=reshape).
 # Verify that by checking for exactly 3 calls to f90_mcopy.
-# This check isn't valid for flang because it allows LLVM to inline.
+# Due to the complexity of counting specific function calls in assembly
+# or .ll files, we are now checking -Minfo messages about whether rank2 is
+# being inlined.
 run:
 	@echo ------------------------------------ executing modified test fs12
-ifneq ($(FC), flang)
-	@mcopy_calls=`grep -ci '$(INSN).*f90_mcopy' fs12.s`; \
-	if [ $$mcopy_calls -ne 3 ]; then \
-	    echo "RESULT: FAIL - expected exactly 3 calls to f90_mcopy, got $$mcopy_calls" ; \
+	@mcopy_calls=`grep -ci 'contig_cpy.*inlined' fs12.txt`; \
+	if [ $$mcopy_calls -ne 0 ]; then \
+	    echo "RESULT: FAIL" ; \
 	    exit 1; \
+	else \
+	  echo "RESULT: PASS" ; \
 	fi
-endif
 	fs12.$(EXESUFFIX)
 
 verify: ;

tools/flang1/flang1exe/ast.c

@@ -2852,6 +2852,8 @@ replace_memsym_of_ast(int ast, SPTR sptr)
   switch (A_TYPEG(ast)) {
   case A_ID:
     return mk_id(sptr);
+  case A_FUNC:
+    return mk_func_node(A_FUNC, mk_id(sptr), A_ARGCNTG(ast), A_ARGSG(ast));
   case A_MEM:
     if (A_TYPEG(A_MEMG(ast)) == A_ID) {
       return mk_member(A_PARENTG(ast), mk_id(sptr), A_DTYPEG(ast)); 

tools/flang1/flang1exe/dinit.c

@@ -951,6 +951,10 @@ dinit_val(int sptr, int dtype, int dtypev, int astval, int op)
   if (A_ALIASG(astval))
     astval = A_ALIASG(astval);
 
+  if (is_procedure_ptr(sptr)) { 
+    /* TBD: Eventually do this for regular pointers? */
+    return astval;
+  } 
   if (POINTERG(sptr)) {
     error(457, 3, gbl.lineno, SYMNAME(sptr), CNULL);
     return 0;
@@ -1533,6 +1537,20 @@ sym_is_dinitd(int sptr)
   if (no_dinitp)
     return;
   DINITP(sptr, 1);
+  if (is_procedure_ptr(sptr)) { 
+    /* TBD: Eventually do this for regular pointers? */
+    SPTR ptr, sdsc, off;
+    ptr = MIDNUMG(sptr);
+    DINITP(MIDNUMG(sptr), 1);
+    sdsc = SDSCG(sptr);
+    if (sdsc && STYPEG(sdsc) != ST_PARAM) {
+      DINITP(sdsc, 1);
+     }
+     off = PTROFFG(sptr);
+     if (off && STYPEG(off) != ST_PARAM) {
+       DINITP(off, 1);
+     }
+  } 
   if (ST_ISVAR(STYPEG(sptr)) && SCG(sptr) == SC_CMBLK)
     /*  set DINIT flag for common block:  */
     DINITP(CMBLKG(sptr), 1);

tools/flang1/flang1exe/exterf.c

@@ -1,5 +1,5 @@
 /*
- * Copyright (c) 1997-2018, NVIDIA CORPORATION.  All rights reserved.
+ * Copyright (c) 1997-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.
@@ -1820,8 +1820,16 @@ queue_symbol(int sptr)
 
   case ST_ENTRY:
   case ST_PROC:
-    if (STYPEG(sptr) == ST_PROC && IS_PROC_DUMMYG(sptr) && SDSCG(sptr)){
-      queue_symbol(SDSCG(sptr));
+    if (STYPEG(sptr) == ST_PROC) {
+      if (ASSOC_PTRG(sptr) > NOSYM) {
+        queue_symbol(ASSOC_PTRG(sptr));
+      }
+      if (PTR_TARGETG(sptr) > NOSYM) {
+        queue_symbol(PTR_TARGETG(sptr));
+      }
+      if (IS_PROC_DUMMYG(sptr) && SDSCG(sptr)){
+        queue_symbol(SDSCG(sptr));
+      }
     }
     if (FVALG(sptr)) {
       queue_symbol(FVALG(sptr));

tools/flang1/flang1exe/interf.c

@@ -5393,6 +5393,9 @@ fill_sym(SYMITEM *ps, int sptr)
   GETFIELD(w34);
   GETFIELD(w35);
   GETFIELD(w36);
+  GETFIELD(lineno);
+  GETFIELD(w39); 
+  GETFIELD(w40); 
 #undef GETFIELD
   stb.stg_base[sptr].uname = 0;
 } /* fill_sym */
@@ -5903,6 +5906,12 @@ fill_links_symbol(SYMITEM *ps, WantPrivates wantPrivates)
       ALTNAMEP(sptr, new_symbol(ALTNAMEG(sptr)));
     break;
   case ST_PROC:
+    if (ASSOC_PTRG(sptr)) {
+      ASSOC_PTRP(sptr, new_symbol(ASSOC_PTRG(sptr)));
+    }
+    if (PTR_TARGETG(sptr)) {
+      PTR_TARGETP(sptr, new_symbol(PTR_TARGETG(sptr)));
+    }
     if (IS_PROC_DUMMYG(sptr) && SDSCG(sptr)) {
       SDSCP(sptr, new_symbol(SDSCG(sptr)));
     }

tools/flang1/flang1exe/lower.h

@@ -131,9 +131,14 @@
  *                Add has_alias bit, and length and name of the alias for Fortran
  *                module variable when it is on the ONLY list of a USE statement.
  *                This is for Fortran LLVM compiler only.
+ *
+ * 19.10        -- 1.54
+ *              All of 1.53 +
+ *              pass allocptr and ptrtarget values for default initialization
+ *              of standalone pointers.
  */
 #define VersionMajor 1
-#define VersionMinor 53
+#define VersionMinor 54
 
 void lower(int);
 void lower_end_contains(void);

tools/flang1/flang1exe/lowerilm.c

@@ -6390,13 +6390,16 @@ lower_data_stmts(void)
         int sptr = A_SPTRG(ivl->u.varref.ptr);
         if (!XBIT(7, 0x100000) && !DINITG(sptr))
           continue;
+
         /*
-         * DO NOT emit dinit info for POINTERs -- delete as part of
+         * Emit dinit info for procedure pointers.
+         *
+         * DO NOT emit dinit info for regular POINTERs -- delete as part of
          * the fix to place init'd pointers in the STATIC# container
          * (data section)
          */
-        if (SCG(sptr) == SC_BASED ||
-            (SCG(sptr) == SC_CMBLK && POINTERG(sptr))) {
+        if (!is_procedure_ptr(sptr) && (SCG(sptr) == SC_BASED ||
+            (SCG(sptr) == SC_CMBLK && POINTERG(sptr)))) {
           continue;
         }
       }

tools/flang1/flang1exe/lowersym.c

@@ -1184,7 +1184,11 @@ lower_pointer_init(void)
             /* 64-bit pointers */
           } else {
           }
-          rilm = lower_null();
+          if (!PTR_TARGETG(sptr)) {
+            rilm = lower_null();
+          } else {
+            rilm = plower("oS", "BASE", PTR_TARGETG(sptr));
+          }
           if (!XBIT(49, 0x20000000)) {
             plower("oii", "PST", lilm, rilm);
           } else if (XBIT(49, 0x100)) {
@@ -4034,8 +4038,11 @@ lower_symbol(int sptr)
        * emit this bit only if emitting ST_MODULE as ST_PROC
        * this conversion happens in putstype()
        */
-      if (sptr != gbl.currsub)
+      if (sptr != gbl.currsub) {
         putbit("is_interface", IS_INTERFACEG(sptr));
+        putval("assocptr", ASSOC_PTRG(sptr));
+        putval("ptrtarget",PTR_TARGETG(sptr));
+      }
 
       strip = 1;
     }
@@ -4262,6 +4269,8 @@ lower_symbol(int sptr)
 #else
     putbit("tpalloc", 0);
 #endif
+    putval("assocptr", ASSOC_PTRG(sptr));
+    putval("ptrtarget", PTR_TARGETG(sptr));
     strip = 1;
     break;
 
@@ -4309,6 +4318,8 @@ lower_symbol(int sptr)
     putbit("has_opts", 0);
     putbit("parref", 0);
     putbit("is_interface", 0);
+    putval("assocptr", 0);
+    putval("ptrtarget", 0);
     strip = 1;
     break;
 
@@ -4508,6 +4519,8 @@ lower_symbol(int sptr)
     putbit("is_interface", IS_INTERFACEG(sptr));
     if (SCG(sptr) == SC_DUMMY)
       putval("descriptor", IS_PROC_DUMMYG(sptr) ? SDSCG(sptr) : 0);
+    putsym("assocptr", ASSOC_PTRG(sptr));
+    putsym("ptrtarget", PTR_TARGETG(sptr));
     if (gbl.stbfil && DTY(DTYPEG(sptr) + 2)) {
       if (fvalfirst) {
         putsym(NULL, FVALG(sptr));
@@ -4741,6 +4754,18 @@ lower_symbols(void)
     if (VISITG(sptr) && STYPEG(sptr) == ST_TYPEDEF && BASETYPEG(sptr)) {
       lower_put_datatype_stb(BASETYPEG(sptr));
     }
+    if (VISITG(sptr) && STYPEG(sptr) == ST_PROC) {
+      SPTR sym = ASSOC_PTRG(sptr);
+      if (sym > NOSYM && !VISITG(sym)) {
+        lower_symbol(sym);
+        VISITP(sym, 1);
+      }
+      sym = PTR_TARGETG(sptr);
+      if (sym > NOSYM && !VISITG(sym)) {
+        lower_symbol(sym);
+        VISITP(sym, 1);
+      }
+    }
     if (VISITG(sptr) && is_procedure_ptr(sptr)) {
       /* make sure we lower type and subtype of procedure ptr */
       int dtype = DTYPEG(sptr);