fixes for 325095 and 332112

Change-Id: I0f2c672839598f3c6de95d9ffc6ff8312fa15b97

tools/flang1/flang1exe/semant.c

@@ -1482,8 +1482,19 @@ semant1(int rednum, SST *top)
         }
         add_overload(gnr, gbl.currsub);
       }
-      if (gbl.currsub)
+      if (gbl.currsub) {
+        gbl.entries = gbl.currsub;
+	if (!sem.which_pass && sem.interface) {
+	 // fix the arguments here..
+	 int old_p_count = PARAMCTG(gbl.currsub);
+         fix_class_ptr_args(gbl.currsub);
+	 int new_p_count = PARAMCTG(gbl.currsub);
+	 if (old_p_count != new_p_count) {
+	     PDNUMP(gbl.currsub, new_p_count - old_p_count);
+	 }
+	}
         pop_subprogram();
+      }
       break;
     }
 
@@ -14699,7 +14710,7 @@ _do_iface(int iface_state, int i)
   }
   if (proc) {
     DTYPEP(proc, DTYPEG(iface));
-    PARAMCTP(proc, paramct);
+    PARAMCTP(proc, paramct-PDNUMG(iface));
     DPDSCP(proc, dpdsc);
     FVALP(proc, fval);
     PUREP(proc, PUREG(iface));

tools/flang1/flang1exe/semant.h

@@ -1590,6 +1590,7 @@ void semfin(void);
 void ipa_semfin(void);
 void semfin_free_memory(void);
 void fix_class_args(int sptr);
+void fix_class_ptr_args(int sptr);
 void llvm_fix_args(int sptr, LOGICAL is_func);
 void do_equiv(void);
 void init_derived_type(SPTR, int, int);

tools/flang1/flang1exe/semfin.c

@@ -275,7 +275,7 @@ add_class_arg_descr_arg(int func_sptr, int arg_sptr, int new_arg_position)
       int descr_sptr = sym_get_arg_sec(arg_sptr);
       SDSCP(arg_sptr, descr_sptr);
       CCSYMP(descr_sptr, TRUE);
-    }
+    }	
   }
   return FALSE;
 }
@@ -1040,6 +1040,24 @@ fix_class_args(int func_sptr)
   }
 }
 
+void
+fix_class_ptr_args(int func_sptr)
+{
+  if (!have_class_args_been_fixed_already(func_sptr)) {
+    /* type descriptors have not yet been added, so now we add them */
+    int orig_count = PARAMCTG(func_sptr);
+    int new_arg_position = orig_count;
+    int j;
+    for (j = 0; j < orig_count; ++j) {
+      int arg_sptr = aux.dpdsc_base[DPDSCG(func_sptr) + j];
+      if (POINTERG(arg_sptr) && SDSCG(arg_sptr)) {
+       inject_arg(func_sptr, SDSCG(arg_sptr), new_arg_position);
+        ++new_arg_position;
+      }
+    }
+  }
+}
+
 static void
 fix_args(int sptr, LOGICAL is_func)
 {

tools/flang1/flang1exe/semfunc2.c

@@ -2140,7 +2140,7 @@ compat_arg_lists(int formal, int actual)
   if (fdscptr == 0 || adscptr == 0 || (flags & DEFER_IFACE_CHK)) {
     return TRUE; /* No dummy parameter descriptor; can't check. */
   }
-  paramct = PARAMCTG(formal);
+  paramct = PARAMCTG(formal) - PDNUMG(formal);
   if (PARAMCTG(actual) != paramct)
     return FALSE;
   for (i = 0; i < paramct; i++, fdscptr++, adscptr++) {

tools/flang1/flang1exe/symtab.c

@@ -2759,6 +2759,7 @@ cmp_interfaces_strict(SPTR sym1, SPTR sym2, cmp_interface_flags flag)
     }
   }
   paramct -= j;
+  if (PDNUMG(sym1)) paramct-=PDNUMG(sym1);
 
   for (j = i = 0; i < paramct2; ++i) {
     psptr2 = aux.dpdsc_base[dpdsc2 + i];
@@ -2767,6 +2768,7 @@ cmp_interfaces_strict(SPTR sym1, SPTR sym2, cmp_interface_flags flag)
     }
   }
   paramct2 -= j;
+  if (PDNUMG(sym2)) paramct2-=PDNUMG(sym2);
 
   if (flg.std != F2008 &&  // AOCC. For f2008, pure attrbute is not considered
       PUREG(sym1) != PUREG(sym2) || IMPUREG(sym1) != IMPUREG(sym2)) {

tools/flang2/flang2exe/tgtutil.cpp

@@ -75,6 +75,7 @@ int dataregion = 0;
 
 static DTYPE tgt_offload_entry_type = DT_NONE;
 extern int HasRequiresUnifiedSharedMemory;
+int mk_ompaccel_load(int ili, DTYPE dtype, int nme);
 
 /* Flags for use with the entry */
 #define DT_VOID_NONE DT_NONE
@@ -565,6 +566,11 @@ tgt_target_fill_params(SPTR arg_base_sptr, SPTR arg_size_sptr, SPTR args_sptr,
       if (TY_ISSCALAR(DTY(param_dtype)) && (targetinfo->symbols[i].map_type & OMP_TGT_MAPTYPE_IMPLICIT) || isMidnum) {
         iliy = mk_ompaccel_ldsptr(param_sptr);
         load_dtype = param_dtype;
+        if (isMidnum && 
+            SDSCG(midnum_sym.host_sym) && ALLOCATTRG(param_sptr) && 
+            SCG(param_sptr) == SC_DUMMY) {
+           iliy = mk_ompaccel_load(iliy, DT_ADDR, addnme(NT_VAR, param_sptr, 0, 0));
+        }
       // AOCC Begin
       } else if (targetinfo->symbols[i].ili_sptr && AD_SDSC(ad)
                                                  && AD_ZBASE(ad)) {
@@ -603,10 +609,18 @@ tgt_target_fill_params(SPTR arg_base_sptr, SPTR arg_size_sptr, SPTR args_sptr,
           if (numdim == 0 ) useMidnum = false;
         }
       }
-      if(isMidnum && useMidnum )
-        ilix = _tgt_target_fill_size(midnum_sym.host_sym,
+      if(isMidnum && useMidnum ) {
+        if (SDSCG(midnum_sym.host_sym) && ALLOCATTRG(param_sptr) && SCG(param_sptr) == SC_DUMMY) {
+            SPTR sptr = midnum_sym.host_sym;
+            int nme = addnme(NT_VAR, sptr, 0, 0);
+            SPTR sdsc = SDSCG(sptr);
+            ilix=ad3ili(IL_LD, ad_acon(sdsc, 48), nme, MSZ_WORD);
+            ilix = mk_ompaccel_mul(ilix, DT_INT8, ad_kconi(size_of(param_dtype)), DT_INT8);
+        } else
+         ilix = _tgt_target_fill_size(midnum_sym.host_sym,
                                      targetinfo->symbols[i].map_type,
                                      targetinfo->symbols[i].ili_base); // AOCC
+      }
       else
         ilix = _tgt_target_fill_size(param_sptr,
                                      targetinfo->symbols[i].map_type,