From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wm1-x333.google.com (mail-wm1-x333.google.com [IPv6:2a00:1450:4864:20::333]) by sourceware.org (Postfix) with ESMTPS id 08809386F419 for ; Wed, 26 Aug 2020 14:49:42 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 08809386F419 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-wm1-x333.google.com with SMTP id y8so1731211wma.0 for ; Wed, 26 Aug 2020 07:49:41 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=embecosm.com; s=google; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=kCyszPvBQgrOebTNVZHkqMg0pE3nS9umhEcq0wruyqk=; b=T+3IUP0CWrnclzzvNAm1DUzJv23sE/Hh4AT/q4fYLD4ScZyJLyWYHA8yNQs+fPYEH2 efyDU00u4tsWS3EWb3eQF5aQLJUECI9DmR9ElKa6wFX0wdfA6j0IFGI4YyduvvhA/pH+ dD3xT4jap9OLCTou/wRvpV3DAGD7oc48ueAyL0/fjoRwD0sOibjxEaiUQSkbn9Gt+2VW hztvUEITBxxEOuTcAUZUfyNIWYcsKHAqqRxmaMgQUftY8bpPMJ5Rg0t6OxA/uf6w9Kiw UeAsKYkGZbIV3+eO6WUI5GAsfPtxz8V+VlUDeuLWtqdSoPaDC5sz1gGIJ2LUllu7MXnY lHVA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references:mime-version:content-transfer-encoding; bh=kCyszPvBQgrOebTNVZHkqMg0pE3nS9umhEcq0wruyqk=; b=ZkQ3fUqjYRHNDaLsny9uoLAIWCDpskHwqp4dZ9PuNP/rZS0+XH+j+JYiH4mmjzhZNp ooNzbGGYLb1kDLS9HyxQ75ch4LJZ7qF0KxBj1AwFeAEjUcsdTUwVh1BPvAK7rsvavu7p M5aasCKr/MnpX2OF05J+0TzO+yeunNajzya9m7LPjL+9pMvNjgd3bKeHc5JPEMJSt7/S 4ewt5wFJHsiy2089Yj2ppb58T6p+8QCWxo/0PGjGoe0jpEA61X0gAQtFuireW6/Dpc9X JlyVocU1Ph+OXqMinaWp2sAxRFzh3AXHuF+qBsfm4Gj7Gor91cfie3ax0yw2n2grnwkc SpcA== X-Gm-Message-State: AOAM5323crKQdoHpneGeQk4agL6LU8c7zse3mTGZH9v/kr1YI4ryL6Fu lyvC6YRhrRipkzpstMy25IB0iNw4QTysnw== X-Google-Smtp-Source: ABdhPJxzmNPx0dcffaFTLEU8w0tSY7EQMO6JPoThC1aJPDKufHLY5fHw5RXdX3dhJQLsVvEucUJxtg== X-Received: by 2002:a1c:e1d6:: with SMTP id y205mr2706449wmg.92.1598453379619; Wed, 26 Aug 2020 07:49:39 -0700 (PDT) Received: from localhost (host109-148-134-218.range109-148.btcentralplus.com. [109.148.134.218]) by smtp.gmail.com with ESMTPSA id k204sm6959743wma.21.2020.08.26.07.49.38 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 26 Aug 2020 07:49:38 -0700 (PDT) From: Andrew Burgess To: gdb-patches@sourceware.org Subject: [PATCHv2 06/10] gdb/fortran: Move Fortran expression handling into f-lang.c Date: Wed, 26 Aug 2020 15:49:13 +0100 Message-Id: <073938fe92bc32bf945322b6043a6b2c6e42651c.1598452395.git.andrew.burgess@embecosm.com> X-Mailer: git-send-email 2.25.4 In-Reply-To: References: MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-8.5 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_SHORT, RCVD_IN_ABUSEAT, 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: Wed, 26 Aug 2020 14:49:45 -0000 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. --- 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