[DebugInfo] Avoid data location of assumed shape array being optimize…

…d away

Base address of assumed shape array is marked as 'dataLocation' field of
array type, this is an artifical variable earlier mentioned as DW_TAG_variable.
With below options this artificial variable is optimized out.
%flang -g -S -emit-llvm test/debug_info/assumed_shape_noopt.f90
%llc -O0 -fast-isel=false -global-isel=false -filetype=obj assumed_shape_noopt.ll
Marking this variable as DW_TAG_formal_parameter is a right thing to do and also
avoids optimization.

test/debug_info/allocatable_arr_param.f90

@@ -4,7 +4,8 @@
 !CHECK: call void @llvm.dbg.declare(metadata i64* %"array$p", metadata [[DLOC:![0-9]+]]
 !CHECK-NEXT: call void @llvm.dbg.declare(metadata i64* %"array$p", metadata [[ALLOCATED:![0-9]+]]
 !CHECK-NEXT: call void @llvm.dbg.declare(metadata i64* %"array$sd", metadata [[ARRAY:![0-9]+]], metadata !DIExpression())
-!CHECK: [[ARRAY]] = !DILocalVariable(name: "array", arg: 1,
+!CHECK: [[ARRAY]] = !DILocalVariable(name: "array",
+!CHECK-SAME: arg: 2,
 !CHECK-SAME: type: [[TYPE:![0-9]+]]
 !CHECK: [[TYPE]] = !DICompositeType(tag: DW_TAG_array_type,
 !CHECK-SAME: dataLocation: [[DLOC]], allocated: [[ALLOCATED]]

test/debug_info/assumed_rank.f90

@@ -4,8 +4,9 @@
 !RUN: %flang -gdwarf-5 -S -emit-llvm %s -o - | FileCheck %s --check-prefix=DWARF5
 
 !DWARF4: call void @llvm.dbg.value(metadata i64* %ararray, metadata [[DLOC:![0-9]+]], metadata !DIExpression())
-!DWARF4: !DILocalVariable(name: "ararray",
-!DWARF4-SAME: type: [[ARTYPE:![0-9]+]]
+!DWARF4: !DILocalVariable(name: "ararray"
+!DWARF4-SAME: arg: 2
+!DWARF4-SAME: type: [[ARTYPE:![0-9]+]])
 !DWARF4: [[ARTYPE]] = !DICompositeType(tag: DW_TAG_array_type, baseType: !{{[0-9]+}}, size: {{[0-9]+}}, align: {{[0-9]+}}, elements: [[ELEMS:![0-9]+]], dataLocation: [[DLOC:![0-9]+]])
 !DWARF4: [[ELEMS]] = !{[[ELEM1:![0-9]+]], [[ELEM2:![0-9]+]], [[ELEM3:![0-9]+]], [[ELEM4:![0-9]+]], [[ELEM5:![0-9]+]], [[ELEM6:![0-9]+]], [[ELEM7:![0-9]+]]}
 !DWARF4: [[ELEM1]] = !DISubrange(lowerBound: !DIExpression(DW_OP_push_object_address, DW_OP_plus_uconst, 80, DW_OP_deref), upperBound: !DIExpression(DW_OP_push_object_address, DW_OP_plus_uconst, 120, DW_OP_deref), stride: !DIExpression(DW_OP_push_object_address, DW_OP_plus_uconst, 112, DW_OP_deref, DW_OP_push_object_address, DW_OP_plus_uconst, 24, DW_OP_deref, DW_OP_mul))
@@ -19,7 +20,8 @@
 
 !DWARF5: call void @llvm.dbg.value(metadata i64* %ararray, metadata [[DLOC:![0-9]+]], metadata !DIExpression())
 !DWARF5: !DILocalVariable(name: "ararray"
-!DWARF5-SAME: type: [[ARTYPE:![0-9]+]]
+!DWARF5-SAME: arg: 2
+!DWARF5-SAME: type: [[ARTYPE:![0-9]+]])
 !DWARF5: [[ARTYPE]] = !DICompositeType(tag: DW_TAG_array_type, baseType: !{{[0-9]+}}, size: {{[0-9]+}}, align: {{[0-9]+}}, elements: [[ELEMS:![0-9]+]], dataLocation: [[DLOC:![0-9]+]], rank: !DIExpression(DW_OP_push_object_address, DW_OP_plus_uconst, 8, DW_OP_deref, DW_OP_constu, 7, DW_OP_and))
 !DWARF5: [[ELEMS]] = !{[[ELEM1:![0-9]+]]}
 !DWARF5: [[ELEM1]] = !DIGenericSubrange(lowerBound: !DIExpression(DW_OP_push_object_address, DW_OP_over, DW_OP_constu, 48, DW_OP_mul, DW_OP_plus_uconst, 80, DW_OP_plus, DW_OP_deref), upperBound: !DIExpression(DW_OP_push_object_address, DW_OP_over, DW_OP_constu, 48, DW_OP_mul, DW_OP_plus_uconst, 120, DW_OP_plus, DW_OP_deref), stride: !DIExpression(DW_OP_push_object_address, DW_OP_over, DW_OP_constu, 48, DW_OP_mul, DW_OP_plus_uconst, 112, DW_OP_plus, DW_OP_deref, DW_OP_push_object_address, DW_OP_plus_uconst, 24, DW_OP_deref, DW_OP_mul))

test/debug_info/assumed_shape_non_contiguous.f90

@@ -3,8 +3,9 @@
 !CHECK: call void @llvm.dbg.value(metadata i64* %array, metadata [[ARRAYDL:![0-9]+]], metadata !DIExpression())
 !CHECK: call void @llvm.dbg.declare(metadata i64* %"array$sd", metadata [[ARRAY:![0-9]+]], metadata !DIExpression())
 !CHECK-LABEL: distinct !DICompileUnit(language: DW_LANG_Fortran90,
-!CHECK: [[ARRAY]] = !DILocalVariable(name: "array",
-!CHECK-SAME: type: [[TYPE:![0-9]+]]
+!CHECK: [[ARRAY]] = !DILocalVariable(name: "array"
+!CHECK-SAME: arg: 3
+!CHECK-SAME: type: [[TYPE:![0-9]+]])
 !CHECK: [[TYPE]] = !DICompositeType(tag: DW_TAG_array_type, baseType: {{![0-9]+}}, size: 32, align: 32, elements: [[ELEM:![0-9]+]], dataLocation: [[ARRAYDL]])
 !CHECK: [[ELEM]] = !{[[ELEM1:![0-9]+]], [[ELEM2:![0-9]+]]}
 !CHECK: [[ELEM1]] = !DISubrange(lowerBound: 1, upperBound: {{![0-9]+}}, stride: !DIExpression(DW_OP_push_object_address, DW_OP_plus_uconst, 112, DW_OP_deref, DW_OP_push_object_address, DW_OP_plus_uconst, 24, DW_OP_deref, DW_OP_mul))

test/debug_info/assumed_shape_noopt.f90

@@ -0,0 +1,32 @@
+!RUN: %flang -g -S -emit-llvm %s -o - | llc -O0 -fast-isel=false -global-isel=false -filetype=obj -o %t
+!RUN: llvm-dwarfdump %t | FileCheck %s
+
+!CHECK-LABEL: DW_TAG_subprogram
+!COM: make sure DLOC's DW_AT_location is available
+!CHECK-LABEL: DW_TAG_subprogram
+  !CHECK: DW_AT_name      ("show")
+    !CHECK:[[DLOC:0x[0-9a-f]+]]: DW_TAG_formal_parameter
+      !CHECK: DW_AT_location
+    !CHECK:[[ARRAY:0x[0-9a-f]+]]: DW_TAG_formal_parameter
+      !CHECK: DW_AT_location
+      !CHECK: DW_AT_type ([[TYPE:0x[0-9a-f]+]]
+    !CHECK: [[TYPE]]: DW_TAG_array_type
+      !CHECK: DW_AT_data_location ([[DLOC]])
+
+subroutine show (array)
+  integer :: array(:,:)
+
+  print *, array
+end subroutine show
+
+program test
+  interface
+     subroutine show (array)
+       integer :: array(:,:)
+     end subroutine show
+  end interface
+
+  integer :: parray(4,4) = reshape((/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16/),(/4,4/))
+
+  call show (parray(1:2,1:2))
+end program test

test/debug_info/cray_ptr_param.f90

@@ -2,7 +2,8 @@
 
 !CHECK-LABEL: define internal void @main_callee
 !CHECK: call void @llvm.dbg.declare(metadata i64* %callee_ptr, metadata [[CALLEE_PTR:![0-9]+]]
-!CHECK: [[CALLEE_PTR]] = !DILocalVariable(name: "callee_ptr", arg: 1
+!CHECK: [[CALLEE_PTR]] = !DILocalVariable(name: "callee_ptr"
+!CHECK-SAME: arg: 1
 
 program main
   pointer (ptr, b)

test/debug_info/pointer_arr_param.f90

@@ -4,7 +4,8 @@
 !CHECK: call void @llvm.dbg.declare(metadata i64* %"array$p", metadata [[DLOC:![0-9]+]]
 !CHECK-NEXT: call void @llvm.dbg.declare(metadata i64* %"array$p", metadata [[ASSOCIATED:![0-9]+]]
 !CHECK-NEXT: call void @llvm.dbg.declare(metadata i64* %"array$sd", metadata [[ARRAY:![0-9]+]], metadata !DIExpression())
-!CHECK: [[ARRAY]] = !DILocalVariable(name: "array", arg: 1, 
+!CHECK: [[ARRAY]] = !DILocalVariable(name: "array"
+!CHECK-SAME: arg: 2
 !CHECK-SAME: type: [[TYPE:![0-9]+]]
 !CHECK: [[TYPE]] = !DICompositeType(tag: DW_TAG_array_type,
 !CHECK-SAME: dataLocation: [[DLOC]], associated: [[ASSOCIATED]]

tools/flang2/flang2exe/cgmain.cpp

@@ -12895,6 +12895,10 @@ formalsAddDebug(SPTR sptr, unsigned i, LL_Type *llType, bool mayHide)
       sptr = new_sptr;
     }
     LL_DebugInfo *db = current_module->debug_info;
+    if (ll_feature_debug_info_ver90(&cpu_llvm_module->ir) &&
+        STYPEG(sptr) == ST_ARRAY && CCSYMG(sptr) &&
+        !LL_MDREF_IS_NULL(get_param_mdnode(db, sptr)))
+      return;
     LL_MDRef param_md = lldbg_emit_param_variable(
         db, sptr, BIH_FINDEX(gbl.entbih), i, CCSYMG(sptr));
     if (!LL_MDREF_IS_NULL(param_md)) {
@@ -13963,3 +13967,15 @@ is_vector_x86_mmx(LL_Type *type) {
   }
   return false;
 }
+
+int
+get_parnum(SPTR sptr)
+{
+  for (int parnum = 1; parnum <= llvm_info.abi_info->nargs; parnum++) {
+    if (llvm_info.abi_info->arg[parnum].sptr == sptr) {
+      return parnum;
+    }
+  }
+
+  return 0;
+}

tools/flang2/flang2exe/cgmain.h

@@ -296,4 +296,5 @@ void insert_llvm_dbg_value(OPERAND *load, LL_MDRef mdnode, SPTR sptr,
                            LL_Type *type);
 
 
+int get_parnum(SPTR sptr);
 #endif

tools/flang2/flang2exe/lldebug.cpp

@@ -193,6 +193,9 @@ static void lldbg_get_bounds_for_sdsc(LL_DebugInfo *db, int findex, SPTR sptr,
 static void lldbg_get_bounds_for_assumed_rank_sdsc(
     LL_DebugInfo *db, SPTR sptr, LL_MDRef *lbnd_expr_mdnode,
     LL_MDRef *ubnd_expr_mdnode, LL_MDRef *stride_expr_mdnode);
+static void lldbg_register_param_mdnode(LL_DebugInfo *db, LL_MDRef mdnode,
+                                        int sptr);
+INLINE static int set_dilocalvariable_flags(int sptr);
 /* ---------------------------------------------------------------------- */
 
 void
@@ -3000,7 +3003,19 @@ lldbg_emit_type(LL_DebugInfo *db, DTYPE dtype, SPTR sptr, int findex,
                 dataloctype = make_lltype_from_sptr(data_sptr);
               if (dataloctype->data_type == LL_PTR)
                 dataloctype = dataloctype->sub_types[0];
-              dataloc = lldbg_emit_local_variable(db, data_sptr, findex, true);
+              if (SCG(data_sptr) == SC_DUMMY) {
+                LL_MDRef type_mdnode = lldbg_emit_type(
+                    db, __POINT_T, data_sptr, findex, false, false, false);
+                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,
+                    set_dilocalvariable_flags(data_sptr), ll_get_md_null());
+                lldbg_register_param_mdnode(db, dataloc, data_sptr);
+
+              } else
+                dataloc =
+                    lldbg_emit_local_variable(db, data_sptr, findex, true);
 
               OPERAND *ld = make_operand();
               ld->ot_type = OT_MDNODE;
@@ -3039,17 +3054,21 @@ lldbg_emit_type(LL_DebugInfo *db, DTYPE dtype, SPTR sptr, int findex,
                     dataloctype = make_lltype_from_sptr(datasptr);
                   if (dataloctype->data_type == LL_PTR)
                     dataloctype = dataloctype->sub_types[0];
-                  dataloc =
-                      lldbg_emit_local_variable(db, datasptr, findex, true);
+                  if (SCG(datasptr) == SC_DUMMY) {
+                    LL_MDRef type_mdnode = lldbg_emit_type(
+                        db, __POINT_T, datasptr, findex, false, false, false);
+                    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,
+                        set_dilocalvariable_flags(datasptr), ll_get_md_null());
+                    lldbg_register_param_mdnode(db, dataloc, datasptr);
+                  } else
+                    dataloc =
+                        lldbg_emit_local_variable(db, datasptr, findex, true);
                   insert_llvm_dbg_declare(dataloc, datasptr, dataloctype, NULL,
                                           OPF_NONE);
                   if (ll_feature_debug_info_ver90(&db->module->ir)) {
-                    LL_MDRef file_mdnode;
-                    if (ll_feature_debug_info_need_file_descriptions(
-                            &db->module->ir))
-                      file_mdnode = get_filedesc_mdnode(db, findex);
-                    else
-                      file_mdnode = lldbg_emit_file(db, findex);
                     BLKINFO *blk_info = get_lexical_block_info(db, sptr, true);
                     LL_MDRef type_mdnode = lldbg_emit_type(
                         db, DT_LOG, sptr, findex, false, false, false);
@@ -3457,7 +3476,7 @@ lldbg_register_value_call(LL_DebugInfo *db, INSTR_LIST *instr, int sptr)
   db->param_idx++;
 }
 
-static LL_MDRef
+LL_MDRef
 get_param_mdnode(LL_DebugInfo *db, int sptr)
 {
   int i;
@@ -3648,9 +3667,12 @@ 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);
-    } else if (ALLOCATTRG(sptr) || POINTERG(sptr)) {
+      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));
     } else {
       type_mdnode =
           lldbg_emit_type(db, dtype, sptr, findex, is_reference, true, false);
@@ -3673,7 +3695,13 @@ lldbg_emit_param_variable(LL_DebugInfo *db, SPTR sptr, int findex, int parnum,
   var_mdnode = lldbg_create_local_variable_mdnode(
       db, DW_TAG_arg_variable, db->cur_subprogram_mdnode, symname, file_mdnode,
       db->cur_subprogram_lineno, parnum, type_mdnode, flags, ll_get_md_null());
-  lldbg_register_param_mdnode(db, var_mdnode, sptr);
+  if (ll_feature_debug_info_ver90(&db->module->ir) &&
+      ((STYPEG(sptr) == ST_ARRAY && (ALLOCATTRG(sptr) || POINTERG(sptr))) ||
+       ASSUMRANKG(sptr) || ASSUMSHPG(sptr)) &&
+      SDSCG(sptr)) {
+    lldbg_register_param_mdnode(db, var_mdnode, SDSCG(sptr));
+  } else
+    lldbg_register_param_mdnode(db, var_mdnode, sptr);
   return var_mdnode;
 }
 

tools/flang2/flang2exe/lldebug.h

@@ -275,4 +275,7 @@ void lldbg_reset_module(LL_DebugInfo *db);
 
 /// \brief Get the debug location mdnode of the current procedure.
 LL_MDRef lldbg_get_subprogram_line(LL_DebugInfo *db);
+
+/// \brief Get parameter mdnode for SPTR
+LL_MDRef get_param_mdnode(LL_DebugInfo *db, int sptr);
 #endif /* LLDEBUG_H_ */