From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wr1-x42f.google.com (mail-wr1-x42f.google.com [IPv6:2a00:1450:4864:20::42f]) by sourceware.org (Postfix) with ESMTPS id D1AD23953CF3 for ; Sat, 19 Sep 2020 08:54:00 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org D1AD23953CF3 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=embecosm.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=andrew.burgess@embecosm.com Received: by mail-wr1-x42f.google.com with SMTP id x14so7806424wrl.12 for ; Sat, 19 Sep 2020 01:54:00 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=embecosm.com; s=google; h=date:from:to:subject:message-id:references:mime-version :content-disposition:in-reply-to; bh=Wpfz6oJ6AjPc3vrxahO3OoQiJqC9MztwtgK5oOAaZWk=; b=gob0iTw3xePpc1WJAsLzvdMmJ6sLJPbN/zDvy5rf4TKakezE19jCWdpC+0hoNEQ1// /+Etma6JADLUUNzqvkEP71lMkRKoP7mmNWfadOJcm+DxSa888ylh4ogov3mnFiHmqMzG lbxr8cHuA9YA6Ec8+0XkxRb9HPyKFOqlkNyzB3sIi+gIwDv/csK8nJZTDzacWNYHMTMj QIg3H7G62Y74iUHASllJl0pOFsRHljULqEyxUqcfKMu/1hqHhVCEMo8aFEB09WmBDTb0 sUWYmkj7uDI4g1BzYIn8A0oW/Empznd0i26JkF+Sgx4HYgRMfDsMzxXBflMxqhUiCQ/E 6pvQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:date:from:to:subject:message-id:references :mime-version:content-disposition:in-reply-to; bh=Wpfz6oJ6AjPc3vrxahO3OoQiJqC9MztwtgK5oOAaZWk=; b=Q4Hc+fe1CTjOPP0cJzKIZb1B9w0mS0lJ9iUdbE6h3PxKVHfSanElay2MmubTKBJXo7 AEuf8R+2TsYFf1N7qZLghaQtP1KPI0+Mi6vbywwRc83iQ+vahjvx30gl1vozpJvR2XQM geCrHZ+VoCx8sK5QnFh4qjJdzBwAzhSfSHBLD2QnEw86vC6QsC+Btx4Ir35o9X33wTp5 UG8ul5DgLMM5+LWIjhooP0xw2wonGzgd6+aECMI24U635sM1QARaeFBn8ybHCWyjfZY+ V0FrXOV7sqIjlR8Dl8zsMiEQwKjqTD/0vKWqdKoeZJELEkhJYZv3r3YvNDkmdfpxPTFf C6Rw== X-Gm-Message-State: AOAM530VjTKfL5XMLUsv8rH4HO74OBuAraE2ZQvPOcS98m8m9Lny/D2N 0tcEZPwOc3PQ0ZNt7EL0gk/KvsI2w4nLeQ== X-Google-Smtp-Source: ABdhPJxotxBEs0uQgcE3Jv6+Jl0LHBqiXs1mqAFqZSdeZ8eVG2EfeE7iw/Kt/J9Km68BBOQe9N8h0Q== X-Received: by 2002:adf:e488:: with SMTP id i8mr44533896wrm.116.1600505639088; Sat, 19 Sep 2020 01:53:59 -0700 (PDT) Received: from localhost (host31-53-80-104.range31-53.btcentralplus.com. [31.53.80.104]) by smtp.gmail.com with ESMTPSA id k15sm10377201wrv.90.2020.09.19.01.53.58 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sat, 19 Sep 2020 01:53:58 -0700 (PDT) Date: Sat, 19 Sep 2020 09:53:57 +0100 From: Andrew Burgess To: gdb-patches@sourceware.org Subject: Re: [PATCHv2 06/10] gdb/fortran: Move Fortran expression handling into f-lang.c Message-ID: <20200919085357.GE1540618@embecosm.com> References: <073938fe92bc32bf945322b6043a6b2c6e42651c.1598452395.git.andrew.burgess@embecosm.com> MIME-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline In-Reply-To: <073938fe92bc32bf945322b6043a6b2c6e42651c.1598452395.git.andrew.burgess@embecosm.com> X-Operating-System: Linux/5.8.9-101.fc31.x86_64 (x86_64) X-Uptime: 09:53:40 up 17:01, 1 user, X-Editor: GNU Emacs [ http://www.gnu.org/software/emacs ] X-Spam-Status: No, score=-10.0 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gdb-patches@sourceware.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gdb-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Sat, 19 Sep 2020 08:54:04 -0000 * Andrew Burgess [2020-08-26 15:49:13 +0100]: > The Fortran specific OP_F77_UNDETERMINED_ARGLIST is currently handled > in the generic expression handling code. As I start to add array > stride support in here the amount of Fortran only code that is forced > into the generic expression evaluation file will grow. > > Now seems like a good time to move this Fortran specific operation > into the Fortran specific files. > > There should be no user visible changes after this commit. > > gdb/ChangeLog: > > * eval.c: Remove 'f-lang.h' include. > (value_f90_subarray): Moved to f-lang.c. > (eval_call): Renamed to... > (evaluate_subexp_do_call): ...this, is no longer static, header > comment moved into header file. > (evaluate_funcall): Update call to eval_call. > (skip_undetermined_arglist): Moved to f-lang.c. > (fortran_value_subarray): Likewise. > (evaluate_subexp_standard): OP_F77_UNDETERMINED_ARGLIST handling > moved to evaluate_subexp_f. > (calc_f77_array_dims): Moved to f-lang.c > * expprint.c (print_subexp_funcall): New function. > (print_subexp_standard): OP_F77_UNDETERMINED_ARGLIST handling > moved to print_subexp_f, OP_FUNCALL uses new function. > (dump_subexp_body_funcall): New function. > (dump_subexp_body_standard): OP_F77_UNDETERMINED_ARGLIST handling > moved to dump_subexp_f, OP_FUNCALL uses new function. > * expression.h (evaluate_subexp_do_call): Declare. > * f-lang.c (value_f90_subarray): Moved from eval.c. > (skip_undetermined_arglist): Likewise. > (calc_f77_array_dims): Likewise. > (fortran_value_subarray): Likewise. > (evaluate_subexp_f): Add OP_F77_UNDETERMINED_ARGLIST support. > (operator_length_f): Likewise. > (print_subexp_f): Likewise. > (dump_subexp_body_f): Likewise. > * fortran-operator.def (OP_F77_UNDETERMINED_ARGLIST): Move > declaration of this operation to here. > * parse.c (operator_length_standard): OP_F77_UNDETERMINED_ARGLIST > support moved to operator_length_f. > * parser-defs.h (dump_subexp_body_funcall): Declare. > (print_subexp_funcall): Declare. > * std-operator.def (OP_F77_UNDETERMINED_ARGLIST): Moved to > fortran-operator.def. I pushed this patch with a slightly modified commit message. Thanks, Andrew > --- > gdb/ChangeLog | 37 +++++++ > gdb/eval.c | 223 ++------------------------------------- > gdb/expprint.c | 61 ++++++----- > gdb/expression.h | 12 +++ > gdb/f-lang.c | 221 ++++++++++++++++++++++++++++++++++++++ > gdb/fortran-operator.def | 8 ++ > gdb/parse.c | 1 - > gdb/parser-defs.h | 16 +++ > gdb/std-operator.def | 8 -- > 9 files changed, 339 insertions(+), 248 deletions(-) > > diff --git a/gdb/eval.c b/gdb/eval.c > index 660edbe34af..3ccc4148e48 100644 > --- a/gdb/eval.c > +++ b/gdb/eval.c > @@ -26,7 +26,6 @@ > #include "frame.h" > #include "gdbthread.h" > #include "language.h" /* For CAST_IS_CONVERSION. */ > -#include "f-lang.h" /* For array bound stuff. */ > #include "cp-abi.h" > #include "infcall.h" > #include "objc-lang.h" > @@ -371,32 +370,6 @@ init_array_element (struct value *array, struct value *element, > return index; > } > > -static struct value * > -value_f90_subarray (struct value *array, > - struct expression *exp, int *pos, enum noside noside) > -{ > - int pc = (*pos) + 1; > - LONGEST low_bound, high_bound; > - struct type *range = check_typedef (value_type (array)->index_type ()); > - enum range_type range_type > - = (enum range_type) longest_to_int (exp->elts[pc].longconst); > - > - *pos += 3; > - > - if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) > - low_bound = range->bounds ()->low.const_val (); > - else > - low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside)); > - > - if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) > - high_bound = range->bounds ()->high.const_val (); > - else > - high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside)); > - > - return value_slice (array, low_bound, high_bound - low_bound + 1); > -} > - > - > /* Promote value ARG1 as appropriate before performing a unary operation > on this argument. > If the result is not appropriate for any particular language then it > @@ -749,17 +722,13 @@ eval_skip_value (expression *exp) > return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1); > } > > -/* Evaluate a function call. The function to be called is in > - ARGVEC[0] and the arguments passed to the function are in > - ARGVEC[1..NARGS]. FUNCTION_NAME is the name of the function, if > - known. DEFAULT_RETURN_TYPE is used as the function's return type > - if the return type is unknown. */ > +/* See expression.h. */ > > -static value * > -eval_call (expression *exp, enum noside noside, > - int nargs, value **argvec, > - const char *function_name, > - type *default_return_type) > +value * > +evaluate_subexp_do_call (expression *exp, enum noside noside, > + int nargs, value **argvec, > + const char *function_name, > + type *default_return_type) > { > if (argvec[0] == NULL) > error (_("Cannot evaluate function -- may be inlined")); > @@ -1230,20 +1199,8 @@ evaluate_funcall (type *expect_type, expression *exp, int *pos, > /* Nothing to be done; argvec already correctly set up. */ > } > > - return eval_call (exp, noside, nargs, argvec, var_func_name, expect_type); > -} > - > -/* Helper for skipping all the arguments in an undetermined argument list. > - This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST > - case of evaluate_subexp_standard as multiple, but not all, code paths > - require a generic skip. */ > - > -static void > -skip_undetermined_arglist (int nargs, struct expression *exp, int *pos, > - enum noside noside) > -{ > - for (int i = 0; i < nargs; ++i) > - evaluate_subexp (NULL_TYPE, exp, pos, noside); > + return evaluate_subexp_do_call (exp, noside, nargs, argvec, > + var_func_name, expect_type); > } > > /* Return true if type is integral or reference to integral */ > @@ -1260,67 +1217,6 @@ is_integral_or_integral_reference (struct type *type) > && is_integral_type (TYPE_TARGET_TYPE (type))); > } > > -/* Called from evaluate_subexp_standard to perform array indexing, and > - sub-range extraction, for Fortran. As well as arrays this function > - also handles strings as they can be treated like arrays of characters. > - ARRAY is the array or string being accessed. EXP, POS, and NOSIDE are > - as for evaluate_subexp_standard, and NARGS is the number of arguments > - in this access (e.g. 'array (1,2,3)' would be NARGS 3). */ > - > -static struct value * > -fortran_value_subarray (struct value *array, struct expression *exp, > - int *pos, int nargs, enum noside noside) > -{ > - if (exp->elts[*pos].opcode == OP_RANGE) > - return value_f90_subarray (array, exp, pos, noside); > - > - if (noside == EVAL_SKIP) > - { > - skip_undetermined_arglist (nargs, exp, pos, noside); > - /* Return the dummy value with the correct type. */ > - return array; > - } > - > - LONGEST subscript_array[MAX_FORTRAN_DIMS]; > - int ndimensions = 1; > - struct type *type = check_typedef (value_type (array)); > - > - if (nargs > MAX_FORTRAN_DIMS) > - error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); > - > - ndimensions = calc_f77_array_dims (type); > - > - if (nargs != ndimensions) > - error (_("Wrong number of subscripts")); > - > - gdb_assert (nargs > 0); > - > - /* Now that we know we have a legal array subscript expression let us > - actually find out where this element exists in the array. */ > - > - /* Take array indices left to right. */ > - for (int i = 0; i < nargs; i++) > - { > - /* Evaluate each subscript; it must be a legal integer in F77. */ > - value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside); > - > - /* Fill in the subscript array. */ > - subscript_array[i] = value_as_long (arg2); > - } > - > - /* Internal type of array is arranged right to left. */ > - for (int i = nargs; i > 0; i--) > - { > - struct type *array_type = check_typedef (value_type (array)); > - LONGEST index = subscript_array[i - 1]; > - > - array = value_subscripted_rvalue (array, index, > - f77_get_lowerbound (array_type)); > - } > - > - return array; > -} > - > struct value * > evaluate_subexp_standard (struct type *expect_type, > struct expression *exp, int *pos, > @@ -1335,7 +1231,6 @@ evaluate_subexp_standard (struct type *expect_type, > struct type *type; > int nargs; > struct value **argvec; > - int code; > int ix; > long mem_offset; > struct type **arg_types; > @@ -1977,84 +1872,6 @@ evaluate_subexp_standard (struct type *expect_type, > case OP_FUNCALL: > return evaluate_funcall (expect_type, exp, pos, noside); > > - case OP_F77_UNDETERMINED_ARGLIST: > - > - /* Remember that in F77, functions, substring ops and > - array subscript operations cannot be disambiguated > - at parse time. We have made all array subscript operations, > - substring operations as well as function calls come here > - and we now have to discover what the heck this thing actually was. > - If it is a function, we process just as if we got an OP_FUNCALL. */ > - > - nargs = longest_to_int (exp->elts[pc + 1].longconst); > - (*pos) += 2; > - > - /* First determine the type code we are dealing with. */ > - arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); > - type = check_typedef (value_type (arg1)); > - code = type->code (); > - > - if (code == TYPE_CODE_PTR) > - { > - /* Fortran always passes variable to subroutines as pointer. > - So we need to look into its target type to see if it is > - array, string or function. If it is, we need to switch > - to the target value the original one points to. */ > - struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type)); > - > - if (target_type->code () == TYPE_CODE_ARRAY > - || target_type->code () == TYPE_CODE_STRING > - || target_type->code () == TYPE_CODE_FUNC) > - { > - arg1 = value_ind (arg1); > - type = check_typedef (value_type (arg1)); > - code = type->code (); > - } > - } > - > - switch (code) > - { > - case TYPE_CODE_ARRAY: > - case TYPE_CODE_STRING: > - return fortran_value_subarray (arg1, exp, pos, nargs, noside); > - > - case TYPE_CODE_PTR: > - case TYPE_CODE_FUNC: > - case TYPE_CODE_INTERNAL_FUNCTION: > - /* It's a function call. */ > - /* Allocate arg vector, including space for the function to be > - called in argvec[0] and a terminating NULL. */ > - argvec = (struct value **) > - alloca (sizeof (struct value *) * (nargs + 2)); > - argvec[0] = arg1; > - tem = 1; > - for (; tem <= nargs; tem++) > - { > - argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside); > - /* Arguments in Fortran are passed by address. Coerce the > - arguments here rather than in value_arg_coerce as otherwise > - the call to malloc to place the non-lvalue parameters in > - target memory is hit by this Fortran specific logic. This > - results in malloc being called with a pointer to an integer > - followed by an attempt to malloc the arguments to malloc in > - target memory. Infinite recursion ensues. */ > - if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC) > - { > - bool is_artificial > - = TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1); > - argvec[tem] = fortran_argument_convert (argvec[tem], > - is_artificial); > - } > - } > - argvec[tem] = 0; /* signal end of arglist */ > - if (noside == EVAL_SKIP) > - return eval_skip_value (exp); > - return eval_call (exp, noside, nargs, argvec, NULL, expect_type); > - > - default: > - error (_("Cannot perform substring on this type")); > - } > - > case OP_COMPLEX: > /* We have a complex number, There should be 2 floating > point numbers that compose it. */ > @@ -3348,27 +3165,3 @@ parse_and_eval_type (char *p, int length) > error (_("Internal error in eval_type.")); > return expr->elts[1].type; > } > - > -/* Return the number of dimensions for a Fortran array or string. */ > - > -int > -calc_f77_array_dims (struct type *array_type) > -{ > - int ndimen = 1; > - struct type *tmp_type; > - > - if ((array_type->code () == TYPE_CODE_STRING)) > - return 1; > - > - if ((array_type->code () != TYPE_CODE_ARRAY)) > - error (_("Can't get dimensions for a non-array type")); > - > - tmp_type = array_type; > - > - while ((tmp_type = TYPE_TARGET_TYPE (tmp_type))) > - { > - if (tmp_type->code () == TYPE_CODE_ARRAY) > - ++ndimen; > - } > - return ndimen; > -} > diff --git a/gdb/expprint.c b/gdb/expprint.c > index 5427a56f6ae..350f291b75e 100644 > --- a/gdb/expprint.c > +++ b/gdb/expprint.c > @@ -53,6 +53,25 @@ print_subexp (struct expression *exp, int *pos, > exp->language_defn->la_exp_desc->print_subexp (exp, pos, stream, prec); > } > > +/* See parser-defs.h. */ > + > +void > +print_subexp_funcall (struct expression *exp, int *pos, > + struct ui_file *stream) > +{ > + (*pos) += 2; > + unsigned nargs = longest_to_int (exp->elts[*pos].longconst); > + print_subexp (exp, pos, stream, PREC_SUFFIX); > + fputs_filtered (" (", stream); > + for (unsigned tem = 0; tem < nargs; tem++) > + { > + if (tem != 0) > + fputs_filtered (", ", stream); > + print_subexp (exp, pos, stream, PREC_ABOVE_COMMA); > + } > + fputs_filtered (")", stream); > +} > + > /* Standard implementation of print_subexp for use in language_defn > vectors. */ > void > @@ -187,18 +206,7 @@ print_subexp_standard (struct expression *exp, int *pos, > return; > > case OP_FUNCALL: > - case OP_F77_UNDETERMINED_ARGLIST: > - (*pos) += 2; > - nargs = longest_to_int (exp->elts[pc + 1].longconst); > - print_subexp (exp, pos, stream, PREC_SUFFIX); > - fputs_filtered (" (", stream); > - for (tem = 0; tem < nargs; tem++) > - { > - if (tem != 0) > - fputs_filtered (", ", stream); > - print_subexp (exp, pos, stream, PREC_ABOVE_COMMA); > - } > - fputs_filtered (")", stream); > + print_subexp_funcall (exp, pos, stream); > return; > > case OP_NAME: > @@ -796,6 +804,22 @@ dump_subexp_body (struct expression *exp, struct ui_file *stream, int elt) > return exp->language_defn->la_exp_desc->dump_subexp_body (exp, stream, elt); > } > > +/* See parser-defs.h. */ > + > +int > +dump_subexp_body_funcall (struct expression *exp, > + struct ui_file *stream, int elt) > +{ > + int nargs = longest_to_int (exp->elts[elt].longconst); > + fprintf_filtered (stream, "Number of args: %d", nargs); > + elt += 2; > + > + for (int i = 1; i <= nargs + 1; i++) > + elt = dump_subexp (exp, stream, elt); > + > + return elt; > +} > + > /* Default value for subexp_body in exp_descriptor vector. */ > > int > @@ -931,18 +955,7 @@ dump_subexp_body_standard (struct expression *exp, > elt += 2; > break; > case OP_FUNCALL: > - case OP_F77_UNDETERMINED_ARGLIST: > - { > - int i, nargs; > - > - nargs = longest_to_int (exp->elts[elt].longconst); > - > - fprintf_filtered (stream, "Number of args: %d", nargs); > - elt += 2; > - > - for (i = 1; i <= nargs + 1; i++) > - elt = dump_subexp (exp, stream, elt); > - } > + elt = dump_subexp_body_funcall (exp, stream, elt); > break; > case OP_ARRAY: > { > diff --git a/gdb/expression.h b/gdb/expression.h > index f1128c44248..5af10f05db1 100644 > --- a/gdb/expression.h > +++ b/gdb/expression.h > @@ -155,6 +155,18 @@ enum noside > extern struct value *evaluate_subexp_standard > (struct type *, struct expression *, int *, enum noside); > > +/* Evaluate a function call. The function to be called is in ARGVEC[0] and > + the arguments passed to the function are in ARGVEC[1..NARGS]. > + FUNCTION_NAME is the name of the function, if known. > + DEFAULT_RETURN_TYPE is used as the function's return type if the return > + type is unknown. */ > + > +extern struct value *evaluate_subexp_do_call (expression *exp, > + enum noside noside, > + int nargs, value **argvec, > + const char *function_name, > + type *default_return_type); > + > /* From expprint.c */ > > extern void print_expression (struct expression *, struct ui_file *); > diff --git a/gdb/f-lang.c b/gdb/f-lang.c > index 58b41d11d11..6210522c182 100644 > --- a/gdb/f-lang.c > +++ b/gdb/f-lang.c > @@ -114,6 +114,134 @@ enum f_primitive_types { > nr_f_primitive_types > }; > > +/* Called from fortran_value_subarray to take a slice of an array or a > + string. ARRAY is the array or string to be accessed. EXP, POS, and > + NOSIDE are as for evaluate_subexp_standard. Return a value that is a > + slice of the array. */ > + > +static struct value * > +value_f90_subarray (struct value *array, > + struct expression *exp, int *pos, enum noside noside) > +{ > + int pc = (*pos) + 1; > + LONGEST low_bound, high_bound; > + struct type *range = check_typedef (value_type (array)->index_type ()); > + enum range_type range_type > + = (enum range_type) longest_to_int (exp->elts[pc].longconst); > + > + *pos += 3; > + > + if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) > + low_bound = range->bounds ()->low.const_val (); > + else > + low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside)); > + > + if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) > + high_bound = range->bounds ()->high.const_val (); > + else > + high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside)); > + > + return value_slice (array, low_bound, high_bound - low_bound + 1); > +} > + > +/* Helper for skipping all the arguments in an undetermined argument list. > + This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST > + case of evaluate_subexp_standard as multiple, but not all, code paths > + require a generic skip. */ > + > +static void > +skip_undetermined_arglist (int nargs, struct expression *exp, int *pos, > + enum noside noside) > +{ > + for (int i = 0; i < nargs; ++i) > + evaluate_subexp (NULL_TYPE, exp, pos, noside); > +} > + > +/* Return the number of dimensions for a Fortran array or string. */ > + > +int > +calc_f77_array_dims (struct type *array_type) > +{ > + int ndimen = 1; > + struct type *tmp_type; > + > + if ((array_type->code () == TYPE_CODE_STRING)) > + return 1; > + > + if ((array_type->code () != TYPE_CODE_ARRAY)) > + error (_("Can't get dimensions for a non-array type")); > + > + tmp_type = array_type; > + > + while ((tmp_type = TYPE_TARGET_TYPE (tmp_type))) > + { > + if (tmp_type->code () == TYPE_CODE_ARRAY) > + ++ndimen; > + } > + return ndimen; > +} > + > +/* Called from evaluate_subexp_standard to perform array indexing, and > + sub-range extraction, for Fortran. As well as arrays this function > + also handles strings as they can be treated like arrays of characters. > + ARRAY is the array or string being accessed. EXP, POS, and NOSIDE are > + as for evaluate_subexp_standard, and NARGS is the number of arguments > + in this access (e.g. 'array (1,2,3)' would be NARGS 3). */ > + > +static struct value * > +fortran_value_subarray (struct value *array, struct expression *exp, > + int *pos, int nargs, enum noside noside) > +{ > + if (exp->elts[*pos].opcode == OP_RANGE) > + return value_f90_subarray (array, exp, pos, noside); > + > + if (noside == EVAL_SKIP) > + { > + skip_undetermined_arglist (nargs, exp, pos, noside); > + /* Return the dummy value with the correct type. */ > + return array; > + } > + > + LONGEST subscript_array[MAX_FORTRAN_DIMS]; > + int ndimensions = 1; > + struct type *type = check_typedef (value_type (array)); > + > + if (nargs > MAX_FORTRAN_DIMS) > + error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); > + > + ndimensions = calc_f77_array_dims (type); > + > + if (nargs != ndimensions) > + error (_("Wrong number of subscripts")); > + > + gdb_assert (nargs > 0); > + > + /* Now that we know we have a legal array subscript expression let us > + actually find out where this element exists in the array. */ > + > + /* Take array indices left to right. */ > + for (int i = 0; i < nargs; i++) > + { > + /* Evaluate each subscript; it must be a legal integer in F77. */ > + value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside); > + > + /* Fill in the subscript array. */ > + subscript_array[i] = value_as_long (arg2); > + } > + > + /* Internal type of array is arranged right to left. */ > + for (int i = nargs; i > 0; i--) > + { > + struct type *array_type = check_typedef (value_type (array)); > + LONGEST index = subscript_array[i - 1]; > + > + array = value_subscripted_rvalue (array, index, > + f77_get_lowerbound (array_type)); > + } > + > + return array; > +} > + > /* Special expression evaluation cases for Fortran. */ > > static struct value * > @@ -285,6 +413,87 @@ evaluate_subexp_f (struct type *expect_type, struct expression *exp, > TYPE_LENGTH (type)); > return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, > TYPE_LENGTH (TYPE_TARGET_TYPE (type))); > + > + > + case OP_F77_UNDETERMINED_ARGLIST: > + /* Remember that in F77, functions, substring ops and array subscript > + operations cannot be disambiguated at parse time. We have made > + all array subscript operations, substring operations as well as > + function calls come here and we now have to discover what the heck > + this thing actually was. If it is a function, we process just as > + if we got an OP_FUNCALL. */ > + int nargs = longest_to_int (exp->elts[pc + 1].longconst); > + (*pos) += 2; > + > + /* First determine the type code we are dealing with. */ > + arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); > + type = check_typedef (value_type (arg1)); > + enum type_code code = type->code (); > + > + if (code == TYPE_CODE_PTR) > + { > + /* Fortran always passes variable to subroutines as pointer. > + So we need to look into its target type to see if it is > + array, string or function. If it is, we need to switch > + to the target value the original one points to. */ > + struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type)); > + > + if (target_type->code () == TYPE_CODE_ARRAY > + || target_type->code () == TYPE_CODE_STRING > + || target_type->code () == TYPE_CODE_FUNC) > + { > + arg1 = value_ind (arg1); > + type = check_typedef (value_type (arg1)); > + code = type->code (); > + } > + } > + > + switch (code) > + { > + case TYPE_CODE_ARRAY: > + case TYPE_CODE_STRING: > + return fortran_value_subarray (arg1, exp, pos, nargs, noside); > + > + case TYPE_CODE_PTR: > + case TYPE_CODE_FUNC: > + case TYPE_CODE_INTERNAL_FUNCTION: > + { > + /* It's a function call. Allocate arg vector, including > + space for the function to be called in argvec[0] and a > + termination NULL. */ > + struct value **argvec = (struct value **) > + alloca (sizeof (struct value *) * (nargs + 2)); > + argvec[0] = arg1; > + int tem = 1; > + for (; tem <= nargs; tem++) > + { > + argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside); > + /* Arguments in Fortran are passed by address. Coerce the > + arguments here rather than in value_arg_coerce as > + otherwise the call to malloc to place the non-lvalue > + parameters in target memory is hit by this Fortran > + specific logic. This results in malloc being called > + with a pointer to an integer followed by an attempt to > + malloc the arguments to malloc in target memory. > + Infinite recursion ensues. */ > + if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC) > + { > + bool is_artificial > + = TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1); > + argvec[tem] = fortran_argument_convert (argvec[tem], > + is_artificial); > + } > + } > + argvec[tem] = 0; /* signal end of arglist */ > + if (noside == EVAL_SKIP) > + return eval_skip_value (exp); > + return evaluate_subexp_do_call (exp, noside, nargs, argvec, NULL, > + expect_type); > + } > + > + default: > + error (_("Cannot perform substring on this type")); > + } > } > > /* Should be unreachable. */ > @@ -318,6 +527,11 @@ operator_length_f (const struct expression *exp, int pc, int *oplenp, > oplen = 1; > args = 2; > break; > + > + case OP_F77_UNDETERMINED_ARGLIST: > + oplen = 3; > + args = 1 + longest_to_int (exp->elts[pc - 2].longconst); > + break; > } > > *oplenp = oplen; > @@ -390,6 +604,10 @@ print_subexp_f (struct expression *exp, int *pos, > case BINOP_FORTRAN_MODULO: > print_binop_subexp_f (exp, pos, stream, prec, "MODULO"); > return; > + > + case OP_F77_UNDETERMINED_ARGLIST: > + print_subexp_funcall (exp, pos, stream); > + return; > } > } > > @@ -432,6 +650,9 @@ dump_subexp_body_f (struct expression *exp, > case BINOP_FORTRAN_MODULO: > operator_length_f (exp, (elt + 1), &oplen, &nargs); > break; > + > + case OP_F77_UNDETERMINED_ARGLIST: > + return dump_subexp_body_funcall (exp, stream, elt); > } > > elt += oplen; > diff --git a/gdb/fortran-operator.def b/gdb/fortran-operator.def > index fd4051ebe59..bfdbc401711 100644 > --- a/gdb/fortran-operator.def > +++ b/gdb/fortran-operator.def > @@ -17,6 +17,14 @@ > You should have received a copy of the GNU General Public License > along with this program. If not, see . */ > > +/* This is EXACTLY like OP_FUNCALL but is semantically different. > + In F77, array subscript expressions, substring expressions and > + function calls are all exactly the same syntactically. They > + may only be disambiguated at runtime. Thus this operator, > + which indicates that we have found something of the form > + ( ). */ > +OP (OP_F77_UNDETERMINED_ARGLIST) > + > /* Single operand builtins. */ > OP (UNOP_FORTRAN_KIND) > OP (UNOP_FORTRAN_FLOOR) > diff --git a/gdb/parse.c b/gdb/parse.c > index 2fb474e27f1..435f87a06e4 100644 > --- a/gdb/parse.c > +++ b/gdb/parse.c > @@ -817,7 +817,6 @@ operator_length_standard (const struct expression *expr, int endpos, > break; > > case OP_FUNCALL: > - case OP_F77_UNDETERMINED_ARGLIST: > oplen = 3; > args = 1 + longest_to_int (expr->elts[endpos - 2].longconst); > break; > diff --git a/gdb/parser-defs.h b/gdb/parser-defs.h > index a9b8a12959b..bc6fc2f9ba3 100644 > --- a/gdb/parser-defs.h > +++ b/gdb/parser-defs.h > @@ -338,6 +338,13 @@ extern int dump_subexp (struct expression *, struct ui_file *, int); > extern int dump_subexp_body_standard (struct expression *, > struct ui_file *, int); > > +/* Dump (to STREAM) a function call like expression at position ELT in the > + expression array EXP. Return a new value for ELT just after the > + function call expression. */ > + > +extern int dump_subexp_body_funcall (struct expression *exp, > + struct ui_file *stream, int elt); > + > extern void operator_length (const struct expression *, int, int *, int *); > > extern void operator_length_standard (const struct expression *, int, int *, > @@ -440,6 +447,15 @@ extern void print_subexp (struct expression *, int *, struct ui_file *, > extern void print_subexp_standard (struct expression *, int *, > struct ui_file *, enum precedence); > > +/* Print a function call like expression to STREAM. This is called as a > + helper function by which point the expression node identifying this as a > + function call has already been stripped off and POS should point to the > + number of function call arguments. EXP is the object containing the > + list of expression elements. */ > + > +extern void print_subexp_funcall (struct expression *exp, int *pos, > + struct ui_file *stream); > + > /* Function used to avoid direct calls to fprintf > in the code generated by the bison parser. */ > > diff --git a/gdb/std-operator.def b/gdb/std-operator.def > index e969bdccaed..6f90875f477 100644 > --- a/gdb/std-operator.def > +++ b/gdb/std-operator.def > @@ -168,14 +168,6 @@ OP (OP_FUNCALL) > pointer. This is an Objective C message. */ > OP (OP_OBJC_MSGCALL) > > -/* This is EXACTLY like OP_FUNCALL but is semantically different. > - In F77, array subscript expressions, substring expressions and > - function calls are all exactly the same syntactically. They > - may only be disambiguated at runtime. Thus this operator, > - which indicates that we have found something of the form > - ( ). */ > -OP (OP_F77_UNDETERMINED_ARGLIST) > - > /* OP_COMPLEX takes a type in the following element, followed by another > OP_COMPLEX, making three exp_elements. It is followed by two double > args, and converts them into a complex number of the given type. */ > -- > 2.25.4 >