From bf14bc7713eea1032bf24c7fb1cb0428fab6703f Mon Sep 17 00:00:00 2001 From: Ron Lieberman Date: Fri, 29 Apr 2022 15:47:52 +0000 Subject: [PATCH] fixes for 325095 and 332112 Change-Id: I0f2c672839598f3c6de95d9ffc6ff8312fa15b97 --- tools/flang1/flang1exe/semant.c | 15 +++++++++++++-- tools/flang1/flang1exe/semant.h | 1 + tools/flang1/flang1exe/semfin.c | 20 +++++++++++++++++++- tools/flang1/flang1exe/semfunc2.c | 2 +- tools/flang1/flang1exe/symtab.c | 2 ++ tools/flang2/flang2exe/tgtutil.cpp | 18 ++++++++++++++++-- 6 files changed, 52 insertions(+), 6 deletions(-) diff --git a/tools/flang1/flang1exe/semant.c b/tools/flang1/flang1exe/semant.c index cf4379c1e5..b22cd31f1e 100644 --- a/tools/flang1/flang1exe/semant.c +++ b/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)); diff --git a/tools/flang1/flang1exe/semant.h b/tools/flang1/flang1exe/semant.h index 46b43e6197..50ef5211c4 100644 --- a/tools/flang1/flang1exe/semant.h +++ b/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); diff --git a/tools/flang1/flang1exe/semfin.c b/tools/flang1/flang1exe/semfin.c index fe0ae15fc7..20e6a1cbc1 100644 --- a/tools/flang1/flang1exe/semfin.c +++ b/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) { diff --git a/tools/flang1/flang1exe/semfunc2.c b/tools/flang1/flang1exe/semfunc2.c index bb7e3bc1b0..b555e6a084 100644 --- a/tools/flang1/flang1exe/semfunc2.c +++ b/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++) { diff --git a/tools/flang1/flang1exe/symtab.c b/tools/flang1/flang1exe/symtab.c index 0046343d7e..ad7cb62500 100644 --- a/tools/flang1/flang1exe/symtab.c +++ b/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)) { diff --git a/tools/flang2/flang2exe/tgtutil.cpp b/tools/flang2/flang2exe/tgtutil.cpp index a9e9eb9249..88deee2c41 100644 --- a/tools/flang2/flang2exe/tgtutil.cpp +++ b/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,