Merge pull request #149 from ThePortlandGroup/nv_stage

Pull 2017-07-18T11-09 Recent NVIDIA Changes

Author: sscalpone

tools/flang1/flang1exe/semant.c

@@ -55,6 +55,7 @@ static void save_host(INTERF *);
 static void restore_host(INTERF *, LOGICAL);
 static void check_end_subprogram(int, int);
 static char *name_of_rutype(int);
+static void convert_intrinsics_to_idents(void);
 static int chk_intrinsic(int, LOGICAL, LOGICAL);
 static int create_func_entry(int);
 static int create_func_entry_result(int);
@@ -1447,6 +1448,7 @@ semant1(int rednum, SST *top)
               CNULL);
         goto executable_shared;
       }
+      convert_intrinsics_to_idents();
       save_host(&host_state);
       gbl.internal = 1;
       restore_host(&host_state, TRUE);
@@ -11988,6 +11990,23 @@ name_of_rutype(int rutype)
   return "";
 }
 
+/* If an intrinsic is declared in a host subprogram and not otherwise used,
+ * convert it to an identifier for the internal subprograms to share.
+ */
+static void
+convert_intrinsics_to_idents()
+{
+  SPTR sptr;
+  assert(gbl.currsub && gbl.internal == 0,
+         "only applicable for non-internal subprogram", 0, ERR_Severe);
+  for (sptr = NOSYM + 1; sptr < stb.firstusym; ++sptr) {
+    if (DCLDG(sptr) && !EXPSTG(sptr) && IS_INTRINSIC(STYPEG(sptr))) {
+      SPTR new_sptr = newsym(sptr);
+      STYPEP(new_sptr, ST_IDENT);
+    }
+  }
+}
+
 /*
  * In certain contexts, a new symbol must be created immediately
  * if the identifier is an intrinsic rather than relying on newsym().

tools/flang2/flang2exe/exp_rte.c

@@ -3013,14 +3013,14 @@ exp_call(ILM_OP opc, ILM *ilmp, int curilm)
   case IM_CDFUNCA:
     i = 4;
   share_cfunc:
+    ilm1 = ILM_OPND(ilmp, i);
+    dtype = IILM_OPND(ilm1, 2);
+    if (IILM_OPC(ilm1) == IM_FARG || IILM_OPC(ilm1) == IM_FARGF)
+      ilm1 = IILM_OPND(ilm1, 1);
+    cfunc = ILM_RESULT(ilm1);
+    cfunc_nme = NME_OF(ilm1);
     if (CFUNCG(exp_call_sym) || (funcptr_flags & FUNCPTR_BINDC) ||
         CMPLXFUNC_C) {
-      ilm1 = ILM_OPND(ilmp, i);
-      dtype = IILM_OPND(ilm1, 2);
-      if (IILM_OPC(ilm1) == IM_FARG || IILM_OPC(ilm1) == IM_FARGF)
-        ilm1 = IILM_OPND(ilm1, 1);
-      cfunc = ILM_RESULT(ilm1);
-      cfunc_nme = NME_OF(ilm1);
       ADDRTKNP(IILM_OPND(ilm1, 1), 1);
       nargs--;
       if (opc == IM_CFUNCA || opc == IM_CDFUNCA) {
@@ -3035,29 +3035,6 @@ exp_call(ILM_OP opc, ILM *ilmp, int curilm)
         garg_ili[0].dtype = dtype;
         garg_ili[0].nme = cfunc_nme;
       }
-      break;
-    }
-    if ((funcptr_flags & FUNCPTR_BINDC)) {
-      ilm1 = ILM_OPND(ilmp, 4);
-    } else {
-      ilm1 = ILM_OPND(ilmp, 3);
-    }
-    dtype = IILM_OPND(ilm1, 2);
-    if (IILM_OPC(ilm1) == IM_FARG)
-      ilm1 = IILM_OPND(ilm1, 1);
-    else if (IILM_OPC(ilm1) == IM_FARGF)
-      ilm1 = IILM_OPND(ilm1, 1);
-    cfunc = ILM_RESULT(ilm1);
-    cfunc_nme = NME_OF(ilm1);
-    if ((funcptr_flags & FUNCPTR_BINDC)) {
-      i = 4; /* ilm pointer to first arg */
-      if (XBIT(121, 0x800)) {
-        garg_ili[0].ilix = cfunc;
-        garg_ili[0].dtype = dtype;
-        garg_ili[0].nme = cfunc_nme;
-      }
-    } else {
-      i = 3; /* ilm pointer to first arg */
     }
     break;
   case IM_CHVFUNCA: