From bd2d4baa2116b6e1bcc9846c664c459282f6431b Mon Sep 17 00:00:00 2001 From: Liuyunlong Date: Tue, 5 Sep 2023 20:32:36 +0800 Subject: [PATCH] [DebugInfo] Fix bug in multi-entry procedures When the compiler generates debuginfo for a procedure, it does not consider that if is an ENTRY statement, the number of arguments will increase by one. We can fix this problem by using the new number of arguments as returned by the process_ll_abi_func_ftn_mod function. --- test/debug_info/entry_argument_1.f90 | 20 ++++++++++++++++++++ tools/flang2/flang2exe/cgmain.cpp | 22 ++++++++++++++++++---- tools/flang2/flang2exe/cgmain.h | 2 ++ tools/flang2/flang2exe/lldebug.cpp | 24 ++++++++++++++++++++---- 4 files changed, 60 insertions(+), 8 deletions(-) create mode 100644 test/debug_info/entry_argument_1.f90 diff --git a/test/debug_info/entry_argument_1.f90 b/test/debug_info/entry_argument_1.f90 new file mode 100644 index 00000000000..d79be85878e --- /dev/null +++ b/test/debug_info/entry_argument_1.f90 @@ -0,0 +1,20 @@ +!RUN: %flang -g -S -emit-llvm %s -o - | FileCheck %s + +!CHECK: [[N1:![0-9]+]] = distinct !DISubprogram +!CHECK: !DILocalVariable(arg: 1, scope: [[N1]] +!CHECK: !DILocalVariable(arg: 2, scope: [[N1]] +!CHECK: !DILocalVariable(name: "a", arg: 3, scope: [[N1]] + +module test +contains + subroutine sub(a) + implicit none + integer(kind = 4) :: m + real(kind = 8), intent(inout) :: a(:,:) + m = size(a, 1) + entry subsub(a) + m = size(a, 1) + 1 + entry subsub1(a) + m = size(a, 1) + 2 + end subroutine sub +end module diff --git a/tools/flang2/flang2exe/cgmain.cpp b/tools/flang2/flang2exe/cgmain.cpp index 28bc756614a..41858b5dadb 100644 --- a/tools/flang2/flang2exe/cgmain.cpp +++ b/tools/flang2/flang2exe/cgmain.cpp @@ -275,6 +275,7 @@ typedef struct ComplexResultList_t { unsigned entries; } ComplexResultList_t; static ComplexResultList_t complexResultList; +LL_ABI_Info *entry_abi; /* --- static prototypes (exported prototypes belong in cgllvm.h) --- */ @@ -1613,11 +1614,12 @@ schedule(void) /* Build up the additional items/dummys needed for the master sptr if there are entries, and call process_formal_arguments on that information. */ - if (has_multiple_entries(gbl.currsub) && get_entries_argnum()) - process_formal_arguments( - process_ll_abi_func_ftn_mod(current_module, get_master_sptr(), 1)); - else + if (has_multiple_entries(gbl.currsub) && get_entries_argnum()) { + entry_abi = process_ll_abi_func_ftn_mod(current_module, get_master_sptr(), 1); + process_formal_arguments(entry_abi); + } else { process_formal_arguments(llvm_info.abi_info); + } made_return = false; get_local_overlap_size(); @@ -14568,3 +14570,15 @@ get_parnum(SPTR sptr) return 0; } + +int +get_entry_parnum(SPTR sptr) +{ + for (unsigned parnum = 1; parnum <= entry_abi->nargs; parnum++) { + if (entry_abi->arg[parnum].sptr == sptr) { + return parnum; + } + } + + return 0; +} diff --git a/tools/flang2/flang2exe/cgmain.h b/tools/flang2/flang2exe/cgmain.h index fbdd824bc27..fe1b51dee60 100644 --- a/tools/flang2/flang2exe/cgmain.h +++ b/tools/flang2/flang2exe/cgmain.h @@ -303,4 +303,6 @@ void insert_llvm_dbg_value(OPERAND *load, LL_MDRef mdnode, SPTR sptr, bool pointer_scalar_need_debug_info(SPTR sptr); int get_parnum(SPTR sptr); + +int get_entry_parnum(SPTR sptr); #endif diff --git a/tools/flang2/flang2exe/lldebug.cpp b/tools/flang2/flang2exe/lldebug.cpp index 26e452a3301..eaac164a791 100644 --- a/tools/flang2/flang2exe/lldebug.cpp +++ b/tools/flang2/flang2exe/lldebug.cpp @@ -3253,10 +3253,15 @@ lldbg_emit_type(LL_DebugInfo *db, DTYPE dtype, SPTR sptr, int findex, if (SCG(data_sptr) == SC_DUMMY) { LL_MDRef type_mdnode = lldbg_emit_type( db, __POINT_T, data_sptr, findex, false, false, false); + int parnum_lldbg = 0; + if (has_multiple_entries(gbl.currsub)) + parnum_lldbg = get_entry_parnum(data_sptr); + else + parnum_lldbg = get_parnum(data_sptr); dataloc = lldbg_create_local_variable_mdnode( db, DW_TAG_arg_variable, db->cur_subprogram_mdnode, NULL, file_mdnode, db->cur_subprogram_lineno, - get_parnum(data_sptr), type_mdnode, + parnum_lldbg, type_mdnode, set_dilocalvariable_flags(data_sptr), ll_get_md_null()); lldbg_register_param_mdnode(db, dataloc, data_sptr); @@ -3317,10 +3322,15 @@ lldbg_emit_type(LL_DebugInfo *db, DTYPE dtype, SPTR sptr, int findex, if (SCG(datasptr) == SC_DUMMY) { LL_MDRef type_mdnode = lldbg_emit_type( db, __POINT_T, datasptr, findex, false, false, false); + int parnum_lldbg = 0; + if (has_multiple_entries(gbl.currsub)) + parnum_lldbg = get_entry_parnum(data_sptr); + else + parnum_lldbg = get_parnum(data_sptr); dataloc = lldbg_create_local_variable_mdnode( db, DW_TAG_arg_variable, db->cur_subprogram_mdnode, NULL, file_mdnode, db->cur_subprogram_lineno, - get_parnum(sptr), type_mdnode, + parnum_lldbg, type_mdnode, set_dilocalvariable_flags(datasptr), ll_get_md_null()); lldbg_register_param_mdnode(db, dataloc, datasptr); } else @@ -3975,12 +3985,18 @@ lldbg_emit_param_variable(LL_DebugInfo *db, SPTR sptr, int findex, int parnum, if ((ASSUMRANKG(sptr) || ASSUMSHPG(sptr)) && SDSCG(sptr)) { type_mdnode = lldbg_emit_type(db, dtype, SDSCG(sptr), findex, is_reference, true, false, sptr); - parnum = get_parnum(SDSCG(sptr)); + if (has_multiple_entries(gbl.currsub)) + parnum = get_entry_parnum(SDSCG(sptr)); + else + parnum = get_parnum(SDSCG(sptr)); } else if (STYPEG(sptr) == ST_ARRAY && (ALLOCATTRG(sptr) || POINTERG(sptr)) && SDSCG(sptr)) { type_mdnode = lldbg_emit_type(db, dtype, sptr, findex, is_reference, true, false, MIDNUMG(sptr)); - parnum = get_parnum(SDSCG(sptr)); + if (has_multiple_entries(gbl.currsub)) + parnum = get_entry_parnum(SDSCG(sptr)); + else + parnum = get_parnum(SDSCG(sptr)); } else { type_mdnode = lldbg_emit_type(db, dtype, sptr, findex, is_reference, true, false);