From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from gateway33.websitewelcome.com (gateway33.websitewelcome.com [192.185.146.80]) by sourceware.org (Postfix) with ESMTPS id 67A583959E43 for ; Sat, 20 Feb 2021 20:16:54 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 67A583959E43 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=tromey.com Authentication-Results: sourceware.org; spf=fail smtp.mailfrom=tom@tromey.com Received: from cm11.websitewelcome.com (cm11.websitewelcome.com [100.42.49.5]) by gateway33.websitewelcome.com (Postfix) with ESMTP id 8E57F66E92 for ; Sat, 20 Feb 2021 14:16:53 -0600 (CST) Received: from box5379.bluehost.com ([162.241.216.53]) by cmsmtp with SMTP id DYgPloQK3SrGMDYgPlK9A9; Sat, 20 Feb 2021 14:16:53 -0600 X-Authority-Reason: nr=8 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=tromey.com; s=default; h=Content-Transfer-Encoding:MIME-Version:References:In-Reply-To: Message-Id:Date:Subject:To:From:Sender:Reply-To:Cc:Content-Type:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=2nPPkJmClp2cBs+K+6ezub1BYF2IfoGWlimLBwC6lMA=; b=ak0JecAA62pyDpfiep5DR6xKv4 66vhW4PT169XRCtm23ex7fzKYbBjYWslTkGz01xr5MRnNbVV03RYfGPsEmWbex24r4ToxN6HTjGc6 +BLHOnDmxjcLwn22Otr0o3bci; Received: from 97-122-70-152.hlrn.qwest.net ([97.122.70.152]:52708 helo=localhost.localdomain) by box5379.bluehost.com with esmtpsa (TLS1.2) tls TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384 (Exim 4.93) (envelope-from ) id 1lDYgP-000Gtl-9v for gdb-patches@sourceware.org; Sat, 20 Feb 2021 13:16:53 -0700 From: Tom Tromey To: gdb-patches@sourceware.org Subject: [PATCH v3 189/206] Remove now-unused Fortran evaluator code Date: Sat, 20 Feb 2021 13:15:52 -0700 Message-Id: <20210220201609.838264-190-tom@tromey.com> X-Mailer: git-send-email 2.26.2 In-Reply-To: <20210220201609.838264-1-tom@tromey.com> References: <20210220201609.838264-1-tom@tromey.com> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-AntiAbuse: This header was added to track abuse, please include it with any abuse report X-AntiAbuse: Primary Hostname - box5379.bluehost.com X-AntiAbuse: Original Domain - sourceware.org X-AntiAbuse: Originator/Caller UID/GID - [47 12] / [47 12] X-AntiAbuse: Sender Address Domain - tromey.com X-BWhitelist: no X-Source-IP: 97.122.70.152 X-Source-L: No X-Exim-ID: 1lDYgP-000Gtl-9v X-Source: X-Source-Args: X-Source-Dir: X-Source-Sender: 97-122-70-152.hlrn.qwest.net (localhost.localdomain) [97.122.70.152]:52708 X-Source-Auth: tom+tromey.com X-Email-Count: 190 X-Source-Cap: ZWx5bnJvYmk7ZWx5bnJvYmk7Ym94NTM3OS5ibHVlaG9zdC5jb20= X-Local-Domain: yes X-Spam-Status: No, score=-3034.7 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, GIT_PATCH_0, JMQ_SPF_NEUTRAL, RCVD_IN_DNSWL_NONE, RCVD_IN_MSPIKE_H2, SPF_HELO_PASS, SPF_NEUTRAL, 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, 20 Feb 2021 20:17:19 -0000 Now that the Fortran parser has switched to the new style, there is no need for the old Fortran evaluation code. gdb/ChangeLog 2021-02-20 Tom Tromey * f-lang.h (class f_language) : Remove. : Remove. * f-lang.c (fortran_value_subarray, evaluate_subexp_f) (operator_length_f, print_unop_subexp_f, print_binop_subexp_f) (print_subexp_f, dump_subexp_body_f, operator_check_f) (f_language::exp_descriptor_tab): Remove. --- gdb/ChangeLog | 9 + gdb/f-lang.c | 810 -------------------------------------------------- gdb/f-lang.h | 10 - 3 files changed, 9 insertions(+), 820 deletions(-) diff --git a/gdb/f-lang.c b/gdb/f-lang.c index 40ae7411afc..fb625d56a03 100644 --- a/gdb/f-lang.c +++ b/gdb/f-lang.c @@ -410,413 +410,6 @@ class fortran_array_repacker_impl struct value *m_val; }; -/* 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) -{ - type *original_array_type = check_typedef (value_type (array)); - bool is_string_p = original_array_type->code () == TYPE_CODE_STRING; - - /* Perform checks for ARRAY not being available. The somewhat overly - complex logic here is just to keep backward compatibility with the - errors that we used to get before FORTRAN_VALUE_SUBARRAY was - rewritten. Maybe a future task would streamline the error messages we - get here, and update all the expected test results. */ - if (exp->elts[*pos].opcode != OP_RANGE) - { - if (type_not_associated (original_array_type)) - error (_("no such vector element (vector not associated)")); - else if (type_not_allocated (original_array_type)) - error (_("no such vector element (vector not allocated)")); - } - else - { - if (type_not_associated (original_array_type)) - error (_("array not associated")); - else if (type_not_allocated (original_array_type)) - error (_("array not allocated")); - } - - /* First check that the number of dimensions in the type we are slicing - matches the number of arguments we were passed. */ - int ndimensions = calc_f77_array_dims (original_array_type); - if (nargs != ndimensions) - error (_("Wrong number of subscripts")); - - /* This will be initialised below with the type of the elements held in - ARRAY. */ - struct type *inner_element_type; - - /* Extract the types of each array dimension from the original array - type. We need these available so we can fill in the default upper and - lower bounds if the user requested slice doesn't provide that - information. Additionally unpacking the dimensions like this gives us - the inner element type. */ - std::vector dim_types; - { - dim_types.reserve (ndimensions); - struct type *type = original_array_type; - for (int i = 0; i < ndimensions; ++i) - { - dim_types.push_back (type); - type = TYPE_TARGET_TYPE (type); - } - /* TYPE is now the inner element type of the array, we start the new - array slice off as this type, then as we process the requested slice - (from the user) we wrap new types around this to build up the final - slice type. */ - inner_element_type = type; - } - - /* As we analyse the new slice type we need to understand if the data - being referenced is contiguous. Do decide this we must track the size - of an element at each dimension of the new slice array. Initially the - elements of the inner most dimension of the array are the same inner - most elements as the original ARRAY. */ - LONGEST slice_element_size = TYPE_LENGTH (inner_element_type); - - /* Start off assuming all data is contiguous, this will be set to false - if access to any dimension results in non-contiguous data. */ - bool is_all_contiguous = true; - - /* The TOTAL_OFFSET is the distance in bytes from the start of the - original ARRAY to the start of the new slice. This is calculated as - we process the information from the user. */ - LONGEST total_offset = 0; - - /* A structure representing information about each dimension of the - resulting slice. */ - struct slice_dim - { - /* Constructor. */ - slice_dim (LONGEST l, LONGEST h, LONGEST s, struct type *idx) - : low (l), - high (h), - stride (s), - index (idx) - { /* Nothing. */ } - - /* The low bound for this dimension of the slice. */ - LONGEST low; - - /* The high bound for this dimension of the slice. */ - LONGEST high; - - /* The byte stride for this dimension of the slice. */ - LONGEST stride; - - struct type *index; - }; - - /* The dimensions of the resulting slice. */ - std::vector slice_dims; - - /* Process the incoming arguments. These arguments are in the reverse - order to the array dimensions, that is the first argument refers to - the last array dimension. */ - if (fortran_array_slicing_debug) - debug_printf ("Processing array access:\n"); - for (int i = 0; i < nargs; ++i) - { - /* For each dimension of the array the user will have either provided - a ranged access with optional lower bound, upper bound, and - stride, or the user will have supplied a single index. */ - struct type *dim_type = dim_types[ndimensions - (i + 1)]; - if (exp->elts[*pos].opcode == OP_RANGE) - { - int pc = (*pos) + 1; - enum range_flag range_flag = (enum range_flag) exp->elts[pc].longconst; - *pos += 3; - - LONGEST low, high, stride; - low = high = stride = 0; - - if ((range_flag & RANGE_LOW_BOUND_DEFAULT) == 0) - low = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); - else - low = f77_get_lowerbound (dim_type); - if ((range_flag & RANGE_HIGH_BOUND_DEFAULT) == 0) - high = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); - else - high = f77_get_upperbound (dim_type); - if ((range_flag & RANGE_HAS_STRIDE) == RANGE_HAS_STRIDE) - stride = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); - else - stride = 1; - - if (stride == 0) - error (_("stride must not be 0")); - - /* Get information about this dimension in the original ARRAY. */ - struct type *target_type = TYPE_TARGET_TYPE (dim_type); - struct type *index_type = dim_type->index_type (); - LONGEST lb = f77_get_lowerbound (dim_type); - LONGEST ub = f77_get_upperbound (dim_type); - LONGEST sd = index_type->bit_stride (); - if (sd == 0) - sd = TYPE_LENGTH (target_type) * 8; - - if (fortran_array_slicing_debug) - { - debug_printf ("|-> Range access\n"); - std::string str = type_to_string (dim_type); - debug_printf ("| |-> Type: %s\n", str.c_str ()); - debug_printf ("| |-> Array:\n"); - debug_printf ("| | |-> Low bound: %s\n", plongest (lb)); - debug_printf ("| | |-> High bound: %s\n", plongest (ub)); - debug_printf ("| | |-> Bit stride: %s\n", plongest (sd)); - debug_printf ("| | |-> Byte stride: %s\n", plongest (sd / 8)); - debug_printf ("| | |-> Type size: %s\n", - pulongest (TYPE_LENGTH (dim_type))); - debug_printf ("| | '-> Target type size: %s\n", - pulongest (TYPE_LENGTH (target_type))); - debug_printf ("| |-> Accessing:\n"); - debug_printf ("| | |-> Low bound: %s\n", - plongest (low)); - debug_printf ("| | |-> High bound: %s\n", - plongest (high)); - debug_printf ("| | '-> Element stride: %s\n", - plongest (stride)); - } - - /* Check the user hasn't asked for something invalid. */ - if (high > ub || low < lb) - error (_("array subscript out of bounds")); - - /* Calculate what this dimension of the new slice array will look - like. OFFSET is the byte offset from the start of the - previous (more outer) dimension to the start of this - dimension. E_COUNT is the number of elements in this - dimension. REMAINDER is the number of elements remaining - between the last included element and the upper bound. For - example an access '1:6:2' will include elements 1, 3, 5 and - have a remainder of 1 (element #6). */ - LONGEST lowest = std::min (low, high); - LONGEST offset = (sd / 8) * (lowest - lb); - LONGEST e_count = std::abs (high - low) + 1; - e_count = (e_count + (std::abs (stride) - 1)) / std::abs (stride); - LONGEST new_low = 1; - LONGEST new_high = new_low + e_count - 1; - LONGEST new_stride = (sd * stride) / 8; - LONGEST last_elem = low + ((e_count - 1) * stride); - LONGEST remainder = high - last_elem; - if (low > high) - { - offset += std::abs (remainder) * TYPE_LENGTH (target_type); - if (stride > 0) - error (_("incorrect stride and boundary combination")); - } - else if (stride < 0) - error (_("incorrect stride and boundary combination")); - - /* Is the data within this dimension contiguous? It is if the - newly computed stride is the same size as a single element of - this dimension. */ - bool is_dim_contiguous = (new_stride == slice_element_size); - is_all_contiguous &= is_dim_contiguous; - - if (fortran_array_slicing_debug) - { - debug_printf ("| '-> Results:\n"); - debug_printf ("| |-> Offset = %s\n", plongest (offset)); - debug_printf ("| |-> Elements = %s\n", plongest (e_count)); - debug_printf ("| |-> Low bound = %s\n", plongest (new_low)); - debug_printf ("| |-> High bound = %s\n", - plongest (new_high)); - debug_printf ("| |-> Byte stride = %s\n", - plongest (new_stride)); - debug_printf ("| |-> Last element = %s\n", - plongest (last_elem)); - debug_printf ("| |-> Remainder = %s\n", - plongest (remainder)); - debug_printf ("| '-> Contiguous = %s\n", - (is_dim_contiguous ? "Yes" : "No")); - } - - /* Figure out how big (in bytes) an element of this dimension of - the new array slice will be. */ - slice_element_size = std::abs (new_stride * e_count); - - slice_dims.emplace_back (new_low, new_high, new_stride, - index_type); - - /* Update the total offset. */ - total_offset += offset; - } - else - { - /* There is a single index for this dimension. */ - LONGEST index - = value_as_long (evaluate_subexp_with_coercion (exp, pos, noside)); - - /* Get information about this dimension in the original ARRAY. */ - struct type *target_type = TYPE_TARGET_TYPE (dim_type); - struct type *index_type = dim_type->index_type (); - LONGEST lb = f77_get_lowerbound (dim_type); - LONGEST ub = f77_get_upperbound (dim_type); - LONGEST sd = index_type->bit_stride () / 8; - if (sd == 0) - sd = TYPE_LENGTH (target_type); - - if (fortran_array_slicing_debug) - { - debug_printf ("|-> Index access\n"); - std::string str = type_to_string (dim_type); - debug_printf ("| |-> Type: %s\n", str.c_str ()); - debug_printf ("| |-> Array:\n"); - debug_printf ("| | |-> Low bound: %s\n", plongest (lb)); - debug_printf ("| | |-> High bound: %s\n", plongest (ub)); - debug_printf ("| | |-> Byte stride: %s\n", plongest (sd)); - debug_printf ("| | |-> Type size: %s\n", - pulongest (TYPE_LENGTH (dim_type))); - debug_printf ("| | '-> Target type size: %s\n", - pulongest (TYPE_LENGTH (target_type))); - debug_printf ("| '-> Accessing:\n"); - debug_printf ("| '-> Index: %s\n", - plongest (index)); - } - - /* If the array has actual content then check the index is in - bounds. An array without content (an unbound array) doesn't - have a known upper bound, so don't error check in that - situation. */ - if (index < lb - || (dim_type->index_type ()->bounds ()->high.kind () != PROP_UNDEFINED - && index > ub) - || (VALUE_LVAL (array) != lval_memory - && dim_type->index_type ()->bounds ()->high.kind () == PROP_UNDEFINED)) - { - if (type_not_associated (dim_type)) - error (_("no such vector element (vector not associated)")); - else if (type_not_allocated (dim_type)) - error (_("no such vector element (vector not allocated)")); - else - error (_("no such vector element")); - } - - /* Calculate using the type stride, not the target type size. */ - LONGEST offset = sd * (index - lb); - total_offset += offset; - } - } - - if (noside == EVAL_SKIP) - return array; - - /* Build a type that represents the new array slice in the target memory - of the original ARRAY, this type makes use of strides to correctly - find only those elements that are part of the new slice. */ - struct type *array_slice_type = inner_element_type; - for (const auto &d : slice_dims) - { - /* Create the range. */ - dynamic_prop p_low, p_high, p_stride; - - p_low.set_const_val (d.low); - p_high.set_const_val (d.high); - p_stride.set_const_val (d.stride); - - struct type *new_range - = create_range_type_with_stride ((struct type *) NULL, - TYPE_TARGET_TYPE (d.index), - &p_low, &p_high, 0, &p_stride, - true); - array_slice_type - = create_array_type (nullptr, array_slice_type, new_range); - } - - if (fortran_array_slicing_debug) - { - debug_printf ("'-> Final result:\n"); - debug_printf (" |-> Type: %s\n", - type_to_string (array_slice_type).c_str ()); - debug_printf (" |-> Total offset: %s\n", - plongest (total_offset)); - debug_printf (" |-> Base address: %s\n", - core_addr_to_string (value_address (array))); - debug_printf (" '-> Contiguous = %s\n", - (is_all_contiguous ? "Yes" : "No")); - } - - /* Should we repack this array slice? */ - if (!is_all_contiguous && (repack_array_slices || is_string_p)) - { - /* Build a type for the repacked slice. */ - struct type *repacked_array_type = inner_element_type; - for (const auto &d : slice_dims) - { - /* Create the range. */ - dynamic_prop p_low, p_high, p_stride; - - p_low.set_const_val (d.low); - p_high.set_const_val (d.high); - p_stride.set_const_val (TYPE_LENGTH (repacked_array_type)); - - struct type *new_range - = create_range_type_with_stride ((struct type *) NULL, - TYPE_TARGET_TYPE (d.index), - &p_low, &p_high, 0, &p_stride, - true); - repacked_array_type - = create_array_type (nullptr, repacked_array_type, new_range); - } - - /* Now copy the elements from the original ARRAY into the packed - array value DEST. */ - struct value *dest = allocate_value (repacked_array_type); - if (value_lazy (array) - || (total_offset + TYPE_LENGTH (array_slice_type) - > TYPE_LENGTH (check_typedef (value_type (array))))) - { - fortran_array_walker p - (array_slice_type, value_address (array) + total_offset, dest); - p.walk (); - } - else - { - fortran_array_walker p - (array_slice_type, value_address (array) + total_offset, - total_offset, array, dest); - p.walk (); - } - array = dest; - } - else - { - if (VALUE_LVAL (array) == lval_memory) - { - /* If the value we're taking a slice from is not yet loaded, or - the requested slice is outside the values content range then - just create a new lazy value pointing at the memory where the - contents we're looking for exist. */ - if (value_lazy (array) - || (total_offset + TYPE_LENGTH (array_slice_type) - > TYPE_LENGTH (check_typedef (value_type (array))))) - array = value_at_lazy (array_slice_type, - value_address (array) + total_offset); - else - array = value_from_contents_and_address (array_slice_type, - (value_contents (array) - + total_offset), - (value_address (array) - + total_offset)); - } - else if (!value_lazy (array)) - array = value_from_component (array, array_slice_type, total_offset); - else - error (_("cannot subscript arrays that are not in memory")); - } - - return array; -} - /* A helper function for UNOP_ABS. */ struct value * @@ -1024,187 +617,6 @@ eval_op_f_allocated (struct type *expect_type, struct expression *exp, return value_from_longest (result_type, result_value); } -/* Special expression evaluation cases for Fortran. */ - -static struct value * -evaluate_subexp_f (struct type *expect_type, struct expression *exp, - int *pos, enum noside noside) -{ - struct value *arg1 = NULL, *arg2 = NULL; - enum exp_opcode op; - int pc; - struct type *type; - - pc = *pos; - *pos += 1; - op = exp->elts[pc].opcode; - - switch (op) - { - default: - *pos -= 1; - return evaluate_subexp_standard (expect_type, exp, pos, noside); - - case UNOP_ABS: - arg1 = evaluate_subexp (nullptr, exp, pos, noside); - return eval_op_f_abs (expect_type, exp, noside, op, arg1); - - case BINOP_MOD: - arg1 = evaluate_subexp (nullptr, exp, pos, noside); - arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside); - return eval_op_f_mod (expect_type, exp, noside, op, arg1, arg2); - - case UNOP_FORTRAN_CEILING: - arg1 = evaluate_subexp (nullptr, exp, pos, noside); - return eval_op_f_ceil (expect_type, exp, noside, op, arg1); - - case UNOP_FORTRAN_FLOOR: - arg1 = evaluate_subexp (nullptr, exp, pos, noside); - return eval_op_f_floor (expect_type, exp, noside, op, arg1); - - case UNOP_FORTRAN_ALLOCATED: - { - arg1 = evaluate_subexp (nullptr, exp, pos, noside); - if (noside == EVAL_SKIP) - return eval_skip_value (exp); - return eval_op_f_allocated (expect_type, exp, noside, op, arg1); - } - - case BINOP_FORTRAN_MODULO: - arg1 = evaluate_subexp (nullptr, exp, pos, noside); - arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside); - return eval_op_f_modulo (expect_type, exp, noside, op, arg1, arg2); - - case FORTRAN_LBOUND: - case FORTRAN_UBOUND: - { - int nargs = longest_to_int (exp->elts[pc + 1].longconst); - (*pos) += 2; - - /* This assertion should be enforced by the expression parser. */ - gdb_assert (nargs == 1 || nargs == 2); - - bool lbound_p = op == FORTRAN_LBOUND; - - /* Check that the first argument is array like. */ - arg1 = evaluate_subexp (nullptr, exp, pos, noside); - fortran_require_array (value_type (arg1), lbound_p); - - if (nargs == 1) - return fortran_bounds_all_dims (lbound_p, exp->gdbarch, arg1); - - /* User asked for the bounds of a specific dimension of the array. */ - arg2 = evaluate_subexp (nullptr, exp, pos, noside); - type = check_typedef (value_type (arg2)); - if (type->code () != TYPE_CODE_INT) - { - if (lbound_p) - error (_("LBOUND second argument should be an integer")); - else - error (_("UBOUND second argument should be an integer")); - } - - return fortran_bounds_for_dimension (lbound_p, exp->gdbarch, arg1, - arg2); - } - break; - - case BINOP_FORTRAN_CMPLX: - arg1 = evaluate_subexp (nullptr, exp, pos, noside); - arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside); - return eval_op_f_cmplx (expect_type, exp, noside, op, arg1, arg2); - - case UNOP_FORTRAN_KIND: - arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS); - return eval_op_f_kind (expect_type, exp, noside, op, arg1); - - 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 (nullptr, 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, argvec[0], - gdb::make_array_view (argvec + 1, - nargs), - NULL, expect_type); - } - - default: - error (_("Cannot perform substring on this type")); - } - } - - /* Should be unreachable. */ - return nullptr; -} - namespace expr { @@ -1721,228 +1133,6 @@ fortran_bound_2arg::evaluate (struct type *expect_type, } /* namespace expr */ -/* Special expression lengths for Fortran. */ - -static void -operator_length_f (const struct expression *exp, int pc, int *oplenp, - int *argsp) -{ - int oplen = 1; - int args = 0; - - switch (exp->elts[pc - 1].opcode) - { - default: - operator_length_standard (exp, pc, oplenp, argsp); - return; - - case UNOP_FORTRAN_KIND: - case UNOP_FORTRAN_FLOOR: - case UNOP_FORTRAN_CEILING: - case UNOP_FORTRAN_ALLOCATED: - oplen = 1; - args = 1; - break; - - case BINOP_FORTRAN_CMPLX: - case BINOP_FORTRAN_MODULO: - oplen = 1; - args = 2; - break; - - case FORTRAN_LBOUND: - case FORTRAN_UBOUND: - oplen = 3; - args = longest_to_int (exp->elts[pc - 2].longconst); - break; - - case OP_F77_UNDETERMINED_ARGLIST: - oplen = 3; - args = 1 + longest_to_int (exp->elts[pc - 2].longconst); - break; - } - - *oplenp = oplen; - *argsp = args; -} - -/* Helper for PRINT_SUBEXP_F. Arguments are as for PRINT_SUBEXP_F, except - the extra argument NAME which is the text that should be printed as the - name of this operation. */ - -static void -print_unop_subexp_f (struct expression *exp, int *pos, - struct ui_file *stream, enum precedence prec, - const char *name) -{ - (*pos)++; - fprintf_filtered (stream, "%s(", name); - print_subexp (exp, pos, stream, PREC_SUFFIX); - fputs_filtered (")", stream); -} - -/* Helper for PRINT_SUBEXP_F. Arguments are as for PRINT_SUBEXP_F, except - the extra argument NAME which is the text that should be printed as the - name of this operation. */ - -static void -print_binop_subexp_f (struct expression *exp, int *pos, - struct ui_file *stream, enum precedence prec, - const char *name) -{ - (*pos)++; - fprintf_filtered (stream, "%s(", name); - print_subexp (exp, pos, stream, PREC_SUFFIX); - fputs_filtered (",", stream); - print_subexp (exp, pos, stream, PREC_SUFFIX); - fputs_filtered (")", stream); -} - -/* Special expression printing for Fortran. */ - -static void -print_subexp_f (struct expression *exp, int *pos, - struct ui_file *stream, enum precedence prec) -{ - int pc = *pos; - enum exp_opcode op = exp->elts[pc].opcode; - - switch (op) - { - default: - print_subexp_standard (exp, pos, stream, prec); - return; - - case UNOP_FORTRAN_KIND: - print_unop_subexp_f (exp, pos, stream, prec, "KIND"); - return; - - case UNOP_FORTRAN_FLOOR: - print_unop_subexp_f (exp, pos, stream, prec, "FLOOR"); - return; - - case UNOP_FORTRAN_CEILING: - print_unop_subexp_f (exp, pos, stream, prec, "CEILING"); - return; - - case UNOP_FORTRAN_ALLOCATED: - print_unop_subexp_f (exp, pos, stream, prec, "ALLOCATED"); - return; - - case BINOP_FORTRAN_CMPLX: - print_binop_subexp_f (exp, pos, stream, prec, "CMPLX"); - return; - - case BINOP_FORTRAN_MODULO: - print_binop_subexp_f (exp, pos, stream, prec, "MODULO"); - return; - - case FORTRAN_LBOUND: - case FORTRAN_UBOUND: - { - unsigned nargs = longest_to_int (exp->elts[*pos + 1].longconst); - (*pos) += 3; - fprintf_filtered (stream, "%s (", - ((op == FORTRAN_LBOUND) ? "LBOUND" : "UBOUND")); - for (unsigned tem = 0; tem < nargs; tem++) - { - if (tem != 0) - fputs_filtered (", ", stream); - print_subexp (exp, pos, stream, PREC_ABOVE_COMMA); - } - fputs_filtered (")", stream); - return; - } - - case OP_F77_UNDETERMINED_ARGLIST: - (*pos)++; - print_subexp_funcall (exp, pos, stream); - return; - } -} - -/* Special expression dumping for Fortran. */ - -static int -dump_subexp_body_f (struct expression *exp, - struct ui_file *stream, int elt) -{ - int opcode = exp->elts[elt].opcode; - int oplen, nargs, i; - - switch (opcode) - { - default: - return dump_subexp_body_standard (exp, stream, elt); - - case UNOP_FORTRAN_KIND: - case UNOP_FORTRAN_FLOOR: - case UNOP_FORTRAN_CEILING: - case UNOP_FORTRAN_ALLOCATED: - case BINOP_FORTRAN_CMPLX: - case BINOP_FORTRAN_MODULO: - operator_length_f (exp, (elt + 1), &oplen, &nargs); - break; - - case FORTRAN_LBOUND: - case FORTRAN_UBOUND: - operator_length_f (exp, (elt + 3), &oplen, &nargs); - break; - - case OP_F77_UNDETERMINED_ARGLIST: - return dump_subexp_body_funcall (exp, stream, elt + 1); - } - - elt += oplen; - for (i = 0; i < nargs; i += 1) - elt = dump_subexp (exp, stream, elt); - - return elt; -} - -/* Special expression checking for Fortran. */ - -static int -operator_check_f (struct expression *exp, int pos, - int (*objfile_func) (struct objfile *objfile, - void *data), - void *data) -{ - const union exp_element *const elts = exp->elts; - - switch (elts[pos].opcode) - { - case UNOP_FORTRAN_KIND: - case UNOP_FORTRAN_FLOOR: - case UNOP_FORTRAN_CEILING: - case UNOP_FORTRAN_ALLOCATED: - case BINOP_FORTRAN_CMPLX: - case BINOP_FORTRAN_MODULO: - case FORTRAN_LBOUND: - case FORTRAN_UBOUND: - /* Any references to objfiles are held in the arguments to this - expression, not within the expression itself, so no additional - checking is required here, the outer expression iteration code - will take care of checking each argument. */ - break; - - default: - return operator_check_standard (exp, pos, objfile_func, data); - } - - return 0; -} - -/* Expression processing for Fortran. */ -const struct exp_descriptor f_language::exp_descriptor_tab = -{ - print_subexp_f, - operator_length_f, - operator_check_f, - dump_subexp_body_f, - evaluate_subexp_f -}; - /* See language.h. */ void diff --git a/gdb/f-lang.h b/gdb/f-lang.h index 9174d8df899..03b59102139 100644 --- a/gdb/f-lang.h +++ b/gdb/f-lang.h @@ -220,11 +220,6 @@ class f_language : public language_defn /* See language.h. */ - const struct exp_descriptor *expression_ops () const override - { return &exp_descriptor_tab; } - - /* See language.h. */ - const struct op_print *opcode_print_table () const override { return op_print_tab; } @@ -236,11 +231,6 @@ class f_language : public language_defn (const lookup_name_info &lookup_name) const override; private: - /* Table of expression handling functions for use by EXPRESSION_OPS - member function. */ - - static const struct exp_descriptor exp_descriptor_tab; - /* Table of opcode data for use by OPCODE_PRINT_TABLE member function. */ static const struct op_print op_print_tab[]; -- 2.26.2